source: trunk/Packages/bgrabitmap/bgratextfx.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 26.7 KB
Line 
1unit BGRATextFX;
2
3{$mode objfpc}{$H+}
4
5{
6 Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType
7
8 This unit provide text effects. The simplest way to render effects is to use TBGRATextEffectFontRenderer class.
9 To do this, create an instance of this class and assign it to a TBGRABitmap.FontRenderer property. Now functions
10 to draw text like TBGRABitmap.TextOut will use the chosen renderer. To set the effects, keep a variable containing
11 the TBGRATextEffectFontRenderer class and modify ShadowVisible and other effects parameters.
12
13 The TBGRATextEffectFontRenderer class makes use of other classes depending on the situation. For example,
14 TBGRATextEffect, which is also in this unit, provides effects on a text mask. But the renderer also uses
15 BGRAVectorize unit in order to have big texts or to rotate them at will.
16
17 Note that you may need TBGRATextEffect if you want to have more control over text effects, especially
18 if you always draw the same text. Keeping the same TBGRATextEffect object will avoid creating the text
19 mask over and over again.
20
21 TextShadow function is a simple function to compute an image containing a text with shadow.
22
23}
24
25interface
26
27uses
28 Classes, SysUtils, Graphics, Types, BGRABitmapTypes, BGRAPhongTypes, BGRAText,
29 BGRACustomTextFX, BGRAVectorize;
30
31type
32 TBGRATextEffect = class;
33
34 { TBGRATextEffectFontRenderer }
35
36 TBGRATextEffectFontRenderer = class(TCustomLCLFontRenderer)
37 private
38 function GetShaderLightPosition: TPoint;
39 function GetVectorizedRenderer: TBGRAVectorizedFontRenderer;
40 procedure SetShaderLightPosition(AValue: TPoint);
41 protected
42 FShaderOwner: boolean;
43 FShader: TCustomPhongShading;
44 FVectorizedRenderer: TBGRAVectorizedFontRenderer;
45 function ShadowActuallyVisible :boolean;
46 function ShaderActuallyActive: boolean;
47 function OutlineActuallyVisible: boolean;
48 procedure Init;
49 function VectorizedFontNeeded: boolean;
50 procedure InternalTextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; texture: IBGRAScanner; align: TAlignment);
51 public
52 ShaderActive: boolean;
53
54 ShadowVisible: boolean;
55 ShadowColor: TBGRAPixel;
56 ShadowRadius: integer;
57 ShadowOffset: TPoint;
58 ShadowQuality: TRadialBlurType;
59
60 OutlineColor: TBGRAPixel;
61 OutlineWidth: single;
62 OutlineVisible,OuterOutlineOnly: boolean;
63 OutlineTexture: IBGRAScanner;
64 constructor Create; overload;
65 constructor Create(AShader: TCustomPhongShading; AShaderOwner: boolean); overload;
66 destructor Destroy; override;
67 procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer;
68 s: string; texture: IBGRAScanner; align: TAlignment); overload; override;
69 procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer;
70 s: string; c: TBGRAPixel; align: TAlignment); overload; override;
71 procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); overload; override;
72 procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment); overload; override;
73 procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment; {%H-}ARightToLeft: boolean); overload; override;
74 procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment; {%H-}ARightToLeft: boolean); overload; override;
75 function TextSize(sUTF8: string): TSize; overload; override;
76 function TextSize(sUTF8: string; AMaxWidth: integer; {%H-}ARightToLeft: boolean): TSize; overload; override;
77 function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; override;
78 property Shader: TCustomPhongShading read FShader;
79 property ShaderLightPosition: TPoint read GetShaderLightPosition write SetShaderLightPosition;
80 property VectorizedFontRenderer: TBGRAVectorizedFontRenderer read GetVectorizedRenderer;
81 end;
82
83 { TBGRATextEffect }
84
85 TBGRATextEffect = class(TBGRACustomTextEffect)
86 protected
87 procedure InitImproveReadability(AText: string; Font: TFont; SubOffsetX,SubOffsetY: single);
88 procedure Init(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer);
89 procedure InitWithFontName(AText: string; AFontName: string; AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX,SubOffsetY: single);
90 public
91 constructor Create(AText: string; Font: TFont; Antialiasing: boolean); overload;
92 constructor Create(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single); overload;
93 constructor Create(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer); overload;
94 constructor Create(AText: string; AFontName: string; AFullHeight: integer; Antialiasing: boolean); overload;
95 constructor Create(AText: string; AFontName: string; AFullHeight: integer; Antialiasing: boolean; SubOffsetX,SubOffsetY: single); overload;
96 constructor Create(AText: string; AFontName: string; AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean); overload;
97 constructor Create(AText: string; AFontName: string; AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX,SubOffsetY: single); overload;
98 end;
99
100function TextShadow(AWidth,AHeight: Integer; AText: String; AFontHeight: Integer; ATextColor,AShadowColor: TBGRAPixel;
101 AOffSetX,AOffSetY: Integer; ARadius: Integer = 0; AFontStyle: TFontStyles = []; AFontName: String = 'Default'; AShowText: Boolean = True; AFontQuality: TBGRAFontQuality = fqFineAntialiasing): TBGRACustomBitmap;
102
103procedure BGRATextOutImproveReadability(bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode);
104
105implementation
106
107uses BGRAGradientScanner, GraphType, Math, BGRAGrayscaleMask;
108
109procedure BGRATextOutImproveReadability(bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode);
110var
111 useClearType,clearTypeRGBOrder: boolean;
112 metric: TFontPixelMetric;
113 deltaX: single;
114 x,y,yb,cury,fromy: integer;
115 toAdd: integer;
116 lines: array[0..3] of integer;
117 parts: array[0..3] of TGrayscaleMask;
118 n,nbLines: integer;
119 alphaMax: NativeUint;
120 ptrPart: TBGRACustomBitmap;
121 pmask: PByte;
122 fx: TBGRATextEffect;
123 FxFont: TFont;
124 prevCenter, newCenter, diffCenter: single;
125 xThird: integer;
126
127begin
128 useClearType:= mode in[irClearTypeRGB,irClearTypeBGR];
129 clearTypeRGBOrder := mode <> irClearTypeBGR;
130 deltaX := xf-floor(xf);
131 x := round(floor(xf));
132
133 FxFont := TFont.Create;
134 FxFont.Assign(AFont);
135 FxFont.Height := fxFont.Height*FontAntialiasingLevel;
136 metric := GetLCLFontPixelMetric(FxFont);
137 if not metric.Defined or (metric.Lineheight < 8*FontAntialiasingLevel) or (metric.Lineheight >= 24*FontAntialiasingLevel) then
138 begin
139 fxFont.Free;
140 if useClearType then
141 begin
142 if ClearTypeRGBOrder then
143 BGRATextOut(bmp, AFont, fqFineClearTypeRGB, xf,yf, text, color, tex, align)
144 else
145 BGRATextOut(bmp, AFont, fqFineClearTypeBGR, xf,yf, text, color, tex, align)
146 end else
147 BGRATextOut(bmp, AFont, fqFineAntialiasing, xf,yf, text, color, tex, align);
148 exit;
149 end;
150
151 if (metric.Baseline-metric.xLine) mod FontAntialiasingLevel >= FontAntialiasingLevel div 3 then
152 begin
153 toAdd := FontAntialiasingLevel- ((metric.Baseline-metric.xLine) mod FontAntialiasingLevel);
154 for yb := 1 to toAdd div 2 do
155 begin
156 if metric.xLine > 0 then dec(metric.xLine);
157 if metric.Baseline < metric.Lineheight then inc(metric.Baseline);
158 end;
159 end;
160 if metric.CapLine >= metric.xLine then metric.CapLine := -1 else
161 begin
162 if (metric.xLine-metric.CapLine) mod FontAntialiasingLevel >= FontAntialiasingLevel div 2 then
163 begin
164 toAdd := FontAntialiasingLevel - (metric.xLine-metric.CapLine) mod FontAntialiasingLevel;
165 metric.CapLine -= toAdd;
166 if metric.CapLine <= 0 then metric.CapLine := -1;
167 end;
168 end;
169
170 nbLines := 0;
171 lines[nbLines] := metric.CapLine+1;
172 inc(nbLines);
173 lines[nbLines] := metric.xLine+1;
174 inc(nbLines);
175 lines[nbLines] := metric.Baseline+1;
176 inc(nbLines);
177 lines[nbLines] := metric.Lineheight+1;
178 inc(nbLines);
179
180 if not useClearType then
181 fx := TBGRATextEffect.Create(text,FxFont,False,deltaX*FontAntialiasingLevel,0,FontAntialiasingLevel,FontAntialiasingLevel) else
182 fx := TBGRATextEffect.Create(text,FxFont,False,0,0,3,0);
183
184 if fx.TextMask = nil then
185 begin
186 fx.Free;
187 FxFont.Free;
188 exit;
189 end;
190 alphaMax := 0;
191 prevCenter := 0;
192 newCenter := 0;
193 for yb := 0 to nbLines-1 do
194 begin
195 if yb= 0 then fromy := 0
196 else fromy := lines[yb-1];
197
198 if lines[yb] > fromy then
199 begin
200 ptrPart := fx.TextMask.GetPtrBitmap(fromy,lines[yb]);
201 if useClearType then
202 parts[yb] := TGrayscaleMask.CreateDownSample(ptrPart,round(ptrPart.Width/FontAntialiasingLevel*3),round(ptrPart.Height/FontAntialiasingLevel))
203 else
204 parts[yb] := TGrayscaleMask.CreateDownSample(ptrPart,round(ptrPart.Width/FontAntialiasingLevel),round(ptrPart.Height/FontAntialiasingLevel));
205 ptrPart.Free;
206
207 if alphaMax < 255 then
208 begin
209 pmask := parts[yb].Data;
210 for n := parts[yb].NbPixels-1 downto 0 do
211 begin
212 if pmask^ > alphaMax then alphaMax := pmask^;
213 inc(pmask);
214 end;
215 end;
216
217 if yb < 2 then
218 begin
219 newCenter += parts[yb].Height;
220 prevCenter += lines[yb]-fromy;
221 end else
222 if yb = 2 then
223 begin
224 newCenter += parts[yb].Height/2;
225 prevCenter += (lines[yb]-fromy)/2;
226 end;
227 end else
228 parts[yb] := nil;
229 end;
230
231 prevCenter /= FontAntialiasingLevel;
232 diffCenter := prevCenter-newCenter;
233 y := round( yf + diffCenter );
234
235 xThird := 0;
236 if useClearType then
237 begin
238 case align of
239 taCenter: xThird:= xThird+round(((fx.TextMaskOffset.x-fx.TextWidth/2)/FontAntialiasingLevel+deltaX)*3);
240 taRightJustify: xThird:= xThird+round(((fx.TextMaskOffset.x-fx.TextWidth)/FontAntialiasingLevel+deltaX)*3);
241 else xThird:= xThird+round((fx.TextMaskOffset.x/FontAntialiasingLevel+deltaX)*3);
242 end;
243 end else
244 begin
245 case align of
246 taCenter: x:= x+round((fx.TextMaskOffset.x-fx.TextWidth/2)/FontAntialiasingLevel);
247 taRightJustify: x:= x+round((fx.TextMaskOffset.x-fx.TextWidth)/FontAntialiasingLevel);
248 else x:= x+round(fx.TextMaskOffset.x/FontAntialiasingLevel);
249 end;
250 end;
251 cury := y+round(fx.TextMaskOffset.y/FontAntialiasingLevel);
252 for yb := 0 to nbLines-1 do
253 if parts[yb] <> nil then
254 begin
255 if (alphaMax > 0) and (alphaMax < 255) then
256 begin
257 pmask := parts[yb].data;
258 for n := parts[yb].NbPixels-1 downto 0 do
259 begin
260 pmask^ := pmask^*255 div alphaMax;
261 inc(pmask);
262 end;
263 end;
264 if useClearType then
265 BGRAFillClearTypeGrayscaleMask(bmp,x,cury,xThird,parts[yb],color,tex,ClearTypeRGBOrder)
266 else if mode = irMask then
267 parts[yb].Draw(bmp,x,cury)
268 else
269 begin
270 if tex <> nil then
271 parts[yb].DrawAsAlpha(bmp,x,cury,tex) else
272 parts[yb].DrawAsAlpha(bmp,x,cury,color);
273 end;
274 inc(cury,parts[yb].Height);
275 parts[yb].Free;
276 end;
277
278 fx.Free;
279 FxFont.Free;
280end;
281
282procedure BGRAReplace(var Destination: TBGRACustomBitmap; Temp: TObject);
283begin
284 Destination.Free;
285 Destination := Temp as TBGRACustomBitmap;
286end;
287
288function TextShadow(AWidth,AHeight: Integer; AText: String; AFontHeight: Integer; ATextColor,AShadowColor: TBGRAPixel;
289 AOffSetX,AOffSetY: Integer; ARadius: Integer = 0; AFontStyle: TFontStyles = []; AFontName: String = 'Default'; AShowText: Boolean = True;
290 AFontQuality: TBGRAFontQuality = fqFineAntialiasing): TBGRACustomBitmap;
291var
292 bmpOut,bmpSdw: TBGRACustomBitmap; OutTxtSize: TSize; OutX,OutY: Integer;
293begin
294 bmpOut:= BGRABitmapFactory.Create(AWidth,AHeight);
295 bmpOut.FontAntialias:= True;
296 bmpOut.FontHeight:= AFontHeight;
297 bmpOut.FontStyle:= AFontStyle;
298 bmpOut.FontName:= AFontName;
299 bmpOut.FontQuality:= AFontQuality;
300
301 OutTxtSize:= bmpOut.TextSize(AText);
302 OutX:= Round(AWidth/2) - Round(OutTxtSize.cx/2);
303 OutY:= Round(AHeight/2) - Round(OutTxtSize.cy/2);
304
305 bmpSdw:= BGRABitmapFactory.Create(OutTxtSize.cx+2*ARadius,OutTxtSize.cy+2*ARadius);
306 bmpSdw.FontAntialias:= True;
307 bmpSdw.FontHeight:= AFontHeight;
308 bmpSdw.FontStyle:= AFontStyle;
309 bmpSdw.FontName:= AFontName;
310 bmpSdw.FontQuality:= AFontQuality;
311
312 bmpSdw.TextOut(ARadius,ARadius,AText,AShadowColor);
313 BGRAReplace(bmpSdw,bmpSdw.FilterBlurRadial(ARadius,rbFast));
314 bmpOut.PutImage(OutX+AOffSetX-ARadius,OutY+AOffSetY-ARadius,bmpSdw,dmDrawWithTransparency);
315 bmpSdw.Free;
316
317 if AShowText = True then bmpOut.TextOut(OutX,OutY,AText,ATextColor);
318
319 Result:= bmpOut;
320end;
321
322{ TBGRATextEffectFontRenderer }
323
324function TBGRATextEffectFontRenderer.GetShaderLightPosition: TPoint;
325begin
326 if FShader = nil then
327 result := point(0,0)
328 else
329 result := FShader.LightPosition;
330end;
331
332function TBGRATextEffectFontRenderer.GetVectorizedRenderer: TBGRAVectorizedFontRenderer;
333begin
334 FVectorizedRenderer.FontEmHeight := FontEmHeight;
335 FVectorizedRenderer.FontName := FontName;
336 FVectorizedRenderer.FontOrientation:= FontOrientation;
337 FVectorizedRenderer.FontQuality := FontQuality;
338 FVectorizedRenderer.FontStyle:= FontStyle;
339
340 FVectorizedRenderer.ShadowColor := ShadowColor;
341 FVectorizedRenderer.ShadowVisible := ShadowVisible;
342 FVectorizedRenderer.ShadowOffset := ShadowOffset;
343 FVectorizedRenderer.ShadowRadius := ShadowRadius;
344
345 FVectorizedRenderer.OutlineColor := OutlineColor;
346 FVectorizedRenderer.OutlineVisible := OutlineVisible;
347 FVectorizedRenderer.OutlineWidth := OutlineWidth;
348 FVectorizedRenderer.OutlineTexture := OutlineTexture;
349 FVectorizedRenderer.OuterOutlineOnly := OuterOutlineOnly;
350 result := FVectorizedRenderer;
351end;
352
353procedure TBGRATextEffectFontRenderer.SetShaderLightPosition(AValue: TPoint);
354begin
355 if FShader <> nil then
356 FShader.LightPosition := AValue;
357end;
358
359function TBGRATextEffectFontRenderer.ShadowActuallyVisible: boolean;
360begin
361 result := ShadowVisible and (ShadowColor.alpha <> 0);
362end;
363
364function TBGRATextEffectFontRenderer.ShaderActuallyActive: boolean;
365begin
366 result := (FShader <> nil) and ShaderActive;
367end;
368
369function TBGRATextEffectFontRenderer.OutlineActuallyVisible: boolean;
370begin
371 result := (OutlineWidth <> 0) and ((OutlineTexture <> nil) or (OutlineColor.alpha <> 0)) and OutlineVisible;
372end;
373
374procedure TBGRATextEffectFontRenderer.Init;
375begin
376 ShaderActive := true;
377
378 ShadowColor := BGRABlack;
379 ShadowVisible := false;
380 ShadowOffset := Point(5,5);
381 ShadowRadius := 5;
382 ShadowQuality:= rbFast;
383
384 OutlineColor := BGRAPixelTransparent;
385 OutlineVisible := True;
386 OutlineWidth:= DefaultOutlineWidth;
387 OuterOutlineOnly:= false;
388 FVectorizedRenderer := TBGRAVectorizedFontRenderer.Create;
389end;
390
391function TBGRATextEffectFontRenderer.VectorizedFontNeeded: boolean;
392var bAntialiasing, bBigFont, bSpecialOutline, bOriented, bEffectVectorizedSupported: boolean;
393 textsz: TSize;
394begin
395 bAntialiasing := FontQuality in [fqFineAntialiasing,fqFineClearTypeRGB,fqFineClearTypeBGR];
396 textsz := inherited TextSize('Hg');
397 bBigFont := (not OutlineActuallyVisible and (textsz.cy >= 24)) or
398 (OutlineActuallyVisible and (textsz.cy > 42));
399 bSpecialOutline:= OutlineActuallyVisible and (abs(OutlineWidth) <> DefaultOutlineWidth);
400 bOriented := FontOrientation <> 0;
401 bEffectVectorizedSupported := OutlineActuallyVisible or ShadowActuallyVisible;
402 if ShaderActuallyActive and (FontOrientation = 0) then
403 result := false //shader not supported by vectorized font
404 else
405 result := bSpecialOutline or
406 (bAntialiasing and bBigFont) or
407 (bOriented and bEffectVectorizedSupported);
408end;
409
410procedure TBGRATextEffectFontRenderer.InternalTextOut(ADest: TBGRACustomBitmap;
411 x, y: single; s: string; c: TBGRAPixel; texture: IBGRAScanner;
412 align: TAlignment);
413var fx: TBGRATextEffect;
414 procedure DoOutline;
415 begin
416 if OutlineActuallyVisible then
417 begin
418 if OutlineTexture <> nil then
419 fx.DrawOutline(ADest,round(x),round(y), OutlineTexture, align)
420 else
421 fx.DrawOutline(ADest,round(x),round(y), OutlineColor, align);
422 end;
423 end;
424begin
425 UpdateFont;
426 if (FFont.Orientation <> 0) or (not ShaderActuallyActive and not ShadowActuallyVisible and not OutlineActuallyVisible) then
427 begin
428 if texture <> nil then
429 inherited TextOut(ADest,x,y,s,texture,align)
430 else
431 inherited TextOut(ADest,x,y,s,c,align);
432 exit;
433 end;
434 fx := TBGRATextEffect.Create(s, FFont, FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB], x-floor(x),y-floor(y));
435 if ShadowActuallyVisible then
436 begin
437 fx.ShadowQuality := ShadowQuality;
438 fx.DrawShadow(ADest,round(x)+ShadowOffset.X,round(y)+ShadowOffset.Y,ShadowRadius,ShadowColor, align);
439 end;
440 if OuterOutlineOnly then DoOutline;
441 if texture <> nil then
442 begin
443 if ShaderActuallyActive then
444 fx.DrawShaded(ADest,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), texture, align)
445 else
446 fx.Draw(ADest,round(x),round(y), texture, align);
447 end else
448 begin
449 if ShaderActuallyActive then
450 fx.DrawShaded(ADest,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), c, align)
451 else
452 fx.Draw(ADest,round(x),round(y), c, align);
453 end;
454 if not OuterOutlineOnly then DoOutline;
455 fx.Free;
456end;
457
458constructor TBGRATextEffectFontRenderer.Create;
459begin
460 inherited Create;
461 FShader := nil;
462 FShaderOwner:= false;
463 Init;
464end;
465
466constructor TBGRATextEffectFontRenderer.Create(AShader: TCustomPhongShading;
467 AShaderOwner: boolean);
468begin
469 inherited Create;
470 Init;
471 FShader := AShader;
472 FShaderOwner := AShaderOwner;
473end;
474
475destructor TBGRATextEffectFontRenderer.Destroy;
476begin
477 if FShaderOwner then FShader.Free;
478 FVectorizedRenderer.Free;
479 inherited Destroy;
480end;
481
482procedure TBGRATextEffectFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x,
483 y: single; orientation: integer; s: string; texture: IBGRAScanner;
484 align: TAlignment);
485begin
486 VectorizedFontRenderer.TextOutAngle(ADest, x, y, orientation, s, texture, align);
487end;
488
489procedure TBGRATextEffectFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x,
490 y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment);
491begin
492 VectorizedFontRenderer.TextOutAngle(ADest, x, y, orientation, s, c, align);
493end;
494
495procedure TBGRATextEffectFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
496 y: single; s: string; texture: IBGRAScanner; align: TAlignment);
497begin
498 if VectorizedFontNeeded then
499 VectorizedFontRenderer.TextOut(ADest,x,y,s,texture,align)
500 else
501 InternalTextOut(ADest,x,y,s,BGRAPixelTransparent,texture,align);
502end;
503
504procedure TBGRATextEffectFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
505 y: single; s: string; c: TBGRAPixel; align: TAlignment);
506begin
507 if VectorizedFontNeeded then
508 VectorizedFontRenderer.TextOut(ADest,x,y,s,c,align)
509 else
510 InternalTextOut(ADest,x,y,s,c,nil,align);
511end;
512
513procedure TBGRATextEffectFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
514 y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment;
515 ARightToLeft: boolean);
516begin
517 if VectorizedFontNeeded then
518 VectorizedFontRenderer.TextOut(ADest,x,y,sUTF8,texture,align,ARightToLeft)
519 else
520 InternalTextOut(ADest,x,y,sUTF8,BGRAPixelTransparent,texture,align);
521end;
522
523procedure TBGRATextEffectFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
524 y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment;
525 ARightToLeft: boolean);
526begin
527 if VectorizedFontNeeded then
528 VectorizedFontRenderer.TextOut(ADest,x,y,sUTF8,c,align,ARightToLeft)
529 else
530 InternalTextOut(ADest,x,y,sUTF8,c,nil,align);
531end;
532
533function TBGRATextEffectFontRenderer.TextSize(sUTF8: string): TSize;
534begin
535 if VectorizedFontNeeded then
536 result := VectorizedFontRenderer.TextSize(sUTF8)
537 else
538 result := inherited TextSize(sUTF8);
539end;
540
541function TBGRATextEffectFontRenderer.TextSize(sUTF8: string;
542 AMaxWidth: integer; ARightToLeft: boolean): TSize;
543begin
544 if VectorizedFontNeeded then
545 result := VectorizedFontRenderer.TextSize(sUTF8, AMaxWidth, ARightToLeft)
546 else
547 result := inherited TextSize(sUTF8, AMaxWidth, ARightToLeft);
548end;
549
550function TBGRATextEffectFontRenderer.TextFitInfo(sUTF8: string;
551 AMaxWidth: integer): integer;
552begin
553 if VectorizedFontNeeded then
554 result := VectorizedFontRenderer.TextFitInfo(sUTF8, AMaxWidth)
555 else
556 result := inherited TextFitInfo(sUTF8, AMaxWidth)
557end;
558
559{ TBGRATextEffect }
560
561procedure TBGRATextEffect.InitImproveReadability(AText: string; Font: TFont;
562 SubOffsetX, SubOffsetY: single);
563var size: TSize;
564 overhang: integer;
565begin
566 FShadowQuality:= rbFast;
567 if SubOffsetX < 0 then SubOffsetX := 0;
568 if SubOffsetY < 0 then SubOffsetY := 0;
569 size := BGRATextSize(Font, fqFineAntialiasing, AText, FontAntialiasingLevel);
570 FTextSize := size;
571 if size.cy = 0 then FTextSize.cy := BGRATextSize(Font, fqFineAntialiasing, 'Hg', FontAntialiasingLevel).cy;
572 overhang := size.cy div 2;
573 size.cx += 2*overhang + ceil(SubOffsetX);
574 size.cy += 2 + ceil(SubOffsetY);
575
576 FOffset := Point(-overhang,-1); //include overhang
577 FTextMask := BGRABitmapFactory.Create(size.cx,size.cy,BGRABlack);
578 BGRATextOutImproveReadability(FTextMask, Font, overhang+SubOffsetX,1+SubOffsetY, AText, BGRAWhite, nil, taLeftJustify, irMask);
579end;
580
581constructor TBGRATextEffect.Create(AText: string; Font: TFont;
582 Antialiasing: boolean; SubOffsetX,SubOffsetY: single);
583begin
584 Init(AText, Font, Antialiasing, SubOffsetX, SubOffsetY, 0,0);
585end;
586
587constructor TBGRATextEffect.Create(AText: string; Font: TFont;
588 Antialiasing: boolean; SubOffsetX, SubOffsetY: single; GrainX, GrainY: Integer
589 );
590begin
591 Init(AText, Font, Antialiasing, SubOffsetX, SubOffsetY, GrainX, GrainY);
592end;
593
594constructor TBGRATextEffect.Create(AText: string; AFontName: string;
595 AFullHeight: integer; Antialiasing: boolean);
596begin
597 InitWithFontName(AText, AFontName, AFullHeight, [], Antialiasing, 0, 0);
598end;
599
600constructor TBGRATextEffect.Create(AText: string; AFontName: string;
601 AFullHeight: integer; Antialiasing: boolean; SubOffsetX, SubOffsetY: single);
602begin
603 InitWithFontName(AText, AFontName, AFullHeight, [], Antialiasing, SubOffsetX, SubOffsetY);
604end;
605
606constructor TBGRATextEffect.Create(AText: string; AFontName: string;
607 AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean);
608begin
609 InitWithFontName(AText, AFontName, AFullHeight, AStyle, Antialiasing, 0, 0);
610end;
611
612constructor TBGRATextEffect.Create(AText: string; AFontName: string;
613 AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX,
614 SubOffsetY: single);
615begin
616 InitWithFontName(AText, AFontName, AFullHeight, AStyle, Antialiasing, SubOffsetX, SubOffsetY);
617end;
618
619procedure TBGRATextEffect.Init(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer);
620const FXAntialiasingLevel = FontAntialiasingLevel;
621var temp: TBGRACustomBitmap;
622 size: TSize;
623 p: PBGRAPixel;
624 n,v,maxAlpha: integer;
625 alpha: byte;
626 sizeX,sizeY: integer;
627 onePixel: integer;
628 quality: TBGRAFontQuality;
629 iSubX,iSubY: integer;
630begin
631 FShadowQuality := rbFast;
632 if Antialiasing and Assigned(BGRATextOutImproveReadabilityProc) then
633 begin
634 InitImproveReadability(AText, Font, SubOffsetX,SubOffsetY);
635 exit;
636 end;
637 if Antialiasing then
638 quality := fqFineAntialiasing
639 else
640 quality := fqSystem;
641 size := BGRAOriginalTextSize(Font,quality,AText,FXAntialiasingLevel);
642 if (size.cx = 0) or (size.cy = 0) then
643 begin
644 size := BGRATextSize(Font,quality,'Hg',FXAntialiasingLevel);
645 FTextSize.cx := 0;
646 FTextSize.cy := size.cy;
647 FOffset := Point(0,0);
648 exit;
649 end;
650 FTextSize := size;
651
652 sizeX := size.cx+size.cy;
653 sizeY := size.cy;
654
655 iSubX := 0;
656 iSubY := 0;
657 if SubOffsetX < 0 then SubOffsetX := 0;
658 if SubOffsetY < 0 then SubOffsetY := 0;
659
660 if Antialiasing then
661 begin
662 sizeX := (sizeX + FXAntialiasingLevel-1);
663 sizeX -= sizeX mod FXAntialiasingLevel;
664
665 sizeY := (sizeY + FXAntialiasingLevel-1);
666 sizeY -= sizeY mod FXAntialiasingLevel;
667
668 if SubOffsetX <> 0 then
669 begin
670 sizeX += ceil(SubOffsetX*FXAntialiasingLevel);
671 iSubX := round(SubOffsetX*FXAntialiasingLevel);
672 end;
673 if SubOffsetY <> 0 then
674 begin
675 sizeY += ceil(SubOffsetY*FXAntialiasingLevel);
676 iSubY := round(SubOffsetY*FXAntialiasingLevel);
677 end;
678
679 OnePixel := FXAntialiasingLevel;
680 end else
681 begin
682 OnePixel := 1;
683
684 if SubOffsetX <> 0 then
685 begin
686 iSubX := round(SubOffsetX);
687 sizeX += iSubX;
688 end;
689 if SubOffsetY <> 0 then
690 begin
691 iSubY := round(SubOffsetY);
692 sizeY += iSubY;
693 end;
694 end;
695 FOffset := Point(-size.cy div 2,-OnePixel); //include overhang
696
697 if GrainX > 0 then
698 begin
699 SizeX := SizeX+ (GrainX-1);
700 SizeX -= SizeX mod GrainX;
701 end;
702 if GrainY > 0 then
703 begin
704 SizeY := SizeY+ (GrainY-1);
705 SizeY -= SizeY mod GrainY;
706 end;
707 temp := BGRABitmapFactory.Create(sizeX, sizeY+2*OnePixel,clBlack);
708 temp.Canvas.Font := Font;
709 temp.Canvas.Font.Height := Font.Height*OnePixel;
710 temp.Canvas.Font.Color := clWhite;
711 temp.Canvas.Font.Quality := FontDefaultQuality;
712 temp.Canvas.Brush.Style := bsClear;
713 temp.Canvas.TextOut(-FOffset.X+iSubX, -FOffset.Y+iSubY, AText);
714
715 if Antialiasing then
716 begin
717 FTextSize.cx := round(FTextSize.cx/FXAntialiasingLevel);
718 FTextSize.cy := round(FTextSize.cy/FXAntialiasingLevel);
719 FOffset := Point(round(FOffset.X/FXAntialiasingLevel),round(FOffset.Y/FXAntialiasingLevel));
720
721 FTextMask := temp.Resample(round(temp.width/FXAntialiasingLevel),round(temp.Height/FXAntialiasingLevel),rmSimpleStretch);
722
723 maxAlpha := 0;
724 p := FTextMask.Data;
725 for n := FTextMask.NbPixels - 1 downto 0 do
726 begin
727 alpha := P^.green;
728 if alpha > maxAlpha then maxAlpha := alpha;
729 Inc(p);
730 end;
731 if maxAlpha <> 0 then
732 begin
733 p := FTextMask.Data;
734 for n := FTextMask.NbPixels - 1 downto 0 do
735 begin
736 v:= integer(p^.green * 255) div maxAlpha;
737 p^.red := v;
738 p^.green := v;
739 p^.blue := v;
740 Inc(p);
741 end;
742 end;
743 temp.Free;
744 end
745 else
746 begin
747 FTextMask := temp;
748 p := FTextMask.data;
749 for n := FTextMask.NbPixels-1 downto 0 do
750 begin
751 alpha := GammaExpansionTab[P^.green] shr 8;
752 p^.green := alpha;
753 p^.red := alpha;
754 p^.blue := alpha;
755 end;
756 end;
757end;
758
759procedure TBGRATextEffect.InitWithFontName(AText: string; AFontName: string;
760 AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX, SubOffsetY: single);
761var lFont: TFont;
762begin
763 lFont := TFont.Create;
764 lFont.Name := AFontName;
765 lFont.Height := AFullHeight * FontFullHeightSign;
766 lFont.Style := AStyle;
767 Init(AText, lFont, Antialiasing, SubOffsetX, SubOffsetY, 0,0);
768 lFont.Free;
769end;
770
771constructor TBGRATextEffect.Create(AText: string; Font: TFont;
772 Antialiasing: boolean);
773begin
774 Init(AText, Font, Antialiasing, 0,0,0,0);
775end;
776
777initialization
778
779 BGRATextOutImproveReadabilityProc := @BGRATextOutImproveReadability;
780
781end.
782
Note: See TracBrowser for help on using the repository browser.