1 // SPDX-License-Identifier: GPL-3.0-only
2 unit UToolText;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 Classes, SysUtils, UTool, UToolVectorial, LCLType, Graphics, BGRABitmap, BGRABitmapTypes, BGRATextFX,
10 BGRAGradients, LCVectorOriginal;
11
12 type
13
14 { TToolText }
15
16 TToolText = class(TVectorialTool)
17 protected
18 FMatrix: TAffineMatrix;
19 FPrevShadow: boolean;
20 FPrevShadowOffset: TPoint;
21 FPrevShadowRadius: single;
ShapeClassnull22 function ShapeClass: TVectorShapeAny; override;
AlwaysRasterizeShapenull23 function AlwaysRasterizeShape: boolean; override;
24 procedure IncludeShadowBounds(var ARect: TRect);
GetCustomShapeBoundsnull25 function GetCustomShapeBounds(ADestBounds: TRect; AMatrix: TAffineMatrix; ADraft: boolean): TRect; override;
26 procedure DrawCustomShape(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); override;
27 procedure ShapeChange(ASender: TObject; ABounds: TRectF; ADiff: TVectorShapeDiff); override;
28 procedure ShapeEditingChange(ASender: TObject); override;
29 procedure AssignShapeStyle(AMatrix: TAffineMatrix; AAlwaysFit: boolean); override;
30 procedure QuickDefineEnd; override;
RoundCoordinatenull31 function RoundCoordinate(constref ptF: TPointF): TPointF; override;
DoToolKeyDownnull32 function DoToolKeyDown(var key: Word): TRect; override;
33 public
34 constructor Create(AManager: TToolManager); override;
GetContextualToolbarsnull35 function GetContextualToolbars: TContextualToolbars; override;
ToolCommandnull36 function ToolCommand(ACommand: TToolCommand): boolean; override;
ToolProvideCommandnull37 function ToolProvideCommand(ACommand: TToolCommand): boolean; override;
38 end;
39
40 implementation
41
42 uses LCVectorTextShapes, BGRALayerOriginal, BGRATransform, BGRAGrayscaleMask,
43 ugraph, math;
44
45 { TToolText }
46
ShapeClassnull47 function TToolText.ShapeClass: TVectorShapeAny;
48 begin
49 result := TTextShape;
50 end;
51
AlwaysRasterizeShapenull52 function TToolText.AlwaysRasterizeShape: boolean;
53 begin
54 Result:= Manager.TextShadow;
55 end;
56
57 procedure TToolText.IncludeShadowBounds(var ARect: TRect);
58 var
59 shadowRect: TRect;
60 begin
61 if Manager.TextShadow then
62 begin
63 shadowRect := ARect;
64 shadowRect.Inflate(ceil(Manager.TextShadowBlurRadius),ceil(Manager.TextShadowBlurRadius));
65 shadowRect.Offset(Manager.TextShadowOffset.X,Manager.TextShadowOffset.Y);
66 ARect := RectUnion(ARect, shadowRect);
67 end;
68 end;
69
GetCustomShapeBoundsnull70 function TToolText.GetCustomShapeBounds(ADestBounds: TRect; AMatrix: TAffineMatrix; ADraft: boolean): TRect;
71 begin
72 Result:= inherited GetCustomShapeBounds(ADestBounds, AMatrix, ADraft);
73 IncludeShadowBounds(result);
74 result.Intersect(ADestBounds);
75 end;
76
77 procedure TToolText.DrawCustomShape(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean);
78 var
79 temp: TBGRABitmap;
80 blur, gray, grayShape: TGrayscaleMask;
81 shapeBounds, blurBounds, r, actualShapeBounds: TRect;
82 begin
83 if Manager.TextShadow then
84 begin
85 shapeBounds := GetCustomShapeBounds(rect(0,0,ADest.Width,ADest.Height),AMatrix,ADraft);
86 shapeBounds.Intersect(ADest.ClipRect);
87 if (shapeBounds.Width > 0) and (shapeBounds.Height > 0) then
88 begin
89 temp := TBGRABitmap.Create(shapeBounds.Width,shapeBounds.Height);
90 inherited DrawCustomShape(temp, AffineMatrixTranslation(-shapeBounds.Left,-shapeBounds.Top)*AMatrix, ADraft);
91 actualShapeBounds := temp.GetImageBounds;
92 if not actualShapeBounds.IsEmpty then
93 begin
94 actualShapeBounds.Offset(shapeBounds.Left,shapeBounds.Top);
95 grayShape := TGrayscaleMask.Create;
96 grayShape.CopyFrom(temp, cAlpha);
97
98 blurBounds := actualShapeBounds;
99 blurBounds.Inflate(ceil(Manager.TextShadowBlurRadius),ceil(Manager.TextShadowBlurRadius));
100 blurBounds.Offset(Manager.TextShadowOffset.X,Manager.TextShadowOffset.Y);
101 r := ADest.ClipRect;
102 r.Inflate(ceil(Manager.TextShadowBlurRadius),ceil(Manager.TextShadowBlurRadius));
103 blurBounds.Intersect(r);
104 gray := TGrayscaleMask.Create(blurBounds.Width,blurBounds.Height);
105 gray.PutImage(shapeBounds.Left-blurBounds.Left+Manager.TextShadowOffset.X,
106 shapeBounds.Top-blurBounds.Top+Manager.TextShadowOffset.Y,grayShape,dmSet);
107 grayShape.Free;
108 blur := gray.FilterBlurRadial(Manager.TextShadowBlurRadius,Manager.TextShadowBlurRadius, rbFast) as TGrayscaleMask;
109 gray.Free;
110 ADest.FillMask(blurBounds.Left,blurBounds.Top,blur,BGRABlack,dmDrawWithTransparency);
111 blur.Free;
112 end;
113 ADest.PutImage(shapeBounds.Left,shapeBounds.Top,temp,dmDrawWithTransparency);
114 temp.Free;
115 end;
116 FPrevShadow := true;
117 FPrevShadowRadius := Manager.TextShadowBlurRadius;
118 FPrevShadowOffset := Manager.TextShadowOffset;
119 end else
120 begin
121 inherited DrawCustomShape(ADest, AMatrix, ADraft);
122 FPrevShadow := false;
123 end;
124 end;
125
126 procedure TToolText.ShapeChange(ASender: TObject; ABounds: TRectF; ADiff: TVectorShapeDiff);
127 var
128 r: TRect;
129 posF: TPointF;
130 begin
131 posF := AffineMatrixInverse(FMatrix)*(FShape as TTextShape).LightPosition;
132 Manager.LightPosition := posF;
133 with ABounds do r := rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom));
134 IncludeShadowBounds(r);
135 inherited ShapeChange(ASender, RectF(r.Left,r.Top,r.Right,r.Bottom), ADiff);
136 end;
137
138 procedure TToolText.ShapeEditingChange(ASender: TObject);
139 begin
140 with (FShape as TTextShape) do
141 Manager.TextAlign := ParagraphAlignment;
142 inherited ShapeEditingChange(ASender);
143 end;
144
145 procedure TToolText.AssignShapeStyle(AMatrix: TAffineMatrix; AAlwaysFit: boolean);
146 var
147 r: TRect;
148 toolDest: TBGRABitmap;
149 zoom: Single;
150 begin
151 inherited AssignShapeStyle(AMatrix, AAlwaysFit);
152 FMatrix := AMatrix;
153 with TTextShape(FShape) do
154 begin
155 zoom := (VectLen(AMatrix[1,1],AMatrix[2,1])+VectLen(AMatrix[1,2],AMatrix[2,2]))/2;
156 FontEmHeight:= zoom*Manager.TextFontSize*Manager.Image.DPI/72;
157 FontName:= Manager.TextFontName;
158 FontStyle:= Manager.TextFontStyle;
159 Aliased := Manager.ShapeOptionAliasing;
160 LightPosition := AMatrix*Manager.LightPosition;
161 AltitudePercent:= Manager.PhongShapeAltitude;
162 ParagraphAlignment:= Manager.TextAlign;
163 PenPhong := Manager.TextPhong;
164 end;
165 if (Manager.TextShadow <> FPrevShadow) or
166 (FPrevShadow and
167 ((Manager.TextShadowBlurRadius <> FPrevShadowRadius) or
168 (Manager.TextShadowOffset <> FPrevShadowOffset))) then
169 begin
170 toolDest := GetToolDrawingLayer;
171 r:= UpdateShape(toolDest);
172 Action.NotifyChange(toolDest, r);
173 end;
174 end;
175
176 procedure TToolText.QuickDefineEnd;
177 begin
178 FShape.Usermode := vsuEditText;
179 end;
180
TToolText.RoundCoordinatenull181 function TToolText.RoundCoordinate(constref ptF: TPointF): TPointF;
182 begin
183 result := PointF(floor(ptF.x)+0.5,floor(ptF.y)+0.5);
184 end;
185
186 constructor TToolText.Create(AManager: TToolManager);
187 begin
188 inherited Create(AManager);
189 FMatrix := AffineMatrixIdentity;
190 end;
191
GetContextualToolbarsnull192 function TToolText.GetContextualToolbars: TContextualToolbars;
193 begin
194 Result:= [ctPenFill,ctText,ctOutlineFill,ctOutlineWidth,ctAliasing];
195 if Manager.TextPhong then include(result, ctAltitude);
196 end;
197
TToolText.DoToolKeyDownnull198 function TToolText.DoToolKeyDown(var key: Word): TRect;
199 var
200 keyUtf8: TUTF8Char;
201 handled: Boolean;
202 begin
203 if Key = VK_SPACE then
204 begin
205 keyUtf8:= ' ';
206 result := ToolKeyPress(keyUtf8);
207 Key := 0;
208 end else
209 if (Key = VK_ESCAPE) and Assigned(FShape) then
210 begin
211 if FShape.Usermode = vsuEditText then
212 FShape.Usermode := vsuEdit
213 else
214 result := ValidateShape;
215 Key := 0;
216 end else
217 if (Key = VK_RETURN) and Assigned(FShape) then
218 begin
219 handled := false;
220 FShape.KeyDown(ShiftState, skReturn, handled);
221 if not handled then ValidateShape;
222 Key := 0;
223 end else
224 Result:=inherited DoToolKeyDown(key);
225 end;
226
ToolCommandnull227 function TToolText.ToolCommand(ACommand: TToolCommand): boolean;
228 begin
229 if Assigned(FShape) and (FShape.Usermode = vsuEditText) then
230 case ACommand of
231 tcCopy: Result:= TTextShape(FShape).CopySelection;
232 tcCut: Result:= TTextShape(FShape).CutSelection;
233 tcPaste: Result:= TTextShape(FShape).PasteSelection;
234 tcDelete: Result:= TTextShape(FShape).DeleteSelection;
235 else
236 result := inherited ToolCommand(ACommand);
237 end
238 else
239 case ACommand of
240 tcDelete:
241 if Assigned(FShape) then
242 begin
243 CancelShape;
244 result := true;
245 end else result := false;
246 else result := inherited ToolCommand(ACommand);
247 end;
248 end;
249
TToolText.ToolProvideCommandnull250 function TToolText.ToolProvideCommand(ACommand: TToolCommand): boolean;
251 begin
252 if Assigned(FShape) and (FShape.Usermode = vsuEditText) then
253 case ACommand of
254 tcCopy,tcCut,tcDelete: result := TTextShape(FShape).HasSelection;
255 tcPaste: result := true;
256 else
257 result := inherited ToolProvideCommand(ACommand);
258 end
259 else
260 case ACommand of
261 tcDelete: result := Assigned(FShape);
262 else result := inherited ToolProvideCommand(ACommand);
263 end;
264 end;
265
266 initialization
267
268 RegisterTool(ptText, TToolText);
269
270 end.
271
272