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.

總結

以上是生活随笔為你收集整理的计算机中丢失vcl190,VCL画图实例的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。