Changeset 472 for GraphicTest/Packages/bgrabitmap/bgrafreetype.pas

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:

• GraphicTest/Packages/bgrabitmap/bgrafreetype.pas (modified) (6 diffs)

GraphicTest/Packages/bgrabitmap/bgrafreetype.pas

@@ -3 +3 @@
 {$mode objfpc}{$H+}
 
+{
+  Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType
+
+  This units provide a font renderer with FreeType fonts, using the integrated FreeType font engine in Lazarus.
+  The simplest way to render effects is to use TBGRAFreeTypeFontRenderer class.
+  To do this, create an instance of this class and assign it to a TBGRABitmap.FontRenderer property. Now functions
+  to draw text like TBGRABitmap.TextOut will use the chosen renderer.
+
+  >> Note that you need to defined the default FreeType font collection
+  >> using LazFreeTypeFontCollection unit.
+
+  To set the effects, keep a variable containing
+  the TBGRAFreeTypeFontRenderer class and modify ShadowVisible and other effects parameters. The FontHinted property
+  allows you to choose if the font is snapped to pixels to make it more readable.
+
+  TBGRAFreeTypeDrawer class is the class that provides basic FreeType drawing
+  by deriving the TFreeTypeDrawer type. You can use it directly, but it is not
+  recommended, because there are less text layout parameters. However, it is
+  necessary if you want to create TBGRATextEffect objects using FreeType fonts.
+}
+
 interface
 
 uses
-  Classes, SysUtils, Graphics, BGRABitmapTypes, EasyLazFreeType, FPimage;
+  Types, Classes, SysUtils, Graphics, BGRABitmapTypes, EasyLazFreeType, FPimage, BGRAText, BGRATextFX, BGRAPhongTypes, LCLVersion;
 
 type
+  TBGRAFreeTypeDrawer = class;
+
+  //this is the class to assign to FontRenderer property of TBGRABitmap
+  { TBGRAFreeTypeFontRenderer }
+
+  TBGRAFreeTypeFontRenderer = class(TBGRACustomFontRenderer)
+  private
+    FDrawer: TBGRAFreeTypeDrawer;
+    FFont: TFreeTypeFont;
+    function GetCollection: TCustomFreeTypeFontCollection;
+    function GetDrawer(ASurface: TBGRACustomBitmap): TBGRAFreeTypeDrawer;
+    function GetShaderLightPosition: TPoint;
+    procedure SetShaderLightPosition(AValue: TPoint);
+  protected
+    FShaderOwner: boolean;
+    FShader: TCustomPhongShading;
+    procedure UpdateFont;
+    procedure Init;
+  public
+    FontHinted: boolean;
+
+    ShaderActive: boolean;
+
+    ShadowVisible: boolean;
+    ShadowColor: TBGRAPixel;
+    ShadowRadius: integer;
+    ShadowOffset: TPoint;
+
+    OutlineColor: TBGRAPixel;
+    OutlineVisible,OuterOutlineOnly: boolean;
+    OutlineTexture: IBGRAScanner;
+
+    constructor Create;
+    constructor Create(AShader: TCustomPhongShading; AShaderOwner: boolean);
+    function GetFontPixelMetric: TFontPixelMetric; override;
+    procedure TextOutAngle({%H-}ADest: TBGRACustomBitmap; {%H-}x, {%H-}y: single; {%H-}orientation: integer; {%H-}s: string; {%H-}c: TBGRAPixel; {%H-}align: TAlignment); override;
+    procedure TextOutAngle({%H-}ADest: TBGRACustomBitmap; {%H-}x, {%H-}y: single; {%H-}orientation: integer; {%H-}s: string; {%H-}texture: IBGRAScanner; {%H-}align: TAlignment); override;
+    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); override;
+    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment); override;
+    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); override;
+    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); override;
+    function TextSize(s: string): TSize; override;
+    destructor Destroy; override;
+    property Collection: TCustomFreeTypeFontCollection read GetCollection;
+    property ShaderLightPosition: TPoint read GetShaderLightPosition write SetShaderLightPosition;
+  end;
 
   { TBGRAFreeTypeDrawer }
