diff --git a/components/freetype/easylazfreetype.pas b/components/freetype/easylazfreetype.pas index bdc8225b4a..0fd0b36c46 100644 --- a/components/freetype/easylazfreetype.pas +++ b/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 - 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; + result := GetBoundsWithOffset(0, 0); 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); - end else + (IncludeFullGrainMax(-yMin+round(y*64),64)+1) div 64) + 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); - y += LineFullHeight; + 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) + RenderDirectly(x,round(y),ARect,OnRender,quality,FClearType) else - RenderDirectly(x,y,ARect,OnRender,quality,FClearType); + 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; diff --git a/components/freetype/lazfreetype.pas b/components/freetype/lazfreetype.pas index 99be8fae40..9d6348f65c 100644 --- a/components/freetype/lazfreetype.pas +++ b/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; + (*****************************************************************) (* *) diff --git a/examples/lazfreetype/mainform.lfm b/examples/lazfreetype/mainform.lfm index 446e3fca3c..bb1ac950b9 100644 --- a/examples/lazfreetype/mainform.lfm +++ b/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 - ClientWidth = 441 + ClientHeight = 336 + 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 - Width = 441 + Top = 296 + 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 - Left = 392 + object LAngle: TLabel + 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 - TabOrder = 2 + Checked = True + OnChange = CheckBox_SingleLineChange + TabOrder = 4 + TabStop = True end end end diff --git a/examples/lazfreetype/mainform.pas b/examples/lazfreetype/mainform.pas index 337b0eb3c3..bd938eac4e 100644 --- a/examples/lazfreetype/mainform.pas +++ b/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 - drawer.DrawText(ftFont1.Information[ftiFullName], ftFont1, x, y, colBlack, [ftaRight, ftaBottom]); + else if CheckBox_SingleLine.Checked then + 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 - drawer.DrawText(ftFont2.Information[ftiFullName], ftFont2, x, y, colRed, 192, [ftaCenter, ftaBaseline]); + else if CheckBox_SingleLine.Checked then + 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 - drawer.DrawText(ftFont3.Information[ftiFullName]+' '+ftFont3.VersionNumber, ftFont3, x, y, colBlack, 128, [ftaLeft, ftaTop]); + else if CheckBox_SingleLine.Checked then + 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);