FreeType: Support for rotated text.

git-svn-id: trunk@63846 -

components/freetype/easylazfreetype.pas

@@ -21,7 +21,7 @@ interface
 uses
   Classes, SysUtils, fpimage, Laz_AVL_Tree,
   // LazUtils                     // Note: Types must be after TTTypes for PByte.
-  LazUTF8, LazFreeType, TTRASTER, TTTypes, Types;
+  LazUTF8, LazFreeType, TTRASTER, TTTypes, TTObjs, Types;
 
 type
   TGlyphRenderQuality = (grqMonochrome, grqLowQuality, grqHighQuality);
@@ -184,6 +184,7 @@ type
     procedure SetHinted(const AValue: boolean); virtual; abstract;
   public
     UnderlineDecoration,StrikeOutDecoration: boolean;
+    Orientation: integer;
     function TextWidth(AText: string): single; virtual; abstract;
     function TextHeight(AText: string): single; virtual; abstract;
     function CharWidthFromUnicode(AUnicode: integer): single; virtual; abstract;
@@ -339,13 +340,16 @@ type
     FLoaded: boolean;
     FGlyphData: TT_Glyph;
     FIndex: integer;
+    FOrientation: Integer;
     function GetAdvance: single;
     function GetBounds: TRect;
     function GetBoundsWithOffset(x, y: single): TRect;
+    {%H-}constructor create;
   public
     constructor Create(AFont: TFreeTypeFont; AIndex: integer);
     function RenderDirectly(x,y: single; Rect: TRect; OnRender : TDirectRenderingFunction; quality : TGlyphRenderQuality; ClearType: boolean = false): boolean;
     function RenderDirectly(ARasterizer: TFreeTypeRasterizer; x,y: single; Rect: TRect; OnRender : TDirectRenderingFunction; quality : TGlyphRenderQuality; ClearType: boolean = false): boolean;
+    function Clone(AOrientation:Integer): TFreeTypeGlyph;
     destructor Destroy; override;
     property Loaded: boolean read FLoaded;
     property Data: TT_Glyph read FGlyphData;
@@ -752,15 +756,8 @@ end;
 { TFreeTypeGlyph }
 
 function TFreeTypeGlyph.GetBounds: TRect;
-var
-  metrics: TT_Glyph_Metrics;
 begin
-  if TT_Get_Glyph_Metrics(FGlyphData, metrics) = TT_Err_Ok then
+  result := GetBoundsWithOffset(0, 0);
-    with metrics.bbox do
-      result := rect(IncludeFullGrainMin(xMin,64) div 64,IncludeFullGrainMin(-yMax,64) div 64,
-         (IncludeFullGrainMax(xMax,64)+1) div 64,(IncludeFullGrainMax(-yMin,64)+1) div 64)
-  else
-      result := TRect.Empty;
 end;
 
 function TFreeTypeGlyph.GetAdvance: single;
@@ -776,15 +773,30 @@ end;
 function TFreeTypeGlyph.GetBoundsWithOffset(x, y: single): TRect;
 var
   metrics: TT_Glyph_Metrics;
+  outline: TT_Outline;
+  bbox: TT_BBox;
+  error: TT_Error;
 begin
-  if TT_Get_Glyph_Metrics(FGlyphData, metrics) = TT_Err_Ok then
+
+  if FOrientation<>0 then
   begin
-    with metrics.bbox do
+    error := TT_Get_Glyph_Outline(FGlyphData, outline{%H-});
+    if error=TT_Err_Ok then
+      error := TT_Get_Outline_BBox(outline, bbox{%H-});
+  end else
+  begin
+    error := TT_Get_Glyph_Metrics(FGlyphData, metrics);
+    if error=TT_Err_Ok then
+      bbox := metrics.bbox;
+  end;
+
+  if error=TT_Err_Ok then
+    with bbox do
       result := rect(IncludeFullGrainMin(xMin+round(x*64),64) div 64,
                      IncludeFullGrainMin(-yMax+round(y*64),64) div 64,
                     (IncludeFullGrainMax(xMax+round(x*64),64)+1) div 64,
-                    (IncludeFullGrainMax(-yMin+round(y*64),64)+1) div 64);
+                    (IncludeFullGrainMax(-yMin+round(y*64),64)+1) div 64)
-  end else
+  else
     result := TRect.Empty;
 end;
 
@@ -796,6 +808,23 @@ begin
   FIndex := AIndex;
 end;
 
