1 unit BGRASVGTheme;
2
3 {$mode delphi}
4
5 interface
6
7 uses
8 Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
9 BGRATheme, BGRABitmap, BGRABitmapTypes, BGRASVG, BGRASVGType, XMLConf,
10 ComponentEditors, PropEdits, Menus, BGRASVGImageList, Math;
11
12 const
13 DEFAULT_CHECKBOX_TEXT_SPACING = 2;
14 DEFAULT_GLYPH_TEXT_SPACING = 6;
15 DEFAULT_BUTTON_TEXT_SPACING = 6;
16
17 type
18
19 { TBGRASVGTheme }
20
21 TBGRASVGTheme = class(TBGRATheme)
22 private
23 FButtonTextSpacing: integer;
24 FCheckboxTextSpacing: integer;
25 FColorizeActiveOp: TBlendOperation;
26 FColorizeDisabledOp: TBlendOperation;
27 FColorizeHoverOp: TBlendOperation;
28 FColorizeNormalOp: TBlendOperation;
29 FGlyphTextSpacing: integer;
30 FOwner: TComponent;
31 FButtonActive: TStringList;
32 FButtonHover: TStringList;
33 FButtonNormal: TStringList;
34 FButtonSliceScalingBottom: integer;
35 FButtonSliceScalingLeft: integer;
36 FButtonSliceScalingRight: integer;
37 FButtonSliceScalingTop: integer;
38 FCheckBoxChecked: TStringList;
39 FCheckBoxUnchecked: TStringList;
40 FColorizeActive: string;
41 FColorizeDisabled: string;
42 FColorizeHover: string;
43 FColorizeNormal: string;
44 FRadioButtonChecked: TStringList;
45 FRadioButtonUnchecked: TStringList;
46 procedure SetButtonActive(AValue: TStringList);
47 procedure SetButtonHover(AValue: TStringList);
48 procedure SetButtonNormal(AValue: TStringList);
49 procedure SetButtonSliceScalingBottom(AValue: integer);
50 procedure SetButtonSliceScalingLeft(AValue: integer);
51 procedure SetButtonSliceScalingRight(AValue: integer);
52 procedure SetButtonSliceScalingTop(AValue: integer);
53 procedure SetButtonTextSpacing(AValue: integer);
54 procedure SetCheckBoxChecked(AValue: TStringList);
55 procedure SetCheckboxTextSpacing(AValue: integer);
56 procedure SetCheckBoxUnchecked(AValue: TStringList);
57 procedure SetColorizeActive(AValue: string);
58 procedure SetColorizeActiveOp(AValue: TBlendOperation);
59 procedure SetColorizeDisabled(AValue: string);
60 procedure SetColorizeDisabledOp(AValue: TBlendOperation);
61 procedure SetColorizeHover(AValue: string);
62 procedure SetColorizeHoverOp(AValue: TBlendOperation);
63 procedure SetColorizeNormal(AValue: string);
64 procedure SetColorizeNormalOp(AValue: TBlendOperation);
65 procedure SetGlyphTextSpacing(AValue: integer);
66 procedure SetRadioButtonChecked(AValue: TStringList);
67 procedure SetRadioButtonUnchecked(AValue: TStringList);
68 protected
69 procedure LoadTheme(const XMLConf: TXMLConfig);
70 procedure SaveTheme(const XMLConf: TXMLConfig);
71 procedure CheckEmptyResourceException(const aResource: string);
72 procedure SliceScalingDraw(const Source: TBGRASVG;
73 const marginLeft, marginTop, marginRight, marginBottom: integer;
74 const Dest: TBGRABitmap; DestDPI: integer);
75 procedure ColorizeSurface(ASurface: TBGRAThemeSurface; AState: TBGRAThemeButtonState);
76 public
77 constructor Create(AOwner: TComponent); override;
78 destructor Destroy; override;
79 public
80 procedure DrawButton(Caption: string; State: TBGRAThemeButtonState;
81 Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface; AImageIndex: Integer = -1; AImageList: TBGRASVGImageList = nil); override;
82 procedure DrawRadioButton(Caption: string; State: TBGRAThemeButtonState;
83 {%H-}Focused: boolean; Checked: boolean; ARect: TRect;
84 ASurface: TBGRAThemeSurface); override;
85 procedure DrawCheckBox(Caption: string; State: TBGRAThemeButtonState;
86 {%H-}Focused: boolean; Checked: boolean; ARect: TRect;
87 ASurface: TBGRAThemeSurface); override;
88 public
89 // XML File
90 procedure SaveToFile(AFileName: string);
91 // XML File
92 procedure LoadFromFile(AFileName: string);
93 // String Stream
94 procedure SaveToStream(AStream: TStream);
95 // String Stream
96 procedure LoadFromStream(AStream: TStream);
97 // Resource
98 procedure LoadFromResource(AResource: string);
99 // Default Theme
100 procedure LoadDefaultTheme;
101 published
102 // Check box unchecked state
103 property CheckBoxUnchecked: TStringList read FCheckBoxUnchecked
104 write SetCheckBoxUnchecked;
105 // Check box checked state
106 property CheckBoxChecked: TStringList read FCheckBoxChecked write SetCheckBoxChecked;
107 // Radio button unchecked state
108 property RadioButtonUnchecked: TStringList
109 read FRadioButtonUnchecked write SetRadioButtonUnchecked;
110 // Radio button checked state
111 property RadioButtonChecked: TStringList
112 read FRadioButtonChecked write SetRadioButtonChecked;
113 // Spacing between checkbox/radiobutton and its text (in 96 DPI)
114 property CheckBoxTextSpacing: integer read FCheckboxTextSpacing write SetCheckboxTextSpacing default DEFAULT_CHECKBOX_TEXT_SPACING;
115 // Button normal state
116 property ButtonNormal: TStringList read FButtonNormal write SetButtonNormal;
117 // Button mouse over state
118 property ButtonHover: TStringList read FButtonHover write SetButtonHover;
119 // Button pressed state
120 property ButtonActive: TStringList read FButtonActive write SetButtonActive;
121 // 9-Slice-Scaling margin left
122 property ButtonSliceScalingLeft: integer
123 read FButtonSliceScalingLeft write SetButtonSliceScalingLeft;
124 // 9-Slice-Scaling margin top
125 property ButtonSliceScalingTop: integer
126 read FButtonSliceScalingTop write SetButtonSliceScalingTop;
127 // 9-Slice-Scaling margin right
128 property ButtonSliceScalingRight: integer
129 read FButtonSliceScalingRight write SetButtonSliceScalingRight;
130 // 9-Slice-Scaling margin bottom
131 property ButtonSliceScalingBottom: integer
132 read FButtonSliceScalingBottom write SetButtonSliceScalingBottom;
133 // Spacing between glyph and its text (in 96 DPI)
134 property GlyphTextSpacing: integer read FGlyphTextSpacing write SetGlyphTextSpacing default DEFAULT_GLYPH_TEXT_SPACING;
135 // Spacing between text and button border (in 96 DPI)
136 property ButtonTextSpacing: integer read FButtonTextSpacing write SetButtonTextSpacing default DEFAULT_BUTTON_TEXT_SPACING;
137 // CSS Color to tint the normal states, use rgba(0,0,0,0) to disable
138 property ColorizeNormal: string read FColorizeNormal write SetColorizeNormal;
139 property ColorizeNormalOp: TBlendOperation read FColorizeNormalOp write SetColorizeNormalOp default boTransparent;
140 // CSS Color to tint the hover states, use rgba(0,0,0,0) to disable
141 property ColorizeHover: string read FColorizeHover write SetColorizeHover;
142 property ColorizeHoverOp: TBlendOperation read FColorizeHoverOp write SetColorizeHoverOp default boTransparent;
143 // CSS Color to tint the active states, use rgba(0,0,0,0) to disable
144 property ColorizeActive: string read FColorizeActive write SetColorizeActive;
145 property ColorizeActiveOp: TBlendOperation read FColorizeActiveOp write SetColorizeActiveOp default boTransparent;
146 // CSS Color to tint the disabled states, use rgba(0,0,0,0) to disable
147 property ColorizeDisabled: string read FColorizeDisabled write SetColorizeDisabled;
148 property ColorizeDisabledOp: TBlendOperation read FColorizeDisabledOp write SetColorizeDisabledOp default boTransparent;
149 end;
150
151 { TBGRASVGThemeComponentEditor }
152
153 TBGRASVGThemeComponentEditor = class(TBaseComponentEditor)
154 private
155 FComponent: TBGRASVGTheme;
156 public
157 constructor Create({%H-}AComponent: TComponent;
158 {%H-}ADesigner: TComponentEditorDesigner); override;
159 procedure Copy; override;
160 procedure Edit; override;
161 procedure ExecuteVerb(Index: Integer); override;
GetComponentnull162 function GetComponent: TComponent; override;
GetCustomHintnull163 function GetCustomHint: String; override;
GetDesignernull164 function GetDesigner: TComponentEditorDesigner; override;
GetHooknull165 function GetHook(out Hook: TPropertyEditorHook): boolean; override;
GetVerbnull166 function GetVerb(Index: Integer): string; override;
GetVerbCountnull167 function GetVerbCount: Integer; override;
IsInInlinednull168 function IsInInlined: Boolean; override;
169 procedure PrepareItem({%H-}Index: Integer; const {%H-}AnItem: TMenuItem); override;
170 procedure Modified; override;
171 end;
172
173 procedure Register;
174
175 implementation
176
177 uses BCTypes, BCTools;
178
179 const
180 RES_CHECKBOXUNCHECKED =
181 '<svg xmlns="http://www.w3.org/2000/svg" height="24" viewBox="0 0 24 24" width="24"><path d="M0 0h24v24H0z" fill="none"/><path d="M19 5v14H5V5h14m0-2H5c-1.1 0-2 .9-2 2v14c0 1.1.9 2 2 2h14c1.1 0 2-.9 2-2V5c0-1.1-.9-2-2-2z"/></svg>';
182 RES_CHECKBOXCHECKED =
183 '<svg xmlns="http://www.w3.org/2000/svg" height="24" viewBox="0 0 24 24" width="24"><path d="M0 0h24v24H0z" fill="none"/><path d="M19 3H5c-1.11 0-2 .9-2 2v14c0 1.1.89 2 2 2h14c1.11 0 2-.9 2-2V5c0-1.1-.89-2-2-2zm-9 14l-5-5 1.41-1.41L10 14.17l7.59-7.59L19 8l-9 9z"/></svg>';
184 RES_RADIOBUTTONUNCHECKED =
185 '<svg xmlns="http://www.w3.org/2000/svg" height="24" viewBox="0 0 24 24" width="24"><path d="M0 0h24v24H0z" fill="none"/><path d="M12 2C6.48 2 2 6.48 2 12s4.48 10 10 10 10-4.48 10-10S17.52 2 12 2zm0 18c-4.42 0-8-3.58-8-8s3.58-8 8-8 8 3.58 8 8-3.58 8-8 8z"/></svg>';
186 RES_RADIOBUTTONCHECKED =
187 '<svg xmlns="http://www.w3.org/2000/svg" height="24" viewBox="0 0 24 24" width="24"><path d="M0 0h24v24H0z" fill="none"/><path d="M12 7c-2.76 0-5 2.24-5 5s2.24 5 5 5 5-2.24 5-5-2.24-5-5-5zm0-5C6.48 2 2 6.48 2 12s4.48 10 10 10 10-4.48 10-10S17.52 2 12 2zm0 18c-4.42 0-8-3.58-8-8s3.58-8 8-8 8 3.58 8 8-3.58 8-8 8z"/></svg>';
188 RES_BUTTON =
189 '<?xml version="1.0" encoding="UTF-8" standalone="no"?><svg xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:cc="http://creativecommons.org/ns#" xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:svg="http://www.w3.org/2000/svg" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape" width="32" height="32" viewBox="0 0 32 32" version="1.1" id="svg8" inkscape:version="1.0.1 (3bc2e813f5, 2020-09-07)" sodipodi:docname="lime.svg"> <style id="style833"></style> <defs id="defs2"> <linearGradient inkscape:collect="always" id="linearGradient858"> <stop style="stop-color:#87cdde;stop-opacity:1" offset="0" id="stop854" /> <stop style="stop-color:#ffffff;stop-opacity:1" offset="1" id="stop856" /> </linearGradient> <linearGradient inkscape:collect="always" xlink:href="#linearGradient858" id="linearGradient1415" x1="3.9924731" y1="5.9193549" x2="3.9924731" y2="2.788172" gradientUnits="userSpaceOnUse" gradientTransform="matrix(4.1517857,0,0,4.1517856,-1.5758928,-1.5758928)" /> </defs> <sodipodi:namedview id="base" pagecolor="#ffffff" bordercolor="#666666" borderopacity="1.0" inkscape:pageopacity="0.0" inkscape:pageshadow="2" inkscape:zoom="11.313708" inkscape:cx="4.3902273" inkscape:cy="23.941929" inkscape:document-units="px" inkscape:current-layer="layer1" inkscape:document-rotation="0" showgrid="true" units="px" inkscape:window-width="1920" inkscape:window-height="1017" inkscape:window-x="-8" inkscape:window-y="-8" inkscape:window-maximized="1"> <inkscape:grid type="xygrid" id="grid837" /> </sodipodi:namedview> <metadata id="metadata5"> <rdf:RDF> <cc:Work rdf:about=""> <dc:format>image/svg+xml</dc:format> <dc:type rdf:resource="http://purl.org/dc/dcmitype/StillImage" /> <dc:title></dc:title> </cc:Work> </rdf:RDF> </metadata> <g inkscape:label="Capa 1" inkscape:groupmode="layer" id="layer1"> <path vectorEffect="non-scaling-stroke" id="rect835" style="fill:url(#linearGradient1415);fill-opacity:1;stroke:#002255;stroke-width:1;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" d="M 9.8000004,0.50000004 H 22.2 c 5.1522,0 9.3,4.14779986 9.3,9.30000016 V 22.2 c 0,5.152199 -4.1478,9.3 -9.3,9.3 H 9.8000004 C 4.6478005,31.5 0.50000005,27.352199 0.50000005,22.2 V 9.8000002 c 0,-5.1522003 4.14780045,-9.30000016 9.30000035,-9.30000016 z" /> </g></svg>';
190 RES_COLORIZENORMAL = 'rgba(0,0,0,0)';
191 RES_COLORIZEHOVER = 'rgba(255,255,255,0.5)';
192 RES_COLORIZEACTIVE = 'rgba(0,0,0,0.5)';
193 RES_COLORIZEDISABLED = 'rgba(127,127,127,0.7)';
194
195 procedure Register;
196 begin
197 RegisterComponents('BGRA Themes', [TBGRASVGTheme]);
198 RegisterComponentEditor(TBGRASVGTheme, TBGRASVGThemeComponentEditor);
199 end;
200
201 { TBGRASVGThemeComponentEditor }
202
203 constructor TBGRASVGThemeComponentEditor.Create(AComponent: TComponent;
204 ADesigner: TComponentEditorDesigner);
205 begin
206 FComponent := TBGRASVGTheme(AComponent);
207 end;
208
209 procedure TBGRASVGThemeComponentEditor.Copy;
210 begin
211
212 end;
213
214 procedure TBGRASVGThemeComponentEditor.Edit;
215 begin
216
217 end;
218
219 procedure TBGRASVGThemeComponentEditor.ExecuteVerb(Index: Integer);
220 var
221 openDlg: TOpenDialog;
222 saveDlg: TSaveDialog;
223 begin
224 case Index of
225 // Load from file
226 0: begin
227 openDlg := TOpenDialog.Create(nil);
228 openDlg.Filter := 'XML|*.xml';
229 try
230 if openDlg.Execute then
231 begin
232 TBGRASVGTheme(GetComponent).LoadFromFile(openDlg.FileName);
233 end;
234 finally
235 openDlg.Free;
236 end;
237 end;
238 // Save to file
239 1: begin
240 saveDlg := TSaveDialog.Create(nil);
241 saveDlg.Filter := 'XML|*.xml';
242 try
243 if saveDlg.Execute then
244 begin
245 TBGRASVGTheme(GetComponent).SaveToFile(saveDlg.FileName);
246 end;
247 finally
248 saveDlg.Free;
249 end;
250 end;
251 end;
252 end;
253
GetVerbnull254 function TBGRASVGThemeComponentEditor.GetVerb(Index: Integer): string;
255 begin
256 case Index of
257 0: Result := 'Load From File...';
258 1: Result := 'Save To File...';
259 else
260 result := '';
261 end;
262 end;
263
GetVerbCountnull264 function TBGRASVGThemeComponentEditor.GetVerbCount: Integer;
265 begin
266 Result := 2;
267 end;
268
TBGRASVGThemeComponentEditor.IsInInlinednull269 function TBGRASVGThemeComponentEditor.IsInInlined: Boolean;
270 begin
271 result := False;
272 end;
273
274 procedure TBGRASVGThemeComponentEditor.PrepareItem(Index: Integer;
275 const AnItem: TMenuItem);
276 begin
277
278 end;
279
280 procedure TBGRASVGThemeComponentEditor.Modified;
281 begin
282
283 end;
284
GetComponentnull285 function TBGRASVGThemeComponentEditor.GetComponent: TComponent;
286 begin
287 Result := FComponent;
288 end;
289
TBGRASVGThemeComponentEditor.GetCustomHintnull290 function TBGRASVGThemeComponentEditor.GetCustomHint: String;
291 begin
292 result := 'SVG Theme';
293 end;
294
GetDesignernull295 function TBGRASVGThemeComponentEditor.GetDesigner: TComponentEditorDesigner;
296 begin
297 result := nil;
298 end;
299
GetHooknull300 function TBGRASVGThemeComponentEditor.GetHook(out Hook: TPropertyEditorHook
301 ): boolean;
302 begin
303 Hook := nil;
304 result := false;
305 end;
306
307 { TBGRASVGTheme }
308
309 procedure TBGRASVGTheme.SetCheckBoxUnchecked(AValue: TStringList);
310 begin
311 CheckEmptyResourceException(AValue.Text);
312 if (AValue <> FCheckBoxUnchecked) then
313 begin
314 FCheckBoxUnchecked.Assign(AValue);
315 InvalidateThemedControls;
316 end;
317 end;
318
319 procedure TBGRASVGTheme.SetColorizeActive(AValue: string);
320 begin
321 if FColorizeActive = AValue then
322 Exit;
323 FColorizeActive := AValue;
324 InvalidateThemedControls;
325 end;
326
327 procedure TBGRASVGTheme.SetColorizeActiveOp(AValue: TBlendOperation);
328 begin
329 if FColorizeActiveOp=AValue then Exit;
330 FColorizeActiveOp:=AValue;
331 InvalidateThemedControls;
332 end;
333
334 procedure TBGRASVGTheme.SetColorizeDisabled(AValue: string);
335 begin
336 if FColorizeDisabled = AValue then
337 Exit;
338 FColorizeDisabled := AValue;
339 InvalidateThemedControls;
340 end;
341
342 procedure TBGRASVGTheme.SetColorizeDisabledOp(AValue: TBlendOperation);
343 begin
344 if FColorizeDisabledOp=AValue then Exit;
345 FColorizeDisabledOp:=AValue;
346 InvalidateThemedControls;
347 end;
348
349 procedure TBGRASVGTheme.SetColorizeHover(AValue: string);
350 begin
351 if FColorizeHover = AValue then
352 Exit;
353 FColorizeHover := AValue;
354 InvalidateThemedControls;
355 end;
356
357 procedure TBGRASVGTheme.SetColorizeHoverOp(AValue: TBlendOperation);
358 begin
359 if FColorizeHoverOp=AValue then Exit;
360 FColorizeHoverOp:=AValue;
361 InvalidateThemedControls;
362 end;
363
364 procedure TBGRASVGTheme.SetColorizeNormal(AValue: string);
365 begin
366 if FColorizeNormal = AValue then
367 Exit;
368 FColorizeNormal := AValue;
369 InvalidateThemedControls;
370 end;
371
372 procedure TBGRASVGTheme.SetColorizeNormalOp(AValue: TBlendOperation);
373 begin
374 if FColorizeNormalOp=AValue then Exit;
375 FColorizeNormalOp:=AValue;
376 InvalidateThemedControls;
377 end;
378
379 procedure TBGRASVGTheme.SetGlyphTextSpacing(AValue: integer);
380 begin
381 if FGlyphTextSpacing=AValue then Exit;
382 FGlyphTextSpacing:=AValue;
383 InvalidateThemedControls;
384 end;
385
386 procedure TBGRASVGTheme.SetRadioButtonChecked(AValue: TStringList);
387 begin
388 CheckEmptyResourceException(AValue.Text);
389 if (AValue <> FRadioButtonChecked) then
390 begin
391 FRadioButtonChecked.Assign(AValue);
392 InvalidateThemedControls;
393 end;
394 end;
395
396 procedure TBGRASVGTheme.SetRadioButtonUnchecked(AValue: TStringList);
397 begin
398 CheckEmptyResourceException(AValue.Text);
399 if (AValue <> FRadioButtonUnchecked) then
400 begin
401 FRadioButtonUnchecked.Assign(AValue);
402 InvalidateThemedControls;
403 end;
404 end;
405
406 procedure TBGRASVGTheme.LoadDefaultTheme;
407 begin
408 FCheckBoxUnchecked.Text := RES_CHECKBOXUNCHECKED;
409 FCheckBoxChecked.Text := RES_CHECKBOXCHECKED;
410 FCheckboxTextSpacing:= DEFAULT_CHECKBOX_TEXT_SPACING;
411 FRadioButtonUnchecked.Text := RES_RADIOBUTTONUNCHECKED;
412 FRadioButtonChecked.Text := RES_RADIOBUTTONCHECKED;
413 FButtonNormal.Text := RES_BUTTON;
414 FButtonHover.Text := '';
415 FButtonActive.Text := '';
416 FButtonSliceScalingLeft := 10;
417 FButtonSliceScalingTop := 10;
418 FButtonSliceScalingRight := 10;
419 FButtonSliceScalingBottom := 10;
420 FGlyphTextSpacing := DEFAULT_GLYPH_TEXT_SPACING;
421 FButtonTextSpacing := DEFAULT_BUTTON_TEXT_SPACING;
422 FColorizeNormal := RES_COLORIZENORMAL;
423 FColorizeHover := RES_COLORIZEHOVER;
424 FColorizeActive := RES_COLORIZEACTIVE;
425 FColorizeDisabled := RES_COLORIZEDISABLED;
426 FColorizeNormalOp := boTransparent;
427 FColorizeHoverOp := boTransparent;
428 FColorizeActiveOp := boTransparent;
429 FColorizeDisabledOp := boTransparent;
430 end;
431
432 procedure TBGRASVGTheme.LoadTheme(const XMLConf: TXMLConfig);
433 begin
434 try
435 XMLConf.RootName := 'BGRASVGTheme';
436 // Button
437 FButtonActive.Text := XMLConf.GetValue('Button/Active/SVG', RES_BUTTON){%H-};
438 FButtonHover.Text := XMLConf.GetValue('Button/Hover/SVG', ''){%H-};
439 FButtonNormal.Text := XMLConf.GetValue('Button/Normal/SVG', ''){%H-};
440 FButtonSliceScalingBottom := XMLConf.GetValue('Button/SliceScaling/Bottom', 10);
441 FButtonSliceScalingLeft := XMLConf.GetValue('Button/SliceScaling/Left', 10);
442 FButtonSliceScalingRight := XMLConf.GetValue('Button/SliceScaling/Right', 10);
443 FButtonSliceScalingTop := XMLConf.GetValue('Button/SliceScaling/Top', 10);
444 FGlyphTextSpacing := XMLConf.GetValue('Button/GlyphSpacing', DEFAULT_GLYPH_TEXT_SPACING);
445 FButtonTextSpacing := XMLConf.GetValue('Button/TextSpacing', DEFAULT_BUTTON_TEXT_SPACING);
446 // CheckBox
447 FCheckBoxChecked.Text := XMLConf.GetValue('CheckBox/Checked/SVG',
448 RES_CHECKBOXCHECKED){%H-};
449 FCheckBoxUnchecked.Text := XMLConf.GetValue('CheckBox/Unchecked/SVG',
450 RES_CHECKBOXUNCHECKED){%H-};
451 FCheckBoxTextSpacing := XMLConf.GetValue('CheckBox/TextSpacing', DEFAULT_CHECKBOX_TEXT_SPACING);
452 // Colorize
453 FColorizeActive := XMLConf{%H-}.GetValue('Colorize/Active', RES_COLORIZEACTIVE);
454 FColorizeDisabled := XMLConf{%H-}.GetValue('Colorize/Disabled', RES_COLORIZEDISABLED);
455 FColorizeHover := XMLConf{%H-}.GetValue('Colorize/Hover', RES_COLORIZEHOVER);
456 FColorizeNormal := XMLConf{%H-}.GetValue('Colorize/Normal', RES_COLORIZENORMAL);
457 FColorizeActiveOp := StrToBlendOperation(XMLConf{%H-}.GetValue('Colorize/ActiveOp', BlendOperationStr[boTransparent]));
458 FColorizeDisabledOp := StrToBlendOperation(XMLConf{%H-}.GetValue('Colorize/DisabledOp', BlendOperationStr[boTransparent]));
459 FColorizeHoverOp := StrToBlendOperation(XMLConf{%H-}.GetValue('Colorize/HoverOp', BlendOperationStr[boTransparent]));
460 FColorizeNormalOp := StrToBlendOperation(XMLConf{%H-}.GetValue('Colorize/NormalOp', BlendOperationStr[boTransparent]));
461 // RadioButton
462 FRadioButtonChecked.Text :=
463 XMLConf.GetValue('RadioButton/Checked/SVG', RES_RADIOBUTTONCHECKED{%H-}){%H-};
464 FRadioButtonUnchecked.Text :=
465 XMLConf.GetValue('RadioButton/Unchecked/SVG', RES_RADIOBUTTONUNCHECKED{%H-}){%H-};
466 finally
467 InvalidateThemedControls;
468 end;
469 end;
470
471 procedure TBGRASVGTheme.SaveTheme(const XMLConf: TXMLConfig);
472 begin
473 XMLConf.RootName := 'BGRASVGTheme';
474 // Button
475 XMLConf.SetValue('Button/Active/SVG', FButtonActive.Text{%H-});
476 XMLConf.SetValue('Button/Hover/SVG', FButtonHover.Text{%H-});
477 XMLConf.SetValue('Button/Normal/SVG', FButtonNormal.Text{%H-});
478 XMLConf.SetValue('Button/SliceScaling/Bottom', FButtonSliceScalingBottom);
479 XMLConf.SetValue('Button/SliceScaling/Left', FButtonSliceScalingLeft);
480 XMLConf.SetValue('Button/SliceScaling/Right', FButtonSliceScalingRight);
481 XMLConf.SetValue('Button/SliceScaling/Top', FButtonSliceScalingTop);
482 XMLConf.SetValue('Button/GlyphSpacing', FGlyphTextSpacing);
483 XMLConf.SetValue('Button/TextSpacing', FButtonTextSpacing);
484 // CheckBox
485 XMLConf.SetValue('CheckBox/Checked/SVG', FCheckBoxChecked.Text{%H-});
486 XMLConf.SetValue('CheckBox/Unchecked/SVG', FCheckBoxUnchecked.Text{%H-});
487 XMLConf.SetValue('CheckBox/TextSpacing', FCheckboxTextSpacing);
488 // Colorize
489 XMLConf.SetValue('Colorize/Active', FColorizeActive{%H-});
490 XMLConf.SetValue('Colorize/Disabled', FColorizeDisabled{%H-});
491 XMLConf.SetValue('Colorize/Hover', FColorizeHover{%H-});
492 XMLConf.SetValue('Colorize/Normal', FColorizeNormal{%H-});
493 XMLConf.SetValue('Colorize/ActiveOp', BlendOperationStr[FColorizeActiveOp{%H-}]);
494 XMLConf.SetValue('Colorize/DisabledOp', BlendOperationStr[FColorizeDisabledOp{%H-}]);
495 XMLConf.SetValue('Colorize/HoverOp', BlendOperationStr[FColorizeHoverOp{%H-}]);
496 XMLConf.SetValue('Colorize/NormalOp', BlendOperationStr[FColorizeNormalOp{%H-}]); // RadioButton
497 XMLConf.SetValue('RadioButton/Checked/SVG', FRadioButtonChecked.Text{%H-});
498 XMLConf.SetValue('RadioButton/Unchecked/SVG', FRadioButtonUnchecked.Text{%H-});
499 end;
500
501 procedure TBGRASVGTheme.CheckEmptyResourceException(const aResource: string);
502 begin
503 if Trim(aResource).IsEmpty then
504 raise Exception.Create('Resource must not be empty.');
505 end;
506
507 procedure TBGRASVGTheme.SliceScalingDraw(const Source: TBGRASVG;
508 const marginLeft, marginTop, marginRight, marginBottom: integer;
509 const Dest: TBGRABitmap; DestDPI: integer);
510 var
511 svgBox: TSVGViewBox;
512 svgTopLeft, svgBottomRight: TPointF;
513 sourcePosX, sourcePosY: array[1..4] of single;
514 destPosX, destPosY: array[1..4] of integer;
515 y, x: integer;
516
517 procedure DrawPart(sourceRect: TRectF; destRect: TRect);
518 var
519 zoom: TPointF;
520 begin
521 if sourceRect.IsEmpty or destRect.IsEmpty then
522 exit;
523 dest.ClipRect := destRect;
524 zoom := PointF(destRect.Width / sourceRect.Width, destRect.Height /
525 sourceRect.Height);
526 Source.Draw(dest.Canvas2D, -sourceRect.Left * zoom.x + destRect.Left,
527 -sourceRect.Top * zoom.y + destRect.Top, Source.DefaultDpi * zoom);
528 end;
529
530 begin
531 svgBox := Source.ViewBoxInUnit[cuPixel];
532 svgTopLeft := svgBox.min;
533 svgBottomRight := svgBox.min + svgBox.size;
534
535 sourcePosX[1] := svgTopLeft.x;
536 sourcePosX[2] := svgTopLeft.x + marginLeft;
537 sourcePosX[3] := svgBottomRight.x - marginRight;
538 sourcePosX[4] := svgBottomRight.x;
539 sourcePosY[1] := svgTopLeft.y;
540 sourcePosY[2] := svgTopLeft.y + marginTop;
541 sourcePosY[3] := svgBottomRight.y - marginBottom;
542 sourcePosY[4] := svgBottomRight.y;
543 if sourcePosX[2] > sourcePosX[3] then
544 begin
545 sourcePosX[2] := (sourcePosX[1] + sourcePosX[4]) / 2;
546 sourcePosX[3] := sourcePosX[2];
547 end;
548 if sourcePosY[2] > sourcePosY[3] then
549 begin
550 sourcePosY[2] := (sourcePosY[1] + sourcePosY[4]) / 2;
551 sourcePosY[3] := sourcePosY[2];
552 end;
553
554 destPosX[1] := 0;
555 destPosX[2] := round(marginLeft * DestDPI / 96);
556 destPosX[3] := dest.Width - round(marginRight * DestDPI / 96);
557 destPosX[4] := dest.Width;
558 destPosY[1] := 0;
559 destPosY[2] := round(marginTop * DestDPI / 96);
560 destPosY[3] := dest.Height - round(marginBottom * DestDPI / 96);
561 destPosY[4] := dest.Height;
562 if destPosX[2] > destPosX[3] then
563 begin
564 destPosX[2] := round((destPosX[1] + destPosX[4]) / 2);
565 destPosX[3] := destPosX[2];
566 end;
567 if destPosY[2] > destPosY[3] then
568 begin
569 destPosY[2] := round((destPosY[1] + destPosY[4]) / 2);
570 destPosY[3] := destPosY[2];
571 end;
572
573 for y := 1 to 3 do
574 for x := 1 to 3 do
575 DrawPart(RectF(sourcePosX[x], sourcePosY[y], sourcePosX[x + 1], sourcePosY[y + 1]),
576 Rect(destPosX[x], destPosY[y], destPosX[x + 1], destPosY[y + 1]));
577 Dest.NoClip;
578 end;
579
580 procedure TBGRASVGTheme.ColorizeSurface(ASurface: TBGRAThemeSurface;
581 AState: TBGRAThemeButtonState);
582 var
583 color: String;
584 op: TBlendOperation;
585 begin
586 case AState of
587 btbsNormal: begin color := FColorizeNormal; op := FColorizeNormalOp; end;
588 btbsHover: begin color := FColorizeHover; op := FColorizeHoverOp; end;
589 btbsActive: begin color := FColorizeActive; op := FColorizeActiveOp; end;
590 else {btbsDisabled} begin color := FColorizeDisabled; op := FColorizeDisabledOp; end;
591 end;
592 ASurface.BitmapColorOverlay(StrToBGRA(color), op);
593 end;
594
595 constructor TBGRASVGTheme.Create(AOwner: TComponent);
596 begin
597 inherited Create(AOwner);
598 FOwner := AOwner;
599 FCheckBoxUnchecked := TStringList.Create;
600 FCheckBoxChecked := TStringList.Create;
601 FRadioButtonUnchecked := TStringList.Create;
602 FRadioButtonChecked := TStringList.Create;
603 FButtonNormal := TStringList.Create;
604 FButtonHover := TStringList.Create;
605 FButtonActive := TStringList.Create;
606 LoadDefaultTheme;
607 end;
608
609 destructor TBGRASVGTheme.Destroy;
610 begin
611 FCheckBoxUnchecked.Free;
612 FCheckBoxChecked.Free;
613 FRadioButtonUnchecked.Free;
614 FRadioButtonChecked.Free;
615 FButtonNormal.Free;
616 FButtonHover.Free;
617 FButtonActive.Free;
618 inherited Destroy;
619 end;
620
621 procedure TBGRASVGTheme.DrawButton(Caption: string;
622 State: TBGRAThemeButtonState; Focused: boolean; ARect: TRect;
623 ASurface: TBGRAThemeSurface; AImageIndex: Integer;
624 AImageList: TBGRASVGImageList);
625 var
626 svg: TBGRASVG;
627 svgCode: String;
628 gs: TSize;
629 bcFont: TBCFont;
630 actualCaption: string;
631 r, rGlyph: TRect;
632 drawText: boolean = True;
633
634 begin
635 with ASurface do
636 begin
637 case State of
638 btbsNormal: svg := TBGRASVG.CreateFromString(FButtonNormal.Text);
639 btbsHover:
640 begin
641 svgCode := FButtonHover.Text;
642 if trim(svgCode) = '' then svgCode := FButtonNormal.Text;
643 svg := TBGRASVG.CreateFromString(svgCode);
644 end;
645 btbsActive:
646 begin
647 svgCode := FButtonActive.Text;
648 if trim(svgCode) = '' then svgCode := FButtonHover.Text;
649 if trim(svgCode) = '' then svgCode := FButtonNormal.Text;
650 svg := TBGRASVG.CreateFromString(svgCode);
651 end;
652 else {btbsDisabled}
653 svg := TBGRASVG.CreateFromString(FButtonNormal.Text);
654 end;
655 SliceScalingDraw(svg, FButtonSliceScalingLeft, FButtonSliceScalingTop,
656 FButtonSliceScalingRight, FButtonSliceScalingBottom, Bitmap,
657 BitmapDPI);
658 svg.Free;
659
660 if Assigned(AImageList) and (AImageIndex > -1) and (AImageIndex < AImageList.Count) then
661 begin
662 gs := AImageList.GetScaledSize(BitmapDPI);
663 if ARect.Width - gs.cx < ScaleForBitmap(GlyphTextSpacing + 2*ButtonTextSpacing) then
664 drawText := false;
665 end
666 else gs := TSize.Create(0, 0);
667
668 bcFont := TBCFont.Create(nil);
669 bcFont.Assign(DestCanvas.Font);
670 bcFont.Scale(BitmapDPI / DestCanvasDPI, false);
671 bcFont.WordBreak := true;
672 bcFont.PaddingBottom:= ScaleForBitmap(ButtonTextSpacing);
673 bcFont.PaddingTop:= ScaleForBitmap(ButtonTextSpacing);
674 bcFont.PaddingRight:= ScaleForBitmap(ButtonTextSpacing);
675 bcFont.PaddingLeft:= ScaleForBitmap(ButtonTextSpacing);
676 bcFont.TextAlignment:= bcaCenter;
677
678 if drawText then
679 actualCaption := Caption
680 else actualCaption:= '';
681
682 r := ScaleForBitmap(ARect, DestCanvasDPI);
683 rGlyph := ComputeGlyphPosition(r, gs.cx, gs.cy, bcaCenter,
684 ScaleForBitmap(GlyphTextSpacing), actualCaption, bcFont);
685 if not rGlyph.IsEmpty then
686 AImageList.Draw(AImageIndex, Bitmap, RectF(rGlyph));
687 RenderText(r, bcFont, actualCaption, Bitmap);
688
689 ColorizeSurface(ASurface, State);
690 DrawBitmap;
691
692 if Focused then
693 begin
694 DestCanvas.Pen.Color := DestCanvas.Font.Color;
695 DestCanvas.Pen.Style := psDash;
696 DestCanvas.Brush.Style := bsClear;
697 r := ARect;
698 r.Inflate(-ScaleForCanvas(FButtonSliceScalingLeft),
699 -ScaleForCanvas(FButtonSliceScalingTop),
700 -ScaleForCanvas(FButtonSliceScalingRight),
701 -ScaleForCanvas(FButtonSliceScalingBottom));
702 DestCanvas.Rectangle(r);
703 DestCanvas.Pen.Style := psSolid;
704 end;
705 end;
706 end;
707
708 procedure TBGRASVGTheme.DrawRadioButton(Caption: string;
709 State: TBGRAThemeButtonState; Focused: boolean; Checked: boolean;
710 ARect: TRect; ASurface: TBGRAThemeSurface);
711 var
712 Style: TTextStyle;
713 svg: TBGRASVG;
714 begin
715 with ASurface do
716 begin
717 BitmapRect := RectWithSize(ARect.Left, ARect.Top, ARect.Height, ARect.Height);
718 if Checked then
719 svg := TBGRASVG.CreateFromString(FRadioButtonChecked.Text)
720 else
721 svg := TBGRASVG.CreateFromString(FRadioButtonUnchecked.Text);
722 svg.StretchDraw(Bitmap.Canvas2D, 0, 0, Bitmap.Width, Bitmap.Height);
723 svg.Free;
724 ColorizeSurface(ASurface, State);
725 DrawBitmap;
726
727 if Caption <> '' then
728 begin
729 fillchar(Style, sizeof(Style), 0);
730 Style.Alignment := taLeftJustify;
731 Style.Layout := tlCenter;
732 Style.Wordbreak := True;
733 DestCanvas.TextRect(
734 Rect(Arect.Height + ScaleForCanvas(CheckBoxTextSpacing), 0,
735 ARect.Right, ARect.Bottom),
736 ARect.Height + ScaleForCanvas(CheckBoxTextSpacing), 0, Caption, Style);
737 end;
738 end;
739 end;
740
741 procedure TBGRASVGTheme.SetCheckBoxChecked(AValue: TStringList);
742 begin
743 CheckEmptyResourceException(AValue.Text);
744 if (AValue <> FCheckBoxChecked) then
745 begin
746 FCheckBoxChecked.Assign(AValue);
747 InvalidateThemedControls;
748 end;
749 end;
750
751 procedure TBGRASVGTheme.SetCheckboxTextSpacing(AValue: integer);
752 begin
753 if FCheckboxTextSpacing=AValue then Exit;
754 FCheckboxTextSpacing:=AValue;
755 InvalidateThemedControls;
756 end;
757
758 procedure TBGRASVGTheme.SetButtonActive(AValue: TStringList);
759 begin
760 if (AValue <> FButtonActive) then
761 begin
762 FButtonActive.Assign(AValue);
763 InvalidateThemedControls;
764 end;
765 end;
766
767 procedure TBGRASVGTheme.SetButtonHover(AValue: TStringList);
768 begin
769 if (AValue <> FButtonHover) then
770 begin
771 FButtonHover.Assign(AValue);
772 InvalidateThemedControls;
773 end;
774 end;
775
776 procedure TBGRASVGTheme.SetButtonNormal(AValue: TStringList);
777 begin
778 CheckEmptyResourceException(AValue.Text);
779 if (AValue <> FButtonNormal) then
780 begin
781 FButtonNormal.Assign(AValue);
782 InvalidateThemedControls;
783 end;
784 end;
785
786 procedure TBGRASVGTheme.SetButtonSliceScalingBottom(AValue: integer);
787 begin
788 if FButtonSliceScalingBottom = AValue then
789 Exit;
790 FButtonSliceScalingBottom := AValue;
791 InvalidateThemedControls;
792 end;
793
794 procedure TBGRASVGTheme.SetButtonSliceScalingLeft(AValue: integer);
795 begin
796 if FButtonSliceScalingLeft = AValue then
797 Exit;
798 FButtonSliceScalingLeft := AValue;
799 InvalidateThemedControls;
800 end;
801
802 procedure TBGRASVGTheme.SetButtonSliceScalingRight(AValue: integer);
803 begin
804 if FButtonSliceScalingRight = AValue then
805 Exit;
806 FButtonSliceScalingRight := AValue;
807 InvalidateThemedControls;
808 end;
809
810 procedure TBGRASVGTheme.SetButtonSliceScalingTop(AValue: integer);
811 begin
812 if FButtonSliceScalingTop = AValue then
813 Exit;
814 FButtonSliceScalingTop := AValue;
815 InvalidateThemedControls;
816 end;
817
818 procedure TBGRASVGTheme.SetButtonTextSpacing(AValue: integer);
819 begin
820 if FButtonTextSpacing=AValue then Exit;
821 FButtonTextSpacing:=AValue;
822 InvalidateThemedControls;
823 end;
824
825 procedure TBGRASVGTheme.DrawCheckBox(Caption: string; State: TBGRAThemeButtonState;
826 Focused: boolean; Checked: boolean; ARect: TRect; ASurface: TBGRAThemeSurface);
827 var
828 Style: TTextStyle;
829 svg: TBGRASVG;
830 begin
831 with ASurface do
832 begin
833 BitmapRect := RectWithSize(ARect.Left, ARect.Top, ARect.Height, ARect.Height);
834 if Checked then
835 svg := TBGRASVG.CreateFromString(FCheckBoxChecked.Text)
836 else
837 svg := TBGRASVG.CreateFromString(FCheckBoxUnchecked.Text);
838 svg.StretchDraw(Bitmap.Canvas2D, 0, 0, Bitmap.Width, Bitmap.Height);
839 svg.Free;
840 ColorizeSurface(ASurface, State);
841 DrawBitmap;
842
843 if Caption <> '' then
844 begin
845 fillchar(Style, sizeof(Style), 0);
846 Style.Alignment := taLeftJustify;
847 Style.Layout := tlCenter;
848 Style.Wordbreak := True;
849 DestCanvas.TextRect(
850 Rect(Arect.Height + ScaleForCanvas(CheckBoxTextSpacing), 0,
851 ARect.Right, ARect.Bottom),
852 ARect.Height + ScaleForCanvas(CheckBoxTextSpacing), 0, Caption, Style);
853 end;
854 end;
855 end;
856
857 procedure TBGRASVGTheme.SaveToFile(AFileName: string);
858 var
859 FXMLConf: TXMLConfig;
860 begin
861 FXMLConf := TXMLConfig.Create(Self);
862 try
863 FXMLConf.Filename := AFileName;
864 SaveTheme(FXMLConf);
865 FXMLConf.Flush;
866 finally
867 FXMLConf.Free;
868 end;
869 end;
870
871 procedure TBGRASVGTheme.LoadFromFile(AFileName: string);
872 var
873 FXMLConf: TXMLConfig;
874 begin
875 FXMLConf := TXMLConfig.Create(Self);
876 try
877 FXMLConf.Filename := AFileName;
878 LoadTheme(FXMLConf);
879 finally
880 FXMLConf.Free;
881 end;
882 end;
883
884 procedure TBGRASVGTheme.SaveToStream(AStream: TStream);
885 var
886 FXMLConf: TXMLConfig;
887 begin
888 FXMLConf := TXMLConfig.Create(Self);
889 try
890 SaveTheme(FXMLConf);
891 FXMLConf.SaveToStream(AStream);
892 FXMLConf.Flush;
893 finally
894 FXMLConf.Free;
895 end;
896 end;
897
898 procedure TBGRASVGTheme.LoadFromStream(AStream: TStream);
899 var
900 FXMLConf: TXMLConfig;
901 begin
902 FXMLConf := TXMLConfig.Create(Self);
903 try
904 FXMLConf.RootName := 'BGRASVGTheme';
905 AStream.Position := 0;
906 FXMLConf.LoadFromStream(AStream);
907 LoadTheme(FXMLConf);
908 finally
909 FXMLConf.Free;
910 end;
911 end;
912
913 procedure TBGRASVGTheme.LoadFromResource(AResource: string);
914 var
915 AStream: TStream;
916 begin
917 AStream := BGRAResource.GetResourceStream(AResource);
918 LoadFromStream(AStream);
919 AStream.Free;
920 end;
921
922 end.
923