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/bgrafreetype.pas

    r494 r521  
    5151    procedure UpdateFont;
    5252    procedure Init;
     53    procedure TextOutAnglePatch(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string;
     54              c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment);
    5355  public
    5456    FontHinted: boolean;
    … …  
    6668    OutlineTexture: IBGRAScanner;
    6769
    68     constructor Create;
    69     constructor Create(AShader: TCustomPhongShading; AShaderOwner: boolean);
     70    constructor Create; overload;
     71    constructor Create(AShader: TCustomPhongShading; AShaderOwner: boolean); overload;
    7072    function GetFontPixelMetric: TFontPixelMetric; override;
    71     procedure TextOutAngle({%H-}ADest: TBGRACustomBitmap; {%H-}x, {%H-}y: single; {%H-}orientation: integer; {%H-}s: string; {%H-}c: TBGRAPixel; {%H-}align: TAlignment); override;
    72     procedure TextOutAngle({%H-}ADest: TBGRACustomBitmap; {%H-}x, {%H-}y: single; {%H-}orientation: integer; {%H-}s: string; {%H-}texture: IBGRAScanner; {%H-}align: TAlignment); override;
    73     procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); override;
    74     procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment); override;
    75     procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); override;
    76     procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); override;
    77     function TextSize(s: string): TSize; override;
     73    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); overload; override;
     74    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); overload; override;
     75    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); overload; override;
     76    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment); overload; override;
     77    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); overload; override;
     78    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); overload; override;
     79    function TextSize(s: string): TSize; overload; override;
     80    function TextSize(sUTF8: string; AMaxWidth: integer; {%H-}ARightToLeft: boolean): TSize; overload; override;
     81    function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; override;
    7882    destructor Destroy; override;
    7983    property Collection: TCustomFreeTypeFontCollection read GetCollection;
    … …  
    112116
    113117    constructor Create(ADestination: TBGRACustomBitmap);
    114     procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); override; overload;
     118    procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); overload; override;
    115119    procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel); overload;
    116120    procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload;
    … …  
    122126    {$ENDIF}
    123127    {$IFDEF BGRABITMAP_USE_LCL15}
    124     procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); override; overload;
     128    procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); overload; override;
    125129    procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel); overload;
    126130    procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload;
    … …  
    133137implementation
    134138
    135 uses BGRABlend, Math;
     139uses BGRABlend, Math, BGRATransform;
    136140
    137141{ TBGRAFreeTypeFontRenderer }
    … …  
    242246end;
    243247
     248procedure TBGRAFreeTypeFontRenderer.TextOutAnglePatch(ADest: TBGRACustomBitmap;
     249  x, y: single; orientation: integer; s: string; c: TBGRAPixel;
     250  tex: IBGRAScanner; align: TAlignment);
     251const orientationToDeg = -0.1;
     252var
     253  temp: TBGRACustomBitmap;
     254  coord: TPointF;
     255  angleDeg: single;
     256  OldOrientation: integer;
     257  filter: TResampleFilter;
     258  OldFontQuality: TBGRAFontQuality;
     259begin
     260  OldOrientation := FontOrientation;
     261  FontOrientation:= 0;
     262  OldFontQuality := FontQuality;
     263
     264  if FontQuality in[fqFineClearTypeRGB,fqFineClearTypeBGR] then FontQuality:= fqFineAntialiasing
     265  else if FontQuality = fqSystemClearType then FontQuality:= fqSystem;
     266
     267  temp := BGRABitmapFactory.Create;
     268  with TextSize(s) do
     269    temp.SetSize(cx,cy);
     270  temp.FillTransparent;
     271  if tex<>nil then
     272    TextOut(temp,0,0, s, tex, taLeftJustify)
     273  else
     274    TextOut(temp,0,0, s, c, taLeftJustify);
     275
     276  orientation:= orientation mod 3600;
     277  if orientation < 0 then orientation += 3600;
     278
     279  angleDeg := orientation * orientationToDeg;
     280  coord := PointF(x,y);
     281  case align of
     282  taRightJustify: coord -= AffineMatrixRotationDeg(angleDeg)*PointF(temp.Width,0);
     283  taCenter: coord -= AffineMatrixRotationDeg(angleDeg)*PointF(temp.Width,0)*0.5;
     284  end;
     285  case orientation of
     286  0,900,1800,2700: filter := rfBox;
     287  else filter := rfCosine;
     288  end;
     289  ADest.PutImageAngle(coord.x,coord.y, temp, angleDeg, filter);
     290  temp.Free;
     291
     292  FontOrientation:= OldOrientation;
     293  FontQuality:= OldFontQuality;
     294end;
     295
    244296constructor TBGRAFreeTypeFontRenderer.Create;
    245297begin
    … …  
    269321  y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment);
    270322begin
     323  TextOutAnglePatch(ADest, x,y, orientation, s, c, nil, align);
     324{procedure TForm1.TextOutAnglePatch(ADest: TBGRABitmap;
     325  x, y: single; orientationTenthDegCCW: integer;
     326  s: string; c: TBGRAPixel; AAlign: TAlignment; AResampleFilter: TResampleFilter);
     327const orientationToDeg = -0.1;
     328var
     329  temp: TBGRABitmap;
     330  coord: TPointF;
     331  angleDeg: single;
     332begin
     333  temp := TBGRABitmap.Create;
     334  ADest.CopyPropertiesTo(temp);
     335  temp.FontOrientation := 0;
     336  with temp.TextSize(s) do
     337    temp.SetSize(cx,cy);
     338  temp.FillTransparent;
     339+
     340  temp.TextOut(0,0, s, c);
     341
     342  angleDeg := orientationTenthDegCCW * orientationToDeg;
     343  coord := PointF(x,y);
     344  case AAlign of
     345  taRightJustify: coord -= AffineMatrixRotationDeg(angleDeg)*PointF(temp.Width,0);
     346  taCenter: coord -= AffineMatrixRotationDeg(angleDeg)*PointF(temp.Width,0)*0.5;
     347  end;
     348
     349  ADest.PutImageAngle(coord.x,coord.y, temp, angleDeg, rfBox);
     350  temp.Free;
     351end;           }
    271352
    272353end;
    … …  
    276357  align: TAlignment);
    277358begin
    278 
     359  TextOutAnglePatch(ADest, x,y, orientation, s, BGRAPixelTransparent, texture, align);
    279360end;
    280361
    … …  
    368449  result.cx := round(FFont.TextWidth(s));
    369450  result.cy := round(FFont.LineFullHeight);
     451end;
     452
     453function TBGRAFreeTypeFontRenderer.TextSize(sUTF8: string; AMaxWidth: integer;
     454  ARightToLeft: boolean): TSize;
     455var
     456  remains: string;
     457  w,h,totalH: single;
     458begin
     459  UpdateFont;
     460
     461  result.cx := 0;
     462  totalH := 0;
     463  h := FFont.LineFullHeight;
     464  repeat
     465    FFont.SplitText(sUTF8, AMaxWidth, remains);
     466    w := FFont.TextWidth(sUTF8);
     467    if round(w)>result.cx then result.cx := round(w);
     468    totalH += h;
     469    sUTF8 := remains;
     470  until remains = '';
     471  result.cy := ceil(totalH);
     472end;
     473
     474function TBGRAFreeTypeFontRenderer.TextFitInfo(sUTF8: string; AMaxWidth: integer): integer;
     475var
     476  remains: string;
     477begin
     478  UpdateFont;
     479  FFont.SplitText(sUTF8, AMaxWidth, remains);
     480  result := length(sUTF8);
    370481end;
    371482
Note: See TracChangeset for help on using the changeset viewer.