+constructor TFreeTypeGlyph.create;
+begin
+end;
+
+function TFreeTypeGlyph.Clone(AOrientation: Integer): TFreeTypeGlyph;
+begin
+  if not FLoaded then
+    raise EFreeType.Create('Cannot create a clone of an empty glyph');
+
+  result := TFreeTypeGlyph.create;
+  result.FLoaded := FLoaded;
+  result.FIndex := FIndex;
+  result.FOrientation := AOrientation;
+
+  TT_Copy_Glyph(FGlyphData, result.FGlyphData);
+end;
+
 function TFreeTypeGlyph.RenderDirectly(x, y: single; Rect: TRect;
   OnRender: TDirectRenderingFunction; quality : TGlyphRenderQuality; ClearType: boolean): boolean;
 begin
@@ -1239,7 +1268,7 @@ begin
     raise EFreeType.Create('No font instance');
   flags := TT_Load_Scale_Glyph;
   if FHinted then flags := flags or TT_Load_Hint_Glyph;
-  result := (TT_Load_Glyph(FInstance, _glyph, glyph_index, flags) <> TT_Err_Ok);
+  result := (TT_Load_Glyph(FInstance, _glyph, glyph_index, flags) = TT_Err_Ok);
 end;
 
 procedure TFreeTypeFont.SetWidthFactor(const AValue: single);
@@ -1526,19 +1555,44 @@ var
   idx: integer;
   g: TFreeTypeGlyph;
   prevCharcode, glyphIndex: integer;
+  txmatrix: TT_Matrix;
+  angle: single;
+  outline: ^TT_Outline;
+  vector: TT_Vector;
+  corrX, corrY: single;
 begin
   if not CheckInstance then exit;
   if AText = '' then exit;
   idx := pos(LineEnding,AText);
+
+  if Orientation<>0 then
+  begin
+    angle := Orientation * PI / 1800;
+    txmatrix.xx :=  Round( cos( angle ) * $10000 );
+    txmatrix.xy := -Round( sin( angle ) * $10000 );
+    txmatrix.yx :=  Round( sin( angle ) * $10000 );
+    txmatrix.yy :=  Round( cos( angle ) * $10000 );
+  end;
+
   while idx <> 0 do
   begin
     RenderText(copy(AText,1,idx-1),x,y,ARect,OnRender);
     delete(AText,1,idx+length(LineEnding)-1);
+    if Orientation<>0 then
+    begin
+      vector.x := 0;
+      vector.y := -round(LineFullHeight * 64);
+      TT_Transform_Vector(vector.x, vector.y, txmatrix);
+      x += vector.x / 64;
+      y -= vector.y / 64;
+    end else
       y += LineFullHeight;
     idx := pos(LineEnding,AText);
   end;
   If Assigned(FOnRenderText) then
     FOnRenderText(AText,x,y);
+
+  // TODO: Rotation at arbitraty angles requires antialiased drawing
   RenderTextDecoration(AText,x,y,ARect,OnRender);
   pstr := @AText[1];
   left := length(AText);
@@ -1546,25 +1600,49 @@ begin
   while left > 0 do
   begin
     charcode := UTF8CodepointToUnicode(pstr, charlen);
-    inc(pstr,charlen);
     dec(left,charlen);
     glyphIndex := CharIndex[charcode];
     g := Glyph[glyphIndex];
+    if Orientation<>0 then
+      g := g.Clone(Orientation);
+
     if g <> nil then
     with g do
     begin
+      corrX := Advance;
+
       if KerningEnabled and (prevCharcode <> -1) then
-        x += GetCharKerning(prevCharcode, charcode).Kerning.x;
+        corrX += round(GetCharKerning(prevCharcode, charcode).Kerning.x);
+
+      vector.x := round(corrX * 64);
+      vector.y := 0;
+
+      if Orientation<>0 then begin
+        outLine := @PGlyph(Data.z)^.outline;
+        TT_Transform_Outline(outline^, txmatrix);
+        TT_Transform_Vector(vector.x, vector.y, txmatrix);
+      end;
+
+      corrX := vector.x / 64;
+      corry := vector.y / 64;
+
       if Hinted then
         RenderDirectly(x,round(y),ARect,OnRender,quality,FClearType)
       else
         RenderDirectly(x,y,ARect,OnRender,quality,FClearType);
+
       if FClearType then
-        x += Advance/3
+        x += corrX/3
       else
-        x += Advance;
+        x += corrX;
+
+      y -= corrY;
+
       prevCharcode := charcode;
+      if Orientation<>0 then
+        g.Free;
     end;
+    inc(pstr,charlen);
   end;
 end;
 

components/freetype/lazfreetype.pas

@@ -231,6 +231,12 @@ uses TTTypes, Classes;
                            glyph_index : Word;
                            load_flags  : Integer ) : TT_Error;
 