@@ -16 +83 @@
     FMask: TBGRACustomBitmap;
     FColor: TBGRAPixel;
+    FInCreateTextEffect: boolean;
     procedure RenderDirectly(x, y, tx: integer; data: pointer);
     procedure RenderDirectlyClearType(x, y, tx: integer; data: pointer);
+    function ShadowActuallyVisible :boolean;
+    function OutlineActuallyVisible: boolean;
+    function ShaderActuallyActive : boolean;
   public
     Destination: TBGRACustomBitmap;
     ClearTypeRGBOrder: boolean;
+    Texture: IBGRAScanner;
+
+    Shader: TCustomPhongShading;
+    ShaderActive: boolean;
+
+    ShadowVisible: boolean;
+    ShadowColor: TBGRAPixel;
+    ShadowRadius: integer;
+    ShadowOffset: TPoint;
+
+    OutlineColor: TBGRAPixel;
+    OutlineVisible,OuterOutlineOnly: boolean;
+    OutlineTexture: IBGRAScanner;
+
     constructor Create(ADestination: TBGRACustomBitmap);
     procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); override; overload;
     procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel); overload;
     procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload;
+    function CreateTextEffect(AText: string; AFont: TFreeTypeRenderableFont): TBGRATextEffect;
     destructor Destroy; override;
   end;
 
+
 implementation
 
