1 // SPDX-License-Identifier: LGPL-3.0-only (modified to allow linking)
2 {******************************* CONTRIBUTOR(S) ******************************
3 - Edivando S. Santos Brasil | mailedivando@gmail.com
4 (Compatibility with delphi VCL 11/2018)
5
6 ***************************** END CONTRIBUTOR(S) *****************************}
7 unit BCSVGViewer;
8
9 {$I bgracontrols.inc}
10
11 interface
12
13 uses
14 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, BGRAGraphicControl,
15 {$IFDEF FPC}LResources, LCLType, {$ENDIF}
16 {$IFNDEF FPC}Types, BGRAGraphics, GraphType, FPImage, {$ENDIF}
17 BGRABitmap, BGRABitmapTypes, BGRASVG, BGRAUnits, BCTypes;
18
19 type
20
21 { TBCSVGViewer }
22
23 TBCSVGViewer = class(TCustomBGRAGraphicControl)
24 private
25 FDrawCheckers: boolean;
26 FHorizAlign: TAlignment;
27 FProportional: boolean;
28 FStretchMode: TBCStretchMode;
29 FDestDPI: single;
30 FUseSVGAlignment: boolean;
31 FVertAlign: TTextLayout;
32 Fx: single;
33 Fy: single;
GetSVGStringnull34 function GetSVGString: string;
35 procedure SetDrawCheckers(AValue: boolean);
36 procedure SetFDestDPI(AValue: single);
37 procedure SetSVGString(AValue: string);
38 procedure SetFx(AValue: single);
39 procedure SetFy(AValue: single);
40 procedure SetHorizAlign(AValue: TAlignment);
41 procedure SetProportional(AValue: boolean);
42 procedure SetStretchMode(AValue: TBCStretchMode);
43 procedure SetUseSVGAlignment(AValue: boolean);
44 procedure SetVertAlign(AValue: TTextLayout);
45 protected
46 FSVG: TBGRASVG;
47 procedure RedrawBitmapContent; override;
48 public
49 constructor Create(AOwner: TComponent); override;
50 destructor Destroy; override;
51 procedure LoadFromFile(AFileName: string);
52 procedure LoadFromResource(Resource: string);
GetSVGRectFnull53 function GetSVGRectF: TRectF;
GetSVGContainerRectFnull54 function GetSVGContainerRectF: TRectF;
55 published
56 { Published declarations }
57 property Align;
58 property Anchors;
59 property OnRedraw;
60 property Bitmap;
61 property BorderSpacing;
62 property Constraints;
63 property SVG: TBGRASVG read FSVG;
64 property SVGString: string read GetSVGString write SetSVGString;
65 property DestDPI: single read FDestDPI write SetFDestDPI {$IFDEF FPC} default
66 96{$ENDIF};
67 property x: single read Fx write SetFx {$IFDEF FPC} default 0{$ENDIF};
68 property y: single read Fy write SetFy {$IFDEF FPC} default 0{$ENDIF};
69 property HorizAlign: TAlignment read FHorizAlign write SetHorizAlign default
70 taCenter;
71 property VertAlign: TTextLayout read FVertAlign write SetVertAlign default tlCenter;
72 property StretchMode: TBCStretchMode
73 read FStretchMode write SetStretchMode default smStretch;
74 property Proportional: boolean read FProportional write SetProportional default True;
75 property DrawCheckers: boolean
76 read FDrawCheckers write SetDrawCheckers default False;
77 property UseSVGAlignment: boolean read FUseSVGAlignment write SetUseSVGAlignment default False;
78 property Color;
79 property ColorOpacity;
80 property OnClick;
81 property OnDblClick;
82 property OnMouseDown;
83 property OnMouseEnter;
84 property OnMouseLeave;
85 property OnMouseMove;
86 property OnMouseUp;
87 {$IFDEF FPC}
88 property OnPaint;
89 {$ENDIF}
90 property OnResize;
91 property Caption;
92 end;
93
94 {$IFDEF FPC}procedure Register;{$ENDIF}
95
96 implementation
97
98 uses BGRAVectorize, math;
99
100 {$IFDEF FPC}
101 procedure Register;
102 begin
103 RegisterComponents('BGRA Controls', [TBCSVGViewer]);
104 end;
105
106 {$ENDIF}
107
108 { TBCSVGViewer }
109
110 procedure TBCSVGViewer.SetFDestDPI(AValue: single);
111 begin
112 if FDestDPI = AValue then
113 Exit;
114 FDestDPI := AValue;
115 DiscardBitmap;
116 end;
117
118 procedure TBCSVGViewer.SetSVGString(AValue: string);
119 begin
120 FSVG.ASUTF8String := AValue;
121 DiscardBitmap;
122 end;
123
124 procedure TBCSVGViewer.SetDrawCheckers(AValue: boolean);
125 begin
126 if FDrawCheckers = AValue then
127 Exit;
128 FDrawCheckers := AValue;
129 DiscardBitmap;
130 end;
131
TBCSVGViewer.GetSVGStringnull132 function TBCSVGViewer.GetSVGString: string;
133 begin
134 Result := FSVG.AsUTF8String;
135 end;
136
137 procedure TBCSVGViewer.SetFx(AValue: single);
138 begin
139 if Fx = AValue then
140 Exit;
141 Fx := AValue;
142 DiscardBitmap;
143 end;
144
145 procedure TBCSVGViewer.SetFy(AValue: single);
146 begin
147 if Fy = AValue then
148 Exit;
149 Fy := AValue;
150 DiscardBitmap;
151 end;
152
153 procedure TBCSVGViewer.SetHorizAlign(AValue: TAlignment);
154 begin
155 if FHorizAlign = AValue then
156 Exit;
157 FHorizAlign := AValue;
158 DiscardBitmap;
159 end;
160
161 procedure TBCSVGViewer.SetProportional(AValue: boolean);
162 begin
163 if FProportional = AValue then
164 Exit;
165 FProportional := AValue;
166 DiscardBitmap;
167 end;
168
169 procedure TBCSVGViewer.SetStretchMode(AValue: TBCStretchMode);
170 begin
171 if FStretchMode = AValue then
172 Exit;
173 FStretchMode := AValue;
174 DiscardBitmap;
175 end;
176
177 procedure TBCSVGViewer.SetUseSVGAlignment(AValue: boolean);
178 begin
179 if FUseSVGAlignment=AValue then Exit;
180 FUseSVGAlignment:=AValue;
181 DiscardBitmap;
182 end;
183
184 procedure TBCSVGViewer.SetVertAlign(AValue: TTextLayout);
185 begin
186 if FVertAlign = AValue then
187 Exit;
188 FVertAlign := AValue;
189 DiscardBitmap;
190 end;
191
192 procedure TBCSVGViewer.RedrawBitmapContent;
193 var
194 r: TRectF;
195 checkersSize: integer;
196 begin
197 if (FBGRA <> nil) and (FBGRA.NbPixels <> 0) then
198 begin
199 r := GetSVGRectF;
200 FBGRA.Fill(ColorToBGRA(ColorToRGB(Color), ColorOpacity));
201 if FDrawCheckers then
202 begin
203 checkersSize := round(8 * DestDPI / 96 * BitmapScale);
204 with GetSVGContainerRectF do
205 FBGRA.DrawCheckers(rect(floor(Left), floor(Top),
206 ceil(right), ceil(Bottom)), CSSWhite, CSSSilver,
207 checkersSize, checkersSize);
208 end;
209 FBGRA.Canvas2D.FontRenderer := TBGRAVectorizedFontRenderer.Create;
210 FSVG.StretchDraw(FBGRA.Canvas2D, r, UseSVGAlignment);
211 if Assigned(OnRedraw) then
212 OnRedraw(self, FBGRA);
213 end;
214 end;
215
216 constructor TBCSVGViewer.Create(AOwner: TComponent);
217 begin
218 inherited Create(AOwner);
219 FSVG := TBGRASVG.Create(100, 100, TCSSUnit.cuPercent);
220 FDestDPI := 96;
221 Fx := 0;
222 Fy := 0;
223 FStretchMode := smStretch;
224 FHorizAlign := taCenter;
225 FVertAlign := tlCenter;
226 FProportional := True;
227 FBitmapAutoScale := False;
228 FUseSVGAlignment:= false;
229 end;
230
231 destructor TBCSVGViewer.Destroy;
232 begin
233 FSVG.Free;
234 inherited Destroy;
235 end;
236
237 procedure TBCSVGViewer.LoadFromFile(AFileName: string);
238 begin
239 FSVG.LoadFromFile(AFileName);
240 DiscardBitmap;
241 end;
242
243 procedure TBCSVGViewer.LoadFromResource(Resource: string);
244 begin
245 FSVG.LoadFromResource(Resource);
246 DiscardBitmap;
247 end;
248
TBCSVGViewer.GetSVGRectFnull249 function TBCSVGViewer.GetSVGRectF: TRectF;
250 var
251 vbSize: TPointF;
252 w, h, dpi: single;
253 containerRect: TRectF;
254
NoStretchnull255 function NoStretch(AX, AY: single): TRectF;
256 begin
257 case HorizAlign of
258 taCenter: Result.Left := (w - vbSize.x) / 2;
259 taRightJustify: Result.Left := w - AX - vbSize.x;
260 else
261 {taLeftJustify} Result.Left := AX;
262 end;
263 case VertAlign of
264 tlCenter: Result.Top := (h - vbSize.y) / 2;
265 tlBottom: Result.Top := h - AY - vbSize.y;
266 else
267 {tlTop} Result.Top := AY;
268 end;
269 Result.Right := Result.Left + vbSize.x;
270 Result.Bottom := Result.Top + vbSize.y;
271 end;
272
273 begin
274 if FSVG = nil then exit(EmptyRectF);
275
276 containerRect := GetSVGContainerRectF;
277 w := containerRect.Width;
278 h := containerRect.Height;
279 dpi := DestDPI * BitmapScale;
280
281 FSVG.Units.ContainerWidth := FloatWithCSSUnit(w * FSVG.Units.DpiX / dpi, cuPixel);
282 FSVG.Units.ContainerHeight := FloatWithCSSUnit(h * FSVG.Units.DpiY / dpi, cuPixel);
283
284 if UseSVGAlignment then
285 exit(FSVG.GetStretchRectF(containerRect.Left, containerRect.Top, containerRect.Width, containerRect.Height));
286
287 vbSize := FSVG.ViewSizeInUnit[cuPixel];
288 vbSize.x := vbSize.x * (dpi / FSVG.Units.DpiX);
289 vbSize.y := vbSize.y * (dpi / FSVG.Units.DpiY);
290 if ((StretchMode = smShrink) and ((vbSize.x > w + 0.1) or (vbSize.y > h + 0.1))) or
291 (StretchMode in[smStretch, smCover]) then
292 begin
293 if Proportional then
294 Result := FSVG.GetStretchRectF(HorizAlign, VertAlign, 0, 0, w, h, StretchMode = smCover)
295 else
296 if StretchMode = smShrink then
297 begin
298 NoStretch(0, 0);
299 if vbSize.x > w then
300 begin
301 Result.Left := 0;
302 Result.Right := w;
303 end;
304 if vbSize.y > h then
305 begin
306 Result.Top := 0;
307 Result.Bottom := h;
308 end;
309 end
310 else
311 Result := RectF(0, 0, w, h);
312 end
313 else
314 result := NoStretch(x, y);
315
316 result.Offset(containerRect.Left, containerRect.Top);
317 end;
318
GetSVGContainerRectFnull319 function TBCSVGViewer.GetSVGContainerRectF: TRectF;
320 var
321 w, h: Integer;
322 dpi, ratioX, ratioY, ratio: single;
323 begin
324 w := BitmapWidth;
325 h := BitmapHeight;
326 dpi := DestDPI * BitmapScale;
327 Result := RectF(0, 0, w, h);
328
329 if (FSVG = nil) or not UseSVGAlignment then exit;
330
331 FSVG.Units.ContainerWidth := FloatWithCSSUnit(w * FSVG.Units.DpiX / dpi, cuPixel);
332 FSVG.Units.ContainerHeight := FloatWithCSSUnit(h * FSVG.Units.DpiY / dpi, cuPixel);
333
334 if (FSVG = nil) or (FSVG.WidthAsPixel = 0) or
335 (FSVG.HeightAsPixel = 0) or (BitmapWidth = 0)
336 or (BitmapHeight = 0) then exit(EmptyRectF);
337
338 ratioX := BitmapWidth / FSVG.WidthAsPixel;
339 ratioY := BitmapHeight / FSVG.HeightAsPixel;
340 case StretchMode of
341 smStretch: ratio := min(ratioX, ratioY);
342 smShrink: ratio := min(1, min(ratioX, ratioY));
343 smCover: ratio := max(ratioX, ratioY);
344 else
345 ratio := 1;
346 end;
347 result := RectWithSizeF(0, 0, FSVG.WidthAsPixel * ratio,
348 FSVG.HeightAsPixel * ratio);
349 result.Offset((BitmapWidth - result.Width) / 2,
350 (BitmapHeight - result.Height) / 2);
351 end;
352
353 end.
354