+  (*****************************************************************)
+  (*  Copy a glyph container into another one                      *)
+  (*                                                               *)
+  function TT_Copy_Glyph( var source : TT_Glyph;
+                          var target : TT_Glyph ) : TT_Error;
+
 const
   TT_Load_Scale_Glyph = 1;  (* ask the loader to scale the glyph  *)
                             (* to the current pointsize/transform *)
@@ -1009,6 +1015,50 @@ uses
     TT_Load_Glyph := error;
   end;
 
+  (*****************************************************************)
+  (*                                                               *)
+  (*                                                               *)
+  function TT_Copy_Glyph(var source: TT_Glyph; var target: TT_Glyph): TT_Error;
+  var
+    src, dst : PGlyph;
+  begin
+
+    src := PGlyph(source.z);
+    dst := PGlyph(target.z);
+
+    if (PGlyph(source.z)<>nil) then
+      begin
+        if dst=nil then
+          begin
+            error := TT_New_Glyph(TT_Face(src^.face), target);
+            if error<>TT_Err_Ok then
+              begin
+                TT_Copy_Glyph := error;
+                exit;
+              end;
+            dst := PGlyph(target.z);
+          end
+        else
+          TT_Done_Outline(dst^.outline);
+
+        dst^.metrics        := src^.metrics;
+        dst^.computed_width := src^.computed_width;
+        dst^.precalc_width  := src^.precalc_width;
+        dst^.is_composite   := src^.is_composite;
+
+        TT_New_Outline(src^.outline.n_points, src^.outline.n_contours, dst^.outline);
+
+        dst^.outline.owner := src^.outline.owner;
+        dst^.outline.high_precision := src^.outline.high_precision;
+        dst^.outline.second_pass := src^.outline.second_pass;
+        dst^.outline.dropout_mode := src^.outline.dropout_mode;
+
+        TT_Copy_Glyph := TT_Copy_Outline( src^.outline, dst^.outline );
+      end
+    else
+      TT_Copy_Glyph := TT_Err_Invalid_Glyph_Handle;
+  end;
+
 
   (*****************************************************************)
   (*                                                               *)

examples/lazfreetype/mainform.lfm

@@ -1,12 +1,12 @@
 object Form1: TForm1
   Left = 362
-  Height = 240
+  Height = 336
   Top = 172
-  Width = 441
+  Width = 624
   Align = alBottom
   Caption = 'Test LazFreeType'
-  ClientHeight = 240
+  ClientHeight = 336
-  ClientWidth = 441
+  ClientWidth = 624
   KeyPreview = True
   OnCreate = FormCreate
   OnDestroy = FormDestroy
@@ -18,18 +18,18 @@ object Form1: TForm1
   object Panel_Option: TPanel
     Left = 0
     Height = 40
-    Top = 200
+    Top = 296
-    Width = 441
+    Width = 624
     Align = alBottom
     ClientHeight = 40
-    ClientWidth = 441
+    ClientWidth = 624
     ParentColor = False
     TabOrder = 0
     object TrackBar_Size: TTrackBar
       Left = 96
       Height = 25
       Top = 8
-      Width = 243
+      Width = 280
       Frequency = 0
       Max = 300
       Min = 1
@@ -39,9 +39,9 @@ object Form1: TForm1
       TabOrder = 0
     end
     object LFontSize: TLabel
-      Left = 336
+      Left = 376
       Height = 16
-      Top = 12
+      Top = 11
       Width = 51
       Alignment = taCenter
       Anchors = [akTop, akRight]
@@ -68,15 +68,46 @@ object Form1: TForm1
       TabOrder = 1
       Value = 1
     end
-    object CheckBox_Rect: TCheckBox
+    object LAngle: TLabel
-      Left = 392
+      Left = 440
+      Height = 15
+      Top = 11
+      Width = 11
+      Anchors = [akTop, akRight]
+      Caption = '0º'
+      ParentColor = False
+    end
+    object CheckBox_SingleLine: TRadioButton
+      Left = 472
       Height = 19
-      Top = 10
+      Top = 12
+      Width = 51
+      Anchors = [akTop, akRight]
+      Caption = '1 Line'
+      OnChange = CheckBox_SingleLineChange
+      TabOrder = 2
+    end
+    object CheckBox_Rot: TRadioButton
+      Left = 576
+      Height = 19
+      Top = 12
+      Width = 38
+      Anchors = [akTop, akRight]
+      Caption = 'Rot'
+      OnChange = CheckBox_SingleLineChange
+      TabOrder = 3
+    end
+    object CheckBox_Para: TRadioButton
+      Left = 528
+      Height = 19
+      Top = 12
       Width = 43
       Anchors = [akTop, akRight]
       Caption = 'Rect'