-uses LCLType, BGRABlend, BGRAText;
+uses LCLType, BGRABlend, Math;
+
+{ TBGRAFreeTypeFontRenderer }
+
+function TBGRAFreeTypeFontRenderer.GetCollection: TCustomFreeTypeFontCollection;
+begin
+  result := EasyLazFreeType.FontCollection;
+end;
+
+function TBGRAFreeTypeFontRenderer.GetDrawer(ASurface: TBGRACustomBitmap): TBGRAFreeTypeDrawer;
+begin
+  result := FDrawer;
+  result.ShadowColor := ShadowColor;
+  result.ShadowOffset := ShadowOffset;
+  result.ShadowRadius := ShadowRadius;
+  result.ShadowVisible := ShadowVisible;
+  result.ClearTypeRGBOrder := FontQuality <> fqFineClearTypeBGR;
+  result.Destination := ASurface;
+  result.OutlineColor := OutlineColor;
+  result.OutlineVisible := OutlineVisible;
+  result.OuterOutlineOnly := OuterOutlineOnly;
+  result.OutlineTexture := OutlineTexture;
+  if ShaderActive then result.Shader := FShader
+   else result.Shader := nil;
+end;
+
+function TBGRAFreeTypeFontRenderer.GetShaderLightPosition: TPoint;
+begin
+  if FShader = nil then
+    result := point(0,0)
+  else
+    result := FShader.LightPosition;
+end;
+
+procedure TBGRAFreeTypeFontRenderer.SetShaderLightPosition(AValue: TPoint);
+begin
+  if FShader <> nil then
+    FShader.LightPosition := AValue;
+end;
+
+procedure TBGRAFreeTypeFontRenderer.UpdateFont;
+var fts: TFreeTypeStyles;
+begin
+  fts := [];
+  if fsBold in FontStyle then fts += [ftsBold];
+  if fsItalic in FontStyle then fts += [ftsItalic];
+  try
+    {$IF (lcl_fullversion>=1010000)}
+    FFont.SetNameAndStyle(FontName,fts);
+    {$ELSE}
+    FFont.Name := FontName;
+    FFont.Style := fts;
+    {$ENDIF}
+  except
+    on ex: exception do
+    begin
+    end;
+  end;
+  if FontEmHeight >= 0 then
+    FFont.SizeInPixels := FontEmHeight
+  else
+    FFont.LineFullHeight := -FontEmHeight;
+  case FontQuality of
+    fqSystem:
+    begin
+      FFont.Quality := grqMonochrome;
+      FFont.ClearType := false;
+    end;
+    fqSystemClearType:
+    begin
+      FFont.Quality:= grqLowQuality;
+      FFont.ClearType:= true;
+    end;
+    fqFineAntialiasing:
+    begin
+      FFont.Quality:= grqHighQuality;
+      FFont.ClearType:= false;
+    end;
+    fqFineClearTypeRGB,fqFineClearTypeBGR:
+    begin
+      FFont.Quality:= grqHighQuality;
+      FFont.ClearType:= true;
+    end;
+  end;
+  FFont.Hinted := FontHinted;
+  {$IF (lcl_fullversion>=1010000)}
+  FFont.StrikeOutDecoration := fsStrikeOut in FontStyle;
+  FFont.UnderlineDecoration := fsUnderline in FontStyle;
+  {$ENDIF}
+end;
+
+procedure TBGRAFreeTypeFontRenderer.Init;
+begin
+  ShaderActive := true;
+
+  FDrawer := TBGRAFreeTypeDrawer.Create(nil);
+  FFont := TFreeTypeFont.Create;
+  FontHinted:= True;
+
+  ShadowColor := BGRABlack;
+  ShadowVisible := false;
+  ShadowOffset := Point(5,5);
+  ShadowRadius := 5;
+end;
+
+constructor TBGRAFreeTypeFontRenderer.Create;
+begin
+  Init;
+end;
+
+constructor TBGRAFreeTypeFontRenderer.Create(AShader: TCustomPhongShading;
+  AShaderOwner: boolean);
+begin
+  Init;
+  FShader := AShader;
+  FShaderOwner := AShaderOwner;
+end;
+
+function TBGRAFreeTypeFontRenderer.GetFontPixelMetric: TFontPixelMetric;
+begin
+  UpdateFont;
+  result.Baseline := round(FFont.Ascent);
+  result.CapLine:= round(FFont.Ascent*0.2);
+  result.DescentLine:= round(FFont.Ascent+FFont.Descent);
+  result.Lineheight := round(FFont.LineFullHeight);
+  result.xLine := round(FFont.Ascent*0.45);
+  result.Defined := True;
+end;
+
+procedure TBGRAFreeTypeFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x,
+  y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment);
+begin
+
+end;
+
+procedure TBGRAFreeTypeFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x,
+  y: single; orientation: integer; s: string; texture: IBGRAScanner;
+  align: TAlignment);
+begin
+
+end;
+
+procedure TBGRAFreeTypeFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
+  y: single; s: string; texture: IBGRAScanner; align: TAlignment);
+begin
+  FDrawer.Texture := texture;
+  TextOut(ADest,x,y,s,BGRAWhite,align);
+  FDrawer.Texture := nil;
+end;
+
+procedure TBGRAFreeTypeFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
+  y: single; s: string; c: TBGRAPixel; align: TAlignment);
+var
+  ftaAlign: TFreeTypeAlignments;
+begin
+  UpdateFont;
+  ftaAlign:= [ftaTop];
+  case align of
+  taLeftJustify: ftaAlign += [ftaLeft];
+  taCenter: ftaAlign += [ftaCenter];
+  taRightJustify: ftaAlign += [ftaRight];
+  end;
+  GetDrawer(ADest).DrawText(s,FFont,x,y,BGRAToFPColor(c),ftaAlign);
+end;
+
+procedure TBGRAFreeTypeFontRenderer.TextRect(ADest: TBGRACustomBitmap;
+  ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel);
+var align: TFreeTypeAlignments;
+    intersectedClip,previousClip: TRect;
+begin
+  previousClip := ADest.ClipRect;
+  if style.Clipping then
+  begin
+    intersectedClip := rect(0,0,0,0);
+    if not IntersectRect(intersectedClip, previousClip, ARect) then exit;
+    ADest.ClipRect := intersectedClip;
+  end;
+  UpdateFont;
+  align := [];
+  case style.Alignment of
+  taCenter: begin ARect.Left := x; align += [ftaCenter]; end;
+  taRightJustify: begin ARect.Left := x; align += [ftaRight]; end;
+  else
+    align += [ftaLeft];
+  end;
+  case style.Layout of
+  {$IF (lcl_fullversion>=1010000)}
+  tlCenter: begin ARect.Top := y; align += [ftaVerticalCenter]; end;
+  {$ENDIF}
+  tlBottom: begin ARect.top := y; align += [ftaBottom]; end;
+  else align += [ftaTop];
+  end;
+  try
+    {$IF (lcl_fullversion>=1010000)}
+    if style.Wordbreak then
+      GetDrawer(ADest).DrawTextRect(s, FFont, ARect.Left,ARect.Top,ARect.Right,ARect.Bottom,BGRAToFPColor(c),align)
+    else
+    {$ENDIF}
+    begin
+      case style.Layout of
+      tlCenter: y := (ARect.Top+ARect.Bottom) div 2;
+      tlBottom: y := ARect.Bottom;
+      else
+        y := ARect.Top;
+      end;
+      case style.Alignment of
+      taLeftJustify: GetDrawer(ADest).DrawText(s,FFont,ARect.Left,y,BGRAToFPColor(c),align);
+      taCenter: GetDrawer(ADest).DrawText(s,FFont,(ARect.Left+ARect.Right-1) div 2,y,BGRAToFPColor(c),align);
+      taRightJustify: GetDrawer(ADest).DrawText(s,FFont,ARect.Right,y,BGRAToFPColor(c),align);
+      end;
+    end;
+  finally
+    if style.Clipping then
+      ADest.ClipRect := previousClip;
+  end;
+end;
+
+procedure TBGRAFreeTypeFontRenderer.TextRect(ADest: TBGRACustomBitmap;
+  ARect: TRect; x, y: integer; s: string; style: TTextStyle;
+  texture: IBGRAScanner);
+begin
+  FDrawer.Texture := texture;
+  TextRect(ADest,ARect,x,y,s,style,BGRAWhite);
+  FDrawer.Texture := nil;
+end;
+
+function TBGRAFreeTypeFontRenderer.TextSize(s: string): TSize;
+begin
+  result.cx := round(FFont.TextWidth(s));
+  result.cy := round(FFont.LineFullHeight);
+end;
+
+destructor TBGRAFreeTypeFontRenderer.Destroy;
+begin
+  FDrawer.Free;
+  FFont.Free;
+  if FShaderOwner then FShader.Free;
+  inherited Destroy;
+end;
 
 { TBGRAFreeTypeDrawer }
