VCL画图实例

代码下载：
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.