1 // SPDX-License-Identifier: GPL-3.0-only
2 unit UToolBrush;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 Classes, SysUtils, UToolBasic, BGRABitmapTypes, BGRABitmap, UTool,
10 UBrushType, LCVectorialFill;
11
12 type
13
14 { TToolGenericBrush }
15
16 TToolGenericBrush = class(TToolPen)
17 private
GetBrushInfonull18 function GetBrushInfo: TLazPaintBrush;
19 protected
20 brushOrigin: TPointF;
21 originDrawn: boolean;
22 defaultBrush: TLazPaintBrush;
DrawBrushAtnull23 function DrawBrushAt(toolDest: TBGRABitmap; x, y: single): TRect; virtual; abstract;
24 procedure PrepareBrush(rightBtn: boolean); virtual; abstract;
25 procedure ReleaseBrush; virtual; abstract;
StartDrawingnull26 function StartDrawing(toolDest: TBGRABitmap; ptF: TPointF; rightBtn: boolean): TRect; override;
ContinueDrawingnull27 function ContinueDrawing(toolDest: TBGRABitmap; {%H-}originF, destF: TPointF; {%H-}rightBtn: boolean): TRect; override;
GetBrushAlphanull28 function GetBrushAlpha(AAlpha: byte): byte;
GetLayerOffsetnull29 function GetLayerOffset: TPoint; override;
30 public
31 constructor Create(AManager: TToolManager); override;
ToolUpnull32 function ToolUp: TRect; override;
SubPixelAccuracynull33 function SubPixelAccuracy: boolean; virtual;
34 destructor Destroy; override;
35 property BrushInfo: TLazPaintBrush read GetBrushInfo;
36 end;
37
38 { TToolBrush }
39
40 TToolBrush = class(TToolGenericBrush)
41 protected
42 coloredBrushImage: TBGRABitmap;
DrawBrushAtnull43 function DrawBrushAt(toolDest: TBGRABitmap; x, y: single): TRect; override;
44 procedure PrepareBrush({%H-}rightBtn: boolean); override;
45 procedure ReleaseBrush; override;
GetAllowedForeFillTypesnull46 function GetAllowedForeFillTypes: TVectorialFillTypes; override;
GetAllowedBackFillTypesnull47 function GetAllowedBackFillTypes: TVectorialFillTypes; override;
48 public
49 destructor Destroy; override;
GetContextualToolbarsnull50 function GetContextualToolbars: TContextualToolbars; override;
51 end;
52
53 { TToolClone }
54
55 TToolClone = class(TToolGenericBrush)
56 protected
57 definingSource: boolean;
58 class var sourceLayerId: integer;
59 class var sourcePosition: TPoint;
60 class var sourcePositionRelative: boolean;
61 class var sourceFlattened: boolean;
62 class var sourceDefined: boolean;
PickColorWithShiftnull63 function PickColorWithShift: boolean; override;
DrawBrushAtnull64 function DrawBrushAt(toolDest: TBGRABitmap; x, y: single): TRect; override;
65 procedure PrepareBrush(rightBtn: boolean); override;
66 procedure ReleaseBrush; override;
DoToolMovenull67 function DoToolMove(toolDest: TBGRABitmap; pt: TPoint; ptF: TPointF): TRect; override;
DoToolShiftClicknull68 function DoToolShiftClick({%H-}toolDest: TBGRABitmap; {%H-}ptF: TPointF; {%H-}rightBtn: boolean): TRect; override;
69 public
SubPixelAccuracynull70 function SubPixelAccuracy: boolean; override;
71 constructor Create(AManager: TToolManager); override;
72 destructor Destroy; override;
GetContextualToolbarsnull73 function GetContextualToolbars: TContextualToolbars; override;
Rendernull74 function Render(VirtualScreen: TBGRABitmap; VirtualScreenWidth, VirtualScreenHeight: integer;
75 BitmapToVirtualScreen: TBitmapToVirtualScreenFunction): TRect; override;
76 end;
77
78 implementation
79
80 uses Math, UGraph, UResourceStrings, Graphics, LazPaintType;
81
82 { TToolClone }
83
TToolClone.PickColorWithShiftnull84 function TToolClone.PickColorWithShift: boolean;
85 begin
86 Result:= false;
87 end;
88
DrawBrushAtnull89 function TToolClone.DrawBrushAt(toolDest: TBGRABitmap; x, y: single): TRect;
90 var source: TBGRABitmap;
91 sourceOfs: TPoint;
92 sourceIdx: Integer;
93 begin
94 if definingSource then
95 begin
96 sourceOfs := Manager.Image.LayerOffset[Manager.Image.CurrentLayerIndex];
97 sourcePosition := Point(round(x) + sourceOfs.x,round(y) + sourceOfs.y);
98 sourceLayerId := Manager.Image.LayerId[Manager.Image.CurrentLayerIndex];
99 sourcePositionRelative:= false;
100 sourceFlattened := ssShift in ShiftState;
101 sourceDefined := true;
102 result := OnlyRenderChange;
103 end else
104 begin
105 if not sourceDefined then
106 begin
107 Manager.ToolPopup(tpmRightClickForSource, 0, true);
108 result := EmptyRect;
109 exit;
110 end;
111 if (ssShift in ShiftState) or sourceFlattened then
112 begin
113 source := Manager.Image.RenderedImage;
114 sourceOfs := Point(0,0);
115 end else
116 begin
117 sourceIdx := Manager.Image.GetLayerIndexById(sourceLayerId);
118 if sourceIdx = -1 then
119 begin
120 Manager.ToolPopup(tpmRightClickForSource, 0, true);
121 result := EmptyRect;
122 exit;
123 end;
124 source := Manager.Image.LayerBitmap[sourceIdx];
125 sourceOfs := Manager.Image.LayerOffset[sourceIdx];
126 end;
127 if not SubPixelAccuracy then
128 begin
129 x := round(x);
130 y := round(y);
131 end;
132 if not sourcePositionRelative then
133 begin
134 sourcePosition.x -= round(x) + sourceOfs.x;
135 sourcePosition.y -= round(y) + sourceOfs.y;
136 sourcePositionRelative := true;
137 end;
138 with BrushInfo.BrushImage do
139 begin
140 x -= (Width-1)/2;
141 y -= (Height-1)/2;
142 result := rect(floor(x-0.5),floor(y-0.5),ceil(x+0.5)+Width,ceil(y+0.5)+Height);
143 end;
144 toolDest.ClipRect := result;
145 source.ScanOffset := Point(sourcePosition.x, sourcePosition.y);
146 toolDest.FillMask(round(x),round(y),BrushInfo.BrushImage,source,dmDrawWithTransparency,Manager.ApplyPressure(255));
147 source.ScanOffset := Point(0,0);
148 toolDest.NoClip;
149 end;
150 end;
151
152 procedure TToolClone.PrepareBrush(rightBtn: boolean);
153 begin
154 definingSource := rightBtn;
155 end;
156
157 procedure TToolClone.ReleaseBrush;
158 begin
159
160 end;
161
DoToolMovenull162 function TToolClone.DoToolMove(toolDest: TBGRABitmap; pt: TPoint; ptF: TPointF
163 ): TRect;
164 begin
165 Manager.ToolPopup(tpmRightClickForSource);
166 Result:=inherited DoToolMove(toolDest, pt, ptF);
167 end;
168
TToolClone.DoToolShiftClicknull169 function TToolClone.DoToolShiftClick(toolDest: TBGRABitmap; ptF: TPointF;
170 rightBtn: boolean): TRect;
171 begin
172 Result:= EmptyRect;
173 end;
174
SubPixelAccuracynull175 function TToolClone.SubPixelAccuracy: boolean;
176 begin
177 Result:=false;
178 end;
179
180 constructor TToolClone.Create(AManager: TToolManager);
181 begin
182 inherited Create(AManager);
183 end;
184
185 destructor TToolClone.Destroy;
186 begin
187 inherited Destroy;
188 end;
189
TToolClone.GetContextualToolbarsnull190 function TToolClone.GetContextualToolbars: TContextualToolbars;
191 begin
192 Result:= [ctPenWidth,ctBrush];
193 end;
194
Rendernull195 function TToolClone.Render(VirtualScreen: TBGRABitmap; VirtualScreenWidth,
196 VirtualScreenHeight: integer;
197 BitmapToVirtualScreen: TBitmapToVirtualScreenFunction): TRect;
198 var sourcePosF: TPointF;
199 begin
200 Result:=inherited Render(VirtualScreen, VirtualScreenWidth,
201 VirtualScreenHeight, BitmapToVirtualScreen);
202 if not sourcePositionRelative and (sourceFlattened or
203 (Manager.Image.LayerBitmapById[sourceLayerId] <> nil)) then
204 begin
205 sourcePosF := BitmapToVirtualScreen(PointF(sourcePosition.X mod Manager.Image.Width,
206 sourcePosition.Y mod Manager.Image.Height));
207 result := RectUnion(result,NicePoint(VirtualScreen, sourcePosF.X,sourcePosF.Y));
208 if sourcePosF.Y > virtualScreenHeight/2 then
209 result := RectUnion(result,NiceText(VirtualScreen, round(sourcePosF.X),round(sourcePosF.Y-6), VirtualScreenWidth,VirtualScreenHeight, rsSourcePosition, taCenter, tlBottom))
210 else
211 result := RectUnion(result,NiceText(VirtualScreen, round(sourcePosF.X),round(sourcePosF.Y+6), VirtualScreenWidth,VirtualScreenHeight, rsSourcePosition, taCenter, tlTop));
212 end;
213 end;
214
215 { TToolBrush }
216
DrawBrushAtnull217 function TToolBrush.DrawBrushAt(toolDest: TBGRABitmap; x, y: single): TRect;
218 begin
219 if not Assigned(coloredBrushImage) then
220 begin
221 result := EmptyRect;
222 exit;
223 end;
224 if not SubPixelAccuracy then
225 begin
226 x := round(x);
227 y := round(y);
228 end;
229 x -= (coloredBrushImage.Width-1)/2;
230 y -= (coloredBrushImage.Height-1)/2;
231 result := rect(floor(x-0.5),floor(y-0.5),ceil(x+0.5)+coloredBrushImage.Width,ceil(y+0.5)+coloredBrushImage.Height);
232 toolDest.ClipRect := result;
233 if not SubPixelAccuracy then
234 toolDest.PutImage(round(x),round(y),coloredBrushImage,dmDrawWithTransparency,GetBrushAlpha(Manager.ApplyPressure(255)))
235 else
236 toolDest.PutImageSubpixel(x,y,coloredBrushImage,GetBrushAlpha(Manager.ApplyPressure(255)));
237 toolDest.NoClip;
238 end;
239
240 procedure TToolBrush.PrepareBrush(rightBtn: boolean);
241 var
242 penColor: TBGRAPixel;
243 begin
244 FreeAndNil(coloredBrushImage);
245 if rightBtn then penColor := Manager.BackColor else penColor := Manager.ForeColor;
246 coloredBrushImage := BrushInfo.MakeColoredBrushImage(BGRA(penColor.red,penColor.green,penColor.blue,GetBrushAlpha(penColor.alpha)));
247 end;
248
249 procedure TToolBrush.ReleaseBrush;
250 begin
251 FreeAndNil(coloredBrushImage);
252 end;
253
TToolBrush.GetAllowedForeFillTypesnull254 function TToolBrush.GetAllowedForeFillTypes: TVectorialFillTypes;
255 begin
256 Result:= [vftSolid];
257 end;
258
TToolBrush.GetAllowedBackFillTypesnull259 function TToolBrush.GetAllowedBackFillTypes: TVectorialFillTypes;
260 begin
261 Result:= [vftSolid];
262 end;
263
264 destructor TToolBrush.Destroy;
265 begin
266 ReleaseBrush;
267 inherited Destroy;
268 end;
269
GetContextualToolbarsnull270 function TToolBrush.GetContextualToolbars: TContextualToolbars;
271 begin
272 Result:= [ctPenFill,ctBackFill,ctPenWidth,ctBrush];
273 end;
274
275 { TToolGenericBrush }
276
TToolGenericBrush.GetBrushInfonull277 function TToolGenericBrush.GetBrushInfo: TLazPaintBrush;
278 begin
279 result := manager.BrushInfo;
280 if result = nil then
281 begin
282 if defaultBrush = nil then
283 defaultBrush := TLazPaintBrush.Create;
284 result := defaultBrush;
285 end;
286 result.Size := manager.PenWidth;
287 end;
288
StartDrawingnull289 function TToolGenericBrush.StartDrawing(toolDest: TBGRABitmap; ptF: TPointF;
290 rightBtn: boolean): TRect;
291 begin
292 if not SubPixelAccuracy then
293 brushOrigin:= PointF(round(ptF.x),round(ptF.y))
294 else brushOrigin := ptF;
295 originDrawn := false;
296 PrepareBrush(rightBtn);
297 result := ContinueDrawing(toolDest, brushOrigin, brushOrigin, rightBtn);
298 end;
299
TToolGenericBrush.ContinueDrawingnull300 function TToolGenericBrush.ContinueDrawing(toolDest: TBGRABitmap; originF,
301 destF: TPointF; rightBtn: boolean): TRect;
302 var v: TPointF;
303 count: integer;
304 len, minLen: single;
305
306 begin
307 result := EmptyRect;
308 if not originDrawn then //and ((destF <> brushOrigin) or not Manager.ToolBrushOriented) then
309 begin
310 result := RectUnion(result, DrawBrushAt(toolDest, brushOrigin.x,brushOrigin.y));
311 originDrawn:= true;
312 end;
313 if destF<>brushOrigin then
314 begin
315 v := destF-brushOrigin;
316 if not SubPixelAccuracy then
317 len := max(abs(v.x),abs(v.y))
318 else
319 len := sqrt(v*v);
320 minLen := round(power(BrushInfo.Size/10,0.8));
321 if minLen < 1 then minLen := 1;
322 if minLen > 5 then minLen := 5;
323 minLen *=Manager.BrushSpacing;
324 if len >= minLen then
325 begin
326 v := v*(1/len)*minLen;
327 count := trunc(len/minLen);
328 while count > 0 do
329 begin
330 brushOrigin += v;
331 result := RectUnion(result, DrawBrushAt(toolDest, brushOrigin.x,brushOrigin.y));
332 originDrawn:= true;
333 dec(count);
334 end;
335 end;
336 end;
337 end;
338
GetBrushAlphanull339 function TToolGenericBrush.GetBrushAlpha(AAlpha: byte): byte;
340 var exponent: single;
341 begin
342 exponent := (BrushInfo.Size-1)/10+1;
343 if exponent > 2 then exponent := 2;
344 result := round(Power(AAlpha/255,exponent)*255)
345 end;
346
GetLayerOffsetnull347 function TToolGenericBrush.GetLayerOffset: TPoint;
348 begin
349 if IsSelectingTool or not Manager.Image.SelectionMaskEmpty then
350 result := Manager.Image.LayerOffset[Manager.Image.CurrentLayerIndex]
351 else
352 result := Point(0,0);
353 end;
354
355 constructor TToolGenericBrush.Create(AManager: TToolManager);
356 begin
357 inherited Create(AManager);
358 end;
359
TToolGenericBrush.ToolUpnull360 function TToolGenericBrush.ToolUp: TRect;
361 var penWasDrawing: boolean;
362 begin
363 penWasDrawing:= penDrawing;
364 Result:=inherited ToolUp;
365 if not penDrawing and penWasDrawing then ReleaseBrush;
366 end;
367
SubPixelAccuracynull368 function TToolGenericBrush.SubPixelAccuracy: boolean;
369 begin
370 result := BrushInfo.Size < 10;
371 end;
372
373 destructor TToolGenericBrush.Destroy;
374 begin
375 FreeAndNil(defaultBrush);
376 inherited Destroy;
377 end;
378
379 initialization
380
381 RegisterTool(ptBrush,TToolBrush);
382 RegisterTool(ptClone,TToolClone);
383
384 TToolClone.sourceLayerId := -1;
385
386 end.
387
388