1 // SPDX-License-Identifier: LGPL-3.0-only (modified to allow linking)
2 { General framework methods for rendering background, borders, text, etc.
3
4 originally written in 2012 by Krzysztof Dibowski dibowski at interia.pl
5 }
6 {******************************* CONTRIBUTOR(S) ******************************
7 - Edivando S. Santos Brasil | mailedivando@gmail.com
8 (Compatibility with delphi VCL 11/2018)
9
10 ***************************** END CONTRIBUTOR(S) *****************************}
11 unit BCTools;
12
13 {$I bgracontrols.inc}
14
15 interface
16
17 uses
18 Classes, SysUtils, Types, Graphics,
19 {$IFDEF FPC}LCLType, LCLIntf,{$ENDIF} {$IFNDEF FPC}BGRAGraphics, GraphType, FPImage, {$ENDIF}
20 BGRABitmap, BGRABitmapTypes, bctypes, Controls, BGRAGradientScanner;
21
ScaleRectnull22 function ScaleRect(ARect: TRect; AScale: Single): TRect;
23 // This method prepare BGRABitmap for rendering BCFont type
24 procedure AssignBCFont(AFont: TBCFont; var ATargetBGRA: TBGRABitmap);
25 // Calculate text height and width (doesn't include wordwrap - just single line)
26 procedure CalculateTextSize(const AText: String; AFont: TBCFont; out ANewWidth, ANewHeight: integer;
27 AShadowMargin: boolean = true);
28 // Calculate text height and width (handles wordwrap and end ellipsis)
29 procedure CalculateTextSizeEx(const AText: String; AFont: TBCFont; out ANewWidth, ANewHeight: integer;
30 AAvailableWidth: integer; AShadowMargin: boolean = false);
31 // Determines the layout of the glyph
32 procedure GetGlyphActualLayout(ACaption: string; AFont: TBCFont;
33 AGlyphAlignment: TBCAlignment; AGlyphMargin: integer; out AHorizAlign: TAlignment;
34 out AVertAlign: TTextLayout; out AGlyphRelativeHorizAlign: TAlignment;
35 out AGlyphRelativeVertAlign: TTextLayout; out AGlyphHorizMargin: integer;
36 out AGlyphVertMargin: integer);
37 // Computes the position the glyph and update rAvail with the space dedicated to text.
38 // Specify the flag AOldPlacement to have the old (buggy) version
39 function ComputeGlyphPosition(var rAvail: TRect;
40 AGlyph: TBitmap; AGlyphAlignment: TBCAlignment; AGlyphMargin: integer;
41 ACaption: string; AFont: TBCFont; AOldPlacement: boolean = false;
42 AGlyphScale: Single = 1): TRect; overload;
43 function ComputeGlyphPosition(var rAvail: TRect;
44 gw, gh: integer; AGlyphAlignment: TBCAlignment; AGlyphMargin: integer;
45 ACaption: string; AFont: TBCFont; AOldPlacement: boolean = false): TRect; overload;
46 // This method correct TRect to border width. As far as border width is bigger,
47 // BGRA drawing rectangle with offset (half border width)
48 procedure CalculateBorderRect(ABorder: TBCBorder; var ARect: TRect);
49 // This returns a rectangle that is inside the border outline
50 procedure CalculateInnerRect(ABorder: TBCBorder; var ARect: TRect);
51 // Create BGRA Gradient Scanner based on BCGradient properties
52 function CreateGradient(AGradient: TBCGradient; ARect: TRect): TBGRAGradientScanner;
53 // Render arrow (used by BCButton with DropDownMenu style)
54 procedure RenderArrow(ATargetBGRA: TBGRABitmap; const ARect: TRect;
55 ASize: Integer; ADirection: TBCArrowDirection; AColor: TColor = clBlack;
56 AOpacity: Byte = 255);
57 // Render customizable backgroud (used e.g. by TBCButton, TBCPanel, TBCLabel)
58 procedure RenderBackground(const ARect: TRect; ABackground: TBCBackground;
59 ATargetBGRA: TBGRABitmap; ARounding: TBCRounding = nil; AHasNoBorder: boolean = false);
60 procedure RenderBackgroundF(x1,y1,x2,y2: single; ABackground: TBCBackground;
61 ATargetBGRA: TBGRABitmap; ARounding: TBCRounding = nil);
62 procedure RenderBackgroundAndBorder(const ARect: TRect; ABackground: TBCBackground;
63 ATargetBGRA: TBGRABitmap; ARounding: TBCRounding; ABorder: TBCBorder; AInnerMargin: single = 0);
64 // Render customizable border (used e.g. by TBCButton, TBCPanel, TBCLabel)
65 procedure RenderBorder(const ARect: TRect; ABorder: TBCBorder;
66 ATargetBGRA: TBGRABitmap; ARounding: TBCRounding = nil);
67 procedure RenderBorderF(x1,y1,x2,y2: single; ABorder: TBCBorder;
68 ATargetBGRA: TBGRABitmap; ARounding: TBCRounding = nil);
69 // Render BCFont (used e.g. by TBCButton, TBCPanel, TBCLabel)
70 procedure RenderText(const ARect: TRect; AFont: TBCFont;
71 const AText: String; ATargetBGRA: TBGRABitmap);
72 // Return LCL horizontal equivalent for BCAlignment
73 function BCAlign2HAlign(AAlign: TBCAlignment): TAlignment;
74 // Return LCL vertical equivalent for BCAlignment
75 function BCAlign2VAlign(AAlign: TBCAlignment): TTextLayout;
76
77 implementation
78
79 uses BGRAPolygon, BGRAFillInfo, BGRAText, math, BGRAUTF8, LazUTF8;
80
81 function ComputeGlyphPosition(var rAvail: TRect; AGlyph: TBitmap;
82 AGlyphAlignment: TBCAlignment; AGlyphMargin: integer; ACaption: string;
83 AFont: TBCFont; AOldPlacement: boolean; AGlyphScale: Single): TRect;
84 var gw, gh: integer;
85 begin
86 if Assigned(AGlyph) and not AGlyph.Empty then
87 begin
88 gw := round(AGlyph.Width * AGlyphScale);
89 gh := round(AGlyph.Height * AGlyphScale);
90 end else
91 begin
92 gw := 0;
93 gh := 0;
94 end;
95 result := ComputeGlyphPosition(rAvail, gw, gh, AGlyphAlignment, AGlyphMargin, ACaption,
96 AFont, AOldPlacement);
97 end;
98
99 procedure CalculateBorderRect(ABorder: TBCBorder; var ARect: TRect);
100 var w: integer;
101 begin
102 if ABorder = nil then Exit;
103 w := ABorder.Width div 2;
104 Inc(ARect.Left, w);
105 Inc(ARect.Top, w);
106 Dec(ARect.Right, w);
107 Dec(ARect.Bottom, w);
108 end;
109
110 procedure CalculateInnerRect(ABorder: TBCBorder; var ARect: TRect);
111 var w: integer;
112 begin
113 if (ABorder = nil) or (ABorder.Style = bboNone) then Exit;
114 w := ABorder.Width;
115 Inc(ARect.Left, w);
116 Inc(ARect.Top, w);
117 Dec(ARect.Right, w);
118 Dec(ARect.Bottom, w);
119 end;
120
121 function CreateGradient(AGradient: TBCGradient; ARect: TRect): TBGRAGradientScanner;
122 begin
123 Result := TBGRAGradientScanner.Create(
124 ColorToBGRA(ColorToRGB(AGradient.StartColor), AGradient.StartColorOpacity),
125 ColorToBGRA(ColorToRGB(AGradient.EndColor), AGradient.EndColorOpacity),
126 AGradient.GradientType, PointF(ARect.Left + Round(
127 ((ARect.Right - ARect.Left) / 100) * AGradient.Point1XPercent),
128 ARect.Top + Round(((ARect.Bottom - ARect.Top) / 100) * AGradient.Point1YPercent)),
129 PointF(ARect.Left + Round(((ARect.Right - ARect.Left) / 100) *
130 AGradient.Point2XPercent), ARect.Top + Round(
131 ((ARect.Bottom - ARect.Top) / 100) * AGradient.Point2YPercent)),
132 AGradient.ColorCorrection, AGradient.Sinus);
133 end;
134
135 procedure RenderBackgroundAndBorder(const ARect: TRect;
136 ABackground: TBCBackground; ATargetBGRA: TBGRABitmap;
137 ARounding: TBCRounding; ABorder: TBCBorder; AInnerMargin: single);
138 var w: single;
139 begin
140 if ABorder.Style = bboNone then
141 begin
142 w := AInnerMargin-0.5;
143 RenderBackgroundF(ARect.Left+w, ARect.Top+w, ARect.Right-1-w,
144 ARect.Bottom-1-w,ABackground,ATargetBGRA,ARounding);
145 end
146 else
147 begin
148 w := (ABorder.Width-1)/2+AInnerMargin;
149 RenderBackgroundF(ARect.Left+w,ARect.Top+w,ARect.Right-1-w,ARect.Bottom-1-w,ABackground,ATargetBGRA,ARounding);
150 RenderBorderF(ARect.Left+w,ARect.Top+w,ARect.Right-1-w,ARect.Bottom-1-w,ABorder,ATargetBGRA,ARounding);
151 end;
152 end;
153
154 procedure RenderBorder(const ARect: TRect; ABorder: TBCBorder;
155 ATargetBGRA: TBGRABitmap; ARounding: TBCRounding = nil);
156 begin
157 RenderBorderF(ARect.Left,ARect.Top,ARect.Right-1,ARect.Bottom-1,ABorder,
158 ATargetBGRA,ARounding);
159 end;
160
161 procedure RenderBorderF(x1,y1,x2,y2: single; ABorder: TBCBorder;
162 ATargetBGRA: TBGRABitmap; ARounding: TBCRounding = nil);
163 var
164 fiLight: TFillBorderRoundRectInfo;
165 rx,ry: Byte;
166 ropt: TRoundRectangleOptions;
167 begin
168 if (x1>x2) or (y1>y2) then exit;
169 if ABorder.Style=bboNone then Exit;
170
171 if ARounding = nil then
172 begin
173 rx := 0;
174 ry := 0;
175 ropt := [];
176 end else
177 begin
178 rx := ARounding.RoundX;
179 ry := ARounding.RoundY;
180 ropt := ARounding.RoundOptions;
181 end;
182
183 ATargetBGRA.RoundRectAntialias(x1,y1,x2,y2,
184 rx, ry, ColorToBGRA(ColorToRGB(ABorder.Color),ABorder.ColorOpacity),
185 ABorder.Width, ropt);
186
187 if ABorder.LightWidth > 0 then
188 begin
189 //compute light position
190 fiLight := TFillBorderRoundRectInfo.Create(
191 x1,y1,x2,y2, rx,
192 ry, ABorder.Width + ABorder.LightWidth, ropt);
193 //check if there is an inner position
194 if fiLight.InnerBorder <> nil then
195 with fiLight.InnerBorder do //fill with light
196 ATargetBGRA.RoundRectAntialias(topleft.x, topleft.y, bottomright.x,
197 bottomright.y, radiusx, radiusY,
198 ColorToBGRA(ColorToRGB(ABorder.LightColor), ABorder.LightOpacity),
199 ABorder.LightWidth, ropt);
200 fiLight.Free;
201 end;
202 end;
203
204 procedure RenderText(const ARect: TRect; AFont: TBCFont;
205 const AText: String; ATargetBGRA: TBGRABitmap);
206 var
207 shd: TBGRABitmap;
208 hal: TAlignment;
209 val: TTextLayout;
210 st: TTextStyle;
211 r: TRect;
212 begin
213 if AText = '' then exit;
214
215 AssignBCFont(AFont,ATargetBGRA);
216
217 hal := BCAlign2HAlign(AFont.TextAlignment);
218 val := BCAlign2VAlign(AFont.TextAlignment);
219
220 FillChar({%H-}st, SizeOf({%H-}st),0);
221
222 st.Wordbreak := AFont.WordBreak;
223 st.Alignment := hal;
224 st.Layout := val;
225 st.SingleLine := AFont.SingleLine;
226 st.EndEllipsis := AFont.EndEllipsis;
227 r := ARect;
228 r.Left += AFont.PaddingLeft;
229 r.Right -= AFont.PaddingRight;
230 r.Top += AFont.PaddingTop;
231 r.Bottom -= AFont.PaddingBottom;
232
233 if AFont.Shadow then
234 begin
235 shd := TBGRABitmap.Create(ATargetBGRA.Width,ATargetBGRA.Height,BGRAPixelTransparent);
236 shd.FontName := ATargetBGRA.FontName;
237 shd.FontStyle := ATargetBGRA.FontStyle;
238 shd.FontQuality := ATargetBGRA.FontQuality;
239 shd.FontHeight := ATargetBGRA.FontHeight;
240 shd.TextRect(r, r.Left, r.Top, AText, st, ColorToBGRA(ColorToRGB(AFont.ShadowColor),
241 AFont.ShadowColorOpacity));
242 BGRAReplace(shd, shd.FilterBlurRadial(AFont.ShadowRadius, rbFast));
243 ATargetBGRA.BlendImage(AFont.ShadowOffsetX, AFont.ShadowOffsetY,
244 shd, boLinearBlend);
245 shd.Free;
246 end;
247
248 ATargetBGRA.TextRect(r,r.Left,r.Top,AText,st,AFont.Color);
249
250 end;
251
252 function BCAlign2HAlign(AAlign: TBCAlignment): TAlignment;
253 begin
254 if AAlign in [bcaCenter, bcaCenterTop, bcaCenterBottom] then
255 Result := taCenter
256 else if AAlign in [bcaRightCenter, bcaRightTop, bcaRightBottom] then
257 Result := taRightJustify
258 else
259 Result := taLeftJustify;
260 end;
261
262 function BCAlign2VAlign(AAlign: TBCAlignment): TTextLayout;
263 begin
264 if AAlign in [bcaCenter, bcaLeftCenter, bcaRightCenter] then
265 Result := tlCenter
266 else if AAlign in [bcaCenterBottom, bcaLeftBottom, bcaRightBottom] then
267 Result := tlBottom
268 else
269 Result := tlTop;
270 end;
271
272 function ScaleRect(ARect: TRect; AScale: Single): TRect;
273 begin
274 with ARect do
275 result := rect(round(Left*AScale), round(Top*AScale),
276 round(Right*AScale), round(Bottom*AScale));
277 end;
278
279 procedure AssignBCFont(AFont: TBCFont; var ATargetBGRA: TBGRABitmap);
280 var c: TBitmap;
281 begin
282 // Canvas is need for calculate font height
283 c := TBitmap.Create;
284 c.Canvas.Font.Name := AFont.Name;
285 c.Canvas.Font.Style := AFont.Style;
286 case AFont.FontQuality of
287 fqSystem: c.Canvas.Font.Quality := fqNonAntialiased;
288 fqFineAntialiasing: c.Canvas.Font.Quality := fqAntialiased;
289 fqFineClearTypeRGB: c.Canvas.Font.Quality := fqProof;
290 fqSystemClearType: c.Canvas.Font.Quality := fqCleartype;
291 end;
292 // FontAntialias is only backward compability for FontQuality property.
293 // FontQuality is published in TBCFont so we don't need FontAntialias anymore.
294 //ATargetBGRA.FontAntialias := AFont.FontAntialias;
295 {%H-}ATargetBGRA.FontStyle := AFont.Style;
296
297 // If font quality is system, then we can leave default values. LCL will
298 // handle everything (when name is "default" or height 0)
299 if AFont.FontQuality in [fqSystem,fqSystemClearType] then
300 begin
301 ATargetBGRA.FontName := AFont.Name;
302 ATargetBGRA.FontHeight := AFont.Height;
303 end
304 else
305 begin
306 // Getting real font name
307 if SameText(AFont.Name,'default')
308 then ATargetBGRA.FontName := string(GetFontData(c.Canvas.Font.Handle).Name)
309 else ATargetBGRA.FontName := AFont.Name;
310
311 // Calculate default height, because when font quality is <> fqSystemXXX
312 // then if height is 0 then it is 0 for real
313 if (AFont.Height=0) then
314 ATargetBGRA.FontHeight := -c.Canvas.TextHeight('Bgra')
315 else
316 ATargetBGRA.FontHeight := AFont.Height;
317 end;
318 ATargetBGRA.FontQuality := AFont.FontQuality;
319 c.Free;
320 end;
321
322 procedure CalculateTextSize(const AText: String; AFont: TBCFont; out ANewWidth,
323 ANewHeight: integer; AShadowMargin: boolean);
324 var
325 s: TSize;
326 tmp: TBGRABitmap;
327 begin
328 if (AText = '') or (AFont = nil) then
329 begin
330 ANewWidth := 0;
331 ANewHeight := 0;
332 Exit;
333 end;
334
335 tmp := TBGRABitmap.Create(0,0);
336 AssignBCFont(AFont, tmp);
337 s := tmp.TextSize(AText);
338 tmp.Free;
339
340 { shadow offset }
341 if AShadowMargin and AFont.Shadow then
342 begin
343 Inc(s.cx, 2 * Abs(AFont.ShadowOffsetX) + 2 * AFont.ShadowRadius);
344 Inc(s.cy, 2 * Abs(AFont.ShadowOffsetY) + 2 * AFont.ShadowRadius);
345 end;
346
347 inc(s.cx, AFont.PaddingLeft+Afont.PaddingRight);
348 inc(s.cy, AFont.PaddingTop+Afont.PaddingBottom);
349
350 ANewWidth := s.cx;
351 ANewHeight := s.cy;
352 end;
353
354 procedure CalculateTextSizeEx(const AText: String; AFont: TBCFont; out
355 ANewWidth, ANewHeight: integer; AAvailableWidth: integer; AShadowMargin: boolean);
356 var
357 s: TSize;
358 tmp: TBGRABitmap;
359 extraX,extraY, fitCount: integer;
360 dotSize: LongInt;
361 begin
362 if (AText = '') or (AFont = nil) then
363 begin
364 ANewWidth := 0;
365 ANewHeight := 0;
366 Exit;
367 end;
368
369 extraX := 0;
370 extraY := 0;
371 { shadow offset }
372 if AShadowMargin and AFont.Shadow then
373 begin
374 Inc(extraX, 2 * Abs(AFont.ShadowOffsetX) + 2 * AFont.ShadowRadius);
375 Inc(extraY, 2 * Abs(AFont.ShadowOffsetY) + 2 * AFont.ShadowRadius);
376 end;
377
378 inc(extraX, AFont.PaddingLeft+Afont.PaddingRight);
379 inc(extraY, AFont.PaddingTop+Afont.PaddingBottom);
380
381 dec(AAvailableWidth, extraX);
382 tmp := TBGRABitmap.Create(0,0);
383 AssignBCFont(AFont, tmp);
384 if AFont.WordBreak then
385 s := tmp.TextSize(AText, AAvailableWidth)
386 else
387 begin
388 s := tmp.TextSize(AText);
389 if AFont.EndEllipsis and (s.cx > AAvailableWidth) then
390 begin
391 dotSize := tmp.TextSize('...').cx;
392 fitCount := tmp.TextFitInfo(AText, AAvailableWidth-dotSize);
393 s.cx := tmp.TextSize(UTF8Copy(AText, 1, fitCount)).cx + dotSize;
394 end;
395 end;
396 tmp.Free;
397
398 ANewWidth := s.cx+extraX;
399 ANewHeight := s.cy+extraY;
400 end;
401
402 procedure GetGlyphActualLayout(ACaption: string; AFont: TBCFont;
403 AGlyphAlignment: TBCAlignment; AGlyphMargin: integer; out AHorizAlign: TAlignment;
404 out AVertAlign: TTextLayout; out AGlyphRelativeHorizAlign: TAlignment;
405 out AGlyphRelativeVertAlign: TTextLayout; out AGlyphHorizMargin: integer;
406 out AGlyphVertMargin: integer);
407 begin
408 if AGlyphAlignment in [bcaLeftTop,bcaLeftCenter,bcaLeftBottom] then AHorizAlign := taLeftJustify
409 else if AGlyphAlignment in [bcaRightTop,bcaRightCenter,bcaRightBottom] then AHorizAlign:= taRightJustify
410 else AHorizAlign:= taCenter;
411 if AGlyphAlignment in [bcaCenter,bcaLeftCenter,bcaRightCenter] then AVertAlign := tlCenter
412 else if AGlyphAlignment in [bcaLeftBottom,bcaCenterBottom,bcaRightBottom] then AVertAlign := tlBottom
413 else AVertAlign := tlTop;
414
415 if ACaption<>'' then
416 begin
417 AGlyphRelativeVertAlign:= AVertAlign;
418 if AVertAlign <> tlCenter then
419 AGlyphRelativeHorizAlign:= AHorizAlign else
420 begin
421 if AHorizAlign = taCenter then
422 begin
423 if IsRightToLeftUTF8(ACaption) then AGlyphRelativeHorizAlign := taRightJustify
424 else AGlyphRelativeHorizAlign := taLeftJustify;
425 end else
426 AGlyphRelativeHorizAlign:= AHorizAlign;
427 end;
428
429 if AFont.TextAlignment in [bcaLeftTop,bcaLeftCenter,bcaLeftBottom] then AHorizAlign := taLeftJustify
430 else if AFont.TextAlignment in [bcaRightTop,bcaRightCenter,bcaRightBottom] then AHorizAlign:= taRightJustify
431 else AHorizAlign := taCenter;
432 if AFont.TextAlignment in [bcaLeftTop,bcaCenterTop,bcaRightTop] then AVertAlign := tlTop
433 else if AFont.TextAlignment in [bcaLeftBottom,bcaCenterBottom,bcaRightBottom] then AVertAlign:= tlBottom
434 else AVertAlign:= tlCenter;
435
436 if AGlyphRelativeVertAlign in[tlTop,tlBottom] then
437 begin
438 if AGlyphRelativeHorizAlign <> taCenter then AGlyphHorizMargin:= AGlyphMargin
439 else AGlyphHorizMargin:= 0;
440 if AGlyphRelativeVertAlign = AVertAlign then AGlyphVertMargin:= AGlyphMargin
441 else AGlyphVertMargin:= 0;
442 end else
443 begin
444 AGlyphHorizMargin:= AGlyphMargin;
445 AGlyphVertMargin:= 0;
446 end;
447 end else
448 begin
449 case AHorizAlign of
450 taCenter: AGlyphRelativeHorizAlign:= taCenter;
451 taRightJustify: AGlyphRelativeHorizAlign:= taLeftJustify;
452 else AGlyphRelativeHorizAlign:= taRightJustify;
453 end;
454 if AHorizAlign <> taCenter then AGlyphHorizMargin := AGlyphMargin
455 else AGlyphHorizMargin := 0;
456 case AVertAlign of
457 tlCenter: AGlyphRelativeVertAlign:= tlCenter;
458 tlBottom: AGlyphRelativeVertAlign:= tlTop;
459 else AGlyphRelativeVertAlign:= tlBottom;
460 end;
461 if AVertAlign <> tlCenter then AGlyphVertMargin := AGlyphMargin
462 else AGlyphVertMargin := 0;
463 end;
464 end;
465
ComputeGlyphPositionnull466 function ComputeGlyphPosition(var rAvail: TRect;
467 gw, gh: integer; AGlyphAlignment: TBCAlignment; AGlyphMargin: integer;
468 ACaption: string; AFont: TBCFont; AOldPlacement: boolean): TRect;
469 var
470 w, h, w2,h2, glyphHorzMargin, glyphVertMargin: integer;
471 horizAlign, relHorizAlign: TAlignment;
472 vertAlign, relVertAlign: TTextLayout;
473 rText, rAll, rGlyph: TRect;
474 l,t: integer;
475
476 procedure AlignRect(var ARect: TRect; const ABounds: TRect; AHorizAlign: TAlignment;
477 AVertAlign: TTextLayout; AHorizMargin: integer = 0; AVertMargin: integer = 0);
478 begin
479 case AHorizAlign of
480 taCenter: ARect.Offset((ABounds.Left+ABounds.Right - (ARect.Right-ARect.Left)) div 2,0);
481 taRightJustify: ARect.Offset(ABounds.Right - AHorizMargin - (ARect.Right-ARect.Left),0);
482 else ARect.Offset(ABounds.Left + AHorizMargin,0);
483 end;
484 case AVertAlign of
485 tlCenter: ARect.Offset(0, (ABounds.Top+ABounds.Bottom - (ARect.Bottom-ARect.Top)) div 2);
486 tlBottom: ARect.Offset(0, ABounds.Bottom - AVertMargin - (ARect.Bottom-ARect.Top));
487 else ARect.Offset(0, ABounds.Top + AVertMargin);
488 end;
489 end;
490
491 begin
492 if (gw = 0) or (gh = 0) then exit(EmptyRect);
493
494 if AOldPlacement then
495 begin
496 if ACaption = '' then
497 begin
498 w := 0;
499 h := 0;
500 end else
501 CalculateTextSize(ACaption, AFont, w, h);
502 l := rAvail.Right - Round(((rAvail.Right - rAvail.Left) + w + gw) / 2);
503 t := rAvail.Bottom - Round(((rAvail.Bottom - rAvail.Top) + gh) / 2);
504 result := rect(l,t,l+gw,t+gh);
505 Inc(rAvail.Left, l + gw + AGlyphMargin);
506 exit;
507 end;
508
509 GetGlyphActualLayout(ACaption, AFont, AGlyphAlignment, AGlyphMargin,
510 horizAlign, vertAlign, relHorizAlign, relVertAlign, glyphHorzMargin, glyphVertMargin);
511
512 if ACaption = '' then
513 begin
514 rGlyph := rect(0,0,gw,gh);
515 AlignRect(rGlyph, rAvail, horizAlign, vertAlign, glyphHorzMargin, glyphVertMargin);
516 exit(rGlyph);
517 end else
518 CalculateTextSizeEx(ACaption, AFont, w, h, rAvail.Right-rAvail.Left);
519
520 if relVertAlign in[tlTop,tlBottom] then
521 begin
522 w2 := max(w,gw+glyphHorzMargin);
523 h2 := h+gh+glyphVertMargin;
524 end else
525 begin
526 w2 := w+gw+glyphHorzMargin;
527 if (ACaption <> '') and (w2 > rAvail.Right-rAvail.Left) then
528 begin
529 CalculateTextSizeEx(ACaption, AFont, w, h, rAvail.Right-rAvail.Left - (gw+glyphHorzMargin));
530 w2 := w+gw+glyphHorzMargin;
531 end;
532 h2 := max(h,gh+glyphVertMargin);
533 end;
534 rAll := rect(0,0,w2,h2);
535 AlignRect(rAll, rAvail, horizAlign, vertAlign);
536
537 rText := rect(0,0,w,h);
538 rGlyph := rect(0,0,gw,gh);
539 case relVertAlign of
540 tlTop: begin
541 AlignRect(rGlyph, rAll, relHorizAlign, tlTop,
542 glyphHorzMargin, glyphVertMargin);
543 AlignRect(rText, rAll, horizAlign, tlBottom);
544 end;
545 tlBottom: begin
546 AlignRect(rGlyph, rAll, relHorizAlign, tlBottom,
547 glyphHorzMargin, glyphVertMargin);
548 AlignRect(rText, rAll, horizAlign, tlTop);
549 end;
550 else begin
551 if relHorizAlign = taRightJustify then
552 begin
553 AlignRect(rGlyph, rAll, taRightJustify, tlCenter,
554 glyphHorzMargin, glyphHorzMargin);
555 AlignRect(rText, rAll, taLeftJustify, tlCenter);
556 end else
557 begin
558 AlignRect(rGlyph, rAll, taLeftJustify, tlCenter,
559 glyphHorzMargin, glyphHorzMargin);
560 AlignRect(rText, rAll, taRightJustify, tlCenter);
561 end;
562 end;
563 end;
564 result := rGlyph;
565 if AFont.WordBreak and (rText.Right < rAvail.Right) then inc(rText.Right); //word-break computation may be one pixel off
566 rAvail := rText;
567 end;
568
569 procedure RenderArrow(ATargetBGRA: TBGRABitmap; const ARect: TRect;
570 ASize: Integer; ADirection: TBCArrowDirection; AColor: TColor; AOpacity: Byte);
571 var
572 p: ArrayOfTPointF;
573 n: byte;
574 temp: TBGRABitmap;
575 w: Integer;
576 begin
577 // We can't draw outside rect
578 w := Min(ASize, ARect.Right - ARect.Left);
579
580 { Poly }
581 SetLength(p, 3);
582
583 temp := TBGRABitmap.Create(w+1, w+1,BGRAPixelTransparent);
584
585 case ADirection of
586 badDown:
587 begin;
588 p[0].x := 0;
589 p[0].y := 0;
590
591 p[1].x := w;
592 p[1].y := 0;
593
594 p[2].x := Round(w/2);
595 p[2].y := w;
596 end;
597 badUp:
598 begin
599 p[0].x := Round(w/2);
600 p[0].y := 0;
601
602 p[1].x := 0;
603 p[1].y := w;
604
605 p[2].x := w;
606 p[2].y := w;
607 end;
608 badLeft:
609 begin
610 p[0].x := 0;
611 p[0].y := Round(w/2);
612
613 p[1].x := w;
614 p[1].y := 0;
615
616 p[2].x := w;
617 p[2].y := w;
618 end;
619 badRight:
620 begin
621 p[0].x := w;
622 p[0].y := Round(w/2);
623
624 p[1].x := 0;
625 p[1].y := 0;
626
627 p[2].x := 0;
628 p[2].y := w;
629 end;
630 end;
631
632 // Fill n times to get best quality
633 for n := 1 to 6 do
634 temp.FillPolyAntialias(p, ColorToBGRA(ColorToRGB(AColor),AOpacity));
635
636 ATargetBGRA.BlendImage(
637 ARect.Right-Round( ((ARect.Right-ARect.Left)/2) + (w/2) ),
638 ARect.Bottom-Round( ((ARect.Bottom-ARect.Top)/2) + (w/2) ),
639 temp,
640 boLinearBlend
641 );
642 temp.Free;
643 end;
644
645 procedure RenderBackgroundF(x1,y1,x2,y2: single; ABackground: TBCBackground;
646 ATargetBGRA: TBGRABitmap; ARounding: TBCRounding = nil);
647 var
648 backcolor: TBGRAPixel;
649 multi: TBGRAMultishapeFiller;
650 back: TBGRABitmap;
651 grect1, grect2: TRect;
652 gra: TBGRAGradientScanner;
653 rx,ry: Byte;
654 ropt: TRoundRectangleOptions;
655 begin
656 if (x1>=x2) or (y1>=y2) then exit;
657 if ARounding = nil then
658 begin
659 rx := 0;
660 ry := 0;
661 ropt := [];
662 end else
663 begin
664 rx := ARounding.RoundX;
665 ry := ARounding.RoundY;
666 ropt := ARounding.RoundOptions;
667 end;
668
669 { Background color }
670 case ABackground.Style of
671 bbsClear: backcolor := BGRAPixelTransparent;
672 // TODO: Why if I use some system colors like clBtnFace, clActiveCaption etc.
673 // without ColorToRGB, I always get Black? Interface: QT
674 bbsColor: backcolor := ColorToBGRA(ColorToRGB(ABackground.Color), ABackground.ColorOpacity);
675 end;
676
677 case ABackground.Style of
678 bbsClear, bbsColor:
679 { Solid background color }
680 ATargetBGRA.FillRoundRectAntialias(x1,y1,x2,y2, rx, ry, {%H-}backcolor, ropt);
681 bbsGradient:
682 begin
683 { Using multishape filler to merge background gradient and border }
684 multi := TBGRAMultishapeFiller.Create;
685 multi.PolygonOrder := poFirstOnTop; { Border will replace background }
686
687 { Gradients }
688 back := TBGRABitmap.Create(ATargetBGRA.Width, ATargetBGRA.Height, BGRAPixelTransparent);
689 grect1 := rect(floor(x1),floor(y1),ceil(x2)+1,ceil(y2)+1);
690 grect2 := grect1;
691 { Gradient 1 }
692 if ABackground.Gradient1EndPercent > 0 then
693 begin
694 grect1.Bottom := grect1.top + Round(((grect1.Bottom-grect1.Top) / 100) * ABackground.Gradient1EndPercent);
695 gra := CreateGradient(ABackground.Gradient1, grect1);
696 back.FillRect(grect1.Left, grect1.Top, grect1.Right, grect1.Bottom,
697 gra, dmSet
698 );
699 gra.Free;
700 end;
701 { Gradient 2 }
702 if ABackground.Gradient1EndPercent < 100 then
703 begin
704 grect2.Top := grect1.Bottom;
705 gra := CreateGradient(ABackground.Gradient2, grect2);
706 back.FillRect(grect2.Left, grect2.Top, grect2.Right, grect2.Bottom,
707 gra, dmSet
708 );
709 gra.Free;
710 end;
711
712 multi.AddRoundRectangle(x1,y1,x2,y2, rx, ry, back, ropt);
713
714 multi.Draw(ATargetBGRA);
715 multi.Free;
716 back.Free;
717 end;
718 end;
719 end;
720
721 procedure RenderBackground(const ARect: TRect; ABackground: TBCBackground;
722 ATargetBGRA: TBGRABitmap; ARounding: TBCRounding = nil; AHasNoBorder: boolean = false);
723 var
724 extraSize: single;
725 begin
726 if AHasNoBorder then extraSize := 0.5
727 else extraSize := 0;
728 RenderBackgroundF(ARect.Left-extraSize, ARect.Top-extraSize, ARect.Right-1+extraSize,
729 ARect.Bottom-1+extraSize,ABackground,ATargetBGRA,ARounding);
730 end;
731
732 end.
733
734