@@ -45 +370 @@
     if (y < 0) or (y >= Destination.height) or (x < 0) or (x > Destination.width-tx) then exit;
 
-    c := FColor;
     psrc := pbyte(data);
     pdest := Destination.ScanLine[y]+x;
-    while tx > 0 do
-    begin
-      DrawPixelInlineWithAlphaCheck(pdest,c,psrc^);
-      inc(psrc);
-      inc(pdest);
-      dec(tx);
+    if Texture = nil then
+    begin
+      c := FColor;
+      while tx > 0 do
+      begin
+        DrawPixelInlineWithAlphaCheck(pdest,c,psrc^);
+        inc(psrc);
+        inc(pdest);
+        dec(tx);
+      end;
+    end else
+    begin
+      Texture.ScanMoveTo(x,y);
+      while tx > 0 do
+      begin
+        DrawPixelInlineWithAlphaCheck(pdest,Texture.ScanNextPixel,psrc^);
+        inc(psrc);
+        inc(pdest);
+        dec(tx);
+      end;
     end;
   end;
@@ -95 +433 @@
       pdest^.blue := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3;
     end;
-    BGRAFillClearTypeRGBMask(Destination,x div 3,y,FMask,FColor,nil,ClearTypeRGBOrder);
-  end;
+    BGRAFillClearTypeRGBMask(Destination,x div 3,y,FMask,FColor,Texture,ClearTypeRGBOrder);
+  end;
+end;
+
+function TBGRAFreeTypeDrawer.ShadowActuallyVisible: boolean;
+begin
+  result := ShadowVisible and (ShadowColor.alpha <> 0);
+end;
+
+function TBGRAFreeTypeDrawer.OutlineActuallyVisible: boolean;
+begin
+  result := ((OutlineTexture <> nil) or (OutlineColor.alpha <> 0)) and OutlineVisible;
+end;
+
+function TBGRAFreeTypeDrawer.ShaderActuallyActive: boolean;
+begin
+  result := (Shader <> nil) and ShaderActive;
 end;
 
