1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit BGRAFontGL;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 BGRAClasses, SysUtils, BGRAGraphics, BGRAOpenGLType, BGRABitmapTypes,
10 Avl_Tree;
11
12 type
13 { TRenderedGlyph }
14
15 TRenderedGlyph = class
16 private
17 FIdentifier: UTF8String;
18 FTexture: IBGLTexture;
19 FHorizontalOverflowPx, FVerticalOverflowPx, FAdvancePx: integer;
20 public
21 constructor Create(AIdentifier: UTF8String; ATexture: IBGLTexture;
22 AHorizontalOverflowPx, AVerticalOverflowPx: integer);
23 procedure Draw(x,y,Scale: single; AColor: TBGRAPixel); overload;
24 procedure Draw(x,y,Scale: single; AGradTopLeft, AGradTopRight, AGradBottomRight, AGradBottomLeft: TBGRAPixel); overload;
25 property Identifier: UTF8String read FIdentifier;
26 property AdvancePx: integer read FAdvancePx;
27 end;
28
29 { IBGLRenderedFont }
30
31 IBGLRenderedFont = interface(IBGLFont)
GetBackgroundColornull32 function GetBackgroundColor: TBGRAPixel;
GetColornull33 function GetColor: TBGRAPixel;
GetFontEmHeightnull34 function GetFontEmHeight: integer;
GetFontFullHeightnull35 function GetFontFullHeight: integer;
GetHorizontalOverflownull36 function GetHorizontalOverflow: single;
GetNamenull37 function GetName: string;
GetQualitynull38 function GetQuality: TBGRAFontQuality;
GetStylenull39 function GetStyle: TFontStyles;
GetVerticalOverflownull40 function GetVerticalOverflow: single;
41 procedure SetBackgroundColor(AValue: TBGRAPixel);
42 procedure SetColor(AValue: TBGRAPixel);
43 procedure SetFontEmHeight(AValue: integer);
44 procedure SetFontFullHeight(AValue: integer);
45 procedure SetHorizontalOverflow(AValue: single);
46 procedure SetName(AValue: string);
47 procedure SetQuality(AValue: TBGRAFontQuality);
48 procedure SetStyle(AValue: TFontStyles);
49 procedure SetVerticalOverflow(AValue: single);
50
51 property Name: string read GetName write SetName;
52 property Style: TFontStyles read GetStyle write SetStyle;
53 property Quality: TBGRAFontQuality read GetQuality write SetQuality;
54 property EmHeight: integer read GetFontEmHeight write SetFontEmHeight;
55 property FullHeight: integer read GetFontFullHeight write SetFontFullHeight;
56 property Color: TBGRAPixel read GetColor write SetColor;
57 property HorizontalOverflow: single read GetHorizontalOverflow write SetHorizontalOverflow;
58 property VerticalOverflow: single read GetVerticalOverflow write SetVerticalOverflow;
59 property BackgroundColor: TBGRAPixel read GetBackgroundColor write SetBackgroundColor;
60 end;
61
62 { TBGLRenderedFont }
63
64 TBGLRenderedFont = class(TBGLCustomFont,IBGLRenderedFont)
65 private
66 FGlyphs: TAVLTree;
67
68 FName: string;
69 FColor: TBGRAPixel;
70 FBackgroundColor: TBGRAPixel;
71 FEmHeight: integer;
72 FHorizontalOverflow: single;
73 FVerticalOverflow: single;
74 FQuality: TBGRAFontQuality;
75 FStyle: TFontStyles;
76 FGradTopLeft, FGradTopRight, FGradBottomRight, FGradBottomLeft: TBGRAPixel;
77 FUseGradientColor: boolean;
78 FClipped: boolean;
79 FWordBreakHandler: TWordBreakHandler;
80
FindGlyphnull81 function FindGlyph(AIdentifier: string): TAVLTreeNode;
GetBackgroundColornull82 function GetBackgroundColor: TBGRAPixel;
GetColornull83 function GetColor: TBGRAPixel;
GetFontEmHeightnull84 function GetFontEmHeight: integer;
GetGlyphnull85 function GetGlyph(AIdentifier: string): TRenderedGlyph;
GetHorizontalOverflownull86 function GetHorizontalOverflow: single;
GetNamenull87 function GetName: string;
GetQualitynull88 function GetQuality: TBGRAFontQuality;
GetStylenull89 function GetStyle: TFontStyles;
GetVerticalOverflownull90 function GetVerticalOverflow: single;
91 procedure SetGlyph(AIdentifier: string; AValue: TRenderedGlyph);
GetFontFullHeightnull92 function GetFontFullHeight: integer;
93 procedure SetBackgroundColor(AValue: TBGRAPixel);
94 procedure SetColor(AValue: TBGRAPixel);
95 procedure SetFontEmHeight(AValue: integer);
96 procedure SetFontFullHeight(AValue: integer);
97 procedure SetHorizontalOverflow(AValue: single);
98 procedure SetName(AValue: string);
99 procedure SetQuality(AValue: TBGRAFontQuality);
100 procedure SetStyle(AValue: TFontStyles);
101 procedure SetVerticalOverflow(AValue: single);
102 protected
103 FRenderer: TBGRACustomFontRenderer;
104 FRendererOwned: boolean;
LoadFromFilenull105 function LoadFromFile({%H-}AFilename: UTF8String): boolean; override;
106 procedure FreeMemoryOnDestroy; override;
CreateGlyphnull107 function CreateGlyph(AIdentifier: string): TRenderedGlyph; virtual;
108 procedure CopyFontToRenderer; virtual;
109 procedure DoTextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel; AHorizontalAlign: TAlignment; AVerticalAlign: TTextLayout); overload; virtual;
110 procedure DoTextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); overload; override;
111 procedure DoTextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); override;
GetClippednull112 function GetClipped: boolean; override;
GetUseGradientColorsnull113 function GetUseGradientColors: boolean; override;
114 procedure SetClipped(AValue: boolean); override;
115 procedure SetUseGradientColors(AValue: boolean); override;
116 procedure DiscardGlyphs; virtual;
117 procedure DefaultWordBreakHandler(var ABefore, AAfter: string);
118 procedure SplitText(var ATextUTF8: string; AMaxWidth: single; out ARemainsUTF8: string);
GetWrappedLinesnull119 function GetWrappedLines(ATextUTF8: string; AWidth: single): TStringList;
120 public
121 constructor Create(ARenderer: TBGRACustomFontRenderer; ARendererOwned: boolean = true);
122 procedure FreeMemory; override;
TextWidthnull123 function TextWidth(const Text: UTF8String): single; override;
TextHeightnull124 function TextHeight(const {%H-}Text: UTF8String): single; override;
TextHeightnull125 function TextHeight(const Text: UTF8String; AWidth: single): single; override;
126 procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); override;
127 property Name: string read GetName write SetName;
128 property Style: TFontStyles read GetStyle write SetStyle;
129 property Quality: TBGRAFontQuality read GetQuality write SetQuality;
130 property EmHeight: integer read GetFontEmHeight write SetFontEmHeight;
131 property FullHeight: integer read GetFontFullHeight write SetFontFullHeight;
132 property Color: TBGRAPixel read GetColor write SetColor;
133 property HorizontalOverflow: single read GetHorizontalOverflow write SetHorizontalOverflow;
134 property VerticalOverflow: single read GetVerticalOverflow write SetVerticalOverflow;
135 property BackgroundColor: TBGRAPixel read GetBackgroundColor write SetBackgroundColor;
136 property WordBreakHandler: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler;
137 property Glyph[AIdentifier: string]: TRenderedGlyph read GetGlyph;
138 end;
139
140 implementation
141
142 uses BGRAUTF8;
143
144 { TRenderedGlyph }
145
146 constructor TRenderedGlyph.Create(AIdentifier: UTF8String; ATexture: IBGLTexture;
147 AHorizontalOverflowPx, AVerticalOverflowPx: integer);
148 begin
149 FIdentifier := AIdentifier;
150 FTexture := ATexture;
151 FHorizontalOverflowPx:= AHorizontalOverflowPx;
152 FVerticalOverflowPx:= AVerticalOverflowPx;
153 FAdvancePx := ATexture.Width - 2*FHorizontalOverflowPx;
154 end;
155
156 procedure TRenderedGlyph.Draw(x, y, Scale: single; AColor: TBGRAPixel);
157 begin
158 FTexture.StretchDraw(x-FHorizontalOverflowPx*Scale,y-FVerticalOverflowPx*Scale, FTexture.Width*Scale, FTexture.Height*Scale, AColor);
159 end;
160
161 procedure TRenderedGlyph.Draw(x, y, Scale: single; AGradTopLeft, AGradTopRight,
162 AGradBottomRight, AGradBottomLeft: TBGRAPixel);
163 begin
164 FTexture.SetGradientColors(AGradTopLeft,AGradTopRight, AGradBottomRight,AGradBottomLeft);
165 FTexture.StretchDraw(x-FHorizontalOverflowPx*Scale,y-FVerticalOverflowPx*Scale, FTexture.Width*Scale, FTexture.Height*Scale);
166 FTexture.GradientColors := false;
167 end;
168
CompareGlyphNodenull169 function CompareGlyphNode(Data1, Data2: Pointer): integer;
170 begin
171 result := CompareStr(TRenderedGlyph(Data1).Identifier,TRenderedGlyph(Data2).Identifier);
172 end;
173
174 { TBGLRenderedFont }
175
FindGlyphnull176 function TBGLRenderedFont.FindGlyph(AIdentifier: string): TAVLTreeNode;
177 var Comp: integer;
178 Node: TAVLTreeNode;
179 begin
180 Node:=FGlyphs.Root;
181 while (Node<>nil) do begin
182 Comp:=CompareStr(AIdentifier,TRenderedGlyph(Node.Data).Identifier);
183 if Comp=0 then break;
184 if Comp<0 then begin
185 Node:=Node.Left
186 end else begin
187 Node:=Node.Right
188 end;
189 end;
190 result := Node;
191 end;
192
GetBackgroundColornull193 function TBGLRenderedFont.GetBackgroundColor: TBGRAPixel;
194 begin
195 result := FBackgroundColor;
196 end;
197
GetColornull198 function TBGLRenderedFont.GetColor: TBGRAPixel;
199 begin
200 result := FColor;
201 end;
202
TBGLRenderedFont.GetFontEmHeightnull203 function TBGLRenderedFont.GetFontEmHeight: integer;
204 begin
205 result := FEmHeight;
206 end;
207
TBGLRenderedFont.CreateGlyphnull208 function TBGLRenderedFont.CreateGlyph(AIdentifier: string): TRenderedGlyph;
209 var b: TBGLCustomBitmap;
210 hOverflow, vOverflow: integer;
211 begin
212 CopyFontToRenderer;
213 with FRenderer.TextSize(AIdentifier) do
214 begin
215 hOverflow := round(cx*HorizontalOverflow)+1;
216 vOverflow:= round(cy*VerticalOverflow)+1;
217 b:= BGLBitmapFactory.Create(cx+2*hOverflow,cy+2*vOverflow,BackgroundColor);
218 FRenderer.TextOut(b, hOverflow,vOverflow, AIdentifier, Color, taLeftJustify);
219 result:= TRenderedGlyph.Create(AIdentifier,b.MakeTextureAndFree,hOverflow,vOverflow);
220 end;
221 end;
222
223 procedure TBGLRenderedFont.CopyFontToRenderer;
224 begin
225 FRenderer.FontName := FName;
226 FRenderer.FontEmHeight := FEmHeight;
227 FRenderer.FontOrientation := 0;
228 FRenderer.FontQuality := FQuality;
229 FRenderer.FontStyle := FStyle;
230 end;
231
232 procedure TBGLRenderedFont.DoTextOut(X, Y: Single; const Text: UTF8String;
233 AColor: TBGRAPixel; AHorizontalAlign: TAlignment; AVerticalAlign: TTextLayout);
234 var
235 pstr: pchar;
236 left,charlen: integer;
237 nextchar: string;
238 g: TRenderedGlyph;
239 begin
240 if Text = '' then exit;
241
242 pstr := @Text[1];
243 left := length(Text);
244 case AHorizontalAlign of
245 taCenter: DecF(x, round(TextWidth(Text)/2));
246 taRightJustify: DecF(x, TextWidth(Text));
247 end;
248 case AVerticalAlign of
249 tlCenter: DecF(y, round(TextHeight(Text)/2));
250 tlBottom: DecF(y, TextHeight(Text)*Scale);
251 end;
252 while left > 0 do
253 begin
254 charlen := UTF8CharacterLength(pstr);
255 setlength(nextchar, charlen);
256 move(pstr^, nextchar[1], charlen);
257 inc(pstr,charlen);
258 dec(left,charlen);
259
260 g := GetGlyph(nextchar);
261 if g <> nil then
262 begin
263 if FUseGradientColor then
264 g.Draw(x,y,Scale,FGradTopLeft,FGradTopRight,FGradBottomRight,FGradBottomLeft)
265 else
266 g.Draw(x,y,Scale,AColor);
267 IncF(x, (g.AdvancePx + StepX) * Scale);
268 end;
269 end;
270 end;
271
272 procedure TBGLRenderedFont.DoTextOut(X, Y: Single; const Text: UTF8String;
273 AColor: TBGRAPixel);
274 begin
275 if Justify then
276 DoTextOut(X,Y,Text,AColor,taLeftJustify,VerticalAlign)
277 else
278 DoTextOut(X,Y,Text,AColor,HorizontalAlign,VerticalAlign);
279 end;
280
281 procedure TBGLRenderedFont.DoTextRect(X, Y, Width, Height: Single;
282 const Text: UTF8String; AColor: TBGRAPixel);
283
284 procedure DoDrawTextLine(LineY, LineWidth: Single; ALine: string; AJustify: boolean);
285 var CurX: single;
286 words: TStringList;
287 wordStart: integer;
288 i: Integer;
289 begin
290 if AJustify then
291 begin
292 words := TStringList.Create;
293 wordStart := 1;
294 for i := 1 to length(ALine) do
295 begin
296 if ALine[i]=' ' then
297 begin
298 words.Add(copy(ALine,wordStart,i-wordStart));
299 wordStart := i+1;
300 end;
301 end;
302 words.add(copy(ALine,wordStart,length(ALine)+1-wordStart));
303 CurX := X;
304 LineWidth := 0;
305 for i := 0 to words.Count-1 do
306 IncF(LineWidth, TextWidth(words[i]));
307
308 for i := 0 to words.Count-1 do
309 begin
310 DoTextOut(CurX+round((Width-LineWidth)/(words.Count-1)*i),LineY,words[i],AColor,taLeftJustify,tlTop);
311 IncF(CurX, TextWidth(words[i]));
312 end;
313 words.Free;
314 end else
315 begin
316 Case HorizontalAlign of
317 taCenter: CurX := round(X+(Width-LineWidth)/2);
318 taRightJustify: CurX := X+Width-LineWidth;
319 else
320 CurX := X;
321 end;
322 DoTextOut(CurX,LineY,ALine,AColor,taLeftJustify,tlTop);
323 end;
324 end;
325
326 var CurY: Single;
327 lineHeight: Single;
328 lines: TStringList;
329 i,originalNbLines: Integer;
330 maxLineCount: int64;
331 begin
332 If Text='' then exit;
333 lines := GetWrappedLines(Text,Width);
334 lineHeight := FullHeight * Scale;
335 originalNbLines := lines.Count;
336
337 if Clipped then
338 begin
339 if lineHeight = 0 then exit;
340 maxLineCount := trunc(Height/lineHeight);
341 if maxLineCount <= 0 then exit;
342 while lines.Count > maxLineCount do
343 lines.Delete(lines.Count-1);
344 end;
345
346 case VerticalAlign of
347 tlCenter: CurY := round(Y+( Height - lines.Count*lineHeight )/2);
348 tlBottom: CurY := Y + Height - lines.Count*lineHeight;
349 else CurY := Y;
350 end;
351
352 for i := 0 to lines.Count-1 do
353 begin
354 DoDrawTextLine(CurY,TextWidth(lines[i]),lines[i],Justify and (i<>originalNbLines-1));
355 IncF(CurY, lineHeight);
356 end;
357 lines.Free;
358 end;
359
GetGlyphnull360 function TBGLRenderedFont.GetGlyph(AIdentifier: string): TRenderedGlyph;
361 var Node: TAVLTreeNode;
362 begin
363 Node := FindGlyph(AIdentifier);
364 if Node = nil then
365 begin
366 if UTF8Length(AIdentifier)<>1 then
367 result := nil
368 else
369 begin
370 result := CreateGlyph(AIdentifier);
371 SetGlyph(AIdentifier, result);
372 end;
373 end
374 else
375 result := TRenderedGlyph(Node.Data);
376 end;
377
TBGLRenderedFont.GetHorizontalOverflownull378 function TBGLRenderedFont.GetHorizontalOverflow: single;
379 begin
380 result := FHorizontalOverflow;
381 end;
382
GetNamenull383 function TBGLRenderedFont.GetName: string;
384 begin
385 result := FName;
386 end;
387
GetQualitynull388 function TBGLRenderedFont.GetQuality: TBGRAFontQuality;
389 begin
390 result := FQuality;
391 end;
392
TBGLRenderedFont.GetStylenull393 function TBGLRenderedFont.GetStyle: TFontStyles;
394 begin
395 result := FStyle;
396 end;
397
GetVerticalOverflownull398 function TBGLRenderedFont.GetVerticalOverflow: single;
399 begin
400 result := FVerticalOverflow;
401 end;
402
403 procedure TBGLRenderedFont.SetGlyph(AIdentifier: string; AValue: TRenderedGlyph);
404 var Node: TAVLTreeNode;
405 begin
406 if AValue.Identifier <> AIdentifier then
407 raise exception.Create('Identifier mismatch');
408 Node := FindGlyph(AIdentifier);
409 if Node <> nil then
410 begin
411 if pointer(AValue) <> Node.Data then
412 TRenderedGlyph(Node.Data).Free;
413 Node.Data := AValue;
414 end else
415 FGlyphs.Add(pointer(AValue));
416 end;
417
418 procedure TBGLRenderedFont.SetStyle(AValue: TFontStyles);
419 begin
420 if FStyle=AValue then Exit;
421 FStyle:=AValue;
422 DiscardGlyphs;
423 end;
424
425 procedure TBGLRenderedFont.SetVerticalOverflow(AValue: single);
426 begin
427 if FVerticalOverflow=AValue then Exit;
428 FVerticalOverflow:=AValue;
429 DiscardGlyphs;
430 end;
431
GetClippednull432 function TBGLRenderedFont.GetClipped: boolean;
433 begin
434 result := FClipped;
435 end;
436
TBGLRenderedFont.GetUseGradientColorsnull437 function TBGLRenderedFont.GetUseGradientColors: boolean;
438 begin
439 result := FUseGradientColor;
440 end;
441
442 procedure TBGLRenderedFont.SetClipped(AValue: boolean);
443 begin
444 FClipped:= AValue;
445 end;
446
447 procedure TBGLRenderedFont.SetUseGradientColors(AValue: boolean);
448 begin
449 FUseGradientColor:= AValue;
450 end;
451
452 procedure TBGLRenderedFont.DiscardGlyphs;
453 begin
454 FGlyphs.FreeAndClear;
455 end;
456
457 procedure TBGLRenderedFont.DefaultWordBreakHandler(var ABefore, AAfter: string);
458 begin
459 BGRADefaultWordBreakHandler(ABefore,AAfter);
460 end;
461
TBGLRenderedFont.GetWrappedLinesnull462 function TBGLRenderedFont.GetWrappedLines(ATextUTF8: string; AWidth: single
463 ): TStringList;
464 var
465 ARemains: string;
466 begin
467 result := TStringList.Create;
468 repeat
469 SplitText(ATextUTF8, AWidth, ARemains);
470 result.Add(ATextUTF8);
471 ATextUTF8 := ARemains;
472 until ARemains = '';
473 end;
474
475 procedure TBGLRenderedFont.SplitText(var ATextUTF8: string; AMaxWidth: single;
476 out ARemainsUTF8: string);
477 var
478 pstr: pchar;
479 p,left,charlen: integer;
480 totalWidth: single;
481 firstChar: boolean;
482 nextchar: string;
483 g: TRenderedGlyph;
484 begin
485 totalWidth := 0;
486 if ATextUTF8 = '' then
487 begin
488 ARemainsUTF8 := '';
489 exit;
490 end else
491 begin
492 p := 1;
493 pstr := @ATextUTF8[1];
494 left := length(ATextUTF8);
495 firstChar := true;
496 while left > 0 do
497 begin
498 if RemoveLineEnding(ATextUTF8,p) then
499 begin
500 ARemainsUTF8 := copy(ATextUTF8,p,length(ATextUTF8)-p+1);
501 ATextUTF8 := copy(ATextUTF8,1,p-1);
502 exit;
503 end;
504
505 charlen := UTF8CharacterLength(pstr);
506 setlength(nextchar, charlen);
507 move(pstr^, nextchar[1], charlen);
508 inc(pstr,charlen);
509
510 g := GetGlyph(nextchar);
511 if g <> nil then
512 begin
513 if not firstChar then IncF(totalWidth, StepX*Scale);
514 IncF(totalWidth, g.AdvancePx*Scale);
515 if not firstChar and (totalWidth > AMaxWidth) then
516 begin
517 ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1);
518 ATextUTF8 := copy(ATextUTF8,1,p-1);
519 if Assigned(FWordBreakHandler) then
520 FWordBreakHandler(ATextUTF8,ARemainsUTF8) else
521 DefaultWordBreakHandler(ATextUTF8,ARemainsUTF8);
522 exit;
523 end;
524 end;
525
526 dec(left,charlen);
527 inc(p,charlen);
528 firstChar := false;
529 end;
530 end;
531 ARemainsUTF8 := ''; //no split
532 end;
533
534 procedure TBGLRenderedFont.SetName(AValue: string);
535 begin
536 if FName=AValue then Exit;
537 FName:=AValue;
538 DiscardGlyphs;
539 end;
540
541 procedure TBGLRenderedFont.SetFontEmHeight(AValue: integer);
542 begin
543 if FEmHeight=AValue then Exit;
544 FEmHeight:=AValue;
545 DiscardGlyphs;
546 end;
547
GetFontFullHeightnull548 function TBGLRenderedFont.GetFontFullHeight: integer;
549 begin
550 if FEmHeight < 0 then
551 result := -EmHeight
552 else
553 result := FRenderer.TextSize('Hg').cy;
554 end;
555
556 procedure TBGLRenderedFont.SetBackgroundColor(AValue: TBGRAPixel);
557 begin
558 if FBackgroundColor=AValue then Exit;
559 FBackgroundColor:=AValue;
560 DiscardGlyphs;
561 end;
562
563 procedure TBGLRenderedFont.SetColor(AValue: TBGRAPixel);
564 begin
565 if FColor=AValue then Exit;
566 FColor:=AValue;
567 DiscardGlyphs;
568 end;
569
570 procedure TBGLRenderedFont.SetFontFullHeight(AValue: integer);
571 begin
572 EmHeight:= -AValue;
573 end;
574
575 procedure TBGLRenderedFont.SetHorizontalOverflow(AValue: single);
576 begin
577 if FHorizontalOverflow=AValue then Exit;
578 FHorizontalOverflow:=AValue;
579 DiscardGlyphs;
580 end;
581
582 procedure TBGLRenderedFont.SetQuality(AValue: TBGRAFontQuality);
583 begin
584 if FQuality=AValue then Exit;
585 FQuality:=AValue;
586 DiscardGlyphs;
587 end;
588
LoadFromFilenull589 function TBGLRenderedFont.LoadFromFile(AFilename: UTF8String): boolean;
590 begin
591 result := false;
592 end;
593
594 procedure TBGLRenderedFont.FreeMemoryOnDestroy;
595 begin
596 FreeMemory;
597 if FRendererOwned then FreeAndNil(FRenderer);
598 FreeAndNil(FGlyphs);
599 end;
600
601 constructor TBGLRenderedFont.Create(ARenderer: TBGRACustomFontRenderer;
602 ARendererOwned: boolean);
603 begin
604 Init;
605 FRenderer := ARenderer;
606 FRendererOwned := ARendererOwned;
607
608 FName := 'Arial';
609 FColor := BGRAWhite;
610 FBackgroundColor := BGRAPixelTransparent;
611 FEmHeight := 20;
612 FStyle := [];
613 FHorizontalOverflow := 0.33;
614 FVerticalOverflow := 0;
615 FQuality := fqFineAntialiasing;
616
617 FGradTopLeft := BGRAWhite;
618 FGradTopRight := BGRAWhite;
619 FGradBottomLeft := BGRAWhite;
620 FGradBottomRight := BGRAWhite;
621 FUseGradientColor:= false;
622 FClipped:= false;
623
624 FGlyphs := TAVLTree.Create(@CompareGlyphNode);
625 FWordBreakHandler:= nil;
626 end;
627
628 procedure TBGLRenderedFont.FreeMemory;
629 begin
630 DiscardGlyphs;
631 inherited FreeMemory;
632 end;
633
TBGLRenderedFont.TextWidthnull634 function TBGLRenderedFont.TextWidth(const Text: UTF8String): single;
635 var
636 pstr: pchar;
637 left,charlen: integer;
638 nextchar: string;
639 g: TRenderedGlyph;
640 firstChar: boolean;
641 begin
642 result := 0;
643 if Text = '' then exit;
644
645 firstChar := true;
646 pstr := @Text[1];
647 left := length(Text);
648 while left > 0 do
649 begin
650 charlen := UTF8CharacterLength(pstr);
651 setlength(nextchar, charlen);
652 move(pstr^, nextchar[1], charlen);
653 inc(pstr,charlen);
654 dec(left,charlen);
655
656 g := GetGlyph(nextchar);
657 if g <> nil then
658 begin
659 if firstChar then
660 firstchar := false
661 else
662 IncF(result, StepX * Scale);
663 IncF(result, g.AdvancePx * Scale);
664 end;
665 end;
666 end;
667
TextHeightnull668 function TBGLRenderedFont.TextHeight(const Text: UTF8String): single;
669 begin
670 result := FullHeight * Scale;
671 end;
672
TextHeightnull673 function TBGLRenderedFont.TextHeight(const Text: UTF8String; AWidth: single
674 ): single;
675 var
676 lines: TStringList;
677 begin
678 lines := GetWrappedLines(Text, AWidth);
679 result := lines.Count * (FullHeight * Scale);
680 lines.Free;
681 end;
682
683 procedure TBGLRenderedFont.SetGradientColors(ATopLeft, ATopRight, ABottomRight,
684 ABottomLeft: TBGRAPixel);
685 begin
686 FGradTopLeft := ATopLeft;
687 FGradTopRight := ATopRight;
688 FGradBottomLeft := ABottomLeft;
689 FGradBottomRight := ABottomRight;
690 GradientColors := true;
691 end;
692
693 end.
694
695