Ignore:
Timestamp:
Apr 17, 2019, 12:58:41 AM (5 years ago)
Author:
chronos
Message:
  • Modified: Propagate project build mode options to used packages.
  • Added: Check memory leaks using heaptrc.
  • Modified: Update BGRABitmap package.
Location:
GraphicTest
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest

    • Property svn:ignore

      •  

        old new  
        88GraphicTest.lps
        99GraphicTest.dbg
         10heaptrclog.trc

  • GraphicTest/Packages/bgrabitmap/bgratext.pas

    r494 r521  
    88  {$DEFINE LCL_RENDERER_IS_FINE}
    99  {$DEFINE LCL_CLEARTYPE_RENDERER_IS_FINE}
     10  {$DEFINE RENDER_TEXT_ON_TBITMAP}
    1011{$ENDIF}
    1112{$IFDEF FREEBSD}
    … …  
    1718  {$DEFINE RENDER_TEXT_ON_TBITMAP}
    1819{$ENDIF}
     20{$IFDEF WINDOWS}
     21  {$IFNDEF LEGACY_FONT_VERTICAL_OFFSET}
     22    {$DEFINE FIX_FONT_VERTICAL_OFFSET}
     23  {$ENDIF}
     24{$ENDIF}
    1925
    2026{
    … …  
    3238
    3339uses
    34   Classes, Types, SysUtils, BGRAGraphics, BGRABitmapTypes, InterfaceBase, BGRAPen, BGRAGrayscaleMask;
     40  Classes, Types, SysUtils, BGRAGraphics, BGRABitmapTypes, InterfaceBase, BGRAPen, BGRAGrayscaleMask,
     41  LCLVersion;
    3542
    3643type
    … …  
    4451    FWordBreakHandler: TWordBreakHandler;
    4552    procedure UpdateFont; virtual;
    46     function TextSizeNoUpdateFont(sUTF8: string): TSize;
    47     procedure InternalTextWordBreak(ADest: TBGRACustomBitmap; ATextUTF8: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel; ATexture: IBGRAScanner; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
     53    function InternalTextSize(sUTF8: string; AShowPrefix: boolean): TSize;
     54    procedure InternalTextWordBreak(ADest: TBGRACustomBitmap; ATextUTF8: string;
     55                                    x, y, AMaxWidth: integer; AColor: TBGRAPixel; ATexture: IBGRAScanner;
     56                                    AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean);
    4857    procedure InternalTextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel; ATexture: IBGRAScanner);
     58    procedure InternalTextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner;
     59                              align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false);
     60    procedure InternalTextOutEllipse(ADest: TBGRACustomBitmap; x, y, availableWidth: single; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner;
     61                              align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false);
     62    procedure InternalSplitText(var ATextUTF8: string; AMaxWidth: integer; out ARemainsUTF8: string; out ALineEndingBreak: boolean;
     63                                AWordBreak: TWordBreakHandler); overload;
     64    procedure InternalSplitText(var ATextUTF8: string; AMaxWidth: integer; out ARemainsUTF8: string;
     65                                AWordBreak: TWordBreakHandler); overload;
     66    procedure DefaultWorkBreakHandler(var ABeforeUTF8, AAfterUTF8: string);
    4967  public
    5068    procedure SplitText(var ATextUTF8: string; AMaxWidth: integer; out ARemainsUTF8: string);
    5169    function GetFontPixelMetric: TFontPixelMetric; override;
    52     procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); override;
    53     procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); override;
    54     procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); override;
    55     procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); override;
    56     procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); override;
    57     procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); override;
    58     procedure TextWordBreak(ADest: TBGRACustomBitmap; AText: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
    59     procedure TextWordBreak(ADest: TBGRACustomBitmap; AText: string; x, y, AMaxWidth: integer; ATexture: IBGRAScanner; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
     70    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; override;
     71    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; override;
     72    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; override;
     73    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; override;
     74    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override;
     75    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override;
     76    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); overload; override;
     77    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); overload; override;
     78    procedure TextWordBreak(ADest: TBGRACustomBitmap; AText: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel; AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean = false); overload;
     79    procedure TextWordBreak(ADest: TBGRACustomBitmap; AText: string; x, y, AMaxWidth: integer; ATexture: IBGRAScanner; AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean = false); overload;
    6080    function TextSize(sUTF8: string): TSize; override;
     81    function TextSizeAngle(sUTF8: string; orientationTenthDegCCW: integer): TSize; override;
     82    function TextSize(sUTF8: string; AMaxWidth: integer; {%H-}ARightToLeft: boolean): TSize; override;
     83    function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; override;
    6184    constructor Create;
    6285    destructor Destroy; override;
    … …  
    6790
    6891  TLCLFontRenderer = class(TCustomLCLFontRenderer)
    69   protected
    70     function TextSurfaceSmaller(sUTF8: string; ARect: TRect): boolean;
    71   public
    72     procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); override;
    73     procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); override;
     92
    7493  end;
    7594
    … …  
    7998
    8099procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; sUTF8: string;
    81   c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
     100  c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0;
     101  ShowPrefix: boolean = false; RightToLeft: boolean = false);
    82102
    83103procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; orientationTenthDegCCW: integer;
    84104  sUTF8: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
    85105
    86 procedure BGRATextRect(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; ARect: TRect; x, y: integer;
     106procedure BGRATextRect(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; ARect: TRect; xf, yf: single;
    87107  sUTF8: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0);
    88108
    89109function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize;
     110function BGRATextFitInfo(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; AMaxWidth: integer): integer;
    90111function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: integer): TSize;
    91 function BGRAOriginalTextSizeEx(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; out actualAntialiasingLevel: integer): TSize;
     112function BGRAOriginalTextSizeEx(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer;
     113                                out actualAntialiasingLevel: integer; out extraVerticalMarginDueToRotation: integer): TSize;
    92114
    93115function BGRATextUnderline(ATopLeft: TPointF; AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF; overload;
    … …  
    101123function LCLFontAvailable: boolean;
    102124function GetFineClearTypeAuto: TBGRAFontQuality;
     125function FixLCLFontFullHeight({%H-}AFontName: string; AFontHeight: integer): integer;
    103126
    104127procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel; texture: IBGRAScanner = nil; RGBOrder: boolean=true);
    … …  
    116139implementation
    117140
    118 uses GraphType, Math, BGRABlend, BGRAUTF8;
     141uses GraphType, Math, BGRABlend, BGRAUTF8, BGRAUnicode, BGRATextBidi
     142     {$IF lcl_fullversion >= 1070000}, lclplatformdef{$ENDIF};
    119143
    120144const MaxPixelMetricCount = 100;
    … …  
    281305function GetLCLFontPixelMetric(AFont: TFont): TFontPixelMetric;
    282306var i,startPos,endPos: integer;
    283 begin
     307  prevHeight,fixHeight: integer;
     308begin
     309  if (AFont.Height < -200) or (AFont.Height > 150) then
     310  begin
     311    prevHeight := AFont.Height;
     312    if AFont.Height < 0 then
     313      fixHeight := -200
     314    else
     315      fixHeight := 150;
     316    AFont.Height := fixHeight;
     317    result := GetLCLFontPixelMetric(AFont);
     318    AFont.Height := prevHeight;
     319
     320    result.Baseline := round(result.Baseline/fixHeight*prevHeight);
     321    result.CapLine := round(result.CapLine/fixHeight*prevHeight);
     322    result.DescentLine := round(result.DescentLine/fixHeight*prevHeight);
     323    result.Lineheight := round(result.Lineheight/fixHeight*prevHeight);
     324    result.xLine := round(result.xLine/fixHeight*prevHeight);
     325    exit;
     326  end;
     327
    284328  FindPixelMetricPos(AFont,startPos,endPos);
    285329  for i := startPos to endPos-1 do
    … …  
    428472        end else
    429473        if (green = 0) then break;
     474        bgra.Free;
    430475    lclBmp.Free;
    431476  end;
    … …  
    433478  fqFineClearTypeComputed:= true;
    434479end;
     480
     481{$IFNDEF WINDOWS}
     482var LCLFontFullHeightRatio : array of record
     483                          FontName: string;
     484                          Ratio: single;
     485                        end;
     486{$ENDIF}
     487
     488function FixLCLFontFullHeight(AFontName: string; AFontHeight: integer): integer;
     489{$IFNDEF WINDOWS}
     490const TestHeight = 200;
     491var
     492  i: Integer;
     493  ratio : single;
     494  f: TFont;
     495  h: LongInt;
     496begin
     497  if (AFontHeight = 0) or
     498    (AFontHeight*FontEmHeightSign > 0) then
     499      result := AFontHeight
     500  else
     501  begin
     502    ratio := EmptySingle;
     503    for i := 0 to high(LCLFontFullHeightRatio) do
     504      if CompareText(AFontName, LCLFontFullHeightRatio[i].FontName)=0 then
     505      begin
     506        ratio := LCLFontFullHeightRatio[i].Ratio;
     507        break;
     508      end;
     509    if ratio = EmptySingle then
     510    begin
     511      f := TFont.Create;
     512      f.Quality := fqDefault;
     513      f.Name := AFontName;
     514      f.Height := FontFullHeightSign*TestHeight;
     515      h := BGRATextSize(f, fqSystem, 'Hg', 1).cy;
     516      if h = 0 then ratio := 1
     517      else ratio := TestHeight/h;
     518
     519      setlength(LCLFontFullHeightRatio, length(LCLFontFullHeightRatio)+1);
     520      LCLFontFullHeightRatio[high(LCLFontFullHeightRatio)].FontName:= AFontName;
     521      LCLFontFullHeightRatio[high(LCLFontFullHeightRatio)].Ratio:= ratio;
     522    end;
     523    result := round(AFontHeight*ratio);
     524  end;
     525end;
     526{$ELSE}
     527begin
     528  result := AFontHeight;
     529end;
     530{$ENDIF}
    435531
    436532function FontEmHeightSign: integer;
    … …  
    469565end;
    470566
    471 function BGRAOriginalTextSizeEx(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; out actualAntialiasingLevel: integer): TSize;
     567function BGRAOriginalTextSizeEx(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer;
     568  out actualAntialiasingLevel: integer; out extraVerticalMarginDueToRotation: integer): TSize;
    472569begin
    473570  actualAntialiasingLevel:= CustomAntialiasingLevel;
     571  extraVerticalMarginDueToRotation := 0;
    474572  if not LCLFontAvailable then
    475573    result := Size(0,0)
    … …  
    490588      Result.cy := 0;
    491589      tempBmp.Canvas.Font.GetTextSize(sUTF8, Result.cx, Result.cy);
     590      if Font.Orientation <> 0 then
     591      begin
     592        tempBmp.Canvas.Font.Orientation:= 0;
     593        extraVerticalMarginDueToRotation := result.cy - tempBmp.Canvas.Font.GetTextHeight(sUTF8);
     594      end;
    492595    except
    493596      on ex: exception do
    … …  
    501604end;
    502605
     606function BGRATextFitInfo(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string;
     607  CustomAntialiasingLevel: Integer; AMaxWidth: integer): integer;
     608var
     609  actualAntialiasingLevel: Integer;
     610begin
     611  if AMaxWidth = 0 then exit(0);
     612  actualAntialiasingLevel:= CustomAntialiasingLevel;
     613  if not LCLFontAvailable then
     614    result := 0
     615  else
     616  begin
     617    try
     618      if tempBmp = nil then tempBmp := TBitmap.Create;
     619      tempBmp.Canvas.Font := Font;
     620      if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then
     621      begin
     622        tempBmp.Canvas.Font.Height := Font.Height*CustomAntialiasingLevel;
     623      end else
     624      begin
     625        tempBmp.Canvas.Font.Height := Font.Height;
     626        actualAntialiasingLevel:= 1;
     627      end;
     628      result := tempBmp.Canvas.TextFitInfo(sUTF8, AMaxWidth*actualAntialiasingLevel);
     629    except
     630      on ex: exception do
     631      begin
     632        result := 0;
     633        LCLFontDisabledValue := True;
     634      end;
     635    end;
     636
     637  end;
     638end;
     639
    503640function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize;
    504 var actualAntialiasingLevel: integer;
    505 begin
    506   result := BGRAOriginalTextSizeEx(Font, Quality, sUTF8, CustomAntialiasingLevel, actualAntialiasingLevel);
     641var actualAntialiasingLevel, extraMargin: integer;
     642begin
     643  result := BGRAOriginalTextSizeEx(Font, Quality, sUTF8, CustomAntialiasingLevel, actualAntialiasingLevel, extraMargin);
     644  {$IFDEF FIX_FONT_VERTICAL_OFFSET}
     645  if extraMargin > 0 then result.cy -= extraMargin;
     646  {$ENDIF}
    507647end;
    508648
    … …  
    515655    result.cy := ceil(Result.cy/CustomAntialiasingLevel);
    516656  end;
     657end;
     658
     659function RemovePrefix(sUTF8: string): string;
     660var i,resLen: integer;
     661begin
     662  setlength(result, length(sUTF8));
     663  resLen := 0;
     664  i := 1;
     665  while i <= length(sUTF8) do
     666  begin
     667    if sUTF8[i] = '&' then
     668    begin // double ('&&') indicate single char '&'
     669      if (i < length(sUTF8)) and (sUTF8[i+1] = '&') then
     670      begin
     671        inc(resLen);
     672        result[resLen] := '&';
     673        inc(i,2);
     674      end else
     675        // single indicate underline
     676        inc(i);
     677    end else
     678    begin
     679      inc(resLen);
     680      result[resLen] := sUTF8[i];
     681      inc(i);
     682    end;
     683  end;
     684  setlength(result,resLen);
    517685end;
    518686
    … …  
    562730      grayscaleMask := TGrayscaleMask.Create(temp, cGreen);
    563731      FreeAndNil(temp);
     732      {$IFNDEF LINUX}
    564733      pb := grayscaleMask.Data;
    565734      for n := grayscaleMask.NbPixels - 1 downto 0 do
    … …  
    568737        Inc(pb);
    569738      end;
     739      {$ENDIF}
    570740    end;
    571741  end;
    … …  
    611781
    612782procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; sUTF8: string;
    613   c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
     783  c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0;
     784  ShowPrefix: boolean = false; RightToLeft: boolean = false);
    614785var
    615786  size: TSize;
    616   temp: TBGRACustomBitmap;
    617   {$IFDEF RENDER_TEXT_ON_TBITMAP}
    618   tempLCL: TBitmap;
    619   {$ENDIF}
    620   xMargin,xThird: integer;
    621   tempSize: TSize;
    622   subX,subY: integer;
    623   x,y :integer;
    624   deltaX: single;
    625   grayscale: TGrayscaleMask;
    626   sizeFactor: integer;
     787  sizeFactor, extraVerticalMargin: integer;
     788  xMarginF: single;
     789  style: TTextStyle;
     790  noPrefix: string;
    627791begin
    628792  if not LCLFontAvailable then exit;
    … …  
    648812  {$ENDIF}
    649813
    650   size := BGRAOriginalTextSizeEx(Font,Quality,sUTF8,CustomAntialiasingLevel,sizeFactor);
     814  if ShowPrefix then
     815    noPrefix := RemovePrefix(sUTF8)
     816  else
     817    noPrefix := sUTF8;
     818
     819  size := BGRAOriginalTextSizeEx(Font,Quality,noPrefix,CustomAntialiasingLevel,sizeFactor,extraVerticalMargin);
    651820  if (size.cx = 0) or (size.cy = 0) then
    652821    exit;
    … …  
    654823  if (size.cy >= 144) and (Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (CustomAntialiasingLevel > 4) then
    655824  begin
    656     BGRATextOut(bmp,Font,Quality,xf,yf,sUTF8,c,tex,align,4);
    657     exit;
     825    CustomAntialiasingLevel:= 4;
     826    size := BGRAOriginalTextSizeEx(Font,Quality,noPrefix,CustomAntialiasingLevel,sizeFactor,extraVerticalMargin);
    658827  end;
    659828
    … …  
    664833  end;
    665834
    666   x := round(xf);
    667   y := round(yf);
    668 
    669   xThird := 0;
    670   tempSize.cx := size.cx;
    671   tempSize.cy := size.cy;
    672   if sizeFactor <> 1 then
    673   begin
    674     tempSize.cx += sizeFactor-1;
    675     tempSize.cx -= tempSize.cx mod sizeFactor;
    676     tempSize.cy += sizeFactor-1;
    677     tempSize.cy -= tempSize.cy mod sizeFactor;
    678 
    679     deltaX := xf-floor(xf);
    680     if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB] then
    681     begin
    682       xThird := floor(deltaX*3) mod 3;
    683       deltaX -= xThird/3;
    684     end;
    685     subX := round(sizeFactor*deltaX);
    686     x := round(floor(xf));
    687     if subX <> 0 then inc(tempSize.cx, sizeFactor);
    688     subY := round(sizeFactor*(yf-floor(yf)));
    689     y := round(floor(yf));
    690     if subY <> 0 then inc(tempSize.cy, sizeFactor);
    691   end else
    692   begin
    693     subX := 0;
    694     subY := 0;
    695   end;
    696 
    697   xMargin := size.cy div 2;
    698   if sizeFactor <> 1 then
    699   begin
    700     xMargin += sizeFactor-1;
    701     xMargin -= xMargin mod sizeFactor;
    702   end;
    703   tempSize.cx += xMargin*2;
    704 
    705   {$IFDEF RENDER_TEXT_ON_TBITMAP}
    706   tempLCL := TBitmap.Create;
    707   tempLCL.Width := tempSize.cx;
    708   tempLCL.Height := tempSize.cy;
    709   tempLCL.Canvas.Brush.Color := clBlack;
    710   tempLCL.Canvas.FillRect(0,0,tempLCL.Width,tempLCL.Height);
    711   with tempLCL do begin
    712   {$ELSE}
    713   temp := bmp.NewBitmap(tempSize.cx, tempSize.cy, BGRABlack);
    714   with temp do begin
    715   {$ENDIF}
    716     Canvas.Font := Font;
    717     Canvas.Font.Height := Font.Height*sizeFactor;
    718     Canvas.Font.Color := clWhite;
    719     Canvas.Brush.Style := bsClear;
    720     Canvas.TextOut(xMargin+subX, subY, sUTF8);
    721   end;
    722   {$IFDEF RENDER_TEXT_ON_TBITMAP}
    723   temp := BGRABitmapFactory.create(tempLCL,False);
    724   tempLCL.Free;
    725   {$ENDIF}
    726 
    727   FilterOriginalText(Quality,CustomAntialiasingLevel, temp, grayscale);
    728   dec(x,round(xMargin/sizeFactor));
    729   BGRAInternalRenderText(bmp, Quality, grayscale,temp, x,y,xThird, c,tex);
    730   if temp <> nil then temp.Free;
    731   if grayscale <> nil then grayscale.Free;
     835  xMarginF := size.cy/sizeFactor;
     836  fillchar({%H-}style,sizeof(style),0);
     837  style.SingleLine := true;
     838  style.Alignment := taLeftJustify;
     839  style.Layout := tlTop;
     840  style.RightToLeft := RightToLeft;
     841  style.ShowPrefix := ShowPrefix;
     842  BGRATextRect(bmp, Font, Quality,
     843        rect(floor(xf-xMarginF), floor(yf), ceil(xf+size.cx/sizeFactor+xMarginF), ceil(yf+size.cy/sizeFactor)),
     844        xf,yf, sUTF8, style, c, tex, sizeFactor);
    732845end;
    733846
    … …  
    740853  size: TSize;
    741854  temp: TBGRACustomBitmap;
    742   TopRight,BottomRight,BottomLeft: TPointF;
    743   Top: Single;
     855  TopLeft,TopRight,BottomRight,BottomLeft: TPointF;
     856  Top,dy: Single;
    744857  Left: Single;
    745858  cosA,sinA: single;
    746859  rotBounds: TRect;
    747   sizeFactor: integer;
     860  sizeFactor, extraVerticalMargin: integer;
    748861  TempFont: TFont;
    749862  oldOrientation: integer;
    … …  
    781894  TempFont.Orientation := orientationTenthDegCCW;
    782895  TempFont.Height := Font.Height;
    783   size := BGRAOriginalTextSizeEx(TempFont,Quality,sUTF8,CustomAntialiasingLevel,sizeFactor);
     896  size := BGRAOriginalTextSizeEx(TempFont,Quality,sUTF8,CustomAntialiasingLevel,sizeFactor, extraVerticalMargin);
    784897  if (size.cx = 0) or (size.cy = 0) then
    785898  begin
    … …  
    787900    exit;
    788901  end;
     902  {$IFDEF FIX_FONT_VERTICAL_OFFSET}
     903  if extraVerticalMargin > 0 then
     904    dy := -extraVerticalMargin*0.5 -1
     905  else
     906    dy := 0;
     907  {$ELSE}
     908  dy := 0;
     909  {$ENDIF}
    789910  tempFont.Free;
    790911
    791912  cosA := cos(orientationTenthDegCCW*Pi/1800);
    792913  sinA := sin(orientationTenthDegCCW*Pi/1800);
    793   TopRight := PointF(cosA*size.cx,-sinA*size.cx);
    794   BottomRight := PointF(cosA*size.cx+sinA*size.cy,cosA*size.cy-sinA*size.cx);
    795   BottomLeft := PointF(sinA*size.cy,cosA*size.cy);
     914  TopLeft := PointF(sinA*dy,cosA*dy);
     915  xf += TopLeft.x/sizeFactor;
     916  yf += TopLeft.y/sizeFactor;
     917  TopRight := TopLeft + PointF(cosA*size.cx,-sinA*size.cx);
     918  BottomRight := TopRight + PointF(sinA*size.cy,cosA*size.cy);
     919  BottomLeft := TopLeft + PointF(sinA*size.cy,cosA*size.cy);
    796920  rotBounds := rect(0,0,0,0);
    797921  Top := 0;
    … …  
    854978end;
    855979
    856 procedure BGRATextRect(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; ARect: TRect; x, y: integer;
     980procedure BGRATextRect(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; ARect: TRect; xf, yf: single;
    857981  sUTF8: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0);
    858982var
    … …  
    9201044    Canvas.Font.Color := clWhite;
    9211045    Canvas.Brush.Style := bsClear;
    922     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);
     1046    Canvas.TextRect(rect(lim.Left-ARect.Left, lim.Top-ARect.Top,
     1047                         (ARect.Right-ARect.Left)*sizeFactor, (ARect.Bottom-ARect.Top)*sizeFactor),
     1048                         round((xf - lim.Left)*sizeFactor), round((yf - lim.Top)*sizeFactor), sUTF8, style);
    9231049  end;
    9241050  {$IFDEF RENDER_TEXT_ON_TBITMAP}
    … …  
    9331059end;
    9341060
    935 { TLCLFontRenderer }
    936 
    937 function TLCLFontRenderer.TextSurfaceSmaller(sUTF8: string; ARect: TRect): boolean;
    938 begin
    939   with TextSize(sUTF8) do
    940     result := cx*cy < (ARect.Right-ARect.Left)*(ARect.Bottom-ARect.Top);
    941 end;
    942 
    943 procedure TLCLFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x,
    944   y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel);
    945 begin
    946   if not style.Clipping or TextSurfaceSmaller(sUTF8,ARect) then
    947   begin
    948     InternalTextRect(ADest,ARect,x,y,sUTF8,style,c,nil);
    949     exit;
    950   end;
    951   UpdateFont;
    952   BGRAText.BGRATextRect(ADest,FFont,FontQuality,ARect,x,y,sUTF8,style,c,nil);
    953 end;
    954 
    955 procedure TLCLFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x,
    956   y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner);
    957 begin
    958   if not style.Clipping or TextSurfaceSmaller(sUTF8,ARect) then
    959   begin
    960     InternalTextRect(ADest,ARect,x,y,sUTF8,style,BGRAPixelTransparent,texture);
    961     exit;
    962   end;
    963   UpdateFont;
    964   BGRAText.BGRATextRect(ADest,FFont,FontQuality,ARect,x,y,sUTF8,style,BGRAPixelTransparent,texture);
    965 end;
    966 
    9671061{ TCustomLCLFontRenderer }
    9681062
    9691063{ Update font properties to internal TFont object }
    9701064procedure TCustomLCLFontRenderer.UpdateFont;
     1065var fixedHeight: integer;
    9711066begin
    9721067  if FFont.Name <> FontName then
    … …  
    9741069  if FFont.Style <> FontStyle then
    9751070    FFont.Style := FontStyle;
    976   if FFont.Height <> FontEmHeight * FontEmHeightSign then
    977     FFont.Height := FontEmHeight * FontEmHeightSign;
     1071  if FontEmHeight < 0 then
     1072    fixedHeight := FixLCLFontFullHeight(FontName, FontEmHeight * FontEmHeightSign)
     1073  else
     1074    fixedHeight := FontEmHeight * FontEmHeightSign;
     1075  if FFont.Height <> fixedHeight then
     1076    FFont.Height := fixedHeight;
    9781077  if FFont.Orientation <> FontOrientation then
    9791078    FFont.Orientation := FontOrientation;
    … …  
    9841083end;
    9851084
    986 function TCustomLCLFontRenderer.TextSizeNoUpdateFont(sUTF8: string): TSize;
    987 begin
     1085function TCustomLCLFontRenderer.InternalTextSize(sUTF8: string; AShowPrefix: boolean): TSize;
     1086begin
     1087  if AShowPrefix then sUTF8 := RemovePrefix(sUTF8);
    9881088  result := BGRAText.BGRATextSize(FFont,FontQuality,sUTF8,FontAntialiasingLevel);
    9891089  if (result.cy >= 24) and (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) then
    … …  
    9931093procedure TCustomLCLFontRenderer.SplitText(var ATextUTF8: string;
    9941094  AMaxWidth: integer; out ARemainsUTF8: string);
    995 var p,totalWidth: integer;
    996 begin
    997   if ATextUTF8= '' then
    998   begin
    999     ARemainsUTF8 := '';
    1000     exit;
    1001   end;
    1002   if RemoveLineEnding(ATextUTF8,1) then
    1003   begin
    1004     ARemainsUTF8:= ATextUTF8;
    1005     ATextUTF8 := '';
    1006     exit;
    1007   end;
     1095var WordBreakHandler: TWordBreakHandler;
     1096begin
    10081097  UpdateFont;
    1009 
    1010   p := 1;
    1011   inc(p, UTF8CharacterLength(@ATextUTF8[p])); //UTF8 chars may be more than 1 byte long
    1012   while p < length(ATextUTF8)+1 do
    1013   begin
    1014     if RemoveLineEnding(ATextUTF8,p) then
    1015     begin
    1016       ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1);
    1017       ATextUTF8 := copy(ATextUTF8,1,p-1);
    1018       exit;
    1019     end;
    1020     totalWidth := TextSizeNoUpdateFont(copy(ATextUTF8,1,p+UTF8CharacterLength(@ATextUTF8[p])-1)).cx; //copy whole last UTF8 char
    1021     if totalWidth > AMaxWidth then
    1022     begin
    1023       ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1);
    1024       ATextUTF8 := copy(ATextUTF8,1,p-1); //this includes the whole last UTF8 char
    1025       if Assigned(FWordBreakHandler) then
    1026         FWordBreakHandler(ATextUTF8,ARemainsUTF8) else
    1027           BGRADefaultWordBreakHandler(ATextUTF8,ARemainsUTF8);
    1028       exit;
    1029     end;
    1030     inc(p, UTF8CharacterLength(@ATextUTF8[p]));
    1031   end;
    1032   ARemainsUTF8 := '';
     1098  if Assigned(FWordBreakHandler) then
     1099    WordBreakHandler := FWordBreakHandler
     1100  else
     1101    WordBreakHandler := @DefaultWorkBreakHandler;
     1102
     1103  InternalSplitText(ATextUTF8, AMaxWidth, ARemainsUTF8, WordBreakHandler);
    10331104end;
    10341105
    … …  
    10701141procedure TCustomLCLFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string;
    10711142  texture: IBGRAScanner; align: TAlignment);
    1072 var mode : TBGRATextOutImproveReadabilityMode;
    10731143begin
    10741144  UpdateFont;
    1075 
    1076   if Assigned(BGRATextOutImproveReadabilityProc) and (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (FFont.Orientation mod 3600 = 0) then
    1077   begin
    1078     case FontQuality of
    1079       fqFineClearTypeBGR: mode := irClearTypeBGR;
    1080       fqFineClearTypeRGB: mode := irClearTypeRGB;
    1081     else
    1082       mode := irNormal;
    1083     end;
    1084     BGRATextOutImproveReadabilityProc(ADest,FFont,x,y,sUTF8,BGRAPixelTransparent,texture,align,mode);
    1085   end else
    1086     BGRAText.BGRATextOut(ADest,FFont,FontQuality,x,y,sUTF8,BGRAPixelTransparent,texture,align);
     1145  InternalTextOut(ADest, x,y, sUTF8, BGRAPixelTransparent,texture, align);
    10871146end;
    10881147
    10891148procedure TCustomLCLFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel;
    10901149  align: TAlignment);
    1091 var mode : TBGRATextOutImproveReadabilityMode;
    10921150begin
    10931151  UpdateFont;
    1094 
    1095   if Assigned(BGRATextOutImproveReadabilityProc) and (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (FFont.Orientation mod 3600 = 0) then
    1096   begin
    1097     case FontQuality of
    1098       fqFineClearTypeBGR: mode := irClearTypeBGR;
    1099       fqFineClearTypeRGB: mode := irClearTypeRGB;
    1100     else
    1101       mode := irNormal;
    1102     end;
    1103     BGRATextOutImproveReadabilityProc(ADest,FFont,x,y,sUTF8,c,nil,align,mode);
    1104   end else
    1105     BGRAText.BGRATextOut(ADest,FFont,FontQuality,x,y,sUTF8,c,nil,align);
     1152  InternalTextOut(ADest, x,y, sUTF8, c,nil, align);
     1153end;
     1154
     1155procedure TCustomLCLFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
     1156  y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment;
     1157  ARightToLeft: boolean);
     1158begin
     1159  UpdateFont;
     1160  InternalTextOut(ADest, x,y, sUTF8, BGRAPixelTransparent,texture, align,
     1161                False, ARightToLeft);
     1162end;
     1163
     1164procedure TCustomLCLFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
     1165  y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment;
     1166  ARightToLeft: boolean);
     1167begin
     1168  UpdateFont;
     1169  InternalTextOut(ADest, x,y, sUTF8, c,nil, align, false, ARightToLeft);
    11061170end;
    11071171
    … …  
    11091173  style: TTextStyle; c: TBGRAPixel);
    11101174begin
     1175  UpdateFont;
    11111176  InternalTextRect(ADest,ARect,x,y,sUTF8,style,c,nil);
    11121177end;
    … …  
    11151180  style: TTextStyle; texture: IBGRAScanner);
    11161181begin
     1182  UpdateFont;
    11171183  InternalTextRect(ADest,ARect,x,y,sUTF8,style,BGRAPixelTransparent,texture);
    11181184end;
    … …  
    11201186procedure TCustomLCLFontRenderer.TextWordBreak(ADest: TBGRACustomBitmap;
    11211187  AText: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel;
    1122   AHorizAlign: TAlignment; AVertAlign: TTextLayout);
    1123 begin
    1124   InternalTextWordBreak(ADest,AText,x,y,AMaxWidth,AColor,nil,AHorizAlign,AVertAlign);
     1188  AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean);
     1189begin
     1190  UpdateFont;
     1191  InternalTextWordBreak(ADest,AText,x,y,AMaxWidth,AColor,nil,AHorizAlign,AVertAlign,ARightToLeft);
    11251192end;
    11261193
    11271194procedure TCustomLCLFontRenderer.TextWordBreak(ADest: TBGRACustomBitmap;
    11281195  AText: string; x, y, AMaxWidth: integer; ATexture: IBGRAScanner;
    1129   AHorizAlign: TAlignment; AVertAlign: TTextLayout);
    1130 begin
    1131   InternalTextWordBreak(ADest,AText,x,y,AMaxWidth,BGRAPixelTransparent,ATexture,AHorizAlign,AVertAlign);
     1196  AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean);
     1197begin
     1198  UpdateFont;
     1199  InternalTextWordBreak(ADest,AText,x,y,AMaxWidth,BGRAPixelTransparent,ATexture,AHorizAlign,AVertAlign,ARightToLeft);
    11321200end;
    11331201
    11341202procedure TCustomLCLFontRenderer.InternalTextWordBreak(
    11351203  ADest: TBGRACustomBitmap; ATextUTF8: string; x, y, AMaxWidth: integer;
    1136   AColor: TBGRAPixel; ATexture: IBGRAScanner; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
    1137 var ARemains: string;
     1204  AColor: TBGRAPixel; ATexture: IBGRAScanner; AHorizAlign: TAlignment;
     1205  AVertAlign: TTextLayout; ARightToLeft: boolean);
     1206var remains, part, curText,nextText: string;
    11381207  stepX,stepY: integer;
    11391208  lines: TStringList;
    11401209  i: integer;
    11411210  lineShift: single;
     1211  WordBreakHandler: TWordBreakHandler;
     1212  lineEndingBreak: boolean;
     1213  bidiLayout: TBidiTextLayout;
     1214  bidiAlign: TBidiTextAlignment;
    11421215begin
    11431216  if (ATextUTF8 = '') or (AMaxWidth <= 0) then exit;
     1217
     1218  if Assigned(FWordBreakHandler) then
     1219    WordBreakHandler := FWordBreakHandler
     1220  else
     1221    WordBreakHandler := @DefaultWorkBreakHandler;
     1222
     1223  if ContainsBidiIsolateOrFormattingUTF8(ATextUTF8) then
     1224  begin
     1225    bidiLayout := TBidiTextLayout.Create(self, ATextUTF8, ARightToLeft);
     1226    bidiLayout.WordBreakHandler:= WordBreakHandler;
     1227    bidiLayout.AvailableWidth := AMaxWidth;
     1228    case AHorizAlign of
     1229      taLeftJustify: bidiAlign:= btaLeftJustify;
     1230      taRightJustify: begin
     1231        bidiAlign:= btaRightJustify;
     1232        x -= AMaxWidth;
     1233      end
     1234      else
     1235      begin
     1236        bidiAlign:= btaCenter;
     1237        x -= AMaxWidth div 2;
     1238      end;
     1239    end;
     1240    for i := 0 to bidiLayout.ParagraphCount-1 do
     1241      bidiLayout.ParagraphAlignment[i] := bidiAlign;
     1242    case AVertAlign of
     1243      tlBottom: bidiLayout.TopLeft := PointF(x, y - bidiLayout.TotalTextHeight);
     1244      tlCenter: bidiLayout.TopLeft := PointF(x, y - bidiLayout.TotalTextHeight/2);
     1245    end;
     1246    if ATexture <> nil then bidiLayout.DrawText(ADest, ATexture)
     1247    else bidiLayout.DrawText(ADest, AColor);
     1248    bidiLayout.Free;
     1249    exit;
     1250  end;
    11441251
    11451252  stepX := 0;
    11461253  stepY := TextSize('Hg').cy;
    11471254
    1148   if AVertAlign = tlTop then
    1149   begin
    1150     repeat
    1151       SplitText(ATextUTF8, AMaxWidth, ARemains);
    1152       if ATexture <> nil then
    1153         TextOut(ADest,x,y,ATextUTF8,ATexture,AHorizAlign)
    1154       else
    1155         TextOut(ADest,x,y,ATextUTF8,AColor,AHorizAlign);
    1156       ATextUTF8 := ARemains;
    1157       X+= stepX;
    1158       Y+= stepY;
    1159     until ARemains = '';
    1160   end else
    1161   begin
    1162     lines := TStringList.Create;
    1163     repeat
    1164       SplitText(ATextUTF8, AMaxWidth, ARemains);
    1165       lines.Add(ATextUTF8);
    1166       ATextUTF8 := ARemains;
    1167     until ARemains = '';
    1168     if AVertAlign = tlCenter then lineShift := lines.Count/2
    1169     else if AVertAlign = tlBottom then lineShift := lines.Count
    1170     else lineShift := 0;
    1171 
    1172     X -= round(stepX*lineShift);
    1173     Y -= round(stepY*lineShift);
    1174     for i := 0 to lines.Count-1 do
    1175     begin
    1176       if ATexture <> nil then
    1177         TextOut(ADest,x,y,lines[i],ATexture,AHorizAlign)
    1178       else
    1179         TextOut(ADest,x,y,lines[i],AColor,AHorizAlign);
    1180       X+= stepX;
    1181       Y+= stepY;
    1182     end;
    1183     lines.Free;
    1184   end;
     1255  lines := TStringList.Create;
     1256  curText := ATextUTF8;
     1257  repeat
     1258    InternalSplitText(curText, AMaxWidth, remains, lineEndingBreak, WordBreakHandler);
     1259    part := curText;
     1260    if not lineEndingBreak then
     1261      // append following direction to part
     1262      case GetFirstStrongBidiClassUTF8(remains) of
     1263        ubcLeftToRight: if ARightToLeft then part += UnicodeCharToUTF8($200E);
     1264        ubcRightToLeft,ubcArabicLetter: if not ARightToLeft then part += UnicodeCharToUTF8($200F);
     1265      end;
     1266    lines.Add(part);
     1267    // prefix next part with previous direction
     1268    nextText := remains;
     1269    if not lineEndingBreak then
     1270      case GetLastStrongBidiClassUTF8(curText) of
     1271        ubcLeftToRight: if ARightToLeft then nextText := UnicodeCharToUTF8($200E) + nextText;
     1272        ubcRightToLeft,ubcArabicLetter: if not ARightToLeft then nextText := UnicodeCharToUTF8($200F) + nextText;
     1273      end;
     1274    curText := nextText;
     1275  until remains = '';
     1276  if AVertAlign = tlCenter then lineShift := lines.Count/2
     1277  else if AVertAlign = tlBottom then lineShift := lines.Count
     1278  else lineShift := 0;
     1279
     1280  X -= round(stepX*lineShift);
     1281  Y -= round(stepY*lineShift);
     1282  for i := 0 to lines.Count-1 do
     1283  begin
     1284    InternalTextOut(ADest,x,y,lines[i],AColor,ATexture,AHorizAlign,false,ARightToLeft);
     1285    X+= stepX;
     1286    Y+= stepY;
     1287  end;
     1288  lines.Free;
    11851289end;
    11861290
    … …  
    11901294var
    11911295  previousClip, intersected: TRect;
    1192   oldOrientation: integer;
     1296  lines: TStringList;
     1297  iStart,i,h: integer;
     1298  availableWidth: integer;
    11931299begin
    11941300  previousClip := ADest.ClipRect;
    … …  
    11991305    ADest.ClipRect := intersected;
    12001306  end;
    1201   oldOrientation:= FontOrientation;
    1202   FontOrientation:= 0;
     1307  FFont.Orientation := 0;
     1308  if style.SystemFont then FFont.Name := 'default';
    12031309
    12041310  if not (style.Alignment in[taCenter,taRightJustify]) then ARect.Left := x;
    12051311  if not (style.Layout in[tlCenter,tlBottom]) then ARect.top := y;
    1206   if ARect.Right <= ARect.Left then exit;
     1312  if (ARect.Right <= ARect.Left) and style.Clipping then
     1313  begin
     1314    ADest.ClipRect := previousClip;
     1315    exit;
     1316  end;
    12071317  if style.Layout = tlCenter then Y := (ARect.Top+ARect.Bottom) div 2 else
    12081318  if style.Layout = tlBottom then Y := ARect.Bottom else
    … …  
    12121322    X := ARect.Left;
    12131323  if style.Wordbreak then
    1214     InternalTextWordBreak(ADest,sUTF8,X,Y,ARect.Right-ARect.Left,c,ATexture,style.Alignment,style.Layout)
     1324  begin
     1325    if style.ShowPrefix then sUTF8 := RemovePrefix(sUTF8); //prefix not handled
     1326    InternalTextWordBreak(ADest,sUTF8,X,Y,ARect.Right-ARect.Left,c,ATexture,
     1327        style.Alignment,style.Layout,style.RightToLeft);
     1328  end
    12151329  else
    12161330  begin
    1217     if style.Layout = tlCenter then Y -= TextSize(sUTF8).cy div 2;
    1218     if style.Layout = tlBottom then Y -= TextSize(sUTF8).cy;
    1219     if ATexture <> nil then
    1220       TextOut(ADest,X,Y,sUTF8,ATexture,style.Alignment)
     1331    lines := nil;
     1332    iStart := 1;
     1333
     1334    if not style.SingleLine then
     1335    begin
     1336      i := iStart;
     1337      while i <= length(sUTF8) do
     1338      begin
     1339        if sUTF8[i] in[#13,#10] then
     1340        begin
     1341          if not assigned(lines) then lines := TStringList.Create;
     1342          lines.add(copy(sUTF8,iStart,i-iStart));
     1343          if (sUTF8[i]=#13) and (i < length(sUTF8)) and (sUTF8[i+1]=#10) then inc(i);
     1344          iStart := i+1
     1345        end;
     1346        inc(i);
     1347      end;
     1348    end;
     1349
     1350    if style.Alignment = taLeftJustify then
     1351      availableWidth := ARect.Right-X
    12211352    else
    1222       TextOut(ADest,X,Y,sUTF8,c,style.Alignment);
    1223   end;
    1224 
    1225   FontOrientation:= oldOrientation;
     1353      availableWidth := ARect.Right-ARect.Left;
     1354    if availableWidth < 0 then availableWidth:= 0;
     1355
     1356    if lines = nil then //only one line
     1357    begin
     1358      if style.Layout = tlCenter then Y -= InternalTextSize(sUTF8,style.ShowPrefix).cy div 2;
     1359      if style.Layout = tlBottom then Y -= InternalTextSize(sUTF8,style.ShowPrefix).cy;
     1360      if style.EndEllipsis then
     1361        InternalTextOutEllipse(ADest,X,Y,availableWidth,sUTF8,c,ATexture,style.Alignment,
     1362                        style.ShowPrefix,style.RightToLeft)
     1363      else
     1364        InternalTextOut(ADest,X,Y,sUTF8,c,ATexture,style.Alignment,
     1365                        style.ShowPrefix,style.RightToLeft);
     1366    end else
     1367    begin    //multiple lines
     1368      lines.add(copy(sUTF8, iStart, length(sUTF8)-iStart+1));
     1369      h := InternalTextSize('Hg',False).cy;
     1370      if style.Layout = tlCenter then Y -= h*lines.Count div 2;
     1371      if style.Layout = tlBottom then Y -= h*lines.Count;
     1372      for i := 0 to lines.Count-1 do
     1373      begin
     1374        if style.EndEllipsis then
     1375          InternalTextOutEllipse(ADest,X,Y,availableWidth,lines[i],c,ATexture,style.Alignment,
     1376                          style.ShowPrefix,style.RightToLeft)
     1377        else
     1378          InternalTextOut(ADest,X,Y,lines[i],c,ATexture,style.Alignment,
     1379                          style.ShowPrefix,style.RightToLeft);
     1380        inc(Y,h);
     1381      end;
     1382      lines.Free;
     1383    end;
     1384
     1385  end;
     1386
    12261387  if style.Clipping then
    12271388    ADest.ClipRect := previousClip;
     1389end;
     1390
     1391procedure TCustomLCLFontRenderer.InternalTextOut(ADest: TBGRACustomBitmap; x,
     1392  y: single; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner;
     1393  align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false);
     1394var mode : TBGRATextOutImproveReadabilityMode;
     1395begin
     1396  {$IFDEF LINUX}
     1397  //help LCL detect the correct direction
     1398  case GetFirstStrongBidiClassUTF8(sUTF8) of
     1399    ubcRightToLeft, ubcArabicLetter: if not ARightToLeft then sUTF8 := UnicodeCharToUTF8($200E) + sUTF8;
     1400    else
     1401      begin //suppose left-to-right
     1402        if ARightToLeft then sUTF8 := UnicodeCharToUTF8($200F) + sUTF8;
     1403      end;
     1404  end;
     1405  {$ENDIF}
     1406  if Assigned(BGRATextOutImproveReadabilityProc) and (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (FFont.Orientation mod 3600 = 0) then
     1407  begin
     1408    case FontQuality of
     1409      fqFineClearTypeBGR: mode := irClearTypeBGR;
     1410      fqFineClearTypeRGB: mode := irClearTypeRGB;
     1411    else
     1412      mode := irNormal;
     1413    end;
     1414    if AShowPrefix then sUTF8 := RemovePrefix(sUTF8); //prefix not handled
     1415    BGRATextOutImproveReadabilityProc(ADest,FFont,x,y,sUTF8,c,texture,align,mode);
     1416  end else
     1417    BGRAText.BGRATextOut(ADest,FFont,FontQuality,x,y,sUTF8,c,texture,align,
     1418        0,AShowPrefix,ARightToLeft);
     1419end;
     1420
     1421procedure TCustomLCLFontRenderer.InternalTextOutEllipse(
     1422  ADest: TBGRACustomBitmap; x, y, availableWidth: single; sUTF8: string;
     1423  c: TBGRAPixel; texture: IBGRAScanner; align: TAlignment;
     1424  AShowPrefix: boolean; ARightToLeft: boolean);
     1425var remain: string;
     1426begin
     1427  if InternalTextSize(sUTF8,AShowPrefix).cx > availableWidth then
     1428  begin
     1429    InternalSplitText(sUTF8, round(availableWidth - InternalTextSize('...',AShowPrefix).cx), remain, nil);
     1430    sUTF8 += '...';
     1431  end;
     1432  InternalTextOut(ADest,x,y,sUTF8,c,texture,align,AShowPrefix,ARightToLeft);
     1433end;
     1434
     1435procedure TCustomLCLFontRenderer.InternalSplitText(var ATextUTF8: string;
     1436  AMaxWidth: integer; out ARemainsUTF8: string; out ALineEndingBreak: boolean; AWordBreak: TWordBreakHandler);
     1437var p,skipCount, charLen: integer;
     1438  zeroWidth: boolean;
     1439  u: Cardinal;
     1440begin
     1441  ALineEndingBreak:= false;
     1442  if ATextUTF8= '' then
     1443  begin
     1444    ARemainsUTF8 := '';
     1445    exit;
     1446  end;
     1447  if RemoveLineEnding(ATextUTF8,1) then
     1448  begin
     1449    ARemainsUTF8:= ATextUTF8;
     1450    ATextUTF8 := '';
     1451    ALineEndingBreak:= true;
     1452    exit;
     1453  end;
     1454
     1455  if AMaxWidth <= 0 then
     1456    skipCount := 0
     1457  else
     1458    skipCount := BGRATextFitInfo(FFont, FontQuality, ATextUTF8, FontAntialiasingLevel, AMaxWidth);
     1459
     1460  if skipCount <= 0 then skipCount := 1;
     1461
     1462  p := 1;
     1463  zeroWidth := true;
     1464  repeat
     1465    charLen := UTF8CharacterLength(@ATextUTF8[p]);
     1466    u := UTF8CodepointToUnicode(@ATextUTF8[p], charLen);
     1467    if not IsZeroWidthUnicode(u) then
     1468      zeroWidth:= false;
     1469    inc(p, charLen); //UTF8 chars may be more than 1 byte long
     1470    dec(skipCount);
     1471
     1472    if RemoveLineEnding(ATextUTF8,p) then
     1473    begin
     1474      ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1);
     1475      ATextUTF8 := copy(ATextUTF8,1,p-1);
     1476      ALineEndingBreak:= true;
     1477      exit;
     1478    end;
     1479  until ((skipCount <= 0) and not zeroWidth) or (p >= length(ATextUTF8)+1);
     1480
     1481  ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1);
     1482  ATextUTF8 := copy(ATextUTF8,1,p-1); //this includes the whole last UTF8 char
     1483  if Assigned(AWordBreak) then AWordBreak(ATextUTF8,ARemainsUTF8);
     1484end;
     1485
     1486procedure TCustomLCLFontRenderer.InternalSplitText(var ATextUTF8: string;
     1487  AMaxWidth: integer; out ARemainsUTF8: string; AWordBreak: TWordBreakHandler);
     1488var lineEndingBreak: boolean;
     1489begin
     1490  InternalSplitText(ATextUTF8,AMaxWidth,ARemainsUTF8,lineEndingBreak,AWordBreak);
     1491end;
     1492
     1493procedure TCustomLCLFontRenderer.DefaultWorkBreakHandler(var ABeforeUTF8,
     1494  AAfterUTF8: string);
     1495begin
     1496  BGRADefaultWordBreakHandler(ABeforeUTF8,AAfterUTF8);
    12281497end;
    12291498
    … …  
    12341503  FontOrientation:= 0;
    12351504  UpdateFont;
    1236   result := TextSizeNoUpdateFont(sUTF8);
     1505  result := InternalTextSize(sUTF8,False);
    12371506  FontOrientation:= oldOrientation;
     1507end;
     1508
     1509function TCustomLCLFontRenderer.TextSizeAngle(sUTF8: string;
     1510  orientationTenthDegCCW: integer): TSize;
     1511var oldOrientation: integer;
     1512begin
     1513  oldOrientation:= FontOrientation;
     1514  FontOrientation:= orientationTenthDegCCW;
     1515  UpdateFont;
     1516  result := InternalTextSize(sUTF8,False);
     1517  FontOrientation:= oldOrientation;
     1518end;
     1519
     1520function TCustomLCLFontRenderer.TextSize(sUTF8: string;
     1521  AMaxWidth: integer; ARightToLeft: boolean): TSize;
     1522var
     1523  remains: string;
     1524  h, i, w: integer;
     1525  WordBreakHandler: TWordBreakHandler;
     1526  layout: TBidiTextLayout;
     1527begin
     1528  UpdateFont;
     1529
     1530  if Assigned(FWordBreakHandler) then
     1531    WordBreakHandler := FWordBreakHandler
     1532  else
     1533    WordBreakHandler := @DefaultWorkBreakHandler;
     1534
     1535  if ContainsBidiIsolateOrFormattingUTF8(sUTF8) then
     1536  begin
     1537    layout := TBidiTextLayout.Create(self, sUTF8, ARightToLeft);
     1538    layout.WordBreakHandler:= WordBreakHandler;
     1539    layout.AvailableWidth := AMaxWidth;
     1540    for i := 0 to layout.ParagraphCount-1 do
     1541      layout.ParagraphAlignment[i] := btaLeftJustify;
     1542    result.cx := 0;
     1543    for i := 0 to layout.PartCount-1 do
     1544    begin
     1545      w := ceil(layout.PartRectF[i].Right);
     1546      if w > result.cx then result.cx := w;
     1547    end;
     1548    result.cy := ceil(layout.TotalTextHeight);
     1549    layout.Free;
     1550  end else
     1551  begin
     1552    result.cx := 0;
     1553    result.cy := 0;
     1554    h := InternalTextSize('Hg',False).cy;
     1555    repeat
     1556      InternalSplitText(sUTF8, AMaxWidth, remains, WordBreakHandler);
     1557      with InternalTextSize(sUTF8, false) do
     1558        if cx > result.cx then result.cx := cx;
     1559      result.cy += h;
     1560      sUTF8 := remains;
     1561    until remains = '';
     1562  end;
     1563end;
     1564
     1565function TCustomLCLFontRenderer.TextFitInfo(sUTF8: string; AMaxWidth: integer
     1566  ): integer;
     1567begin
     1568  UpdateFont;
     1569  result := BGRATextFitInfo(FFont, FontQuality, sUTF8, FontAntialiasingLevel, AMaxWidth);
    12381570end;
    12391571
Note: See TracChangeset for help on using the changeset viewer.