代码下载:
https://download.csdn.net/download/zhujianqiangqq/12394579
代码实例(电脑版、平板版):
1 unit Unit1; 2 3 interface 4 5 uses 6 System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects, 8 FMX.Controls.Presentation, FMX.StdCtrls, FMX.Edit; 9 10 type 11 TCanvasData = record //定义绘制数据数组 12 //画笔可设置的参数 13 PenStartSize: Integer; //画笔开始大小 14 PenMinSize: Integer; //画笔最小大小 15 PenMaxSize: Integer; //画笔最大大小 16 PenMobileBorder: Integer; //移动界限,超过这个值就改变笔大小值 17 PenChangeValue: Integer; //画笔每次改变的大小 18 PenSizeChangeSpeed: Integer;//笔的改变速度,越小改变的速度越快 19 //画图用到的参数 20 PenCurrentSize: Integer; //画笔当前大小 21 PenLastPoint: TPointF; //画笔最后的点 22 PenMobileDistance: TPointF; //画笔移动了多少距离 23 MouseDownTab:Boolean; //鼠标按下标记 24 Yadd:Integer; 25 end; 26 27 TForm1 = class(TForm) 28 IMOriginal: TImage; 29 IMCanvas: TImage; 30 Paint: TPanel; 31 operate: TPanel; 32 Label1: TLabel; 33 Label2: TLabel; 34 Label3: TLabel; 35 Label4: TLabel; 36 Label5: TLabel; 37 Label6: TLabel; 38 LEPenStartSize: TEdit; 39 LEPenMinSize: TEdit; 40 LEPenMaxSize: TEdit; 41 LEPenMobileBorder: TEdit; 42 LEPenChangeValue: TEdit; 43 LEPenSizeChangeSpeed: TEdit; 44 Timer1: TTimer; 45 Button1: TButton; 46 procedure IMCanvasMouseDown(Sender: TObject; Button: TMouseButton; 47 Shift: TShiftState; X, Y: Single); 48 procedure IMCanvasMouseMove(Sender: TObject; Shift: TShiftState; X, 49 Y: Single); 50 procedure FormCreate(Sender: TObject); 51 procedure IMCanvasMouseUp(Sender: TObject; Button: TMouseButton; 52 Shift: TShiftState; X, Y: Single); 53 procedure Timer1Timer(Sender: TObject); 54 procedure LEPenStartSizeChange(Sender: TObject); 55 procedure FormResize(Sender: TObject); 56 procedure Button1Click(Sender: TObject); 57 private 58 { Private declarations } 59 public 60 { Public declarations } 61 end; 62 63 var 64 Form1: TForm1; 65 MYCanvasData: TCanvasData;//定义画笔数据变量 66 67 implementation 68 uses 69 System.UIConsts; 70 71 {$R *.fmx} 72 {$R *.LgXhdpiPh.fmx ANDROID} 73 74 procedure TForm1.LEPenStartSizeChange(Sender: TObject); 75 begin 76 MYCanvasData.PenStartSize := StrToInt(LEPenStartSize.Text); //开始笔头大小 77 MYCanvasData.PenMinSize := StrToInt(LEPenMinSize.Text); //最小笔头 78 MYCanvasData.PenMaxSize := StrToInt(LEPenMaxSize.Text); //最大笔头 79 MYCanvasData.PenMobileBorder := StrToInt(LEPenMobileBorder.Text); //移动距离 超过值时 改变笔头大小 80 MYCanvasData.PenChangeValue := StrToInt(LEPenChangeValue.Text); //每次大小变动的单位 81 MYCanvasData.PenCurrentSize := StrToInt(LEPenSizeChangeSpeed.Text); //笔头 大小 改变的速度 越小速度越快 82 end; 83 84 procedure TForm1.Button1Click(Sender: TObject); 85 begin 86 IMCanvas.Bitmap := nil; 87 IMCanvas.Bitmap.SetSize(Round(IMCanvas.Width), Round(IMCanvas.Height)); 88 end; 89 90 procedure TForm1.FormCreate(Sender: TObject); 91 begin 92 IMOriginal.SendToBack; 93 94 LEPenStartSize.Text := '5'; 95 LEPenMinSize.Text := '4'; 96 LEPenMaxSize.Text := '10'; 97 LEPenMobileBorder.Text := '5'; 98 LEPenChangeValue.Text := '1'; 99 LEPenSizeChangeSpeed.Text := '3'; 100 101 MYCanvasData.PenStartSize := 5; 102 MYCanvasData.PenMinSize := 4; 103 MYCanvasData.PenMaxSize := 10; 104 MYCanvasData.PenMobileBorder := 5; 105 MYCanvasData.PenChangeValue := 1; 106 MYCanvasData.PenSizeChangeSpeed := 3; 107 108 LEPenStartSize.OnChange := LEPenStartSizeChange; 109 LEPenMinSize.OnChange := LEPenStartSizeChange; 110 LEPenMaxSize.OnChange := LEPenStartSizeChange; 111 LEPenMobileBorder.OnChange := LEPenStartSizeChange; 112 LEPenChangeValue.OnChange := LEPenStartSizeChange; 113 LEPenSizeChangeSpeed.OnChange := LEPenStartSizeChange; 114 115 IMCanvas.Bitmap.SetSize(Round(IMCanvas.Width), Round(IMCanvas.Height)); 116 // IMCanvas.Bitmap.Clear(TAlphaColors.White); 117 end; 118 119 procedure TForm1.FormResize(Sender: TObject); 120 begin 121 IMCanvas.Bitmap.SetSize(Round(IMCanvas.Width), Round(IMCanvas.Height)); 122 end; 123 124 procedure TForm1.IMCanvasMouseDown(Sender: TObject; Button: TMouseButton; 125 Shift: TShiftState; X, Y: Single); 126 begin 127 case Button of 128 TMouseButton.mbLeft: 129 begin 130 MYCanvasData.PenCurrentSize := MYCanvasData.PenStartSize; 131 MYCanvasData.PenMobileDistance.X := -1; 132 MYCanvasData.PenLastPoint.X := X; 133 MYCanvasData.PenLastPoint.Y := Y; 134 //Yadd:=1; 135 MYCanvasData.MouseDownTab := True; 136 end; 137 TMouseButton.mbRight: ; 138 TMouseButton.mbMiddle: ; 139 end; 140 end; 141 142 procedure TForm1.IMCanvasMouseMove(Sender: TObject; Shift: TShiftState; X, 143 Y: Single); 144 var 145 p1, p2: TPointF; 146 begin 147 Form1.Caption:='当前笔头大小:' + IntToStr(MYCanvasData.PenCurrentSize); 148 if MYCanvasData.MouseDownTab then 149 begin 150 IMCanvas.Bitmap.Canvas.BeginScene; 151 IMCanvas.Bitmap.Canvas.Stroke.Thickness := MYCanvasData.PenCurrentSize; 152 IMCanvas.Bitmap.Canvas.Stroke.Cap := TStrokeCap.Round; 153 154 p1 := TPointF.Create(MYCanvasData.PenLastPoint.X, MYCanvasData.PenLastPoint.Y); 155 p2 := TPointF.Create(X, Y); 156 157 IMCanvas.Bitmap.Canvas.DrawLine(p1, p2, 100); 158 IMCanvas.Bitmap.Canvas.EndScene; 159 160 MYCanvasData.PenLastPoint.X := X; 161 MYCanvasData.PenLastPoint.Y := Y; 162 end; 163 end; 164 165 procedure TForm1.IMCanvasMouseUp(Sender: TObject; Button: TMouseButton; 166 Shift: TShiftState; X, Y: Single); 167 begin 168 case Button of 169 TMouseButton.mbLeft: MYCanvasData.MouseDownTab := False; 170 TMouseButton.mbRight:; 171 TMouseButton.mbMiddle:; 172 end; 173 end; 174 175 procedure TForm1.Timer1Timer(Sender: TObject); 176 begin 177 if MYCanvasData.MouseDownTab then 178 Begin 179 if MYCanvasData.PenMobileDistance.X > -1 then 180 begin 181 Inc(MYCanvasData.Yadd); 182 if (Abs(MYCanvasData.PenMobileDistance.X - MYCanvasData.PenLastPoint.X) < MYCanvasData.PenMobileBorder) and 183 (Abs(MYCanvasData.PenMobileDistance.Y - MYCanvasData.PenLastPoint.Y) < MYCanvasData.PenMobileBorder) then 184 Begin 185 if (MYCanvasData.Yadd >= MYCanvasData.PenSizeChangeSpeed) then 186 if (MYCanvasData.PenCurrentSize < MYCanvasData.PenMaxSize) then 187 begin 188 MYCanvasData.PenCurrentSize := MYCanvasData.PenCurrentSize + MYCanvasData.PenChangeValue; 189 MYCanvasData.Yadd:=1; 190 end; 191 end 192 else 193 begin 194 if (MYCanvasData.Yadd >= MYCanvasData.PenSizeChangeSpeed) then 195 if (MYCanvasData.PenCurrentSize > MYCanvasData.PenMinSize) then 196 begin 197 MYCanvasData.PenCurrentSize := MYCanvasData.PenCurrentSize - MYCanvasData.PenChangeValue; 198 MYCanvasData.Yadd := 1; 199 end; 200 end; 201 end; 202 MYCanvasData.PenMobileDistance.X := MYCanvasData.PenLastPoint.X; 203 MYCanvasData.PenMobileDistance.Y := MYCanvasData.PenLastPoint.Y; 204 End; 205 end; 206 207 end.
代码实例(手机版):
1 procedure TForm1.FormCreate(Sender: TObject); 2 begin 3 IMOriginal.SendToBack; 4 5 LEPenStartSize.Text := '2';//'5'; 6 LEPenMinSize.Text := '2';//'4'; 7 LEPenMaxSize.Text := '5';//'10'; 8 LEPenMobileBorder.Text := '20';//'5'; 9 LEPenChangeValue.Text := '1';//'1'; 10 LEPenSizeChangeSpeed.Text := '1'; 11 12 MYCanvasData.PenStartSize := 2; 13 MYCanvasData.PenMinSize := 2; 14 MYCanvasData.PenMaxSize := 5; 15 MYCanvasData.PenMobileBorder := 20;//'5'; 16 MYCanvasData.PenChangeValue := 1; 17 MYCanvasData.PenSizeChangeSpeed := 1; 18 19 LEPenStartSize.OnChange := LEPenStartSizeChange; 20 LEPenMinSize.OnChange := LEPenStartSizeChange; 21 LEPenMaxSize.OnChange := LEPenStartSizeChange; 22 LEPenMobileBorder.OnChange := LEPenStartSizeChange; 23 LEPenChangeValue.OnChange := LEPenStartSizeChange; 24 LEPenSizeChangeSpeed.OnChange := LEPenStartSizeChange; 25 26 IMCanvas.Bitmap.SetSize(Round(IMCanvas.Width), Round(IMCanvas.Height)); 27 // IMCanvas.Bitmap.Clear(TAlphaColors.White); 28 end; 29 30 procedure TForm1.IMCanvasMouseMove(Sender: TObject; Shift: TShiftState; X, 31 Y: Single); 32 var 33 p1, p2: TPointF; 34 begin 35 Form1.Caption:='当前笔头大小:' + FloatToStr(MYCanvasData.PenCurrentSize); 36 if MYCanvasData.MouseDownTab then 37 begin 38 IMCanvas.Bitmap.Canvas.BeginScene; 39 IMCanvas.Bitmap.Canvas.Stroke.Thickness := MYCanvasData.PenCurrentSize; 40 IMCanvas.Bitmap.Canvas.Stroke.Cap := TStrokeCap.Round; 41 42 p1 := TPointF.Create(MYCanvasData.PenLastPoint.X/3, MYCanvasData.PenLastPoint.Y/3); 43 p2 := TPointF.Create(X/3, Y/3); 44 45 IMCanvas.Bitmap.Canvas.DrawLine(p1, p2, 1); 46 IMCanvas.Bitmap.Canvas.EndScene; 47 48 MYCanvasData.PenLastPoint.X := X; 49 MYCanvasData.PenLastPoint.Y := Y; 50 end; 51 end;