-      OnChange = CheckBox_RectChange
+      Checked = True
-      TabOrder = 2
+      OnChange = CheckBox_SingleLineChange
+      TabOrder = 4
+      TabStop = True
     end
   end
 end

examples/lazfreetype/mainform.pas

@@ -5,7 +5,7 @@ unit mainform;
 interface
 
 uses
-  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  Classes, SysUtils, Math, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
   ComCtrls, ExtCtrls, Spin, fpimage, LCLType,
 
   IntfGraphics, GraphType,      //Intf basic routines
@@ -19,13 +19,16 @@ type
   { TForm1 }
 
   TForm1 = class(TForm)
-    CheckBox_Rect: TCheckBox;
+    CheckBox_SingleLine: TRadioButton;
+    CheckBox_Para: TRadioButton;
+    CheckBox_Rot: TRadioButton;
     Label1: TLabel;
+    LAngle: TLabel;
     LFontSize: TLabel;
     Panel_Option: TPanel;
     SpinEdit_Zoom: TSpinEdit;
     TrackBar_Size: TTrackBar;
-    procedure CheckBox_RectChange(Sender: TObject);
+    procedure CheckBox_SingleLineChange(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
@@ -35,11 +38,14 @@ type
     procedure TrackBar_SizeChange(Sender: TObject);
   private
     procedure UpdateSizeLabel;
+    procedure UpdateAngleLabel;
   public
     lazimg: TLazIntfImage;
     drawer: TIntfFreeTypeDrawer;
     ftFont1,ftFont2,ftFont3: TFreeTypeFont;
     mx,my: integer; //mouse position
+    fSin,fCos: double;
+    fAngle: double;
     procedure EraseBackground(DC: HDC); override;
     procedure SetupFonts;
   end;
@@ -125,8 +131,9 @@ begin
   ftFont3 := nil;
 end;
 
-procedure TForm1.CheckBox_RectChange(Sender: TObject);
+procedure TForm1.CheckBox_SingleLineChange(Sender: TObject);
 begin
+  LAngle.Enabled := CheckBox_Rot.Checked;
   invalidate;
 end;
 
@@ -143,6 +150,14 @@ procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer
 begin
   mx := X;
   my := Y;
+  if CheckBox_Rot.Checked then
+  begin
+    fAngle := ArcTan2(Panel_Option.Top/2 - my, mx - ClientWidth/2);
+    SinCos(fAngle, fSin, fCos);
+    fAngle := RadToDeg(fAngle);
+    if fAngle<0 then fAngle += 360;
+    UpdateAngleLabel;
+  end;
   invalidate;
 end;
 
@@ -154,15 +169,28 @@ begin
   if ftFont3 <> nil then ftFont3.SizeInPoints := TrackBar_Size.Position;
 end;
 
+procedure TForm1.UpdateAngleLabel;
+begin
+  LAngle.Caption := format('%3.0fº',[fAngle]);
+end;
+
 procedure TForm1.FormPaint(Sender: TObject);
 const testtext = 'The'#13#10'quick brown fox jumps over the lazy dog';
 var bmp: TBitmap;
     tx,ty: integer;
     p: array of TCharPosition;
-    x,y: single;
+    x,y,h,rx,ry: single;
     i: integer;
     StartTime,EndTime,EndTime2: TDateTime;
     zoom: integer;
+    Orientation: Integer;
+
+    procedure Rotate(dx,dy:single);
+    begin
+      rx := tx/2 + (fCos*dx - fSin*dy);
+      ry := ty/2 - (fSin*dx + fCos*dy);
+    end;
+
 begin
   if lazimg = nil then exit;
   canvas.Font.Name := 'Comic Sans MS';
@@ -170,6 +198,11 @@ begin
   zoom := SpinEdit_Zoom.Value;
   StartTime := Now;
 
+  if not CheckBox_Rot.Checked then
+    Orientation := 0
+  else
+    Orientation := round(fAngle*10);
+
   tx := ClientWidth div zoom;
   ty := Panel_Option.Top div zoom;
   if (lazimg.Width <> tx) or (lazimg.Height <> ty) then
@@ -179,17 +212,31 @@ begin
 
   x := mx/zoom;
   y := my/zoom;
+  if CheckBox_Rot.Checked then
+  begin
+    h := 0.0;
+    if ftFont1<>nil then h += ftFont1.LineFullHeight;
+    if ftFont2<>nil then h += ftFont2.LineFullHeight;
+    if ftFont3<>nil then h += ftFont3.LineFullHeight;
+    h := h / 2;
+  end;
 
   if ftFont1<>nil then
   begin
     ftFont1.Hinted := true;
-    ftFont1.ClearType := true;
+    ftFont1.ClearType := not CheckBox_Rot.Checked; // ClearType and rotation is not working yet
     ftFont1.Quality := grqHighQuality;
     ftFont1.SmallLinePadding := false;
-    if CheckBox_Rect.Checked then
+    ftFont1.Orientation := Orientation;
+    if CheckBox_Para.Checked then
       drawer.DrawTextRect(testtext, ftFont1, 0,0, tx/3,ty, colBlack, [ftaLeft, ftaBottom])
-    else
+    else if CheckBox_SingleLine.Checked then
-      drawer.DrawText(ftFont1.Information[ftiFullName], ftFont1, x, y, colBlack, [ftaRight, ftaBottom]);
+      drawer.DrawText(ftFont1.Information[ftiFullName], ftFont1, x, y, colBlack, [ftaRight, ftaBottom])
+    else begin
+      Rotate( -ftFont1.TextWidth(ftFont1.Information[ftiFullName])/2,
+              h - ftFont1.LineFullHeight);
+      drawer.DrawText(ftFont1.Information[ftiFullName], ftFont1, rx, ry,   colBlack);
+    end;
   end;
 
   if ftFont2<>nil then
@@ -197,23 +244,34 @@ begin
     ftFont2.Hinted := false;
     ftFont2.ClearType := false;
     ftFont2.Quality := grqHighQuality;
-    if CheckBox_Rect.Checked then
+    ftFont2.Orientation := Orientation;
+    if CheckBox_Para.Checked then
       drawer.DrawTextRect(testtext, ftFont2, tx/3,0, 2*tx/3,ty, colRed, [ftaCenter, ftaVerticalCenter])
-    else
+    else if CheckBox_SingleLine.Checked then
-      drawer.DrawText(ftFont2.Information[ftiFullName], ftFont2, x, y, colRed, 192, [ftaCenter, ftaBaseline]);
+      drawer.DrawText(ftFont2.Information[ftiFullName], ftFont2, x, y, colRed, 192, [ftaCenter, ftaBaseline])
+    else begin
+      Rotate( -ftFont2.TextWidth(ftFont2.Information[ftiFullName])/2,
+              -ftFont2.LineFullHeight/2);
+      drawer.DrawText(ftFont2.Information[ftiFullName], ftFont2, rx, ry, colRed);
+    end;
   end;
 
   if ftFont3<>nil then begin
     ftFont3.Hinted := false;
     ftFont3.ClearType := false;
     ftFont3.Quality := grqMonochrome;
-    if CheckBox_Rect.Checked then
+    ftFont3.Orientation := Orientation;
+    if CheckBox_Para.Checked then
       drawer.DrawTextRect(testtext, ftFont3, 2*tx/3,0, tx,ty, colBlue, [ftaRight, ftaTop])
-    else
+    else if CheckBox_SingleLine.Checked then
-      drawer.DrawText(ftFont3.Information[ftiFullName]+' '+ftFont3.VersionNumber, ftFont3, x, y, colBlack, 128, [ftaLeft, ftaTop]);
+      drawer.DrawText(ftFont3.Information[ftiFullName]+' '+ftFont3.VersionNumber, ftFont3, x, y, colBlack, 128, [ftaLeft, ftaTop])
+    else begin
+      Rotate( -ftFont3.TextWidth(ftFont3.Information[ftiFullName])/2, - h );
+      drawer.DrawText(ftFont3.Information[ftiFullName], ftFont3, rx, ry, colBlue);
+    end;
   end;
 
-  if (ftFont1<>nil) and not CheckBox_Rect.Checked then
+  if (ftFont1<>nil) and CheckBox_SingleLine.Checked then
   begin
     p := ftFont1.CharsPosition(ftFont1.Information[ftiFullName],[ftaRight, ftaBottom]);
     for i := 0 to high(p) do
@@ -233,7 +291,11 @@ begin
   EndTime2 := Now;
 
   Canvas.TextOut(0,0, inttostr(round((EndTime-StartTime)*24*60*60*1000))+' ms + '+inttostr(round((EndTime2-EndTime)*24*60*60*1000))+' ms');
-
+  if CheckBox_Rot.Checked then
+  begin
+    Canvas.Pen.Color := clFuchsia;
+    Canvas.Line(ClientWidth div 2, Panel_Option.Top div 2, mx, my);
+  end;
 end;
 
 procedure TForm1.FormShow(Sender: TObject);