@@ -103 +456 @@
   Destination := ADestination;
   ClearTypeRGBOrder:= true;
+  ShaderActive := true;
 end;
 
 procedure TBGRAFreeTypeDrawer.DrawText(AText: string;
   AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor);
-begin
-  FColor := FPColorToBGRA(AColor);
-  if AFont.ClearType then
-    AFont.RenderText(AText, x, y, Destination.ClipRect, @RenderDirectlyClearType)
-  else
-    AFont.RenderText(AText, x, y, Destination.ClipRect, @RenderDirectly);
+var fx: TBGRATextEffect;
+  procedure DoOutline;
+  begin
+    if OutlineActuallyVisible then
+    begin
+      if OutlineTexture <> nil then
+        fx.DrawOutline(Destination,round(x),round(y), OutlineTexture)
+      else
+        fx.DrawOutline(Destination,round(x),round(y), OutlineColor);
+    end;
+  end;
+begin
+  if not FInCreateTextEffect and (ShadowActuallyVisible or OutlineActuallyVisible or ShaderActuallyActive) then
+  begin
+    fx := CreateTextEffect(AText, AFont);
+    y -= AFont.Ascent;
+    if ShadowActuallyVisible then fx.DrawShadow(Destination, round(x+ShadowOffset.X),round(y+ShadowOffset.Y), ShadowRadius, ShadowColor);
+    if OuterOutlineOnly then DoOutline;
+
+    if texture <> nil then
+    begin
+      if ShaderActuallyActive then
+        fx.DrawShaded(Destination,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), texture)
+      else
+        fx.Draw(Destination,round(x),round(y), texture);
+    end else
+    begin
+      if ShaderActuallyActive then
+        fx.DrawShaded(Destination,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), FPColorToBGRA(AColor))
+      else
+        fx.Draw(Destination,round(x),round(y), FPColorToBGRA(AColor));
+    end;
+    if not OuterOutlineOnly then DoOutline;
+    fx.Free;
+  end else
+  begin
+    FColor := FPColorToBGRA(AColor);
+    if AFont.ClearType then
+      AFont.RenderText(AText, x, y, Destination.ClipRect, @RenderDirectlyClearType)
+    else
+      AFont.RenderText(AText, x, y, Destination.ClipRect, @RenderDirectly);
+  end;
 end;
 
@@ -128 +518 @@
 end;
 
+function TBGRAFreeTypeDrawer.CreateTextEffect(AText: string;
+  AFont: TFreeTypeRenderableFont): TBGRATextEffect;
+var
+  mask: TBGRACustomBitmap;
+  tx,ty,marginHoriz,marginVert: integer;
+  tempDest: TBGRACustomBitmap;
+  tempTex: IBGRAScanner;
+  tempClearType: boolean;
+begin
+  FInCreateTextEffect:= True;
+  try
+    tx := ceil(AFont.TextWidth(AText));
+    ty := ceil(AFont.TextHeight(AText));
+    marginHoriz := ty div 2;
+    marginVert := 1;
+    mask := BGRABitmapFactory.Create(tx+2*marginHoriz,ty+2*marginVert,BGRABlack);
+    tempDest := Destination;
+    tempTex := Texture;
+    tempClearType:= AFont.ClearType;
+    Destination := mask;
+    Texture := nil;
+    AFont.ClearType := false;
+    DrawText(AText,AFont,marginHoriz,marginVert,BGRAWhite,[ftaTop,ftaLeft]);
+    Destination := tempDest;
+    Texture := tempTex;
+    AFont.ClearType := tempClearType;
+    mask.ConvertToLinearRGB;
+    result := TBGRATextEffect.Create(mask, true,tx,ty,point(-marginHoriz,-marginVert));
+  finally
+    FInCreateTextEffect:= false;
+  end;
+end;
+
 destructor TBGRAFreeTypeDrawer.Destroy;
 begin