1 unitUnit1;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; varKey: Char);38 procedureLEPenStartSizeMouseLeave(Sender: TObject);39 procedureLEPenStartSizeChange(Sender: TObject);40 procedureIMCanvasMouseDown(Sender: TObject; Button: TMouseButton;41 Shift: TShiftState; X, Y: Integer);42 procedureFormCreate(Sender: TObject);43 procedureIMCanvasMouseMove(Sender: TObject; Shift: TShiftState; X,44 Y: Integer);45 procedureIMCanvasMouseUp(Sender: TObject; Button: TMouseButton;46 Shift: TShiftState; X, Y: Integer);47 procedureTimer1Timer(Sender: TObject);48 procedureButton1Click(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 procedureTForm1.Button1Click(Sender: TObject);64 begin

65 IMCanvas.Picture := nil;66 end;67

68 procedureTForm1.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 procedureTForm1.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; varKey: Char);109 begin

110 if not ((Key in ['0'..'9']) or (Key=#8)) then Key:=#0;111 end;112

113 procedureTForm1.LEPenStartSizeMouseLeave(Sender: TObject);114 begin

115 if Length((Sender as TLabeledEdit).Text)<1 then (Sender as TLabeledEdit).Text:='1';116 end;117

118 procedureTForm1.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 procedureTForm1.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 procedureTForm1.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 procedureTForm1.Timer1Timer(Sender: TObject);175 begin

176 if MYCanvasData.MouseDownTab then

177 Begin178 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 Begin184 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.