代码下载：
https://download.csdn.net/download/zhujianqiangqq/12394576
代码实例：
1 unit Unit1;
2
3 interface
4
5 uses
6 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
8 type
9 TCanvasData = record //定义绘制数据数组
10 //画笔可设置的参数
11 PenStartSize: Integer; //画笔开始大小
12 PenMinSize: Integer; //画笔最小大小
13 PenMaxSize: Integer; //画笔最大大小
14 PenMobileBorder: Integer; //移动界限，超过这个值就改变笔大小值
15 PenChangeValue: Integer; //画笔每次改变的大小
16 PenSizeChangeSpeed: Integer;//笔的改变速度，越小改变的速度越快
17 //画图用到的参数
18 PenCurrentSize: Integer; //画笔当前大小
19 PenLastPoint: TPoint; //画笔最后的点
20 PenMobileDistance: TPoint; //画笔移动了多少距离
21 MouseDownTab:Boolean; //鼠标按下标记
22 Yadd:Integer;
23 end;
24
25 type
26 TForm1 = class(TForm)
27 LEPenStartSize: TLabeledEdit;
28 LEPenChangeValue: TLabeledEdit;
29 LEPenMinSize: TLabeledEdit;
30 LEPenMaxSize: TLabeledEdit;
31 LEPenMobileBorder: TLabeledEdit;
32 LEPenSizeChangeSpeed: TLabeledEdit;
33 IMCanvas: TImage;
34 Timer1: TTimer;
35 IMOriginal: TImage;
36 Button1: TButton;
37 procedure LEPenStartSizeKeyPress(Sender: TObject; var Key: Char);
38 procedure LEPenStartSizeMouseLeave(Sender: TObject);
39 procedure LEPenStartSizeChange(Sender: TObject);
40 procedure IMCanvasMouseDown(Sender: TObject; Button: TMouseButton;
41 Shift: TShiftState; X, Y: Integer);
42 procedure FormCreate(Sender: TObject);
43 procedure IMCanvasMouseMove(Sender: TObject; Shift: TShiftState; X,
44 Y: Integer);
45 procedure IMCanvasMouseUp(Sender: TObject; Button: TMouseButton;
46 Shift: TShiftState; X, Y: Integer);
47 procedure Timer1Timer(Sender: TObject);
48 procedure Button1Click(Sender: TObject);
49 private
50 { Private declarations }
51 public
52 { Public declarations }
53 end;
54
55 var
56 Form1: TForm1;
57 MYCanvasData: TCanvasData;//定义画笔数据变量
58
59 implementation
60 uses Winapi.GDIPAPI, Winapi.GDIPOBJ{, Winapi.GDIPUTIL};
61 {$R *.dfm}
62
63 procedure TForm1.Button1Click(Sender: TObject);
64 begin
65 IMCanvas.Picture := nil;
66 end;
67
68 procedure TForm1.FormCreate(Sender: TObject);
69 begin
70 IMOriginal.Height := IMCanvas.Height;
71 IMOriginal.Width := IMCanvas.Width;
72 IMOriginal.Top := 0;
73 IMOriginal.Left := 0;
74 IMOriginal.SendToBack;
75
76 LEPenStartSize.Text := '5';
77 LEPenMinSize.Text := '4';
78 LEPenMaxSize.Text := '10';
79 LEPenMobileBorder.Text := '5';
80 LEPenChangeValue.Text := '1';
81 LEPenSizeChangeSpeed.Text := '3';
82
83 MYCanvasData.PenStartSize := 5;
84 MYCanvasData.PenMinSize := 4;
85 MYCanvasData.PenMaxSize := 10;
86 MYCanvasData.PenMobileBorder := 5;
87 MYCanvasData.PenChangeValue := 1;
88 MYCanvasData.PenSizeChangeSpeed := 3;
89
90 LEPenStartSize.OnChange := LEPenStartSizeChange;
91 LEPenMinSize.OnChange := LEPenStartSizeChange;
92 LEPenMaxSize.OnChange := LEPenStartSizeChange;
93 LEPenMobileBorder.OnChange := LEPenStartSizeChange;
94 LEPenChangeValue.OnChange := LEPenStartSizeChange;
95 LEPenSizeChangeSpeed.OnChange := LEPenStartSizeChange;
96 end;
97
98 procedure TForm1.LEPenStartSizeChange(Sender: TObject);
99 begin
100 MYCanvasData.PenStartSize := StrToInt(LEPenStartSize.Text); //开始笔头大小
101 MYCanvasData.PenMinSize := StrToInt(LEPenMinSize.Text); //最小笔头
102 MYCanvasData.PenMaxSize := StrToInt(LEPenMaxSize.Text); //最大笔头
103 MYCanvasData.PenMobileBorder := StrToInt(LEPenMobileBorder.Text); //移动距离 超过值时 改变笔头大小
104 MYCanvasData.PenChangeValue := StrToInt(LEPenChangeValue.Text); //每次大小变动的单位
105 MYCanvasData.PenCurrentSize := StrToInt(LEPenSizeChangeSpeed.Text); //笔头 大小 改变的速度 越小速度越快
106 end;
107
108 procedure TForm1.LEPenStartSizeKeyPress(Sender: TObject; var Key: Char);
109 begin
110 if not ((Key in ['0'..'9']) or (Key=#8)) then Key:=#0;
111 end;
112
113 procedure TForm1.LEPenStartSizeMouseLeave(Sender: TObject);
114 begin
115 if Length((Sender as TLabeledEdit).Text)<1 then (Sender as TLabeledEdit).Text:='1';
116 end;
117
118 procedure TForm1.IMCanvasMouseDown(Sender: TObject; Button: TMouseButton;
119 Shift: TShiftState; X, Y: Integer);
120 begin
121 case Button of
122 mbLeft:begin
123 MYCanvasData.PenCurrentSize := MYCanvasData.PenStartSize;
124 MYCanvasData.PenMobileDistance.X := -1;
125 MYCanvasData.PenLastPoint.X := X;
126 MYCanvasData.PenLastPoint.Y := Y;
127 // Yadd:=1;
128 MYCanvasData.MouseDownTab := True;
129 end;
130 mbRight: ;
131 mbMiddle:;
132 end;
133 end;
134
135
136 procedure TForm1.IMCanvasMouseMove(Sender: TObject; Shift: TShiftState; X,
137 Y: Integer);
138 var
139 graphics: TGPGraphics;
140 pen: TGPPen;
141 begin
142 Form1.Caption:='当前笔头大小:' + IntToStr(MYCanvasData.PenCurrentSize);
143 if MYCanvasData.MouseDownTab then
144 begin
145 graphics := TGPGraphics.Create(Canvas.Handle);
146 try
147 pen := TGPPen.Create(aclBlack, MYCanvasData.PenCurrentSize);
148 try
149 pen.SetStartCap(LineCapRound); //设置线帽，让线看起来更圆润
150 pen.SetEndCap(LineCapRound);
151 graphics.SetSmoothingMode(SmoothingModeHighQuality); //抗锯齿
152 graphics.DrawLine(pen, MYCanvasData.PenLastPoint.X, MYCanvasData.PenLastPoint.Y, X, Y); //画线
153 MYCanvasData.PenLastPoint.X := X;
154 MYCanvasData.PenLastPoint.Y := Y;
155 finally
156 pen.Free;
157 end;
158 finally
159 graphics.Free;
160 end;
161 end;
162 end;
163
164 procedure TForm1.IMCanvasMouseUp(Sender: TObject; Button: TMouseButton;
165 Shift: TShiftState; X, Y: Integer);
166 begin
167 case Button of
168 mbLeft: MYCanvasData.MouseDownTab := False;
169 mbRight: ;
170 mbMiddle:;
171 end;
172 end;
173
174 procedure TForm1.Timer1Timer(Sender: TObject);
175 begin
176 if MYCanvasData.MouseDownTab then
177 Begin
178 if MYCanvasData.PenMobileDistance.X > -1 then
179 begin
180 Inc(MYCanvasData.Yadd);
181 if (Abs(MYCanvasData.PenMobileDistance.X - MYCanvasData.PenLastPoint.X) < MYCanvasData.PenMobileBorder) and
182 (Abs(MYCanvasData.PenMobileDistance.Y - MYCanvasData.PenLastPoint.Y) < MYCanvasData.PenMobileBorder) then
183 Begin
184 if (MYCanvasData.Yadd >= MYCanvasData.PenSizeChangeSpeed) then
185 if (MYCanvasData.PenCurrentSize < MYCanvasData.PenMaxSize) then
186 begin
187 MYCanvasData.PenCurrentSize := MYCanvasData.PenCurrentSize + MYCanvasData.PenChangeValue;
188 MYCanvasData.Yadd:=1;
189 end;
190 end
191 else
192 begin
193 if (MYCanvasData.Yadd >= MYCanvasData.PenSizeChangeSpeed) then
194 if (MYCanvasData.PenCurrentSize > MYCanvasData.PenMinSize) then
195 begin
196 MYCanvasData.PenCurrentSize := MYCanvasData.PenCurrentSize - MYCanvasData.PenChangeValue;
197 MYCanvasData.Yadd := 1;
198 end;
199 end;
200 end;
201 MYCanvasData.PenMobileDistance.X := MYCanvasData.PenLastPoint.X;
202 MYCanvasData.PenMobileDistance.Y := MYCanvasData.PenLastPoint.Y;
203 End;
204 end;
205
206
207 end.
来源：oschina
链接：https://my.oschina.net/u/4303145/blog/4268924