Ignore:
Timestamp:
Apr 9, 2015, 9:58:36 PM (10 years ago)
Author:
chronos
Message:
  • Fixed: Use csOpaque control style also to Image, PaintBox and OpenGLControl.
  • Modified: Change size of test frame with SpinEdits as delayed using timer.
  • Updated: BRGABitmap package to version 8.1.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/Packages/bgrabitmap/bgratext.pas

    r452 r472  
    55interface
    66
    7 { Text functions use a temporary bitmap where the operating system text drawing is used.
     7{
     8  Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType
     9
     10  This unit provides basic text rendering functions using LCL, and general
     11  text definitions.
     12
     13  Text functions use a temporary bitmap where the operating system text drawing is used.
    814  Then it is scaled down (if antialiasing is activated), and colored.
    915
    10   These routines are rather slow. }
     16  These routines are rather slow, so you may use other font renderers
     17  like TBGRATextEffectFontRenderer in BGRATextFX if you want to use LCL fonts,
     18  or, if you have TrueType fonts files, you may use TBGRAFreeTypeFontRenderer
     19  in BGRAFreeType. }
    1120
    1221uses
    13   Classes, Types, SysUtils, Graphics, BGRABitmapTypes;
    14 
    15 procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; s: string;
     22  Classes, Types, SysUtils, Graphics, BGRABitmapTypes, InterfaceBase, BGRAPen, BGRAGrayscaleMask;
     23
     24type
     25  TWordBreakHandler = procedure(var ABeforeUTF8, AAfterUTF8: string) of object;
     26
     27  { TCustomLCLFontRenderer }
     28
     29  TCustomLCLFontRenderer = class(TBGRACustomFontRenderer)
     30  protected
     31    FFont: TFont;             //font parameters
     32    FWordBreakHandler: TWordBreakHandler;
     33    procedure UpdateFont; virtual;
     34    function TextSizeNoUpdateFont(sUTF8: string): TSize;
     35    procedure InternalTextWordBreak(ADest: TBGRACustomBitmap; ATextUTF8: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel; ATexture: IBGRAScanner; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
     36    procedure InternalTextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel; ATexture: IBGRAScanner);
     37  public
     38    procedure SplitText(var ATextUTF8: string; AMaxWidth: integer; out ARemainsUTF8: string);
     39    function GetFontPixelMetric: TFontPixelMetric; override;
     40    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); override;
     41    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); override;
     42    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); override;
     43    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); override;
     44    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); override;
     45    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); override;
     46    procedure TextWordBreak(ADest: TBGRACustomBitmap; AText: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
     47    procedure TextWordBreak(ADest: TBGRACustomBitmap; AText: string; x, y, AMaxWidth: integer; ATexture: IBGRAScanner; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
     48    function TextSize(sUTF8: string): TSize; override;
     49    constructor Create;
     50    destructor Destroy; override;
     51    property OnWordBreak: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler;
     52  end;
     53
     54  { TLCLFontRenderer }
     55
     56  TLCLFontRenderer = class(TCustomLCLFontRenderer)
     57  protected
     58    function TextSurfaceSmaller(sUTF8: string; ARect: TRect): boolean;
     59  public
     60    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); override;
     61    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); override;
     62  end;
     63
     64function CleanTextOutString(s: string): string; //this works with UTF8 strings as well
     65function RemoveLineEnding(var s: string; indexByte: integer): boolean; //this works with UTF8 strings however the index is the byte index
     66function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean;
     67
     68procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; sUTF8: string;
    1669  c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
    1770
    18 procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; orientation: integer;
    19   s: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
     71procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; orientationTenthDegCCW: integer;
     72  sUTF8: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
    2073
    2174procedure BGRATextRect(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; ARect: TRect; x, y: integer;
    22   s: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0);
    23 
    24 function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; s: string; CustomAntialiasingLevel: Integer): TSize;
    25 
    26 function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; s: string; CustomAntialiasingLevel: integer): TSize;
    27 
    28 function GetFontHeightSign(AFont: TFont): integer;
     75  sUTF8: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0);
     76
     77function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize;
     78function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: integer): TSize;
     79function BGRAOriginalTextSizeEx(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; out actualAntialiasingLevel: integer): TSize;
     80procedure BGRADefaultWordBreakHandler(var ABefore,AAfter: string);
     81
     82function BGRATextUnderline(ATopLeft: TPointF; AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF; overload;
     83function BGRATextUnderline(ATopLeft: TPointF; AWidth: Single; ABaseline, AEmHeight: single): ArrayOfTPointF; overload;
     84function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF; overload;
     85function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; ABaseline, AEmHeight, AXHeight: single): ArrayOfTPointF; overload;
     86
     87function GetFontHeightSign: integer;
    2988function FontEmHeightSign: integer;
    3089function FontFullHeightSign: integer;
    31 
     90function LCLFontAvailable: boolean;
     91
     92procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel; texture: IBGRAScanner = nil; RGBOrder: boolean=true);
    3293procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner = nil; RGBOrder: boolean=true);
    3394procedure BGRAFillClearTypeRGBMask(dest: TBGRACustomBitmap; x,y: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner = nil; KeepRGBOrder: boolean=true);
    34 
    35 const FontAntialiasingLevel = 6;
     95procedure BGRAInternalRenderText(dest: TBGRACustomBitmap; Quality: TBGRAFontQuality; grayscale: TGrayscaleMask; temp: TBGRACustomBitmap;
     96    x,y,xThird: integer; c: TBGRAPixel; tex: IBGRAScanner);
     97
     98const FontAntialiasingLevel = {$IFDEF LINUX}3{$ELSE}6{$ENDIF}; //linux rendering is already great
    3699const FontDefaultQuality = fqAntialiased;
    37100
    … …  
    40103implementation
    41104
    42 uses Math, BGRABlend;
     105uses GraphType, Math, BGRABlend, LCLProc;
    43106
    44107const MaxPixelMetricCount = 100;
    45108
    46109var
     110  LCLFontDisabledValue: boolean;
    47111  TempBmp: TBitmap;
    48112  FontHeightSignComputed: boolean;
    … …  
    68132  size: TSize;
    69133begin
     134  if not LCLFontAvailable then
     135  begin
     136    top := 0;
     137    bottom := 0;
     138    totalHeight := 0;
     139    exit;
     140  end;
    70141  size := BGRAOriginalTextSize(font,fqSystem,text,FontAntialiasingLevel);
    71142  mask := BGRABitmapFactory.Create(size.cx,size.cy,BGRABlack);
    … …  
    221292end;
    222293
    223 function GetFontHeightSign(AFont: TFont): integer;
     294const DefaultFontHeightSign = -1;
     295
     296function BGRATextUnderline(ATopLeft: TPointF;
     297  AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF;
     298begin
     299  result := BGRATextUnderline(ATopLeft, AWidth, AMetrics.Baseline,AMetrics.Baseline-AMetrics.CapLine);
     300end;
     301
     302function BGRATextUnderline(ATopLeft: TPointF;
     303  AWidth: Single; ABaseline, AEmHeight: single): ArrayOfTPointF;
     304var height,y: single;
     305begin
     306  height := AEmHeight*0.1;
     307  y := ATopLeft.y+ABaseline+1.5*height;
     308  result := ComputeWidePolylinePoints([PointF(ATopLeft.x,y),
     309                   PointF(ATopLeft.x+AWidth,y)],height,BGRABlack,pecFlat,pjsMiter,
     310                   SolidPenStyle, []);
     311end;
     312
     313function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single;
     314  AMetrics: TFontPixelMetric): ArrayOfTPointF;
     315begin
     316  result := BGRATextStrikeOut(ATopLeft, AWidth, AMetrics.Baseline,AMetrics.Baseline-AMetrics.CapLine,AMetrics.Baseline-AMetrics.xLine);
     317end;
     318
     319function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; ABaseline,
     320  AEmHeight, AXHeight: single): ArrayOfTPointF;
     321var height,y: single;
     322begin
     323  height := AEmHeight*0.075;
     324  y := ATopLeft.y+ABaseline-AXHeight*0.5;
     325  result := ComputeWidePolylinePoints([PointF(ATopLeft.x,y),
     326                   PointF(ATopLeft.x+AWidth,y)],height,BGRABlack,pecFlat,pjsMiter,
     327                   SolidPenStyle, []);
     328end;
     329
     330function GetFontHeightSign: integer;
    224331var
    225332  HeightP1, HeightM1: integer;
    226333begin
     334  if LCLFontDisabledValue then
     335  begin
     336    result := DefaultFontHeightSign;
     337    exit;
     338  end;
     339
    227340  if FontHeightSignComputed then
    228341  begin
    … …  
    231344  end;
    232345
    233   if tempBmp = nil then tempBmp := TBitmap.Create;
    234   tempBmp.Canvas.Font.Assign(AFont);
    235   tempBmp.Canvas.Font.Height := 20;
    236   HeightP1  := tempBmp.Canvas.TextExtent('Hg').cy;
    237   tempBmp.Canvas.Font.Height := -20;
    238   HeightM1  := tempBmp.Canvas.TextExtent('Hg').cy;
    239 
    240   if HeightP1 > HeightM1 then
    241     FontHeightSignValue := 1
    242   else
    243     FontHeightSignValue := -1;
     346  if WidgetSet.LCLPlatform = lpNoGUI then
     347  begin
     348    LCLFontDisabledValue:= True;
     349    result := -1;
     350    exit;
     351  end;
     352
     353  try
     354    if tempBmp = nil then tempBmp := TBitmap.Create;
     355    tempBmp.Canvas.Font.Name := 'Arial';
     356    tempBmp.Canvas.Font.Style := [];
     357    tempBmp.Canvas.Font.Height := 20;
     358    HeightP1  := tempBmp.Canvas.TextExtent('Hg').cy;
     359    tempBmp.Canvas.Font.Height := -20;
     360    HeightM1  := tempBmp.Canvas.TextExtent('Hg').cy;
     361
     362    if HeightP1 > HeightM1 then
     363      FontHeightSignValue := 1
     364    else
     365      FontHeightSignValue := -1;
     366  except
     367    on ex: Exception do
     368    begin
     369      LCLFontDisabledValue := True;
     370      result := -1;
     371      exit;
     372    end;
     373  end;
    244374  FontHeightSignComputed := true;
    245375  result := FontHeightSignValue;
    … …  
    247377
    248378function FontEmHeightSign: integer;
    249 var f: TFont;
    250 begin
    251   if FontHeightSignComputed then
    252   begin
    253     result := FontHeightSignValue;
    254     exit;
    255   end;
    256   f:= TFont.Create;
    257   f.Name := 'Arial';
    258   result := GetFontHeightSign(f);
    259   f.Free;
     379begin
     380  result := GetFontHeightSign;
    260381end;
    261382
    … …  
    265386end;
    266387
    267 procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean);
     388function LCLFontAvailable: boolean;
     389begin
     390  if not FontHeightSignComputed then GetFontHeightSign;
     391  result := not LCLFontDisabledValue;
     392end;
     393
     394procedure BGRAFillClearTypeMaskPtr(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; maskData: PByte; maskPixelSize: NativeInt; maskRowSize: NativeInt; maskWidth,maskHeight: integer; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean);
    268395var
    269396  pdest: PBGRAPixel;
    … …  
    302429  yMask,n: integer;
    303430  a: byte;
    304   pmask: PBGRAPixel;
     431  pmask: PByte;
    305432  dx:integer;
    306433  miny,maxy,minx,minxThird,maxx,alphaMinX,alphaMaxX,alphaLineLen: integer;
    … …  
    322449
    323450begin
    324   alphaLineLen := mask.Width+2;
     451  alphaLineLen := maskWidth+2;
    325452
    326453  xThird -= 1; //for first subpixel
    … …  
    333460  if y >= dest.ClipRect.Top then miny := 0
    334461    else miny := dest.ClipRect.Top-y;
    335   if y+mask.Height-1 < dest.ClipRect.Bottom then
    336     maxy := mask.Height-1 else
     462  if y+maskHeight-1 < dest.ClipRect.Bottom then
     463    maxy := maskHeight-1 else
    337464      maxy := dest.ClipRect.Bottom-1-y;
    338465
    … …  
    351478  end;
    352479
    353   if x*3+xThird+mask.Width-1 < dest.ClipRect.Right*3 then
    354   begin
    355     maxx := (x*3+xThird+mask.Width-1) div 3;
     480  if x*3+xThird+maskWidth-1 < dest.ClipRect.Right*3 then
     481  begin
     482    maxx := (x*3+xThird+maskWidth-1) div 3;
    356483    alphaMaxX := alphaLineLen-1;
    357484    rightOnSide := false;
    … …  
    373500      if leftOnSide then
    374501      begin
    375         pmask := mask.ScanLine[yMask]+(alphaMinX-1);
    376         a := pmask^.green div 3;
     502        pmask := maskData + (yMask*maskRowSize)+ (alphaMinX-1)*maskPixelSize;
     503        a := pmask^ div 3;
    377504        v1 := a+a;
    378505        v2 := a;
    379506        v3 := 0;
    380         inc(pmask);
     507        inc(pmask, maskPixelSize);
    381508      end else
    382509      begin
    383         pmask := mask.ScanLine[yMask];
     510        pmask := maskData + (yMask*maskRowSize);
    384511        v1 := 0;
    385512        v2 := 0;
    … …  
    389516      for n := countBetween-1 downto 0 do
    390517      begin
    391         a := pmask^.green div 3;
     518        a := pmask^ div 3;
    392519        v1 += a;
    393520        v2 += a;
    394521        v3 += a;
    395         inc(pmask);
     522        inc(pmask, maskPixelSize);
    396523
    397524        NextAlpha(v1);
    … …  
    403530      if rightOnSide then
    404531      begin
    405         a := pmask^.green div 3;
     532        a := pmask^ div 3;
    406533        v1 += a;
    407534        v2 += a+a;
    … …  
    414541    end;
    415542  end;
     543end;
     544
     545procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x,
     546  y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel;
     547  texture: IBGRAScanner; RGBOrder: boolean);
     548var delta: NativeInt;
     549begin
     550  delta := mask.Width;
     551  BGRAFillClearTypeMaskPtr(dest,x,y,xThird,mask.ScanLine[0],1,delta,mask.Width,mask.Height,color,texture,RGBOrder);
     552end;
     553
     554procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean);
     555var delta: NativeInt;
     556begin
     557  delta := mask.Width*sizeof(TBGRAPixel);
     558  if mask.LineOrder = riloBottomToTop then
     559    delta := -delta;
     560  BGRAFillClearTypeMaskPtr(dest,x,y,xThird,pbyte(mask.ScanLine[0])+1,sizeof(TBGRAPixel),delta,mask.Width,mask.Height,color,texture,RGBOrder);
    416561end;
    417562
    … …  
    466611end;
    467612
    468 function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; s: string; CustomAntialiasingLevel: Integer): TSize;
    469 begin
    470   if tempBmp = nil then tempBmp := TBitmap.Create;
    471   tempBmp.Canvas.Font := Font;
    472   if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then tempBmp.Canvas.Font.Height := Font.Height*CustomAntialiasingLevel else
    473     tempBmp.Canvas.Font.Height := Font.Height;
    474   Result.cx := 0;
    475   Result.cy := 0;
    476   tempBmp.Canvas.Font.GetTextSize(s, Result.cx, Result.cy);
    477 end;
    478 
    479 function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; s: string; CustomAntialiasingLevel: Integer): TSize;
    480 begin
    481   result := BGRAOriginalTextSize(Font, Quality, s, CustomAntialiasingLevel);
     613function BGRAOriginalTextSizeEx(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; out actualAntialiasingLevel: integer): TSize;
     614begin
     615  actualAntialiasingLevel:= CustomAntialiasingLevel;
     616  if not LCLFontAvailable then
     617    result := Size(0,0)
     618  else
     619  begin
     620    try
     621      if tempBmp = nil then tempBmp := TBitmap.Create;
     622      tempBmp.Canvas.Font := Font;
     623      if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then
     624      begin
     625        tempBmp.Canvas.Font.Height := Font.Height*CustomAntialiasingLevel;
     626      end else
     627      begin
     628        tempBmp.Canvas.Font.Height := Font.Height;
     629        actualAntialiasingLevel:= 1;
     630      end;
     631      Result.cx := 0;
     632      Result.cy := 0;
     633      tempBmp.Canvas.Font.GetTextSize(sUTF8, Result.cx, Result.cy);
     634    except
     635      on ex: exception do
     636      begin
     637        result := Size(0,0);
     638        LCLFontDisabledValue := True;
     639      end;
     640    end;
     641
     642  end;
     643end;
     644
     645function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize;
     646var actualAntialiasingLevel: integer;
     647begin
     648  result := BGRAOriginalTextSizeEx(Font, Quality, sUTF8, CustomAntialiasingLevel, actualAntialiasingLevel);
     649end;
     650
     651procedure BGRADefaultWordBreakHandler(var ABefore, AAfter: string);
     652var p: integer;
     653begin
     654  if (AAfter <> '') and (ABefore <> '') and (AAfter[1]<> ' ') and (ABefore[length(ABefore)] <> ' ') then
     655  begin
     656    p := length(ABefore);
     657    while (p > 1) and (ABefore[p-1] <> ' ') do dec(p);
     658    if p > 1 then //can put the word after
     659    begin
     660      AAfter := copy(ABefore,p,length(ABefore)-p+1)+AAfter;
     661      ABefore := copy(ABefore,1,p-1);
     662    end else
     663    begin //cannot put the word after, so before
     664
     665    end;
     666  end;
     667  while (ABefore <> '') and (ABefore[length(ABefore)] =' ') do delete(ABefore,length(ABefore),1);
     668  while (AAfter <> '') and (AAfter[1] =' ') do delete(AAfter,1,1);
     669end;
     670
     671function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize;
     672begin
     673  result := BGRAOriginalTextSize(Font, Quality, sUTF8, CustomAntialiasingLevel);
    482674  if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then
    483675  begin
    … …  
    488680
    489681procedure FilterOriginalText(Quality: TBGRAFontQuality; CustomAntialiasingLevel: Integer; var temp: TBGRACustomBitmap;
    490   c: TBGRAPixel; tex: IBGRAScanner);
     682  out grayscaleMask: TGrayscaleMask);
    491683var
     684  n: integer;
     685  maxAlpha: NativeUint;
     686  pb: PByte;
     687  multiplyX: integer;
    492688  resampled: TBGRACustomBitmap;
    493   P:       PBGRAPixel;
    494   n,xb,yb,v: integer;
    495   alpha, maxAlpha: integer;
    496 begin
     689begin
     690  grayscaleMask := nil;
    497691  case Quality of
    498   fqFineClearTypeBGR,fqFineClearTypeRGB:
    499     begin
     692  fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing:
     693    begin
     694      if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB] then multiplyX:= 3 else multiplyX:= 1;
    500695      if (temp.Height < CustomAntialiasingLevel*8) and (temp.Height >= CustomAntialiasingLevel*3) then
    501696      begin
    502697        temp.ResampleFilter := rfSpline;
    503         resampled := temp.Resample(round(temp.width/CustomAntialiasingLevel*3),round(temp.Height/CustomAntialiasingLevel),rmFineResample);
     698        resampled := temp.Resample(round(temp.width/CustomAntialiasingLevel*multiplyX),round(temp.Height/CustomAntialiasingLevel),rmFineResample);
     699        grayscaleMask := TGrayscaleMask.Create(resampled,cGreen);
     700        FreeAndNil(resampled);
    504701      end else
    505         resampled := temp.Resample(round(temp.width/CustomAntialiasingLevel*3),round(temp.Height/CustomAntialiasingLevel),rmSimpleStretch);
     702        grayscaleMask := TGrayscaleMask.CreateDownSample(temp, round(temp.width/CustomAntialiasingLevel*multiplyX),round(temp.Height/CustomAntialiasingLevel));
     703      FreeAndNil(temp);
    506704
    507705      maxAlpha := 0;
    508       p := resampled.Data;
    509       for n := resampled.NbPixels - 1 downto 0 do
    510       begin
    511         alpha    := P^.green;
    512         if alpha > maxAlpha then maxAlpha := alpha;
    513         Inc(p);
     706      pb := grayscaleMask.Data;
     707      for n := grayscaleMask.NbPixels - 1 downto 0 do
     708      begin
     709        if Pb^ > maxAlpha then maxAlpha := Pb^;
     710        Inc(pb);
    514711      end;
    515       if maxAlpha <> 0 then
    516       begin
    517         p := resampled.Data;
    518         for n := resampled.NbPixels - 1 downto 0 do
     712      if (maxAlpha <> 0) and (maxAlpha <> 255) then
     713      begin
     714        pb := grayscaleMask.Data;
     715        for n := grayscaleMask.NbPixels - 1 downto 0 do
    519716        begin
    520           v:= integer(p^.green * 255) div maxAlpha;
    521           p^.red := v;
    522           p^.green := v;
    523           p^.blue := v;
    524           Inc(p);
     717          pb^:= pb^ * 255 div maxAlpha;
     718          Inc(pb);
    525719        end;
    526720      end;
    527       temp.Free;
    528       temp := resampled;
    529     end;
    530   fqFineAntialiasing:
    531     begin
    532       if (temp.Height < CustomAntialiasingLevel*8) and (temp.Height >= CustomAntialiasingLevel*3) then
    533       begin
    534         temp.ResampleFilter := rfSpline;
    535         resampled := temp.Resample(round(temp.width/CustomAntialiasingLevel),round(temp.Height/CustomAntialiasingLevel),rmFineResample);
    536       end else
    537         resampled := temp.Resample(round(temp.width/CustomAntialiasingLevel),round(temp.Height/CustomAntialiasingLevel),rmSimpleStretch);
    538 
    539       maxAlpha := 0;
    540       if tex = nil then
    541       begin
    542         p := resampled.Data;
    543         for n := resampled.NbPixels - 1 downto 0 do
    544         begin
    545           alpha    := P^.green;
    546           if alpha > maxAlpha then maxAlpha := alpha;
    547           if alpha = 0 then
    548             p^:= BGRAPixelTransparent else
    549           begin
    550             p^.red   := c.red;
    551             p^.green := c.green;
    552             p^.blue  := c.blue;
    553             p^.alpha := alpha;
    554           end;
    555           Inc(p);
    556         end;
    557 
    558         if maxAlpha <> 0 then
    559         begin
    560           p := resampled.Data;
    561           for n := resampled.NbPixels - 1 downto 0 do
    562           begin
    563             p^.alpha := integer(p^.alpha * c.alpha) div maxAlpha;
    564             Inc(p);
    565           end;
    566         end;
    567       end else
    568       begin
    569         p := resampled.Data;
    570         for n := resampled.NbPixels - 1 downto 0 do
    571         begin
    572           alpha    := P^.green;
    573           if alpha > maxAlpha then maxAlpha := alpha;
    574           Inc(p);
    575         end;
    576         if maxAlpha = 0 then
    577           resampled.FillTransparent
     721    end;
     722  fqSystem:
     723    begin
     724      grayscaleMask := TGrayscaleMask.Create(temp, cGreen);
     725      FreeAndNil(temp);
     726      pb := grayscaleMask.Data;
     727      for n := grayscaleMask.NbPixels - 1 downto 0 do
     728      begin
     729        pb^:= GammaExpansionTab[pb^] shr 8;
     730        Inc(pb);
     731      end;
     732    end;
     733  end;
     734end;
     735
     736function CleanTextOutString(s: string): string;
     737var idxIn, idxOut: integer;
     738begin
     739  setlength(result, length(s));
     740  idxIn := 1;
     741  idxOut := 1;
     742  while IdxIn <= length(s) do
     743  begin
     744    if not (s[idxIn] in[#13,#10,#9]) then //those characters are always 1 byte long so it is the same with UTF8
     745    begin
     746      result[idxOut] := s[idxIn];
     747      inc(idxOut);
     748    end;
     749    inc(idxIn);
     750  end;
     751  setlength(result, idxOut-1);
     752end;
     753
     754function RemoveLineEnding(var s: string; indexByte: integer): boolean;
     755begin //we can ignore UTF8 character length because #13 and #10 are always 1 byte long
     756      //so this function can be applied to UTF8 strings as well
     757  result := false;
     758  if length(s) >= indexByte then
     759  begin
     760    if s[indexByte] in[#13,#10] then
     761    begin
     762      result := true;
     763      if length(s) >= indexByte+1 then
     764      begin
     765        if (s[indexByte+1] <> s[indexByte]) and (s[indexByte+1] in[#13,#10]) then
     766          delete(s,indexByte,2)
    578767        else
    579           for yb := 0 to resampled.Height-1 do
    580           begin
    581             p := resampled.ScanLine[yb];
    582             tex.ScanMoveTo(0,yb);
    583             for xb := 0 to resampled.Width-1 do
    584             begin
    585               c := tex.ScanNextPixel;
    586               alpha    := integer(P^.green*c.alpha) div maxAlpha;
    587               if alpha = 0 then
    588                 p^:= BGRAPixelTransparent else
    589               begin
    590                 c.alpha := alpha;
    591                 p^ := c;
    592               end;
    593               Inc(p);
    594             end;
    595           end;
    596       end;
    597 
    598       temp.Free;
    599       temp := resampled;
    600     end;
    601   fqSystem:
    602     begin
    603       if tex = nil then
    604       begin
    605         p := temp.Data;
    606         for n := temp.NbPixels - 1 downto 0 do
    607         begin
    608           alpha    := GammaExpansionTab[P^.green] shr 8;
    609           alpha    := (c.alpha * alpha) div (255);
    610           if alpha = 0 then p^:= BGRAPixelTransparent else
    611           begin
    612             p^.red   := c.red;
    613             p^.green := c.green;
    614             p^.blue  := c.blue;
    615             p^.alpha := alpha;
    616           end;
    617           Inc(p);
    618         end;
    619       end else
    620       begin
    621         for yb := 0 to temp.Height-1 do
    622         begin
    623           p := temp.Scanline[yb];
    624           tex.ScanMoveTo(0,yb);
    625           for xb := 0 to temp.Width-1 do
    626           begin
    627             c := tex.ScanNextPixel;
    628             alpha    := GammaExpansionTab[P^.green] shr 8;
    629             alpha    := (c.alpha * alpha) div (255);
    630             if alpha = 0 then p^:= BGRAPixelTransparent else
    631             begin
    632               p^.red   := c.red;
    633               p^.green := c.green;
    634               p^.blue  := c.blue;
    635               p^.alpha := alpha;
    636             end;
    637             Inc(p);
    638           end;
    639         end;
    640       end;
    641     end;
    642   end;
    643 end;
    644 
    645 procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; s: string;
     768          delete(s,indexByte,1);
     769      end
     770        else
     771          delete(s,indexByte,1);
     772    end;
     773  end;
     774end;
     775
     776function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean;
     777var indexByte: integer;
     778    pIndex: PChar;
     779begin
     780  pIndex := UTF8CharStart(@sUTF8[1],length(sUTF8),indexUTF8);
     781  if pIndex = nil then
     782  begin
     783    result := false;
     784    exit;
     785  end;
     786  indexByte := pIndex - @sUTF8[1];
     787  result := RemoveLineEnding(sUTF8, indexByte);
     788end;
     789
     790procedure BGRAInternalRenderText(dest: TBGRACustomBitmap; Quality: TBGRAFontQuality; grayscale: TGrayscaleMask; temp: TBGRACustomBitmap;
     791  x,y,xThird: integer; c: TBGRAPixel; tex: IBGRAScanner);
     792begin
     793  if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB,fqSystemClearType] then
     794  begin
     795    if grayscale <> nil then
     796      BGRAFillClearTypeGrayscaleMask(dest,x,y,xThird, grayscale,c,tex,Quality=fqFineClearTypeRGB)
     797    else if temp <> nil then
     798      BGRAFillClearTypeRGBMask(dest,x,y, temp,c,tex);
     799  end
     800  else
     801  begin
     802    if grayscale <> nil then
     803    begin
     804      if tex <> nil then
     805        grayscale.DrawAsAlpha(dest, x, y, tex) else
     806        grayscale.DrawAsAlpha(dest, x, y, c);
     807    end
     808    else if temp <> nil then
     809      dest.PutImage(x, y, temp, dmDrawWithTransparency);
     810  end;
     811end;
     812
     813procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; sUTF8: string;
    646814  c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
    647815var
    … …  
    653821  x,y :integer;
    654822  deltaX: single;
    655 begin
     823  grayscale: TGrayscaleMask;
     824  sizeFactor: integer;
     825begin
     826  if not LCLFontAvailable then exit;
     827
    656828  if CustomAntialiasingLevel = 0 then
    657829    CustomAntialiasingLevel:= FontAntialiasingLevel;
    … …  
    659831  if Font.Orientation mod 3600 <> 0 then
    660832  begin
    661     BGRATextOutAngle(bmp,Font,Quality,xf,yf,Font.Orientation,s,c,tex,align);
    662     exit;
    663   end;
    664 
    665   size := BGRAOriginalTextSize(Font,Quality,s,CustomAntialiasingLevel);
     833    BGRATextOutAngle(bmp,Font,Quality,xf,yf,Font.Orientation,sUTF8,c,tex,align);
     834    exit;
     835  end;
     836
     837  size := BGRAOriginalTextSizeEx(Font,Quality,sUTF8,CustomAntialiasingLevel,sizeFactor);
    666838  if (size.cx = 0) or (size.cy = 0) then
    667839    exit;
    … …  
    669841  if (size.cy >= 144) and (Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (CustomAntialiasingLevel > 4) then
    670842  begin
    671     BGRATextOut(bmp,Font,Quality,xf,yf,s,c,tex,align,4);
    672     exit;
    673   end;
    674 
    675   if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then
    676   begin
    677     case align of
    678       taLeftJustify: ;
    679       taCenter: xf -= size.cx/2/CustomAntialiasingLevel;
    680       taRightJustify: xf -= size.cx/CustomAntialiasingLevel;
    681     end;
    682   end else
    683   begin
    684     case align of
    685       taLeftJustify: ;
    686       taCenter: xf -= size.cx/2;
    687       taRightJustify: xf -= size.cx;
    688     end;
     843    BGRATextOut(bmp,Font,Quality,xf,yf,sUTF8,c,tex,align,4);
     844    exit;
     845  end;
     846
     847  case align of
     848    taLeftJustify: ;
     849    taCenter: xf -= size.cx/2/sizeFactor;
     850    taRightJustify: xf -= size.cx/sizeFactor;
    689851  end;
    690852
    … …  
    695857  tempSize.cx := size.cx;
    696858  tempSize.cy := size.cy;
    697   if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then
    698   begin
    699     tempSize.cx += CustomAntialiasingLevel-1;
    700     tempSize.cx -= tempSize.cx mod CustomAntialiasingLevel;
    701     tempSize.cy += CustomAntialiasingLevel-1;
    702     tempSize.cy -= tempSize.cy mod CustomAntialiasingLevel;
     859  if sizeFactor <> 1 then
     860  begin
     861    tempSize.cx += sizeFactor-1;
     862    tempSize.cx -= tempSize.cx mod sizeFactor;
     863    tempSize.cy += sizeFactor-1;
     864    tempSize.cy -= tempSize.cy mod sizeFactor;
    703865
    704866    deltaX := xf-floor(xf);
    … …  
    708870      deltaX -= xThird/3;
    709871    end;
    710     subX := round(CustomAntialiasingLevel*deltaX);
     872    subX := round(sizeFactor*deltaX);
    711873    x := round(floor(xf));
    712     if subX <> 0 then inc(tempSize.cx, CustomAntialiasingLevel);
    713     subY := round(CustomAntialiasingLevel*(yf-floor(yf)));
     874    if subX <> 0 then inc(tempSize.cx, sizeFactor);
     875    subY := round(sizeFactor*(yf-floor(yf)));
    714876    y := round(floor(yf));
    715     if subY <> 0 then inc(tempSize.cy, CustomAntialiasingLevel);
     877    if subY <> 0 then inc(tempSize.cy, sizeFactor);
    716878  end else
    717879  begin
    … …  
    721883
    722884  xMargin := size.cy div 2;
    723   if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then
    724   begin
    725     xMargin += CustomAntialiasingLevel-1;
    726     xMargin -= xMargin mod CustomAntialiasingLevel;
     885  if sizeFactor <> 1 then
     886  begin
     887    xMargin += sizeFactor-1;
     888    xMargin -= xMargin mod sizeFactor;
    727889  end;
    728890  tempSize.cx += xMargin*2;
    … …  
    730892  temp := bmp.NewBitmap(tempSize.cx, tempSize.cy, BGRABlack);
    731893  temp.Canvas.Font := Font;
    732   if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then temp.Canvas.Font.Height := Font.Height*CustomAntialiasingLevel
    733    else temp.Canvas.Font.Height := Font.Height;
     894  temp.Canvas.Font.Height := Font.Height*sizeFactor;
    734895  temp.Canvas.Font.Color := clWhite;
    735896  temp.Canvas.Brush.Style := bsClear;
    736   temp.Canvas.TextOut(xMargin+subX, subY, s);
    737 
    738   FilterOriginalText(Quality,CustomAntialiasingLevel, temp,c,tex);
    739 
    740   if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB] then
    741     BGRAFillClearTypeMask(bmp,x-round(xMargin/CustomAntialiasingLevel),y,xThird, temp,c,tex,Quality=fqFineClearTypeRGB)
    742   else
    743   begin
    744     if Quality = fqSystemClearType then
    745       BGRAFillClearTypeRGBMask(bmp,x-xMargin,y, temp,c,tex)
    746     else if Quality = fqFineAntialiasing then
    747       bmp.PutImage(x-round(xMargin/CustomAntialiasingLevel), y, temp, dmDrawWithTransparency)
    748     else bmp.PutImage(x-xMargin, y, temp, dmDrawWithTransparency);
    749   end;
    750   temp.Free;
    751 end;
    752 
    753 procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; orientation: integer;
    754   s: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
     897  temp.Canvas.TextOut(xMargin+subX, subY, sUTF8);
     898
     899  FilterOriginalText(Quality,CustomAntialiasingLevel, temp, grayscale);
     900  dec(x,round(xMargin/sizeFactor));
     901  BGRAInternalRenderText(bmp, Quality, grayscale,temp, x,y,xThird, c,tex);
     902  if temp <> nil then temp.Free;
     903  if grayscale <> nil then grayscale.Free;
     904end;
     905
     906procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single;
     907  orientationTenthDegCCW: integer;
     908  sUTF8: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
    755909var
    756910  x,y: integer;
    … …  
    766920  TempFont: TFont;
    767921  oldOrientation: integer;
     922  grayscale:TGrayscaleMask;
    768923
    769924  procedure rotBoundsAdd(pt: TPointF);
    … …  
    778933
    779934begin
     935  if not LCLFontAvailable then exit;
     936
    780937  if CustomAntialiasingLevel = 0 then
    781938    CustomAntialiasingLevel:= FontAntialiasingLevel;
    782939
    783   if orientation mod 3600 = 0 then
     940  if orientationTenthDegCCW mod 3600 = 0 then
    784941  begin
    785942    oldOrientation := Font.Orientation;
    786943    Font.Orientation := 0;
    787     BGRATextOut(bmp,Font,Quality,xf,yf,s,c,tex,align);
     944    BGRATextOut(bmp,Font,Quality,xf,yf,sUTF8,c,tex,align);
    788945    Font.Orientation := oldOrientation;
    789946    exit;
    … …  
    791948  TempFont := TFont.Create;
    792949  TempFont.Assign(Font);
    793   TempFont.Orientation := orientation;
     950  TempFont.Orientation := orientationTenthDegCCW;
    794951  TempFont.Height := Font.Height;
    795   size := BGRAOriginalTextSize(TempFont,Quality,s,CustomAntialiasingLevel);
     952  size := BGRAOriginalTextSizeEx(TempFont,Quality,sUTF8,CustomAntialiasingLevel,sizeFactor);
    796953  if (size.cx = 0) or (size.cy = 0) then
    797954  begin
    … …  
    799956    exit;
    800957  end;
    801   if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then
    802     sizeFactor := CustomAntialiasingLevel
    803   else
    804     sizeFactor := 1;
    805 
    806   cosA := cos(orientation*Pi/1800);
    807   sinA := sin(orientation*Pi/1800);
     958  tempFont.Free;
     959
     960  cosA := cos(orientationTenthDegCCW*Pi/1800);
     961  sinA := sin(orientationTenthDegCCW*Pi/1800);
    808962  TopRight := PointF(cosA*size.cx,-sinA*size.cx);
    809963  BottomRight := PointF(cosA*size.cx+sinA*size.cy,cosA*size.cy-sinA*size.cx);
    … …  
    843997  temp.Canvas.Font := Font;
    844998  temp.Canvas.Font.Color := clWhite;
    845   temp.Canvas.Font.Orientation := orientation;
     999  temp.Canvas.Font.Orientation := orientationTenthDegCCW;
    8461000  temp.Canvas.Font.Height := round(Font.Height*sizeFactor);
    8471001  temp.Canvas.Brush.Style := bsClear;
    848   temp.Canvas.TextOut(-rotBounds.Left+deltaX, -rotBounds.Top+deltaY, s);
    849 
    850   FilterOriginalText(Quality,CustomAntialiasingLevel,temp,c,tex);
    851 
    852   if Quality in [fqFineClearTypeRGB,fqFineClearTypeBGR] then
    853     BGRAFillClearTypeMask(bmp, x, y, 0, temp, c,tex,Quality = fqFineClearTypeRGB) else
    854   begin
    855     if Quality = fqSystemClearType then
    856       BGRAFillClearTypeRGBMask(bmp, x, y, temp, c,tex)
    857     else
    858       bmp.PutImage(x, y, temp, dmDrawWithTransparency);
    859   end;
     1002  temp.Canvas.TextOut(-rotBounds.Left+deltaX, -rotBounds.Top+deltaY, sUTF8);
     1003
     1004  FilterOriginalText(Quality,CustomAntialiasingLevel,temp,grayscale);
     1005  BGRAInternalRenderText(bmp, Quality, grayscale,temp, x,y,0, c,tex);
    8601006  temp.Free;
    861   tempFont.Free;
     1007  grayscale.Free;
    8621008end;
    8631009
    8641010procedure BGRATextRect(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; ARect: TRect; x, y: integer;
    865   s: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0);
     1011  sUTF8: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0);
    8661012var
    8671013  lim: TRect;
    … …  
    8701016  sizeFactor: integer;
    8711017  cr: TRect;
    872 begin
     1018  grayscale:TGrayscaleMask;
     1019begin
     1020  if not LCLFontAvailable then exit;
     1021
    8731022  if CustomAntialiasingLevel = 0 then
    8741023    CustomAntialiasingLevel:= FontAntialiasingLevel;
    … …  
    9011050  temp.Canvas.Font.Color := clWhite;
    9021051  temp.Canvas.Brush.Style := bsClear;
    903   temp.Canvas.TextRect(rect(lim.Left-ARect.Left, lim.Top-ARect.Top, (ARect.Right-ARect.Left)*sizeFactor, (ARect.Bottom-ARect.Top)*sizeFactor), (x - lim.Left)*sizeFactor, (y - lim.Top)*sizeFactor, s, style);
    904 
    905   FilterOriginalText(Quality,CustomAntialiasingLevel,temp,c,tex);
    906   if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB] then
    907     BGRAFillClearTypeMask(bmp,lim.Left, lim.Top, 0, temp, c,tex,Quality = fqFineClearTypeRGB)
    908   else if Quality = fqSystemClearType then
    909     BGRAFillClearTypeRGBMask(bmp,lim.Left, lim.Top, temp, c,tex)
     1052  temp.Canvas.TextRect(rect(lim.Left-ARect.Left, lim.Top-ARect.Top, (ARect.Right-ARect.Left)*sizeFactor, (ARect.Bottom-ARect.Top)*sizeFactor), (x - lim.Left)*sizeFactor, (y - lim.Top)*sizeFactor, sUTF8, style);
     1053
     1054  FilterOriginalText(Quality,CustomAntialiasingLevel,temp,grayscale);
     1055  BGRAInternalRenderText(bmp, Quality, grayscale,temp, lim.left,lim.top,0, c,tex);
     1056  temp.Free;
     1057  grayscale.Free;
     1058end;
     1059
     1060{ TLCLFontRenderer }
     1061
     1062function TLCLFontRenderer.TextSurfaceSmaller(sUTF8: string; ARect: TRect): boolean;
     1063begin
     1064  with TextSize(sUTF8) do
     1065    result := cx*cy < (ARect.Right-ARect.Left)*(ARect.Bottom-ARect.Top);
     1066end;
     1067
     1068procedure TLCLFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x,
     1069  y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel);
     1070begin
     1071  if not style.Clipping or TextSurfaceSmaller(sUTF8,ARect) then
     1072  begin
     1073    InternalTextRect(ADest,ARect,x,y,sUTF8,style,c,nil);
     1074    exit;
     1075  end;
     1076  UpdateFont;
     1077  BGRAText.BGRATextRect(ADest,FFont,FontQuality,ARect,x,y,sUTF8,style,c,nil);
     1078end;
     1079
     1080procedure TLCLFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x,
     1081  y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner);
     1082begin
     1083  if not style.Clipping or TextSurfaceSmaller(sUTF8,ARect) then
     1084  begin
     1085    InternalTextRect(ADest,ARect,x,y,sUTF8,style,BGRAPixelTransparent,texture);
     1086    exit;
     1087  end;
     1088  UpdateFont;
     1089  BGRAText.BGRATextRect(ADest,FFont,FontQuality,ARect,x,y,sUTF8,style,BGRAPixelTransparent,texture);
     1090end;
     1091
     1092{ TCustomLCLFontRenderer }
     1093
     1094{ Update font properties to internal TFont object }
     1095procedure TCustomLCLFontRenderer.UpdateFont;
     1096begin
     1097  if FFont.Name <> FontName then
     1098    FFont.Name := FontName;
     1099  if FFont.Style <> FontStyle then
     1100    FFont.Style := FontStyle;
     1101  if FFont.Height <> FontEmHeight * FontEmHeightSign then
     1102    FFont.Height := FontEmHeight * FontEmHeightSign;
     1103  if FFont.Orientation <> FontOrientation then
     1104    FFont.Orientation := FontOrientation;
     1105  if FontQuality = fqSystemClearType then
     1106    FFont.Quality := fqCleartype
    9101107  else
    911     bmp.PutImage(lim.Left, lim.Top, temp, dmDrawWithTransparency);
    912   temp.Free;
     1108    FFont.Quality := FontDefaultQuality;
     1109end;
     1110
     1111function TCustomLCLFontRenderer.TextSizeNoUpdateFont(sUTF8: string): TSize;
     1112begin
     1113  result := BGRAText.BGRATextSize(FFont,FontQuality,sUTF8,FontAntialiasingLevel);
     1114  if (result.cy >= 24) and (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) then
     1115    result := BGRAText.BGRATextSize(FFont,FontQuality,sUTF8,4);
     1116end;
     1117
     1118procedure TCustomLCLFontRenderer.SplitText(var ATextUTF8: string;
     1119  AMaxWidth: integer; out ARemainsUTF8: string);
     1120var p,totalWidth: integer;
     1121begin
     1122  if ATextUTF8= '' then
     1123  begin
     1124    ARemainsUTF8 := '';
     1125    exit;
     1126  end;
     1127  if RemoveLineEnding(ATextUTF8,1) then
     1128  begin
     1129    ARemainsUTF8:= ATextUTF8;
     1130    ATextUTF8 := '';
     1131    exit;
     1132  end;
     1133  UpdateFont;
     1134
     1135  p := 1;
     1136  inc(p, UTF8CharacterLength(@ATextUTF8[p])); //UTF8 chars may be more than 1 byte long
     1137  while p < length(ATextUTF8)+1 do
     1138  begin
     1139    if RemoveLineEnding(ATextUTF8,p) then
     1140    begin
     1141      ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1);
     1142      ATextUTF8 := copy(ATextUTF8,1,p-1);
     1143      exit;
     1144    end;
     1145    totalWidth := TextSizeNoUpdateFont(copy(ATextUTF8,1,p+UTF8CharacterLength(@ATextUTF8[p])-1)).cx; //copy whole last UTF8 char
     1146    if totalWidth > AMaxWidth then
     1147    begin
     1148      ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1);
     1149      ATextUTF8 := copy(ATextUTF8,1,p-1); //this includes the whole last UTF8 char
     1150      if Assigned(FWordBreakHandler) then
     1151        FWordBreakHandler(ATextUTF8,ARemainsUTF8) else
     1152          BGRADefaultWordBreakHandler(ATextUTF8,ARemainsUTF8);
     1153      exit;
     1154    end;
     1155    inc(p, UTF8CharacterLength(@ATextUTF8[p]));
     1156  end;
     1157  ARemainsUTF8 := '';
     1158end;
     1159
     1160function TCustomLCLFontRenderer.GetFontPixelMetric: TFontPixelMetric;
     1161var fxFont: TFont;
     1162begin
     1163  UpdateFont;
     1164  if FontQuality in[fqSystem,fqSystemClearType] then
     1165    result := BGRAText.GetFontPixelMetric(FFont)
     1166  else
     1167  begin
     1168    FxFont := TFont.Create;
     1169    FxFont.Assign(FFont);
     1170    FxFont.Height := fxFont.Height*FontAntialiasingLevel;
     1171    Result:= BGRAText.GetFontPixelMetric(FxFont);
     1172    if Result.Baseline <> -1 then Result.Baseline:= round((Result.Baseline-1)/FontAntialiasingLevel);
     1173    if Result.CapLine <> -1 then Result.CapLine:= round(Result.CapLine/FontAntialiasingLevel);
     1174    if Result.DescentLine <> -1 then Result.DescentLine:= round((Result.DescentLine-1)/FontAntialiasingLevel);
     1175    if Result.Lineheight <> -1 then Result.Lineheight:= round(Result.Lineheight/FontAntialiasingLevel);
     1176    if Result.xLine <> -1 then Result.xLine:= round(Result.xLine/FontAntialiasingLevel);
     1177    FxFont.Free;
     1178  end;
     1179end;
     1180
     1181procedure TCustomLCLFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer;
     1182  sUTF8: string; c: TBGRAPixel; align: TAlignment);
     1183begin
     1184  UpdateFont;
     1185  BGRAText.BGRATextOutAngle(ADest,FFont,FontQuality,x,y,orientationTenthDegCCW,sUTF8,c,nil,align);
     1186end;
     1187
     1188procedure TCustomLCLFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer;
     1189  sUTF8: string; texture: IBGRAScanner; align: TAlignment);
     1190begin
     1191  UpdateFont;
     1192  BGRAText.BGRATextOutAngle(ADest,FFont,FontQuality,x,y,orientationTenthDegCCW,sUTF8,BGRAPixelTransparent,texture,align);
     1193end;
     1194
     1195procedure TCustomLCLFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string;
     1196  texture: IBGRAScanner; align: TAlignment);
     1197var mode : TBGRATextOutImproveReadabilityMode;
     1198begin
     1199  UpdateFont;
     1200
     1201  if Assigned(BGRATextOutImproveReadabilityProc) and (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (FFont.Orientation mod 3600 = 0) then
     1202  begin
     1203    case FontQuality of
     1204      fqFineClearTypeBGR: mode := irClearTypeBGR;
     1205      fqFineClearTypeRGB: mode := irClearTypeRGB;
     1206    else
     1207      mode := irNormal;
     1208    end;
     1209    BGRATextOutImproveReadabilityProc(ADest,FFont,x,y,sUTF8,BGRAPixelTransparent,texture,align,mode);
     1210  end else
     1211    BGRAText.BGRATextOut(ADest,FFont,FontQuality,x,y,sUTF8,BGRAPixelTransparent,texture,align);
     1212end;
     1213
     1214procedure TCustomLCLFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel;
     1215  align: TAlignment);
     1216var mode : TBGRATextOutImproveReadabilityMode;
     1217begin
     1218  UpdateFont;
     1219
     1220  if Assigned(BGRATextOutImproveReadabilityProc) and (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (FFont.Orientation mod 3600 = 0) then
     1221  begin
     1222    case FontQuality of
     1223      fqFineClearTypeBGR: mode := irClearTypeBGR;
     1224      fqFineClearTypeRGB: mode := irClearTypeRGB;
     1225    else
     1226      mode := irNormal;
     1227    end;
     1228    BGRATextOutImproveReadabilityProc(ADest,FFont,x,y,sUTF8,c,nil,align,mode);
     1229  end else
     1230    BGRAText.BGRATextOut(ADest,FFont,FontQuality,x,y,sUTF8,c,nil,align);
     1231end;
     1232
     1233procedure TCustomLCLFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string;
     1234  style: TTextStyle; c: TBGRAPixel);
     1235begin
     1236  InternalTextRect(ADest,ARect,x,y,sUTF8,style,c,nil);
     1237end;
     1238
     1239procedure TCustomLCLFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string;
     1240  style: TTextStyle; texture: IBGRAScanner);
     1241begin
     1242  InternalTextRect(ADest,ARect,x,y,sUTF8,style,BGRAPixelTransparent,texture);
     1243end;
     1244
     1245procedure TCustomLCLFontRenderer.TextWordBreak(ADest: TBGRACustomBitmap;
     1246  AText: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel;
     1247  AHorizAlign: TAlignment; AVertAlign: TTextLayout);
     1248begin
     1249  InternalTextWordBreak(ADest,AText,x,y,AMaxWidth,AColor,nil,AHorizAlign,AVertAlign);
     1250end;
     1251
     1252procedure TCustomLCLFontRenderer.TextWordBreak(ADest: TBGRACustomBitmap;
     1253  AText: string; x, y, AMaxWidth: integer; ATexture: IBGRAScanner;
     1254  AHorizAlign: TAlignment; AVertAlign: TTextLayout);
     1255begin
     1256  InternalTextWordBreak(ADest,AText,x,y,AMaxWidth,BGRAPixelTransparent,ATexture,AHorizAlign,AVertAlign);
     1257end;
     1258
     1259procedure TCustomLCLFontRenderer.InternalTextWordBreak(
     1260  ADest: TBGRACustomBitmap; ATextUTF8: string; x, y, AMaxWidth: integer;
     1261  AColor: TBGRAPixel; ATexture: IBGRAScanner; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
     1262var ARemains: string;
     1263  stepX,stepY: integer;
     1264  lines: TStringList;
     1265  i: integer;
     1266  lineShift: single;
     1267begin
     1268  if (ATextUTF8 = '') or (AMaxWidth <= 0) then exit;
     1269
     1270  stepX := 0;
     1271  stepY := TextSize('Hg').cy;
     1272
     1273  if AVertAlign = tlTop then
     1274  begin
     1275    repeat
     1276      SplitText(ATextUTF8, AMaxWidth, ARemains);
     1277      if ATexture <> nil then
     1278        TextOut(ADest,x,y,ATextUTF8,ATexture,AHorizAlign)
     1279      else
     1280        TextOut(ADest,x,y,ATextUTF8,AColor,AHorizAlign);
     1281      ATextUTF8 := ARemains;
     1282      X+= stepX;
     1283      Y+= stepY;
     1284    until ARemains = '';
     1285  end else
     1286  begin
     1287    lines := TStringList.Create;
     1288    repeat
     1289      SplitText(ATextUTF8, AMaxWidth, ARemains);
     1290      lines.Add(ATextUTF8);
     1291      ATextUTF8 := ARemains;
     1292    until ARemains = '';
     1293    if AVertAlign = tlCenter then lineShift := lines.Count/2
     1294    else if AVertAlign = tlBottom then lineShift := lines.Count
     1295    else lineShift := 0;
     1296
     1297    X -= round(stepX*lineShift);
     1298    Y -= round(stepY*lineShift);
     1299    for i := 0 to lines.Count-1 do
     1300    begin
     1301      if ATexture <> nil then
     1302        TextOut(ADest,x,y,lines[i],ATexture,AHorizAlign)
     1303      else
     1304        TextOut(ADest,x,y,lines[i],AColor,AHorizAlign);
     1305      X+= stepX;
     1306      Y+= stepY;
     1307    end;
     1308    lines.Free;
     1309  end;
     1310end;
     1311
     1312procedure TCustomLCLFontRenderer.InternalTextRect(ADest: TBGRACustomBitmap;
     1313  ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel;
     1314  ATexture: IBGRAScanner);
     1315var
     1316  previousClip, intersected: TRect;
     1317  oldOrientation: integer;
     1318begin
     1319  previousClip := ADest.ClipRect;
     1320  if style.Clipping then
     1321  begin
     1322    intersected := rect(0,0,0,0);
     1323    if not IntersectRect(intersected, previousClip, ARect) then exit;
     1324    ADest.ClipRect := intersected;
     1325  end;
     1326  oldOrientation:= FontOrientation;
     1327  FontOrientation:= 0;
     1328
     1329  if not (style.Alignment in[taCenter,taRightJustify]) then ARect.Left := x;
     1330  if not (style.Layout in[tlCenter,tlBottom]) then ARect.top := y;
     1331  if ARect.Right <= ARect.Left then exit;
     1332  if style.Layout = tlCenter then Y := (ARect.Top+ARect.Bottom) div 2 else
     1333  if style.Layout = tlBottom then Y := ARect.Bottom else
     1334    Y := ARect.Top;
     1335  if style.Alignment = taCenter then X := (ARect.Left+ARect.Right) div 2 else
     1336  if style.Alignment = taRightJustify then X := ARect.Right else
     1337    X := ARect.Left;
     1338  if style.Wordbreak then
     1339    InternalTextWordBreak(ADest,sUTF8,X,Y,ARect.Right-ARect.Left,c,ATexture,style.Alignment,style.Layout)
     1340  else
     1341  begin
     1342    if style.Layout = tlCenter then Y -= TextSize(sUTF8).cy div 2;
     1343    if style.Layout = tlBottom then Y -= TextSize(sUTF8).cy;
     1344    if ATexture <> nil then
     1345      TextOut(ADest,X,Y,sUTF8,ATexture,style.Alignment)
     1346    else
     1347      TextOut(ADest,X,Y,sUTF8,c,style.Alignment);
     1348  end;
     1349
     1350  FontOrientation:= oldOrientation;
     1351  if style.Clipping then
     1352    ADest.ClipRect := previousClip;
     1353end;
     1354
     1355function TCustomLCLFontRenderer.TextSize(sUTF8: string): TSize;
     1356begin
     1357  UpdateFont;
     1358  result := TextSizeNoUpdateFont(sUTF8);
     1359end;
     1360
     1361constructor TCustomLCLFontRenderer.Create;
     1362begin
     1363  FFont := TFont.Create;
     1364end;
     1365
     1366destructor TCustomLCLFontRenderer.Destroy;
     1367begin
     1368  FFont.Free;
     1369  inherited Destroy;
    9131370end;
    9141371
Note: See TracChangeset for help on using the changeset viewer.