576 lines
15 KiB
ObjectPascal
576 lines
15 KiB
ObjectPascal
|
{******************************************************************}
|
||
|
|
{ GDIPKerning }
|
||
|
|
{ }
|
||
|
|
{ home page : http://www.mwcs.de }
|
||
|
|
{ email : martin.walter@mwcs.de }
|
||
|
|
{ }
|
||
|
|
{ date : 20-11-2007 }
|
||
|
|
{ }
|
||
|
|
{ version : 1.1 }
|
||
|
|
{ }
|
||
|
|
{ Use of this file is permitted for commercial and non-commercial }
|
||
|
|
{ use, as long as the author is credited. }
|
||
|
|
{ This file (c) 2007 Martin Walter }
|
||
|
|
{ }
|
||
|
|
{ This Software is distributed on an "AS IS" basis, WITHOUT }
|
||
|
|
{ WARRANTY OF ANY KIND, either express or implied. }
|
||
|
|
{ }
|
||
|
|
{ *****************************************************************}
|
||
|
|
{ Adapted for FR 7 by Oleg Adibekov }
|
||
|
|
{ *****************************************************************}
|
||
|
|
|
||
|
|
unit frxGDIPKerning;
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
{$I frx.inc}
|
||
|
|
|
||
|
|
uses
|
||
|
|
Windows,
|
||
|
|
Classes,
|
||
|
|
{$IFDEF Delphi16}
|
||
|
|
Winapi.GDIPOBJ,
|
||
|
|
Winapi.GDIPAPI,
|
||
|
|
{$ELSE}
|
||
|
|
frxGDIPOBJ,
|
||
|
|
frxGDIPAPI,
|
||
|
|
{$ENDIF}
|
||
|
|
Types,
|
||
|
|
frxSVGCanvas;
|
||
|
|
|
||
|
|
type
|
||
|
|
TKerningPairs = array of TKerningPair;
|
||
|
|
PKerningPairs = ^TKerningPairs;
|
||
|
|
|
||
|
|
TKerning = record
|
||
|
|
Chars: Cardinal;
|
||
|
|
Cell: Integer;
|
||
|
|
Kerning: Integer;
|
||
|
|
end;
|
||
|
|
|
||
|
|
PKerning = ^TKerning;
|
||
|
|
|
||
|
|
TGPKerningText = class(TObject)
|
||
|
|
private
|
||
|
|
FKerningList: TList;
|
||
|
|
FKerningPairs: TKerningPairs;
|
||
|
|
FPairCount: Integer;
|
||
|
|
FLastFont: WideString;
|
||
|
|
FLastWeight: Integer;
|
||
|
|
FLastStyle: Integer;
|
||
|
|
FFontSizeFactor: Double;
|
||
|
|
|
||
|
|
FFont: HFont;
|
||
|
|
FOldFont: HFont;
|
||
|
|
FDC: HDC;
|
||
|
|
FGPFont: TGPFont;
|
||
|
|
|
||
|
|
procedure PrepareDC;
|
||
|
|
procedure UnprepareDC;
|
||
|
|
procedure PrepareFont(const LF: TLogFontW);
|
||
|
|
procedure UnprepareFont;
|
||
|
|
procedure PrepareKerning(const Font: TGPFont); overload;
|
||
|
|
procedure PrepareKerning(const Font: TGPFont; const Graphics: TGPGraphics;
|
||
|
|
WithFactor: Boolean); overload;
|
||
|
|
procedure UnprepareKerning;
|
||
|
|
procedure ClearKerningList;
|
||
|
|
procedure AddToKerningList(const First, Second: Word;
|
||
|
|
Cell, Kerning: Integer);
|
||
|
|
function IndexOfKerning(const First, Second: Word): Integer;
|
||
|
|
|
||
|
|
function GetDistance(const Index: Integer;
|
||
|
|
const DistanceFactor, KerningFactor: Single): Single;
|
||
|
|
|
||
|
|
procedure Clear;
|
||
|
|
|
||
|
|
function AddGlyphToPath(const Path: TGPGraphicsPath; const Char: WideChar;
|
||
|
|
const Family: TGPFontFamily; const Style: Integer; const Size: Single;
|
||
|
|
const Origin: TGPPointF; const Format: TGPStringFormat): TStatus;
|
||
|
|
|
||
|
|
function AddGlyphToGraphics(const Graphics: TGPGraphics;
|
||
|
|
const Char: WideChar; const Font: TGPFont; const Origin: TGPPointF;
|
||
|
|
const Format: TGPStringFormat; const Brush: TGPBrush): TStatus;
|
||
|
|
|
||
|
|
procedure AddDecoration(const Path: TGPGraphicsPath;
|
||
|
|
const Left, Top, Width: Single; const Font: TGPFont; dY: Single);
|
||
|
|
public
|
||
|
|
constructor Create;
|
||
|
|
destructor Destroy; override;
|
||
|
|
|
||
|
|
function AddToPath(const Path, UPath, LPath, OPath: TGPGraphicsPath;
|
||
|
|
const Text: WideString; const Family: TGPFontFamily; Style: Integer;
|
||
|
|
const Size: Single; TextOrigin: TTextOrigin;
|
||
|
|
const DistanceFactor: Single = 1;
|
||
|
|
const KerningFactor: Single = 1): TStatus;
|
||
|
|
|
||
|
|
function AddToGraphics(const Graphics: TGPGraphics;
|
||
|
|
const Text: WideString; const Font: TGPFont; Origin: TGPPointF;
|
||
|
|
const Format: TGPStringFormat; const Brush: TGPBrush;
|
||
|
|
const DistanceFactor: Single = 1;
|
||
|
|
const KerningFactor: Single = 1): TStatus; overload;
|
||
|
|
|
||
|
|
function AddToGraphics(const Graphics: TGPGraphics;
|
||
|
|
const Text: WideString; const Font: TGPFont; Origin: TGPPoint;
|
||
|
|
const Format: TGPStringFormat; const Brush: TGPBrush;
|
||
|
|
const DistanceFactor: Single = 1;
|
||
|
|
const KerningFactor: Single = 1): TStatus; overload;
|
||
|
|
|
||
|
|
function MeasureText(const Text: WideString; const Font: TGPFont;
|
||
|
|
const DistanceFactor: Single = 1;
|
||
|
|
const KerningFactor: Single = 1): Single;
|
||
|
|
|
||
|
|
function GetCellWidth(const First, Second: Word;
|
||
|
|
const DistanceFactor: Single = 1;
|
||
|
|
const KerningFactor: Single = 1): Single;
|
||
|
|
|
||
|
|
procedure Prepare(const Family: TGPFontFamily; Style: Integer;
|
||
|
|
const Size: Single; const Format: TGPStringFormat);
|
||
|
|
|
||
|
|
procedure Unprepare;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function KerningText: TGPKerningText;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
var
|
||
|
|
FKerningText: TGPKerningText;
|
||
|
|
|
||
|
|
function KerningText: TGPKerningText;
|
||
|
|
begin
|
||
|
|
if not Assigned(FKerningText) then
|
||
|
|
FKerningText := TGPKerningText.Create;
|
||
|
|
|
||
|
|
Result := FKerningText;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TKerningText }
|
||
|
|
|
||
|
|
procedure TGPKerningText.AddDecoration(const Path: TGPGraphicsPath; const Left,
|
||
|
|
Top, Width: Single; const Font: TGPFont; dY: Single);
|
||
|
|
var
|
||
|
|
YPos, Height: Single;
|
||
|
|
begin
|
||
|
|
if Path <> nil then
|
||
|
|
begin
|
||
|
|
Height := Font.GetSize / 20;
|
||
|
|
YPos := Top + Font.GetSize * dY + Height / 2;
|
||
|
|
Path.SetFillMode(FillModeWinding);
|
||
|
|
Path.AddRectangle(MakeRect(Left, YPos, Width, Height));
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TGPKerningText.AddGlyphToGraphics(const Graphics: TGPGraphics;
|
||
|
|
const Char: WideChar; const Font: TGPFont; const Origin: TGPPointF;
|
||
|
|
const Format: TGPStringFormat; const Brush: TGPBrush): TStatus;
|
||
|
|
begin
|
||
|
|
Result := Graphics.DrawString(Char, -1, Font, Origin, Format, Brush);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TGPKerningText.AddGlyphToPath(const Path: TGPGraphicsPath;
|
||
|
|
const Char: WideChar; const Family: TGPFontFamily; const Style: Integer;
|
||
|
|
const Size: Single; const Origin: TGPPointF;
|
||
|
|
const Format: TGPStringFormat): TStatus;
|
||
|
|
begin
|
||
|
|
Result := Path.AddString(Char, -1, Family, Style, Size, Origin, Format);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TGPKerningText.AddToGraphics(const Graphics: TGPGraphics;
|
||
|
|
const Text: WideString; const Font: TGPFont; Origin: TGPPointF;
|
||
|
|
const Format: TGPStringFormat; const Brush: TGPBrush;
|
||
|
|
const DistanceFactor: Single = 1; const KerningFactor: Single = 1): TStatus;
|
||
|
|
var
|
||
|
|
P1, P2: PWideChar;
|
||
|
|
Status: TStatus;
|
||
|
|
begin
|
||
|
|
Status := Ok;
|
||
|
|
if Text = '' then
|
||
|
|
begin
|
||
|
|
Result := Ok;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
PrepareKerning(Font, Graphics, False);
|
||
|
|
try
|
||
|
|
P1 := PWideChar(Text);
|
||
|
|
while (P1^ <> #0) do
|
||
|
|
begin
|
||
|
|
Status := AddGlyphToGraphics(Graphics, P1^, Font, Origin, Format, Brush);
|
||
|
|
if Status <> Ok then
|
||
|
|
Break;
|
||
|
|
P2 := P1 + 1;
|
||
|
|
Origin.X := Origin.X + GetCellWidth(Word(P1^), Word(P2^),
|
||
|
|
DistanceFactor, KerningFactor);
|
||
|
|
Inc(P1);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
UnprepareDC;
|
||
|
|
end;
|
||
|
|
Result := Status;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TGPKerningText.AddToGraphics(const Graphics: TGPGraphics;
|
||
|
|
const Text: WideString; const Font: TGPFont; Origin: TGPPoint;
|
||
|
|
const Format: TGPStringFormat; const Brush: TGPBrush;
|
||
|
|
const DistanceFactor: Single = 1; const KerningFactor: Single = 1): TStatus;
|
||
|
|
var
|
||
|
|
OriginF: TGPPointF;
|
||
|
|
begin
|
||
|
|
OriginF.X := Origin.X;
|
||
|
|
OriginF.Y := Origin.Y;
|
||
|
|
Result := AddToGraphics(Graphics, Text, Font, OriginF, Format, Brush,
|
||
|
|
DistanceFactor, KerningFactor);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TGPKerningText.AddToKerningList(const First, Second: Word;
|
||
|
|
Cell, Kerning: Integer);
|
||
|
|
var
|
||
|
|
Item: PKerning;
|
||
|
|
begin
|
||
|
|
GetMem(Item, SizeOf(TKerning));
|
||
|
|
Item^.Chars := First shl 16 + Second;
|
||
|
|
Item^.Cell := Cell;
|
||
|
|
Item^.Kerning := Kerning;
|
||
|
|
FKerningList.Add(Item);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TGPKerningText.Clear;
|
||
|
|
begin
|
||
|
|
UnprepareKerning;
|
||
|
|
UnprepareDC;
|
||
|
|
UnprepareFont;
|
||
|
|
|
||
|
|
FGPFont.Free;
|
||
|
|
FGPFont := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TGPKerningText.ClearKerningList;
|
||
|
|
var
|
||
|
|
C: Integer;
|
||
|
|
begin
|
||
|
|
for C := 0 to FKerningList.Count - 1 do
|
||
|
|
FreeMem(FKerningList[C]);
|
||
|
|
|
||
|
|
FKerningList.Clear;
|
||
|
|
end;
|
||
|
|
|
||
|
|
constructor TGPKerningText.Create;
|
||
|
|
begin
|
||
|
|
inherited;
|
||
|
|
FKerningList := TList.Create;
|
||
|
|
end;
|
||
|
|
|
||
|
|
destructor TGPKerningText.Destroy;
|
||
|
|
begin
|
||
|
|
Clear;
|
||
|
|
FKerningList.Free;
|
||
|
|
|
||
|
|
inherited;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TGPKerningText.GetCellWidth(const First, Second: Word;
|
||
|
|
const DistanceFactor: Single = 1; const KerningFactor: Single = 1): Single;
|
||
|
|
var
|
||
|
|
GM: TGlyphMetrics;
|
||
|
|
Count: Cardinal;
|
||
|
|
Cell: Integer;
|
||
|
|
Kerning: Integer;
|
||
|
|
Mat: TMat2;
|
||
|
|
C: Integer;
|
||
|
|
begin
|
||
|
|
C := IndexOfKerning(First, Second);
|
||
|
|
if C <> -1 then
|
||
|
|
begin
|
||
|
|
Result := GetDistance(C, DistanceFactor, KerningFactor) * FFontSizeFactor;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
FillChar(Mat, SizeOf(Mat), 0);
|
||
|
|
Mat.eM11.value := 1;
|
||
|
|
Mat.eM22.value := 1;
|
||
|
|
|
||
|
|
Count := GetGlyphOutlineW(FDC, First, GGO_METRICS, GM, 0, nil, Mat);
|
||
|
|
if (Count = GDI_ERROR) then
|
||
|
|
begin
|
||
|
|
Result := -1;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
Cell := GM.gmCellIncX + GM.gmCellIncY;
|
||
|
|
Kerning := 0;
|
||
|
|
|
||
|
|
for C := 0 to FPairCount - 1 do
|
||
|
|
begin
|
||
|
|
if (FKerningPairs[C].wFirst = First) and
|
||
|
|
(FKerningPairs[C].wSecond = Second) then
|
||
|
|
begin
|
||
|
|
Kerning := FKerningPairs[C].iKernAmount;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
AddToKerningList(First, Second, Cell, Kerning);
|
||
|
|
|
||
|
|
Result := (Cell * DistanceFactor + Kerning * KerningFactor) * FFontSizeFactor;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TGPKerningText.GetDistance(const Index: Integer;
|
||
|
|
const DistanceFactor, KerningFactor: Single): Single;
|
||
|
|
var
|
||
|
|
Kerning: PKerning;
|
||
|
|
begin
|
||
|
|
Kerning := PKerning(FKerningList[Index]);
|
||
|
|
Result := Kerning^.Cell * DistanceFactor + Kerning^.Kerning * KerningFactor;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TGPKerningText.IndexOfKerning(const First, Second: Word): Integer;
|
||
|
|
var
|
||
|
|
Chars: Cardinal;
|
||
|
|
begin
|
||
|
|
Chars := First shl 16 + Second;
|
||
|
|
for Result := 0 to FKerningList.Count - 1 do
|
||
|
|
if PKerning(FKerningList[Result])^.Chars = Chars then
|
||
|
|
Exit;
|
||
|
|
Result := -1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TGPKerningText.MeasureText(const Text: WideString;
|
||
|
|
const Font: TGPFont; const DistanceFactor: Single = 1;
|
||
|
|
const KerningFactor: Single = 1): Single;
|
||
|
|
var
|
||
|
|
P1, P2: PWideChar;
|
||
|
|
begin
|
||
|
|
Result := 0;
|
||
|
|
|
||
|
|
if Text = '' then
|
||
|
|
Exit;
|
||
|
|
|
||
|
|
PrepareKerning(Font);
|
||
|
|
try
|
||
|
|
P1 := PWideChar(Text);
|
||
|
|
while (P1^ <> #0) do
|
||
|
|
begin
|
||
|
|
P2 := P1 + 1;
|
||
|
|
Result := Result + GetCellWidth(Word(P1^), Word(P2^), DistanceFactor,
|
||
|
|
KerningFactor);
|
||
|
|
Inc(P1);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
UnprepareDC;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TGPKerningText.Prepare(const Family: TGPFontFamily; Style: Integer;
|
||
|
|
const Size: Single; const Format: TGPStringFormat);
|
||
|
|
begin
|
||
|
|
FGPFont.Free;
|
||
|
|
FGPFont := TGPFont.Create(Family, Size, Style);
|
||
|
|
PrepareKerning(FGPFont);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TGPKerningText.PrepareDC;
|
||
|
|
begin
|
||
|
|
if (FDC <> 0) then
|
||
|
|
Exit;
|
||
|
|
|
||
|
|
FDC := GetDC(0);
|
||
|
|
FOldFont := SelectObject(FDC, FFont);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TGPKerningText.PrepareFont(const LF: TLogFontW);
|
||
|
|
begin
|
||
|
|
if (FFont <> 0) then
|
||
|
|
Exit;
|
||
|
|
|
||
|
|
FFont := CreateFontIndirectW(LF);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TGPKerningText.PrepareKerning(const Font: TGPFont;
|
||
|
|
const Graphics: TGPGraphics; WithFactor: Boolean);
|
||
|
|
var
|
||
|
|
LF: TLogFontW;
|
||
|
|
S: WideString;
|
||
|
|
DC: HDC;
|
||
|
|
Factor, Size: Single;
|
||
|
|
begin
|
||
|
|
Font.GetLogFontW(Graphics, LF);
|
||
|
|
|
||
|
|
Size := Font.GetSize;
|
||
|
|
|
||
|
|
if Font.GetUnit in [UnitWorld, UnitPixel] then
|
||
|
|
WithFactor := True;
|
||
|
|
|
||
|
|
if WithFactor then
|
||
|
|
begin
|
||
|
|
FFontSizeFactor := Size / 1000;
|
||
|
|
LF.lfHeight := -1000;
|
||
|
|
//LF.lfHeight := Round(Size * -1000)
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
DC := Graphics.GetHDC;
|
||
|
|
Factor := -GetDeviceCaps(DC, LOGPIXELSY) / 72;
|
||
|
|
FFontSizeFactor := Size * Factor / 1000;
|
||
|
|
LF.lfHeight := 1000;
|
||
|
|
//LF.lfHeight := Round(Size * Factor * 1000);
|
||
|
|
Graphics.ReleaseHDC(DC);
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
S := LF.lfFaceName;
|
||
|
|
if (S = FLastFont) and
|
||
|
|
(LF.lfWeight = FLastWeight) and (LF.lfItalic = FLastStyle) then
|
||
|
|
begin
|
||
|
|
PrepareDC;
|
||
|
|
Exit;
|
||
|
|
end else
|
||
|
|
UnprepareFont;
|
||
|
|
|
||
|
|
FLastFont := WideString(LF.lfFaceName);
|
||
|
|
FLastWeight := LF.lfWeight;
|
||
|
|
FLastStyle := LF.lfItalic;
|
||
|
|
|
||
|
|
PrepareFont(LF);
|
||
|
|
PrepareDC;
|
||
|
|
ClearKerningList;
|
||
|
|
|
||
|
|
FPairCount := GetKerningPairs(FDC, 0, PKerningPair(nil)^);
|
||
|
|
if (FPairCount > 0) then
|
||
|
|
begin
|
||
|
|
SetLength(FKerningPairs, FPairCount);
|
||
|
|
GetKerningPairs(FDC, FPairCount, FKerningPairs[0]);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TGPKerningText.PrepareKerning(const Font: TGPFont);
|
||
|
|
var
|
||
|
|
G: TGPGraphics;
|
||
|
|
DC: HDC;
|
||
|
|
begin
|
||
|
|
DC := GetDC(0);
|
||
|
|
G := TGPGraphics.Create(DC);
|
||
|
|
PrepareKerning(Font, G, True);
|
||
|
|
G.Free;
|
||
|
|
ReleaseDC(0, DC);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TGPKerningText.AddToPath(const Path, UPath, LPath, OPath: TGPGraphicsPath;
|
||
|
|
const Text: WideString; const Family: TGPFontFamily; Style: Integer;
|
||
|
|
const Size: Single; TextOrigin: TTextOrigin; const DistanceFactor,
|
||
|
|
KerningFactor: Single): TStatus;
|
||
|
|
var
|
||
|
|
P1, P2: PWideChar;
|
||
|
|
Status: TStatus;
|
||
|
|
Font: TGPFont;
|
||
|
|
Width: Single;
|
||
|
|
SF: TGPStringFormat;
|
||
|
|
Start, Origin: TGPPointF;
|
||
|
|
i: Integer;
|
||
|
|
begin
|
||
|
|
Status := Ok;
|
||
|
|
if Text = '' then
|
||
|
|
begin
|
||
|
|
Result := Ok;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
Style := Style and not FontStyleUnderline and not FontStyleStrikeout;
|
||
|
|
Font := TGPFont.Create(Family, Size, Style);
|
||
|
|
try
|
||
|
|
PrepareKerning(Font);
|
||
|
|
|
||
|
|
i := 0;
|
||
|
|
Start := MakePoint(TextOrigin.X[0] + TextOrigin.DX[0], TextOrigin.Y[0] + TextOrigin.DY[0]);
|
||
|
|
Origin := Start;
|
||
|
|
|
||
|
|
Width := MeasureText(Text, Font, DistanceFactor, KerningFactor);
|
||
|
|
|
||
|
|
AddDecoration(LPath, Start.X, Start.Y, Width, Font, 0.55);
|
||
|
|
|
||
|
|
SF := TGPStringFormat.Create(TGPStringFormat.GenericTypographic);
|
||
|
|
try
|
||
|
|
SF.SetFormatFlags(StringFormatFlagsMeasureTrailingSpaces);
|
||
|
|
|
||
|
|
try
|
||
|
|
P1 := PWideChar(Text);
|
||
|
|
while (P1^ <> #0) do
|
||
|
|
begin
|
||
|
|
Status := AddGlyphToPath(Path, P1^, Family, Style, Size, Origin, SF);
|
||
|
|
if Status <> Ok then
|
||
|
|
Break;
|
||
|
|
|
||
|
|
Inc(i);
|
||
|
|
if i <= High(TextOrigin.X) then
|
||
|
|
Origin.X := TextOrigin.X[i]
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
P2 := P1 + 1;
|
||
|
|
Origin.X := Origin.X + GetCellWidth(Word(P1^), Word(P2^),
|
||
|
|
DistanceFactor, KerningFactor);
|
||
|
|
end;
|
||
|
|
|
||
|
|
if i <= High(TextOrigin.DX) then
|
||
|
|
Origin.X := Origin.X + TextOrigin.DX[i];
|
||
|
|
|
||
|
|
if i <= High(TextOrigin.Y) then
|
||
|
|
Origin.Y := TextOrigin.Y[i];
|
||
|
|
|
||
|
|
if i <= High(TextOrigin.DY) then
|
||
|
|
Origin.Y := Origin.Y + TextOrigin.DY[i];
|
||
|
|
|
||
|
|
Inc(P1);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
UnprepareDC;
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
SF.Free;
|
||
|
|
end;
|
||
|
|
|
||
|
|
AddDecoration(UPath, Start.X, Start.Y, Width, Font, 0.95);
|
||
|
|
AddDecoration(OPath, Start.X, Start.Y, Width, Font, 0.05);
|
||
|
|
finally
|
||
|
|
Font.Free;
|
||
|
|
end;
|
||
|
|
|
||
|
|
Result := Status;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TGPKerningText.Unprepare;
|
||
|
|
begin
|
||
|
|
UnprepareDC;
|
||
|
|
FGPFont.Free;
|
||
|
|
FGPFont := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TGPKerningText.UnprepareDC;
|
||
|
|
begin
|
||
|
|
if (FOldFont <> 0) and (FDC <> 0) then
|
||
|
|
SelectObject(FDC, FOldFont);
|
||
|
|
FoldFont := 0;
|
||
|
|
|
||
|
|
if FDC <> 0 then
|
||
|
|
ReleaseDC(0, FDC);
|
||
|
|
FDC := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TGPKerningText.UnprepareFont;
|
||
|
|
begin
|
||
|
|
if FFont <> 0 then
|
||
|
|
DeleteObject(FFont);
|
||
|
|
FFont := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TGPKerningText.UnprepareKerning;
|
||
|
|
begin
|
||
|
|
SetLength(FKerningPairs, 0);
|
||
|
|
FPairCount := 0;
|
||
|
|
ClearKerningList;
|
||
|
|
end;
|
||
|
|
|
||
|
|
initialization
|
||
|
|
FKerningText := nil;
|
||
|
|
finalization
|
||
|
|
FKerningText.Free;
|
||
|
|
end.
|