{************************************************************}
{                 Delphi VCL Extensions                      }
{                                                            }
{    Parsing and drawing TTF texts by curves and polygons    }
{                                                            }
{      Copyright (c) 2002-2013 SoftGold software company     }
{                                                            }
{************************************************************}

unit TTF;
{$INCLUDE SGDXF.INC}

interface

uses
   Windows, Classes, SysUtils, Graphics, sgConsts, Math, MVFont, Registry
  {$IFDEF SGFPC}
   ,JwaWinGDI
   {$ENDIF}
{$IFDEF SGDEL_XE2}
  , System.UITypes, System.Types
{$ENDIF}
{$IFDEF SGDEL_XE4}
  , AnsiStrings
{$ENDIF}
  , sgShellApi, sgFunction, sgLists;

const
  cnstHeigthDef = 5472;
  cnstTrueType = ' (TrueType)';
  cnstCharSetDef = DEFAULT_CHARSET;

type
  TsgFontType = (ftUndefined, ftTTF, ftTTC, ftFON, ftSHX, ftDFT);
  TsgFontTypes = set of TsgFontType;

  TsgTTFFloat = Single;

  PsgTTFPoint = ^TsgTTFPoint;
  TsgTTFPoint = record
    X, Y: TsgTTFFloat;
  end;

  PsgTTFRect = ^TsgTTFRect;
  TsgTTFRect = record
  case Integer of
    0: (Left, Top, Right, Bottom: TsgTTFFloat);
    1: (TopLeft, BottomRight: TsgTTFPoint);
  end;

  TsgFontListProc = function(const AFullName, AFaceName, AStyle, AScript: string;
    const AIndex: Integer; const AMetricFlags: Cardinal;
    const AParam: Pointer): Integer;

  TsgContainerOfTextGlyphs = class;
  TsgGDIAdapter = class;
  TsgGlyph = class;
  TsgTableFonts = class;
  TsgTextGlyph = class;

  TsgContainerOfTextGlyphs = class
  private
    FLock: TRTLCriticalSection;
    FContainer: TStringList;
    FRefs: Integer;
  protected
    function GetCount: Integer;
    function GetTextGlyph(Index: Integer): TsgTextGlyph;
  public
    constructor Create;
    destructor Destroy; override;
    function AddTextGlyphsByFont(const AFont: TmvExtFont): TsgTextGlyph; overload;
    function AddTextGlyphsByFont(const AFontName: string;
      const AFontStyle: TFontStyles;
      const ACharSet: TFontCharset = cnstCharSetDef): TsgTextGlyph; overload;
    procedure Clear;
    function IndexOf(const AFontName: string;
      const AStyles: TFontStyles): Integer;
    procedure Reference;
    procedure Release;
    function Lock: Integer;
    procedure Unlock;
    property Count: Integer read GetCount;
    property TextGlyph[Index: Integer]: TsgTextGlyph read GetTextGlyph;
  end;

  TsgGDIAdapter = class
  private
    FDC: THandle;
  public
    procedure Polyline(var Points; var Count: Integer); virtual;
    procedure PolyPolygon(var Points; var Counts; Count: Integer); virtual;
    procedure PolyPolyline(var Points; var Counts; Count: Integer); virtual;
    procedure SetPolyFillMode(Mode: Integer); virtual;
    property DC: THandle read FDC write FDC;
  end;

  TsgGlyph = class
  private
    FBox: TsgTTFRect;
    FPolyPolyline: TsgThreadContainerList;
    FRealLeft: TsgTTFFloat;
    FRealRight: TsgTTFFloat;
    procedure CurveTo(const APPointCurve1, APPointCurve2: PFPoint);
    procedure MoveTo(const APPointMove: PFPoint);
  protected
    procedure AddDecomposeLineInList(const AList: TList;
      const APPolyCutve: PTTPolyCurve);
    procedure AddDecomposeQSplineInList(const AList: TList;
      const APPolyCutve: PTTPolyCurve);
    procedure AddFirstPoint;
    procedure CalcBox;
    procedure ClearPoints;
    procedure Decompose(const ABuffer: Pointer; ASize: LongInt);
    procedure UnionBoxAndMakeOffset(var ABox: TsgTTFRect;
      var AOffset: TsgTTFPoint);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Draw(ADC: THandle; const AXOffset: Double;
      const APMatrix: PFMatrix; const AFill: Boolean);
    property Box: TsgTTFRect read FBox;
  end;

  TsgTableFonts = class
  private
    FAddedFonts: Boolean;
    FFontNames: TStringList;
    FFontFiles: TStringList;
    FSortNames: TList;
    FSortFiles: TList;
    function AddFontFilesInfo(var AIndex: Integer; AFontName,
      AFileName: string): Boolean;
    function OpenRegistryKeyFonts(const ARegistry: TRegistry): Boolean;
  protected
    procedure AddFonts;
    function GetDataOfName(const AIndexes: TList; const AFind, ARez: TStringList;
      const AName: string): string;
    procedure Sort;
  public
    constructor Create;
    destructor Destroy; override;
    function GetFileName(const AFontName: string): string;
    function GetFontName(const AFileName: string): string;
    function GetFontType(const AFontName: string): TsgFontType;
  end;

  TsgTextGlyph = class
  private
    FAbove: Integer;
    FBelow: Integer;
    FFillText: Boolean;
    FFontName: string;
    FFontStyle: TFontStyles;
    FGlyphs: TsgThreadContainerList;
    FGlyphsUniCode: TList;
    FKoef: Double;
    function GetGlyph(const AIndex: Integer): TsgGlyph;
    procedure GetGlyphParamsInternal(const AGlyph: TsgGlyph;
      const AFontStyles: TmvFontStyles; const APMatrix: PFMatrix;
      const AList: TList; const APBox: PFRect);
    function GetGlyphUni(AIndex: Integer): TsgGlyph;
    procedure SetKoef(const ACanvas: TCanvas; AChar: Integer);
  protected
    procedure AddBoundariesByGlyphs(const AListOfGlyphs: TList;
      const AMatrix: PFMatrix; const ABoundaries: TList);
    procedure AddBoundaryOfGlyph(const AGlyph: TsgGlyph; const ABounds: TList;
      const AMatrix: PFMatrix; const AYMin, AYMax: Double; var AXOffset: Double);
    procedure AddGlyph(const ACanvas: TCanvas; const AIsUnicode: Boolean;
      const AKey: Integer);
    function AddPointsOfGlyph(const AGlyph: TsgGlyph; const APoints: TList;
      const APMatrix: PFMatrix; var AXOffset: Double; const AEpsilon: PFPoint = nil): Integer;
    function AddPolyPointOfText(const AText: string; const ATextW: WideString;
      const AListOfGlyphs: TList; AFontStyles: TmvFontStyles;
      const APMatrix: PFMatrix; const APolyPoint: TList;
      const AEpsilon: PFPoint = nil): Integer;
    function CreateGlyph(const ACanvas: TCanvas; const AIsUnicode: Boolean;
      const AKey: Integer): TsgGlyph;
    procedure DrawLine(const ADC: THandle; const APMatrix: PFMatrix;
      const APoint1, APoint2: TsgTTFPoint);
    function GetFontParams(const APMatrix: PFMatrix): TsgFontParams;
    function GetGlyphCur(const ADC: THandle; const AIsUnicode: Boolean;
      const AIndex: Integer): TsgGlyph;
    function GetTextChar(const AIndex: Integer; const ATextA:
      string; ATextW: WideString; const AIsUnicode: Boolean): Integer;
    function GetTextLength(const ATextA: string; ATextW: WideString;
      var AIsUnicode: Boolean): Integer;
    procedure SetPointsForAboveLine(const ALength: Double;
      var APoint1, APoint2: TsgTTFPoint);
    procedure SetPointsForStrikeOut(const ALength: Double;
      var APoint1, APoint2: TsgTTFPoint);
    procedure SetPointsForUnderLine(const ALength: Double;
      var APoint1, APoint2: TsgTTFPoint);
  public
    constructor Create;
    destructor Destroy; override;
    procedure ClearPointsInGplyphs;
    procedure DrawTextExtW(ADC: THandle; const AFontStyles: TmvFontStyles;
      const AText: string; const ATextW: WideString; const AMatrix: PFMatrix);
    procedure DrawTextW(ADC: THandle; const AText: string;
      const ATextW: WideString;  const APMatrix: PFMatrix);
    procedure InitKoef(ACanvas: TCanvas);
    function GetBox(const AText: string; const APMatrix: PFMatrix;
      const APFontParams: PsgFontParams): TFRect;
    function GetBoxW(const AText: string; const ATextW: WideString;
      const APMatrix: PFMatrix; const APFontParams: PsgFontParams): TFRect;
    function GetGlyphParams(const AChar: Char; const AFontStyles: {$IFDEF SGFPC}Integer{$ELSE}Byte{$ENDIF};
      const APMatrix: PFMatrix; const AList: TList; const APBox: PFRect): Boolean;
    function GetPolyPolylineW(const AText: string; const ATextW: WideString;
      const AFontStyles: {$IFDEF SGFPC}Integer{$ELSE}Byte{$ENDIF};
      const APMatrix: PFMatrix; const AList, ABounds: TList;
      const AEpsilon: PFPoint = nil): Integer;
    procedure LoadedW(const AText: string; const ATextW: WideString;
      const AFont: TFont); overload;
    procedure LoadedW(const AText: string; const ATextW: WideString;
      const AFontName: string; const AFontStyle: TFontStyles;
      const ACharSet: TFontCharset = cnstCharSetDef); overload;
    procedure SetFontParams(const AFont: TFont); overload;
    procedure SetFontParams(const AFontName: string; const AFontStyle: TFontStyles); overload;
    property FillText: Boolean read FFillText write FFillText;
    property FontName: string read FFontName;
    property FontStyle: TFontStyles read FFontStyle;
    property HKoef: Double read FKoef;
  end;

procedure FindGDIFonts(const AFonts: TStrings; const AFirstFaceNameOnly: Boolean = True);
procedure FreeListHasNil(var AList: TList);
function GetFileNameByFontName(const AFontName: string): string;
function GetFontIdByNameAndStyle(const AFontName: string;
  const AStyle: TFontStyles):  string;
function GetFontNameByFileName(const AFileName: string): string;
function GetFontNameWithoutStyle(const AName: string): string;
function GetFontStyleByFontName(const AFontName: string): TmvFontStyles;
function GetFontTypeByFileNameExt(const AFileName: string): TsgFontType;
function GetFontTypeByFontName(const AFontName: string): TsgFontType;
function GetFontTypeEx(const AFontName: string): TsgFontTypes;
function GetNameOfFont(const AFont: TFont): string;
function GetFPointFromPointFx(const AFixedPoint: PPointFX): TFPoint;
function GetQualityApproximation: Byte;
function IsNotTTFFont(const AFontName: string): Boolean;
function IsSystemNotRasterFont(const AFontName: string): Integer;
function IsSystemNotRasterFontEx(const AFontName: string): Integer;
function MakeFPointFromTTF(const APoint: TsgTTFPoint): TFPoint;
procedure SetQualityApproximation(const AValue: Byte);
procedure SwapBufferOfBytes(const APBuffer: Pointer; const ACount: Integer);
function SymbolExistDC(const ADC: HDC; const AKey: WORD): Boolean;
function SymbolExistDCA(const ADC: HDC; const AKey: WORD;
  const AMat: TMat2): Boolean;
function SymbolExistDCW(const ADC: HDC; const AKey: WORD;
  const AMat: TMat2): Boolean;
function SymbolExistFont(const AFont: TFont; const AKey: WORD): Boolean;
function SymbolExistFontName(const AFontName: string;
  const AKey: WORD): Boolean;

var
  ContainerOfTextGlyphs: TsgContainerOfTextGlyphs = nil;
  GDIAdapter: TsgGDIAdapter;

implementation

uses
  sgXMLParser;

const
  cnstBold = ' Bold';
  cnstTTFBadRect: TsgTTFRect = (Left: 1E20; Top: -1E20; Right: -1E20;
    Bottom: 1E20);
  cnstCurveRecursionLimit = 16;
  cnstDefaultQualityApproximation = 4;
  cnstGlyphsCount = 256;
  constCSIDL_FONTS = $0014;
  cnstHiChar = Ord('Q');
  cnstItalic = ' Italic';
  cnstLangIDOfEnglish = 1033;
  cnstLeftBracket = ' (';
  cnstLowChar = Ord('y');
  cnstName = 'name';
  cnstTTFPointZero: TsgTTFPoint =();
  cnstTTFRectZero: TsgTTFRect = ();
  cnstRegKeyCurrentVersion = 'CurrentVersion';
  cnstRegKeyFonts = 'Fonts';
  cnstRegKeyHKLM = HKEY_LOCAL_MACHINE;
  cnstRegKeyMicrosoft = 'Microsoft';
  cnstRegKeyMicrosoft9X = 'Windows';
  cnstRegKeyMicrosoftNT = 'Windows NT';
  cnstRegKeySoftware = 'SOFTWARE';
  cnstSizeOfOutlineTextmetric = SizeOf(TOutlineTextmetric);
  cnstSpace = ' ';
  cnstSymbols: array [0..5] of Integer = (Integer('h'), Integer('H'),
    Integer('W'), Integer('Q'), Integer('X'), Integer('y'));
  cnstGlyphOutlineMatrix: TMat2 = ();
  cnstDelimiter = '=';

  cnstFonts = 'Fonts';
  cnstFaceName = 'FaceName';
  cnstFullName = 'FullName';
  cnstStyle = 'Style';
  cnstFontType = 'FontType';
  cnstFontFlags = 'FontFlags';
  cnstFontCharSet = 'CharSet';
  cnstScript = 'Script';

type
  TsgNameTableHeader = packed record
    Selector, NRCount, StorageOffset: Word;
  end;

  TsgNameRecord = packed record
    PlatformID, EncodingID, LanguageID: Word;
    NameID, StringLength, StringOffset: Word;
  end;

  TsgOffsetTable = packed record
    MajorVersion, MinorVersion, NumOfTables: Word;
    SearchRange, EntrySelector, RangeShift: Word;
  end;

  TsgTableDirectory = packed record
    Tag: array[0..3] of AnsiChar;//Char;
    CheckSum, Offset, Length: DWord;
  end;

  PEnumFacesParam = ^TEnumFacesParam;
  TEnumFacesParam = record
    Data: Pointer;
    Proc: TsgFontListProc;
  end;

  { GetFontResourceInfoW

    undocumented feature

    Parameters:
    AFilename - font file name
    ABufferSize - size of buffer for resouce information
    ABuffer - buffer for returned resouce information
    AQueryType - resouce information query type:
      - QFR_0 = 0 	         DWORD or LPVOID unknown
      - QFR_DESCRIPTION = 1  The function provides a string that an NT-based
                             operating system will use to describe the font file.
                             A null-terminated Unicode string is written to
                             the buffer pointed to by lpBuffer.
      - QFR_LOGFONT = 2 	   Array of LOGFONTW
      - QFR_PDEV = 3         PDEV ?
      - QFR_FONTFILE = 4     scalable font file name
      - QFR_5 - 5 	         DWORD (Windows XP: Always returns 0);
  }
  TGetFontResourceInfo = function(AFilename: PWideChar; var ABufferSize: DWORD;
    ABuffer: PWideChar; AQueryType: DWORD): Cardinal; stdcall;

var
  DirOfWinFonts: string = '';
  DrawGlyphPts, DrawGlyphPtsCount: TsgIntegerList;
  RegKeyMicrosoftWindows: string = cnstRegKeyMicrosoftNT;
  TableFonts: TsgTableFonts = nil;
  Generator: TsgGeneratorShapeEdge = nil;
  XMLFonts: sgXMLParser.TsgParser = nil;
  GetFontResourceInfo: TGetFontResourceInfo = nil; // undocumented feature

procedure AddLine(const AList: TList; const APoint1, APoint2: TFPoint);{$IFDEF SG_INLINE}inline;{$ENDIF}
var
  vList: TList;
begin
  vList := TList.Create;
  AList.Add(vList);
  AddFPointInList(vList, APoint1);
  AddFPointInList(vList, APoint2);
end;

procedure AddListTTFPoint(const AList: TList; const APoint: TFPoint);
var
  vPPoint: PsgTTFPoint;
begin
  New(vPPoint);
  AList.Add(vPPoint);
  vPPoint^.X := APoint.X;
  vPPoint^.Y := APoint.Y;
end;

function CompareStrVal(const AVal1, AVal2: string): Integer;
begin
  Result := AnsiCompareText(AVal1, AVal2);//without case sensitivity
//  Result := AnsiCompareStr(AVal1, AVal2);//with case sensitivity
end;

function CompareGlyphMetrics(const ASize1, ASize2: Integer;
  const AGlyphM1, AGlyphM2: TGlyphMetrics): Boolean;
begin
  Result := (ASize1 = ASize2) and CompareMem(@AGlyphM1, @AGlyphM2,
    SizeOf(TGlyphMetrics));
end;

function EnumFontsProc(AEnumLogFont: PEnumLogFont;
  ANewTextMetric: PNewTextMetric; AFontType: Integer;
  Data: LPARAM): Integer;{$IFDEF WIN32}stdcall {$ELSE}export{$ENDIF};
var
  S: string;
begin
  Result:= 1;
  S := {$IFDEF SGFPC}string(PChar(@{$ENDIF}AEnumLogFont^.elfFullName{$IFDEF SGFPC})){$ENDIF};
  if (Pos(PChar(S), PChar(Data)) <> 0) and (AFontType <> RASTER_FONTTYPE) then
    Result:= 0;
end;

function EnumFontsProcLoadXML(AEnumLogFontEx: PEnumLogFontEx;
  AEnumTextMetric: PEnumTextMetric; AFontType: DWORD;
  Data: LPARAM): Integer; {$IFDEF WIN32}stdcall{$ELSE}export{$ENDIF};
var
  vROOT: TsgNode absolute Data;
  vFont, vFace: TsgNode;
  vFullName, vFaceName: string;
begin
  Result := 1;
  vFullName := {$IFDEF SGFPC}string(PChar(@{$ENDIF}AEnumLogFontEx^.elfFullName{$IFDEF SGFPC})){$ENDIF};
  vFaceName := AEnumLogFontEx^.elfLogFont.lfFaceName;
  if (Length(vFullName) > 0) and (Length(vFaceName) > 0) then
  begin
    vFont := TsgNode(vROOT.GetNodeByAttribValue(cnstFullName, cnstName, vFullName));
    if vFont = nil then
    begin
      vFont := vROOT.AddChildNV(cnstFullName, '');
      vFont.AddAttribNV(cnstName, vFullName);
    end;
    vFace := TsgNode(vFont.GetNodeByAttribValue(cnstFaceName, cnstName, vFaceName));
    if vFace = nil then
    begin
      vFace := vFont.AddChildNV(cnstFaceName, '');
      vFace.AddAttribNV(cnstName, vFaceName);

      vFace.AddAttribNV(cnstStyle, {$IFDEF SGFPC}string(PChar(@{$ENDIF}AEnumLogFontEx^.elfStyle{$IFDEF SGFPC})){$ENDIF});
      vFace.AddAttribNV(cnstFontCharSet, IntToStr(AEnumLogFontEx^.elfLogFont.lfCharSet));
      vFace.AddAttribNV(cnstFontType, IntToStr(AFontType));
      vFace.AddAttribNV(cnstFontFlags, IntToStr(AEnumTextMetric^.etmNewTextMetricEx.ntmTm.ntmFlags));
      vFace.AddAttribNV(cnstScript, {$IFDEF SGFPC}string(PChar(@{$ENDIF}AEnumLogFontEx^.elfScript{$IFDEF SGFPC})){$ENDIF});
    end;
  end;
end;

function InitFontList: Integer;
var
  vDC: HDC;
  vFonts: TsgNode;
  vLogFont: TLogFont;
begin
  Result := 0;
  if XMLFonts = nil then
  begin
    XMLFonts := TsgParser.Create;
    vFonts := TsgNode.Create;
    vFonts.Name := cnstFonts;
    XMLFonts.ROOT.Add(vFonts);
    vFonts.AddAttribNV(cnstVersion, '1.0');
    vDC:= GetDC(0);
    try
      FillChar(vLogFont, SizeOf(TLogFont), 0);
      vLogFont.lfCharSet := DEFAULT_CHARSET;
      EnumFontFamiliesEx(vDC, {$IFDEF SGFPC}@vLogFont{$ELSE}vLogFont{$ENDIF}, @EnumFontsProcLoadXML, LPARAM(vFonts), 0);
    finally
      ReleaseDC(0, vDC);
    end;
    Result := 1;
  end;
end;

procedure FreeFontList;
begin
  if XMLFonts <> nil then
  begin
    FreeAndNil(XMLFonts);
  end;
end;

function EnumFaceNames(const AFullName, AFaceName, AStyle, AScript: string;
    const AIndex: Integer; const AMetricFlags: Cardinal;
    const AParam: PEnumFacesParam): Integer;
var
  J: Integer;
  vFaceNameNode: TsgNode;
  vFullNameNode: TsgNodeSample;
  vFontFlags, vFontType, vMetrixFlags: Cardinal;
begin
  Result := -1;
  J := 0;
  vFullNameNode := XMLFonts.ROOT.NodeByName[cnstFonts].ChildNodes[AIndex];
  while (J < vFullNameNode.ChildNodesCount) and (Result <= -1) do
  begin
    vFaceNameNode := TsgNode(vFullNameNode.ChildNodes[J]);
    vFontFlags := vFaceNameNode.Attributes.NodeByName[cnstFontFlags].ValueAsInt;
    vFontType := vFaceNameNode.Attributes.NodeByName[cnstFontType].ValueAsInt;
    vMetrixFlags := vFontFlags or (vFontType shl 24);
    Result := AParam^.Proc(AFullName, vFaceNameNode.Attributes.NodeByName[cnstName].Value,
      vFaceNameNode.Attributes.NodeByName[cnstStyle].Value,
      vFaceNameNode.Attributes.NodeByName[cnstScript].Value, J, vMetrixFlags, AParam^.Data);
    Inc(J);
  end;
end;

function EnumFullNamesList(const AProc: TsgFontListProc; const AParam: PEnumFacesParam): Integer;
var
  I: Integer;
  vFullName: string;
  vROOT: TsgNodeSample;
begin
  Result := -1;
  InitFontList;
  vROOT := XMLFonts.ROOT.NodeByName[cnstFonts];
  if vROOT <> nil then
  begin
    I := 0;
    Result := -1;
    while (I < vROOT.ChildNodesCount) and (Result <= -1) do
    begin
      vFullName := TsgNode(vROOT.ChildNodes[I]).Attributes.NodeByName[cnstName].Value;
      Result := AProc(vFullName, '', '', '', I, 0, AParam);
      Inc(I);
    end;
  end;
end;

function EnumFontList(const AProc: TsgFontListProc; const AData: Pointer): Integer;
var
  vEnumFacesParam: TEnumFacesParam;
begin
  InitFontList;
  vEnumFacesParam.Data := AData;
  vEnumFacesParam.Proc := AProc;
  Result := EnumFullNamesList(@EnumFaceNames, @vEnumFacesParam);
end;

procedure ExpandTTFRect(var ARect: TsgTTFRect; const APoint: TsgTTFPoint);
begin
  if ARect.Left > APoint.X then
    ARect.Left := APoint.X;
  if ARect.Top < APoint.Y then
    ARect.Top := APoint.Y;
  if ARect.Right < APoint.X then
    ARect.Right := APoint.X;
  if ARect.Bottom > APoint.Y then
    ARect.Bottom := APoint.Y;
end;

function FindFontByName(const AIndex: Integer; const AFontName: string;
    const AMetricFlags: Cardinal; const AParam: Pointer): Integer;
var
  vFindedName: string;
begin
  Result := -1;
  vFindedName := PChar(AParam);
  if (AnsiPos(AFontName, vFindedName) > 0) or
     (AnsiPos(vFindedName, AFontName) > 0) then
    Result := AIndex;
end;

function FindFontNameInTTFStream(const AStream: Tstream;
  const ANameRecord: TsgNameRecord): string;
var
  vBuffer: string;
begin
  Result := '';
  SetLength(vBuffer, ANameRecord.StringLength);
  if AStream.Read(vBuffer[1], ANameRecord.StringLength) <> ANameRecord.StringLength then
    Exit;
  if (ANameRecord.PlatformID in [0, 3]) and
   (ANameRecord.EncodingID in [0..1]) then
  begin
    SwapBufferOfBytes(@vBuffer[1], ANameRecord.StringLength);
    WideCharLenToStrVar(PWideChar(@vBuffer[1]),
      ANameRecord.StringLength shr 1, Result);
  end
  else
    if (ANameRecord.PlatformID in [1, 2]) and(ANameRecord.EncodingID = 0) then
      SetString(Result, PChar(@vBuffer[1]),ANameRecord.StringLength);
end;

function FindNameRecordByLanguageID(const AStream: TStream;
  const ALangID: Integer; const ANameTableHeader: TsgNameTableHeader;
  var ANameRecord: TsgNameRecord): Boolean;
var
  I: Integer;
  vNameRecordTmp: TsgNameRecord;
begin
  Result := False;
  for I := 0 to ANameTableHeader.NRCount - 1 do
  begin
    if AStream.Read(vNameRecordTmp, 12) <> 12 then
      Exit;
    SwapBufferOfBytes(@vNameRecordTmp, 12);
    if ((vNameRecordTmp.NameID = 4) and (vNameRecordTmp.StringLength > 0)) and
       ( (not Result) or
         ((vNameRecordTmp.LanguageID = ALangID) and
          (ANameRecord.LanguageID <> ALangID)) or
         ((vNameRecordTmp.LanguageID = cnstLangIDOfEnglish) and
          (ANameRecord.LanguageID <> cnstLangIDOfEnglish)) or
         ((vNameRecordTmp.LanguageID = 0) and (ANameRecord.LanguageID <> 0))
       ) then
    begin
      ANameRecord := vNameRecordTmp;
      Result := True;
    end;
  end;
end;

function FindStringByObject(const AList: TList; const AStrings: TStringList;
  const AValue: string; var AIndex: Integer): Boolean;
var
  vLowIndex, vHiIndex, vMiddleIndex, vResultOfCompare: Integer;
  vValueCompare: string;
begin
  Result := False;
  vLowIndex := 0;
  vHiIndex := AList.Count - 1;
  while vLowIndex <= vHiIndex do
  begin
    vMiddleIndex := (vLowIndex + vHiIndex) shr 1;
    vValueCompare := AStrings.Strings[Integer(AList.List[vMiddleIndex])];
    vResultOfCompare := CompareStrVal(vValueCompare, AValue);
    if vResultOfCompare < 0 then
      vLowIndex := vMiddleIndex + 1
    else
    begin
      vHiIndex := vMiddleIndex - 1;
      if vResultOfCompare = 0 then
      begin
        AIndex := Integer(AList.List[vMiddleIndex]);
        Result := True;
        Break;
      end;
    end;
  end;
end;

function FindTableDirName(const AStream: TStream;
  const AOffsetTable: TsgOffsetTable; var ATableDir: TsgTableDirectory): Boolean;
var
  I: Integer;
begin
  Result := False;
  I := 0;
  while (I < AOffsetTable.NumOfTables) and (not Result) do
  begin
    if AStream.Read(ATableDir, 16) <> 16 then
      Exit;
    Result := {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrLIComp(ATableDir.Tag, cnstName, 4) = 0;
    Inc(I);
  end;
end;

function TryAdd(AFonts: TStrings; const AFaceName: string;
  const AMetricFlags: Cardinal): Integer;
begin
  Result := AFonts.IndexOf(AFaceName);
  if Result < 0 then
    Result := AFonts.AddObject(AFaceName, TObject(AMetricFlags))
  else
    AFonts.Objects[Result] := TObject(Cardinal(AFonts.Objects[Result]) or AMetricFlags);
end;

function AddFontFirstFaceNameOnly(const AFullName, AFaceName, AStyle, AScript: string;
  const AIndex: Integer; const AMetricFlags: Cardinal; const AParam: Pointer): Integer;
begin
  Result := -1;
  if AIndex = 0 then
    TryAdd(TStrings(AParam), AFaceName, AMetricFlags);
end;

function AddFont(const AFullName, AFaceName, AStyle, AScript: string;
  const AIndex: Integer; const AMetricFlags: Cardinal; const AParam: Pointer): Integer;
begin
  Result := -1;
  TryAdd(TStrings(AParam), AFaceName, AMetricFlags);
end;

procedure FindGDIFonts(const AFonts: TStrings; const AFirstFaceNameOnly: Boolean);
begin
  InitFontList;
  if AFirstFaceNameOnly then
    EnumFontList(@AddFontFirstFaceNameOnly, Pointer(AFonts))
  else
    EnumFontList(@AddFont, Pointer(AFonts))
end;

procedure FreeListHasNil(var AList: TList);
var
  I: Integer;
begin
  for I := 0 to AList.Count - 1 do
    if AList.List[I] <> nil then
      TObject(AList.List[I]).Free;
  AList.Free;
end;

function GetFileNameByFontName(const AFontName: string): string;
begin
  if TableFonts <> nil then
    Result := TableFonts.GetFileName(AFontName)
  else
    Result := '';
end;

function GetFontIdByNameAndStyle(const AFontName: string;
  const AStyle: TFontStyles):  string;
begin

  Result := AFontName + IntToStr({$IFDEF SGFPC}Integer{$ELSE}Byte{$ENDIF}(AStyle));
end;

function GetFontNameByFileName(const AFileName: string): string;
begin
  if TableFonts <> nil then
    Result := TableFonts.GetFontName(AFileName)
  else
    Result := '';
end;

function GetFontNameWithoutStyle(const AName: string): string;
var
  vPos1, vPos2, vPos3: Integer;
begin
  vPos1 := AnsiPos(cnstBold, AName);
  vPos2 := AnsiPos(cnstItalic, AName);
  vPos3 := AnsiPos(cnstSpace + cnstLeftBracket, AName);
  if vPos3 = 0 then
    vPos3 := Length(AName) + 1;
  if (vPos1 > 0) and (vPos3 > vPos1) then
    vPos3 := vPos1;
  if (vPos2 > 0) and (vPos3 > vPos2) then
    vPos3 := vPos2;
  Result := Copy(AName, 1, vPos3 - 1);
end;

function GetFontStyleByFontName(const AFontName: string): TmvFontStyles;
var
  vPos: Integer;
begin
  vPos := AnsiPos(cnstBold, AFontName);
  if vPos > 0 then
    Result := [fmBold]
  else
    Result := [];
  vPos := AnsiPos(cnstItalic, AFontName);
  if vPos > 0 then
    Result := Result + [fmItalic];
end;

function GetFontTypeByFileNameExt(const AFileName: string): TsgFontType;
const
  cnstExts: array [TsgFontType] of string = ('', '.TTF', '.TTC', '.FON', '.SHX',
    '');
var
  I: TsgFontType;
  vExt: string;
begin
  Result := ftUndefined;
  vExt := AnsiUpperCase(ExtractFileExt(AFileName));
  if Length(vExt) > 0 then
  begin
    for I := Low(TsgFontType) to High(TsgFontType) do
      if cnstExts[I] = vExt then
      begin
        Result := I;
        Break;
      end;
  end;
end;

function GetFontTypeByFontName(const AFontName: string): TsgFontType;
begin
  if TableFonts <> nil then
    Result := TableFonts.GetFontType(AFontName)
  else
    Result := ftUndefined;
end;

function GetFontTypeEx(const AFontName: string): TsgFontTypes;
var
  I: Integer;
  vROOT: TsgNodeSample;
  vFullNameNode, vFaceNameNode: TsgNode;
  vFontType: Cardinal;
begin
  Result := [];
  InitFontList;
  vROOT := XMLFonts.ROOT.NodeByName[cnstFonts];
  if vROOT <> nil then
  begin
    for I := 0 to vROOT.ChildNodesCount - 1 do
    begin
      vFullNameNode := TsgNode(vROOT.ChildNodes[I]);
      vFaceNameNode := TsgNode(vFullNameNode.GetNodeByAttribValue(cnstFaceName,
         cnstName, AFontName, False));
      if vFaceNameNode <> nil then
      begin
        vFontType := vFaceNameNode.Attributes.NodeByName[cnstFontType].ValueAsInt;
        if vFontType and RASTER_FONTTYPE <> 0 then
          Include(Result, ftFON);
        if vFontType and DEVICE_FONTTYPE <> 0 then
          Include(Result, ftDFT);
        if vFontType and TRUETYPE_FONTTYPE <> 0 then
          Include(Result, ftTTF);
        if vFontType and SHX_FONTTYPE <> 0 then
          Include(Result, ftSHX);
        Break;
      end;
    end;
  end;
  if Result = [] then
    Result := [ftUndefined];
end;

function GetNameOfFont(const AFont: TFont): string;
begin
  Result := AFont.Name;
  SetLength(Result, StrLen(PChar(Result)));
end;

function GetFPointFromPointFx(const AFixedPoint: PPointFX): TFPoint;
begin
  Result.X := AFixedPoint^.X.value + AFixedPoint^.X.fract * cnstFract16;
  Result.Y := AFixedPoint^.Y.value + AFixedPoint^.Y.fract * cnstFract16;
  Result.Z := 0;
(*
  if IsHiY then
    Result.Y := -Result.Y;
*)
end;

function GetQualityApproximation: Byte;
begin
  if Generator = nil then
    SetQualityApproximation(cnstDefaultQualityApproximation);
  Result := Generator.QualityApproximation;
end;

function GetLocaleFontFullNameByFileName(const AFontFileName: string): string;
var
  vBuf: array[0 .. LF_FULLFACESIZE - 1] of WideChar;
  vSize: DWORD;
begin
  Result := '';
  if Assigned(@GetFontResourceInfo) then
  begin
    vSize := SizeOf(vBuf);
    if GetFontResourceInfo(PWideChar(WideString(AFontFileName)), vSize, @vBuf[0], 1) <> 0 then
      Result := string(WideString(PWideChar(@vBuf[0])));
  end;
end;

function GetFontDataFromFile(const AFontFileName: string;
  var ALogFont: PLogFontW): Cardinal;
begin
  ALogFont := nil;
  Result := 0;
  if Assigned(@GetFontResourceInfo) then
  begin
    if GetFontResourceInfo(PWideChar(WideString(AFontFileName)), Result, nil, 2) <> 0 then
    begin
      GetMem(ALogFont, Result);
      if GetFontResourceInfo(PWideChar(WideString(AFontFileName)), Result, PWideChar(ALogFont), 2) = 0 then
      begin
        FreeMem(ALogFont, Result);
        ALogFont := nil;
        Result := 0;
      end;
    end;
  end;
end;

function GetTTFFontName(const AFileName: string): string;
var
  vOffsetTable: TsgOffsetTable;
  vTableDir: TsgTableDirectory;
  vNameTableHeader: TsgNameTableHeader;
  vNameRecord: TsgNameRecord;
  vLangID: Integer;
  vStream: TStream;
  vHandle: THandle;
begin
  Result:='';
  if not FileExists(AFileName) then Exit;
  vHandle := FileOpen(AFileName, fmOpenRead or fmShareDenyWrite);
  if vHandle <> INVALID_HANDLE_VALUE then
  begin
    vStream := THandleStream.Create(vHandle);
    try
      if vStream.Read(vOffsetTable, 12) <> 12 then
        Exit;
      SwapBufferOfBytes(@vOffsetTable, 12);
      if (vOffsetTable.MajorVersion <> 1) or (vOffsetTable.MinorVersion <> 0) then
        Exit;
      if FindTableDirName(vStream, vOffsetTable, vTableDir) then
      begin
        vTableDir.Offset := SwapWords(vTableDir.Offset);
        vStream.Position := vTableDir.Offset;
        if (vStream.Read(vNameTableHeader,6) <> 6) or (vNameTableHeader.Selector <> 0) then
          Exit;
        SwapBufferOfBytes(@vNameTableHeader, 6);
        vLangID := cnstLangIDOfEnglish;//GetSystemDefaultvLangID;
        if FindNameRecordByLanguageID(vStream, vLangID, vNameTableHeader, vNameRecord) then
        begin
          vStream.Position := vTableDir.Offset + vNameTableHeader.StorageOffset +
            vNameRecord.StringOffset;
          Result := FindFontNameInTTFStream(vStream, vNameRecord);
        end;
      end;
    finally
      vStream.Free;
    end;
  end;
end;

procedure InitDirOfWinFonts;
begin
  if not GetSpecialFolderPath(constCSIDL_FONTS, DirOfWinFonts) then
    DirOfWinFonts := '';
end;

procedure InitDrawGlyphsParams;
begin
  if DrawGlyphPts = nil then
    DrawGlyphPts := TsgIntegerList.Create
  else
    DrawGlyphPts.Count := 0;
  if DrawGlyphPtsCount = nil then
    DrawGlyphPtsCount := TsgIntegerList.Create
  else
    DrawGlyphPtsCount.Count := 0;
end;

procedure InitRegKeyMicrosoftWindows;
var
  vOSVersionInfo: TOSVersionInfo;
begin
  vOSVersionInfo.dwOSVersionInfoSize := Sizeof(TOSVersionInfo);
  GetVersionEx(vOSVersionInfo);
  if vOSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
    RegKeyMicrosoftWindows := cnstRegKeyMicrosoftNT
  else
    RegKeyMicrosoftWindows := cnstRegKeyMicrosoft9X;
end;

function InValues(const AValue, AMinValue, AMaxValue: WORD): Boolean;
begin
  Result := (AMinValue <= AValue) and (AValue <= AMaxValue);
end;

function IsNotTTFFont(const AFontName: string): Boolean;
var
  vFontType: TsgFontType;
begin
  vFontType := GetFontTypeByFontName(AFontName);
  Result := not (vFontType in [ftTTF, ftTTC]);
end;

function IsSystemNotRasterFont(const AFontName: string): Integer;
var
  vDC: HDC;
begin
  Result := 0;
  vDC:= GetDC(0);
  try
    if not{$IFDEF SGFPC}Boolean({$ENDIF}EnumFontFamilies(vDC, nil, @EnumFontsProc, LPARAM(PChar(AFontName))){$IFDEF SGFPC}){$ENDIF} then
      Result := 1;
  finally
    ReleaseDC(0, vDC);
  end;
end;

function IsSystemNotRasterFontEx(const AFontName: string): Integer;
var
  vFontTypes: TsgFontTypes;
begin
  Result := -1;
  vFontTypes := GetFontTypeEx(AFontName);
  if not (ftUndefined in vFontTypes) then
    Result := Integer([ftTTF, ftTTC] * vFontTypes <> []);
end;

function MakeFPointFromTTF(const APoint: TsgTTFPoint): TFPoint;
begin
  Result.X := APoint.X;
  Result.Y := APoint.Y;
  Result.Z := 0;
end;

function TTFPointXMat(const AX, AY: TsgTTFFloat;
  const AMatrix: TFMatrix): TsgTTFPoint;
begin
  Result.X := AX * AMatrix.M[0,0] + AY * AMatrix.M[1,0] + AMatrix.M[3,0];
  Result.Y := AX * AMatrix.M[0,1] + AY * AMatrix.M[1,1] + AMatrix.M[3,1];
end;

function TTFPointXMatScreen(const APoint: TsgTTFPoint;
  const AMatrix: TFMatrix): TPoint;
var
  vTmpPoint: TsgTTFPoint;
begin
  vTmpPoint := TTFPointXMat(APoint.X, APoint.Y, AMatrix);
  Result.X := Round(vTmpPoint.X);
  Result.Y := Round(vTmpPoint.Y);
end;

function TTFPointXMatto3D(const APoint: TsgTTFPoint;
  const AMatrix: TFMatrix): TFPoint;
var
  vTmpPoint: TsgTTFPoint;
begin
  vTmpPoint := TTFPointXMat(APoint.X, APoint.Y, AMatrix);
  Result.X := vTmpPoint.X;
  Result.Y := vTmpPoint.Y;
  Result.Z := AMatrix.M[3,2];
end;

procedure SetQualityApproximation(const AValue: Byte);
begin
  if Generator = nil then
    Generator := TsgGeneratorShapeEdge.Create;
  Generator.QualityApproximation := AValue;
end;

procedure SortListByStrings(const AList: TList; const AStrings: TStringList;
  ALowIndex, ATopIndex: Integer);
var
  vLowIndex, vTopIndex, vMiddleIndex: Integer;
  vPointerTmp: Pointer;
  vValue: string;
begin
  repeat
    vLowIndex := ALowIndex;
    vTopIndex := ATopIndex;
    vMiddleIndex := (ALowIndex + ATopIndex) shr 1;
    repeat
      vValue := AStrings.Strings[Integer(AList.List[vMiddleIndex])];
      while CompareStrVal(AStrings.Strings[Integer(AList.List[vLowIndex])], vValue) < 0 do
        Inc(vLowIndex);
      while CompareStrVal(AStrings.Strings[Integer(AList.List[vTopIndex])], vValue) > 0 do
        Dec(vTopIndex);
      if vLowIndex <= vTopIndex then
      begin
        vPointerTmp := AList.List[vLowIndex];
        AList.List[vLowIndex] := AList.List[vTopIndex];
        AList.List[vTopIndex] := vPointerTmp;
        if vMiddleIndex = vLowIndex then
          vMiddleIndex := vTopIndex
        else
          if vMiddleIndex = vTopIndex then
            vMiddleIndex := vLowIndex;
        Inc(vLowIndex);
        Dec(vTopIndex);
      end;
    until vLowIndex > vTopIndex;
    if ALowIndex < vTopIndex then
      SortListByStrings(AList, AStrings, ALowIndex, vTopIndex);
    ALowIndex := vLowIndex;
  until vLowIndex >= ATopIndex;
end;

function SubTTFPoints(const APoint1, APoint2: TsgTTFPoint): TsgTTFPoint;
begin
  Result.X := APoint1.X - APoint2.X;
  Result.Y := APoint1.Y - APoint2.Y;
end;

procedure SwapBufferOfBytes(const APBuffer: Pointer; const ACount: Integer);
var
  I: Integer;
  vPWord: PWORD;
begin
  vPWord := APBuffer;
  for I := 1 to (ACount shr 1) do
  begin
    vPWord^ := SwapBytes(vPWord^);
    Inc(vPWord);
  end;
end;

function SymbolExistDC(const ADC: HDC; const AKey: WORD): Boolean;
var
  vMatrix: TMat2;
begin
  FillChar(vMatrix, sizeof(vMatrix), 0);
  vMatrix.eM11.Value := 1;
  vMatrix.eM22.Value := 1;
  if AKey > 255 then
    Result := SymbolExistDCW(ADC, AKey, vMatrix)
  else
    Result := SymbolExistDCA(ADC, AKey, vMatrix);
end;

function SymbolExistDCA(const ADC: HDC; const AKey: WORD;
  const AMat: TMat2): Boolean;
var
  vTextMetric: TTextMetricA;
  vGlyphMetrixcsByKey, vGlyphMetricsByDefault: TGlyphMetrics;
  vSizeByKey, vSizeByDefault: Integer;
  vBufferByKey, vBufferByDefault: AnsiString;
  vDefaultKey: WORD;
begin
  Result := False;
  GetTextMetricsA(ADC, vTextMetric);
  vDefaultKey := WORD(vTextMetric.tmDefaultChar);
  if InValues(AKey, WORD(vTextMetric.tmFirstChar), WORD(vTextMetric.tmLastChar)) then
  begin
    vSizeByKey := GetGlyphOutline(ADC, AKey, GGO_NATIVE,
      vGlyphMetrixcsByKey, 0, nil, AMat);
    vSizeByDefault := GetGlyphOutline(ADC, vDefaultKey,
      GGO_NATIVE , vGlyphMetricsByDefault, 0, nil, AMat);
    if CompareGlyphMetrics(vSizeByKey, vSizeByDefault,
      vGlyphMetrixcsByKey, vGlyphMetricsByDefault) then
    begin
      SetLength(vBufferByKey, vSizeByKey);
      GetGlyphOutline(ADC, AKey, GGO_NATIVE, vGlyphMetrixcsByKey,
        vSizeByKey, @vBufferByKey[1], AMat);
      SetLength(vBufferByDefault, vSizeByDefault);
      GetGlyphOutline(ADC, vDefaultKey, GGO_NATIVE, vGlyphMetricsByDefault,
        vSizeByDefault, @vBufferByDefault[1], AMat);
      Result := not CompareMem(@vBufferByKey[1], @vBufferByDefault[1],
        vSizeByKey);
    end
    else
      Result := True;
  end;
end;

function SymbolExistDCW(const ADC: HDC; const AKey: WORD;
  const AMat: TMat2): Boolean;
var
  vTextMetric: TTextMetricW;
  vGlyphMetricsByKey, vGlyphMetricsByDefault: TGlyphMetrics;
  vSizeByKey, vSizeByDefault: Integer;
  vBufferByKey, vBufferByDefault: AnsiString;
  vDefaultKey: WORD;
begin
  Result := False;
  GetTextMetricsW(ADC, vTextMetric);
  vDefaultKey := WORD(vTextMetric.tmDefaultChar);
  if InValues(AKey, WORD(vTextMetric.tmFirstChar), WORD(vTextMetric.tmLastChar)) then
  begin
    vSizeByKey := GetGlyphOutlineW(ADC, AKey, GGO_NATIVE , vGlyphMetricsByKey,
      0, nil, AMat);
    vSizeByDefault := GetGlyphOutlineW(ADC, vDefaultKey, GGO_NATIVE,
      vGlyphMetricsByDefault, 0, nil, AMat);
    if CompareGlyphMetrics(vSizeByKey, vSizeByDefault, vGlyphMetricsByKey,
     vGlyphMetricsByDefault) then
    begin
      SetLength(vBufferByKey, vSizeByKey);
      GetGlyphOutlineW(ADC, AKey, GGO_NATIVE, vGlyphMetricsByKey,
        vSizeByKey, @vBufferByKey[1], AMat);
      SetLength(vBufferByDefault, vSizeByDefault);
      GetGlyphOutlineW(ADC, vDefaultKey, GGO_NATIVE, vGlyphMetricsByDefault,
        vSizeByDefault, @vBufferByDefault[1], AMat);
      Result := not CompareMem(@vBufferByKey[1], @vBufferByDefault[1],
        vSizeByKey);
    end
    else
      Result := True;
  end;
end;

function SymbolExistFont(const AFont: TFont; const AKey: WORD): Boolean;
var
  vDC: HDC;
begin
  vDC := GetDC(0);
  try
    AFont.Height := cnstHeigthDef;
    SelectObject(vDC, AFont.Handle);
    Result := SymbolExistDC(vDC, AKey);
  finally
    ReleaseDC(0, vDC);
  end;
end;

function SymbolExistFontName(const AFontName: string;
  const AKey: WORD): Boolean;
var
  vFont: TFont;
begin
  vFont := TFont.Create;
  try
    vFont.Name := AFontName;
    Result := SymbolExistFont(vFont, AKey);
  finally
    vFont.Free;
  end;
end;

procedure TransTTFRectCorners(var ARect: TsgTTFRect; const AMatrix: PFMatrix);
var
  R: TsgTTFRect;
begin
  R := cnstTTFBadRect;
  ExpandTTFRect(R, TTFPointXMat(ARect.Left, ARect.Top, AMatrix^));
  ExpandTTFRect(R, TTFPointXMat(ARect.Left, ARect.Bottom, AMatrix^));
  ExpandTTFRect(R, TTFPointXMat(ARect.Right, ARect.Top, AMatrix^));
  ExpandTTFRect(R, TTFPointXMat(ARect.Right, ARect.Bottom, AMatrix^));
  ARect := R;
end;

  {TsgContainerOfTextGlyphs}

function TsgContainerOfTextGlyphs.GetCount: Integer;
begin
  Result := FContainer.Count;
end;

function TsgContainerOfTextGlyphs.GetTextGlyph(Index: Integer): TsgTextGlyph;
begin
  if Index < FContainer.Count then
    Result := TsgTextGlyph(FContainer.Objects[Index])
  else
    Result := nil;
end;

constructor TsgContainerOfTextGlyphs.Create;
begin
  InitializeCriticalSection(FLock);
  FContainer := TStringList.Create;
  FContainer.Duplicates := dupAccept;
{$IFDEF SG_DEL6}
  FContainer.CaseSensitive := True;
{$ENDIF}
  FContainer.Sorted := True;
  FRefs := 0;
end;

destructor TsgContainerOfTextGlyphs.Destroy;
begin
  Clear;
  FreeAndNil(FContainer);
  DeleteCriticalSection(FLock);
  inherited Destroy;
end;

{  AddTextGlyphsByFont
   AFont - Describes font characteristics used when displaying text
   This function creates and adds container of symbols for the specified text
   style                                                                       }
function TsgContainerOfTextGlyphs.AddTextGlyphsByFont(const AFont: TmvExtFont):
  TsgTextGlyph;
begin
  Result := AddTextGlyphsByFont(GetNameOfFont(AFont), TFontStyles(AFont.Style),
    AFont.Charset);
end;

function TsgContainerOfTextGlyphs.AddTextGlyphsByFont(const AFontName: string;
  const AFontStyle: TFontStyles;
  const ACharSet: TFontCharset = cnstCharSetDef): TsgTextGlyph;
var
  vFontID: string;
begin
  Lock;
  try
    Result := TsgTextGlyph.Create;
    Result.SetFontParams(AFontName, AFontStyle);
    vFontID := GetFontIdByNameAndStyle(Result.FontName, Result.FontStyle);//add FontId Font.CharSet
    FContainer.AddObject(vFontID, Result);
    Result.LoadedW('', '', AFontName, AFontStyle, ACharSet);
  finally
    Unlock;
  end;
end;

procedure TsgContainerOfTextGlyphs.Clear;
var
  I: Integer;
begin
  for I := 0 to FContainer.Count - 1 do
    FContainer.Objects[I].Free;
  FContainer.Clear;
end;

function TsgContainerOfTextGlyphs.IndexOf(const AFontName: string;
  const AStyles: TFontStyles): Integer;
var
  vFontID: string;
begin
  vFontID := GetFontIdBynameAndStyle(AFontName, AStyles);
  Result := FContainer.IndexOf(vFontID);
end;

function TsgContainerOfTextGlyphs.Lock: Integer;
begin
  EnterCriticalSection(FLock);
  Result := FLock.LockCount;
end;

procedure TsgContainerOfTextGlyphs.Reference;
begin
  Inc(FRefs);
end;

procedure TsgContainerOfTextGlyphs.Release;
begin
  Dec(FRefs, Integer(FRefs > 0));
  if FRefs < 1 then
    Clear;
end;

procedure TsgContainerOfTextGlyphs.Unlock;
begin
  LeaveCriticalSection(FLock);
end;

{ TsgGDIAdapter }

procedure TsgGDIAdapter.Polyline(var Points; var Count: Integer);
begin
  Windows.Polyline(DC, Points, Count);
end;

procedure TsgGDIAdapter.PolyPolygon(var Points; var Counts; Count: Integer);
begin
  Windows.PolyPolygon(DC, Points, Counts, Count);
end;

procedure TsgGDIAdapter.PolyPolyline(var Points, Counts; Count: Integer);
begin
  Windows.PolyPolyline(DC, Points, Counts, Count);
end;

procedure TsgGDIAdapter.SetPolyFillMode(Mode: Integer);
begin
  Windows.SetPolyFillMode(DC, Mode);
end;

 { TsgGlyph }

procedure TsgGlyph.CurveTo(const APPointCurve1, APPointCurve2: PFPoint);
var
  vList: TList;
  vPointLast: TFPoint;
  vLockList: TList;
begin
  vLockList := FPolyPolyline.LockList;
  try
    vList := TList(vLockList.Last);
    vPointLast := MakeFPointFromTTF(PsgTTFPoint(vList.Last)^);
    AddListTTFPoint(vList, vPointLast);
    Generator.SetListAndProc(vList, @AddListTTFPoint);
    Generator.CreateQuadraticSpline(vPointLast, APPointCurve1^, APPointCurve2^);
    AddListTTFPoint(vList, APPointCurve2^);
  finally
    FPolyPolyline.UnlockList;
  end;
end;

procedure TsgGlyph.MoveTo(const APPointMove: PFPoint);
var
  vList: TList;
  vLockList: TList;
begin
  vLockList := FPolyPolyline.LockList;
  try
    if vLockList.Count <> 0 then
      AddFirstPoint;
    vList := TList.Create;
    vLockList.Add(vList);
    AddListTTFPoint(vList, APPointMove^);
  finally
    FPolyPolyline.UnlockList;
  end;
end;

procedure TsgGlyph.AddDecomposeLineInList(const AList: TList;
  const APPolyCutve: PTTPolyCurve);
var
  I: Integer;
begin
  for I := 0 to APPolyCutve^.cpfx - 1 do
    AddListTTFPoint(AList, GetFPointFromPointFx(@APPolyCutve^.apfx[I]));
end;

procedure TsgGlyph.AddDecomposeQSplineInList(const AList: TList;
  const APPolyCutve: PTTPolyCurve);
var
  I, vSize: Integer;
  vPoint1, vPoint2: TFPoint;
begin
  vSize := APPolyCutve^.cpfx - 2;
  for I := 0 to vSize do
  begin
    vPoint1 := GetFPointFromPointFx(@APPolyCutve^.apfx[I]);
    vPoint2 := GetFPointFromPointFx(@APPolyCutve^.apfx[I + 1]);
    if I < vSize then
      vPoint2 := MiddleFPoint2D(vPoint1, vPoint2);
    CurveTo(@vPoint1, @vPoint2);
  end;
end;

procedure TsgGlyph.AddFirstPoint;
var
  vPoint: PsgTTFPoint;
  vLockList: TList;
begin
  vLockList := FPolyPolyline.LockList;
  try
    New(vPoint);
    vPoint^ := PsgTTFPoint(TList(vLockList.Last).First)^;
    TList(vLockList.Last).Add(vPoint);
  finally
    FPolyPolyline.UnlockList;
  end;
end;

procedure TsgGlyph.CalcBox;
var
  I, J, Cnt: Integer;
  vPointsList: TList;
  vLockList: TList;
begin
  FBox := cnstTTFBadRect;
  vLockList := FPolyPolyline.LockList;
  try
    for I := 0 to vLockList.Count - 1 do
    begin
      vPointsList := vLockList[I];
      Cnt :=  vPointsList.Count - 1;
      for J := 0 to Cnt do
        ExpandTTFRect(FBox, PsgTTFPoint(vPointsList.List[J])^);
    end;
  finally
    FPolyPolyline.UnlockList;
  end;
end;

procedure TsgGlyph.ClearPoints;
var
  vLockList: TList;
begin
  vLockList := FPolyPolyline.LockList;
  try
    ClearRecordListOfList(vLockList, False);
  finally
    FPolyPolyline.UnlockList;
  end;
end;

{  Decompose

ABuffer - pointer to the memory space that contains information about the symbol
ASize  -  size to the memory space that contains information about the symbol

   Decodes information about the symbol's structure extracting its outline  }
procedure TsgGlyph.Decompose(const ABuffer: Pointer; ASize: LongInt);
var
  vPolyHeader: PTTPolygonHeader;
  vPPolyCutve: PTTPolyCurve;
  vGlyphCurrent, vGlyphEnd, vPolyEnd, vPolyCurrent: PAnsiChar;
  vPoint: TFPoint;
  vLockList: TList;
begin
  vLockList := FPolyPolyline.LockList;
  try
    vGlyphCurrent := ABuffer;
    vGlyphEnd := vGlyphCurrent + ASize;
    while LongInt(@vGlyphCurrent[0]) < LongInt(@vGlyphEnd[0]) do
    begin
      vPolyHeader := @vGlyphCurrent[0];
      vPolyEnd := vGlyphCurrent + vPolyHeader^.cb;
      vPolyCurrent := vGlyphCurrent + sizeof(TTTPolygonHeader);
      vPoint := GetFPointFromPointFx(@vPolyHeader^.pfxStart);
      MoveTo(@vPoint);
      while LongInt(@vPolyCurrent[0]) < LongInt(@vPolyEnd[0]) do
      begin
        vPPolyCutve := @vPolyCurrent[0];
        case vPPolyCutve^.wType of
          TT_PRIM_LINE:     AddDecomposeLineInList(TList(vLockList.Last),
            vPPolyCutve);
          TT_PRIM_QSPLINE:  AddDecomposeQSplineInList(TList(vLockList.Last),
            vPPolyCutve);
        end;
        vPolyCurrent := vPolyCurrent + Sizeof(WORD) shl 1 + sizeof(TPointfx) *
          vPPolyCutve^.cpfx;
      end;
      vGlyphCurrent := vGlyphCurrent + vPolyHeader^.cb;
    end;
    AddFirstPoint;
  finally
    FPolyPolyline.UnlockList;
  end;
end;

procedure TsgGlyph.UnionBoxAndMakeOffset(var ABox: TsgTTFRect;
  var AOffset: TsgTTFPoint);
var
  vBox: TsgTTFRect;
begin
  vBox.Left := FBox.Left + AOffset.X;
  vBox.Right := FBox.Right + AOffset.X;
  vBox.Top := FBox.Top + AOffset.Y;
  vBox.Bottom := FBox.Bottom + AOffset.Y;
  ExpandTTFRect(ABox, vBox.TopLeft);
  ExpandTTFRect(ABox, vBox.BottomRight);
  AOffset.X := AOffset.X + (vBox.Right - vBox.Left);
end;

constructor TsgGlyph.Create;
begin
  FPolyPolyline := TsgThreadContainerList.Create;
  FBox := cnstTTFRectZero;
end;

destructor TsgGlyph.Destroy;
begin
  ClearPoints;
  FPolyPolyline.Free;
  inherited Destroy;
end;

procedure TsgGlyph.Draw(ADC: THandle; const AXOffset: Double;
  const APMatrix: PFMatrix; const AFill: Boolean);
var
  I, J, Cnt: Integer;
  vPointsList: TList;
  vPoint: TsgTTFPoint;
  vScreenPoint: TPoint;
  vLockList: TList;
begin
  InitDrawGlyphsParams;
  vLockList := FPolyPolyline.LockList;
  try
    for I := 0 to vLockList.Count - 1 do
    begin
      vPointsList := vLockList.List[I];
      DrawGlyphPtsCount.Add(vPointsList.Count);
      Cnt := vPointsList.Count - 1;
      for J := 0 to Cnt do
      begin
        vPoint := PsgTTFPoint(vPointsList.List[J])^;
        vPoint.X := vPoint.X + AXOffset;
        vScreenPoint := TTFPointXMatScreen(vPoint, APMatrix^);
        DrawGlyphPts.Add(vScreenPoint.X);
        DrawGlyphPts.Add(vScreenPoint.Y);
      end;
    end;
  finally
    FPolyPolyline.UnlockList;
  end;
  GDIAdapter.DC := ADC;
  if AFill then
    GDIAdapter.PolyPolygon(DrawGlyphPts.List[0], DrawGlyphPtsCount.List[0],
      DrawGlyphPtsCount.Count)
  else
    GDIAdapter.PolyPolyline(DrawGlyphPts.List[0], DrawGlyphPtsCount.List[0],
      DrawGlyphPtsCount.Count);
  //PolyPolygon(ACanvas.Handle, DrawGlyphPts.List^, DrawGlyphPtsCount.List^, DrawGlyphPtsCount.Count);
end;

  {TsgTableFonts}

function TsgTableFonts.AddFontFilesInfo(var AIndex: Integer;
  AFontName, AFileName: string): Boolean;
var
  vFontType: TsgFontType;
  I, C: Integer;
  vFontName, vFileName: string;
  vLogFont, vLogFontBase: PLogFontW; // array of TLogFontW
  vSize: Cardinal;
begin
  Result := False;
  vFontName := '';
  try
    vFileName := ExtractFileName(AFileName);
    vFontType := GetFontTypeByFileNameExt(vFileName);
    FFontFiles.AddObject(vFileName, Pointer(vFontType));
    if DirOfWinFonts <> '' then
    begin
      if Length(AFileName) <= Length(FFontFiles[FFontFiles.Count - 1]) then
        AFileName := DirOfWinFonts + AFileName;
      if vFontType = ftTTF then
        vFontName := GetTTFFontName(AFileName);
      if vFontName = '' then
      begin
        vSize := GetFontDataFromFile(AFileName, vLogFontBase);
        if vSize > 0 then
        try
          C := vSize div SizeOf(TLogFontW);
          vLogFont := vLogFontBase;
          I := 0;
          repeat
            vFontName := string(WideString(PWideChar(@vLogFont^.lfFaceName[0])));
            if vLogFont^.lfWeight >= 700 then
              vFontName := vFontName + cnstBold;
            if vLogFont^.lfItalic <> 0 then
              vFontName := vFontName + cnstItalic;
            if (I > 0) and (FFontNames[AIndex] <> vFontName) then
            begin
              Inc(AIndex);
              FFontNames.Insert(AIndex, vFontName);
              FFontFiles.AddObject(vFileName, Pointer(vFontType));
            end
            else
              FFontNames[AIndex] := vFontName;
            Inc(vLogFont);
            Inc(I);
          until I >= C;
        finally
          FreeMem(vLogFontBase, vSize);
        end;
      end;
    end;
    if vFontName = '' then
      vFontName := AFontName;
    I := AnsiPos(cnstLeftBracket, vFontName);
    if I > 0 then
      SetLength(vFontName, I - 1);
    FFontNames[AIndex] := Trim(vFontName);
    Inc(AIndex);
    Result := True;
  except
  end;
end;

function TsgTableFonts.OpenRegistryKeyFonts(const ARegistry: TRegistry): Boolean;
begin
  Result := False;
{$IFDEF SGDEL_5}
  ARegistry.Access := KEY_READ;
{$ENDIF}
  ARegistry.RootKey := cnstRegKeyHKLM;
  if ARegistry.OpenKey(cnstRegKeySoftware, False) then
    if ARegistry.OpenKey(cnstRegKeyMicrosoft, False) then
      if ARegistry.OpenKey(RegKeyMicrosoftWindows, False) then
         if ARegistry.OpenKey(cnstRegKeyCurrentVersion, False) then
            Result := ARegistry.OpenKey(cnstRegKeyFonts, False);
end;

procedure TsgTableFonts.AddFonts;
var
  vReg: TRegistry;
  I: Integer;
  vRegInfo: TRegDataInfo;
  vFontName: string;
begin
  if FAddedFonts then
    Exit;
  FAddedFonts := True;
  vReg := TRegistry.Create;
  try
    if OpenRegistryKeyFonts(vReg) then
    begin
      vReg.GetValueNames(FFontNames);
      FFontFiles.Capacity := FFontNames.Count;
      I := 0;
      while I < FFontNames.Count do
      try
        vFontName := FFontNames[I];
        if (vReg.GetDataInfo(vFontName, vRegInfo)) and (vRegInfo.RegData = rdString) and
           not AddFontFilesInfo(I, vFontName, vReg.ReadString(vFontName)) then
          FFontNames.Delete(I);
      except
        FFontNames.Delete(I);
      end;
    end;
  finally
    vReg.CloseKey;
    vReg.Free;
    Sort;
  end;
end;

function TsgTableFonts.GetDataOfName(const AIndexes: TList;
  const AFind, ARez: TStringList; const AName: string): string;
var
  vIndex: Integer;
begin
  if (AFind.Count = 0) or (ARez.Count = 0) then
    AddFonts;
  if not FindStringByObject(AIndexes, AFind, AName, vIndex) then
    vIndex := AFind.IndexOf(AName);
  if (vIndex > -1) and (vIndex < ARez.Count) then
    Result := ARez[vIndex]
  else
    Result := '';
end;

procedure TsgTableFonts.Sort;
var
  I: Integer;
begin
  FSortNames.Count := FFontNames.Count;
  FSortFiles.Count := FSortNames.Count;
  for I := 0 to FSortNames.Count - 1 do
  begin
    FSortNames.List[I] := Pointer(I);
    FSortFiles.List[I] := Pointer(I);
  end;
  SortListByStrings(FSortNames, FFontNames, 0, FSortNames.Count - 1);
  SortListByStrings(FSortFiles, FFontFiles, 0, FSortFiles.Count - 1);
end;

constructor TsgTableFonts.Create;
begin
  FFontNames := TStringList.Create;
  FFontFiles := TStringList.Create;
  FSortNames := TList.Create;
  FSortFiles := TList.Create;
end;

destructor TsgTableFonts.Destroy;
begin
  FSortNames.Free;
  FSortFiles.Free;

  FFontNames.Free;
  FFontFiles.Free;
  inherited Destroy;
end;

function TsgTableFonts.GetFileName(const AFontName: string): string;
begin
  Result := GetDataOfName(FSortNames, FFontNames, FFontFiles, AFontName);
end;

function TsgTableFonts.GetFontName(const AFileName: string): string;
begin
  Result := GetDataOfName(FSortFiles, FFontFiles, FFontNames, AFileName);
end;

function TsgTableFonts.GetFontType(const AFontName: string): TsgFontType;
var
  vIndex: Integer;
begin
  Result := ftUndefined;
  if (FFontFiles.Count = 0) or (FFontNames.Count = 0) then
    AddFonts;
  if not FindStringByObject(FSortNames, FFontNames, AFontName, vIndex) then
    vIndex := FFontNames.IndexOf(AFontName);
  if vIndex > -1 then
    Result := TsgFontType(FFontFiles.Objects[vIndex]);
end;

{TsgTextGlyph}

function TsgTextGlyph.GetGlyph(const AIndex: Integer): TsgGlyph;
var
  vLockList: TList;
begin
  if AIndex < cnstGlyphsCount then
  begin
    vLockList := FGlyphs.LockList;
    try
      Result := vLockList.List[AIndex];
    finally
      FGlyphs.UnlockList;
    end;
  end
  else
    Result := GetGlyphUni(AIndex);
end;

procedure TsgTextGlyph.GetGlyphParamsInternal(const AGlyph: TsgGlyph;
  const AFontStyles: TmvFontStyles; const APMatrix: PFMatrix;
  const AList: TList; const APBox: PFRect);
var
  I, J: Integer;
  vPoly, vNewList: TList;
  vGP: PsgTTFPoint;
  vPoint: PFPoint;
  P: TFPoint;
  vXOffset: Double;
  P1, P2: TsgTTFPoint;
  vLockList: TList;
begin
  if AList <> nil then
  begin
    P.Z := 0;
    vLockList := AGlyph.FPolyPolyline.LockList;
    try
      for I := 0 to vLockList.Count - 1 do
      begin
        vPoly := vLockList.List[I];
        vNewList := TList.Create;
        AList.Add(vNewList);
        vNewList.Count := vPoly.Count;
        for J := 0 to vPoly.Count - 1 do
        begin
          New(vPoint);
          vNewList.List[J] := vPoint;
          vGP := vPoly.List[J];
          P.X := vGP^.X;
          P.Y := vGP^.Y;
          vPoint^ := FPointXMat(P, APMatrix^);
        end;
      end;
    finally
      AGlyph.FPolyPolyline.UnlockList;
    end;
    vXOffset := AGlyph.FBox.Right - AGlyph.FBox.Left;
    if fmUnderline in AFontStyles then
    begin
      SetPointsForUnderLine(vXOffset, P1, P2);
      AddLine(AList, TTFPointXMatto3D(P1, APMatrix^),
        TTFPointXMatto3D(P2, APMatrix^));
    end;
    if fmStrikeOut in AFontStyles then
    begin
      SetPointsForStrikeOut(vXOffset, P1, P2);
      AddLine(AList, TTFPointXMatto3D(P1, APMatrix^),
        TTFPointXMatto3D(P2, APMatrix^));
    end;
  end;
  if APBox <> nil then
  begin
    APBox^.TopLeft := MakeFPoint(AGlyph.FBox.Left, AGlyph.FBox.Top, 0);
    APBox^.BottomRight := MakeFPoint(AGlyph.FBox.Right, AGlyph.FBox.Bottom, 0);
    TransRectCorners(APBox^, APMatrix^);
  end;
end;

function TsgTextGlyph.GetGlyphUni(AIndex: Integer): TsgGlyph;
var
  I: Integer;
  vLockList: TList;
begin
  if (FGlyphsUniCode <> nil) then
  begin
    I :=  FGlyphsUniCode.IndexOf(Pointer(AIndex));
    if I > -1 then
    begin
      vLockList := FGlyphs.LockList;
      try
        Result := vLockList.List[cnstGlyphsCount + I]
      finally
        FGlyphs.UnlockList;
      end;
    end
    else
      Result := nil;
  end
  else
    Result := nil;
end;

procedure TsgTextGlyph.SetKoef(const ACanvas: TCanvas; AChar: Integer);
var
  vBlackBox: Double;
  vGlyph: TsgGlyph;
  vGlyphMetrics: TGlyphMetrics;
begin
  GetGlyphOutline(ACanvas.Handle, AChar, GGO_METRICS, vGlyphMetrics, 0, nil,
    cnstGlyphOutlineMatrix);
  if (vGlyphMetrics.gmBlackBoxY <> 0) then
    FKoef := cnstHeigthDef / vGlyphMetrics.gmBlackBoxY
  else
  begin
    AddGlyph(ACanvas, False, AChar);
    vGlyph := GetGlyph(AChar);
    vBlackBox := (vGlyph.Box.Top - vGlyph.Box.Bottom);
    if Abs(vBlackBox) < fAccuracy then
      vBlackBox := fAccuracy;
    FKoef := cnstHeigthDef / vBlackBox;
  end;
end;

procedure TsgTextGlyph.AddBoundariesByGlyphs(const AListOfGlyphs: TList;
  const AMatrix: PFMatrix; const ABoundaries: TList);
var
  I: Integer;
  vGlyph: TsgGlyph;
  vXOffset, vYMax, vYMin: Double;
begin
  if (AListOfGlyphs = nil) or (AListOfGlyphs.Count = 0) then Exit;
  vXOffset := 0;
  vYMax := FAbove;
  vYMin := FBelow;
  for I := 0 to AListOfGlyphs.Count - 1 do
  begin
    vGlyph := AListOfGlyphs.List[I];
    if vYMax < vGlyph.Box.Top then
      vYMax := vGlyph.Box.Top;
    if vYMin > vGlyph.Box.Bottom then
      vYMin := vGlyph.Box.Bottom;
  end;
  vXOffset := 0;
   for I := 0 to AListOfGlyphs.Count - 1 do
    AddBoundaryOfGlyph(AListOfGlyphs.List[I], ABoundaries, AMatrix, vYMin,
      vYMax, vXOffset);
end;

procedure TsgTextGlyph.AddBoundaryOfGlyph(const AGlyph: TsgGlyph;
  const ABounds: TList; const AMatrix: PFMatrix; const AYMin, AYMax: Double;
  var AXOffset: Double);
var
  vListNew: TList;
  vPPoint: PFPoint;
  vX1, vX2, vY1, vY2: Double;
begin
  vListNew := TList.Create;
  ABounds.Add(vListNew);
  vListNew.Capacity := 5;
  vX1 := AGlyph.FRealLeft + AXOffset;
  vY1 := AYMax;
  vX2 := AGlyph.FRealRight + AXOffset;
  vY2 := AYMin;
  New(vPPoint);
  vListNew.Add(vPPoint);
  vPPoint^ := FPointXMat(MakeFPoint(vX1, vY1, 0), AMatrix^);
  New(vPPoint);
  vListNew.Add(vPPoint);
  vPPoint^ := FPointXMat(MakeFPoint(vX2, vY1, 0), AMatrix^);
  New(vPPoint);
  vListNew.Add(vPPoint);
  vPPoint^ := FPointXMat(MakeFPoint(vX2, vY2, 0), AMatrix^);
  New(vPPoint);
  vListNew.Add(vPPoint);
  vPPoint^ := FPointXMat(MakeFPoint(vX1, vY2, 0), AMatrix^);
  New(vPPoint);
  vListNew.Add(vPPoint);
  vPPoint^ := FPointXMat(MakeFPoint(vX1, vY1, 0), AMatrix^);
  AXOffset := AXOffset + AGlyph.FBox.Right - AGlyph.FBox.Left;
end;

procedure TsgTextGlyph.AddGlyph(const ACanvas: TCanvas;
  const AIsUnicode: Boolean; const AKey: Integer);
var
  vLockList: TList;
begin
  vLockList := FGlyphs.LockList;
  try
    if AKey < cnstGlyphsCount then
    begin
      if vLockList[AKey] = nil then
        vLockList[AKey] := CreateGlyph(ACanvas, AIsUnicode, AKey);
    end
    else
    begin
      if GetGlyphUni(AKey) = nil then
      begin
        if FGlyphsUniCode = nil then
          FGlyphsUniCode := TList.Create;
        FGlyphsUniCode.Add(Pointer(AKey));
        vLockList.Add(CreateGlyph(ACanvas, AIsUnicode, AKey));
      end;
    end;
  finally
    FGlyphs.UnlockList;
  end;
end;

function TsgTextGlyph.AddPointsOfGlyph(const AGlyph: TsgGlyph;
  const APoints: TList; const APMatrix: PFMatrix;
  var AXOffset: Double; const AEpsilon: PFPoint): Integer;
var
  J, K, CntJ, CntK: Integer;
  vList, vListNew: TList;
  vPPoint: PsgTTFPoint;
  vPoint: TFPoint;
  vAddPoint: PFPoint;
  vLockList: TList;
begin
  Result := 0;
  vLockList := AGlyph.FPolyPolyline.LockList;
  try
    CntJ := vLockList.Count - 1;
    for J := 0 to CntJ do
    begin
      vList := vLockList.List[J];
      vListNew := TList.Create;
      APoints.Add(vListNew);
      Inc(Result);
      vListNew.Capacity := vList.Count;
      CntK := vList.Count - 1;
      vAddPoint := nil;
      for K := 0 to CntK do
      begin
        vPPoint := vList.List[K];
        vPoint := FPointXMat(MakeFPoint(vPPoint^.X + AXOffset, vPPoint^.Y, 0),
          APMatrix^);
        if (AEpsilon = nil) or (vAddPoint = nil) then
          vAddPoint := AddFPointInList(vListNew, vPoint)
        else
        begin
          if not IsRangeFPoints(vAddPoint^, vPoint, AEpsilon^) then
            vAddPoint := AddFPointInList(vListNew, vPoint);
        end;
      end;
    end;
  finally
    AGlyph.FPolyPolyline.UnlockList;
  end;
  AXOffset := AXOffset + AGlyph.FBox.Right - AGlyph.FBox.Left;
end;

function TsgTextGlyph.AddPolyPointOfText(const AText: string;
  const ATextW: WideString;
  const AListOfGlyphs: TList; AFontStyles: TmvFontStyles;
  const APMatrix: PFMatrix; const APolyPoint: TList;
  const AEpsilon: PFPoint = nil): Integer;
var
  I, vGlyphKey, vLength: Integer;
  vIsUnicode: Boolean;
  vXOffset: Double;
  vGlyph: TsgGlyph;
  vPoint1, vPoint2: TsgTTFPoint;
begin
  Result := 0;
  vXOffset := 0;
  vLength := GetTextLength(AText, ATextW, vIsUnicode);
  if AListOfGlyphs <> nil then
    AListOfGlyphs.Capacity := vLength;
  for I := 1 to vLength do
  begin
    vGlyphKey := GetTextChar(I, AText, ATextW, vIsUnicode);
    vGlyph := GetGlyph(vGlyphKey);
    if vGlyph <> nil then
    begin
      Inc(Result, AddPointsOfGlyph(vGlyph, APolyPoint, APMatrix, vXOffset, AEpsilon));
      if AListOfGlyphs <> nil then
        AListOfGlyphs.Add(vGlyph);
    end;
  end;
 if fmUnderline in AFontStyles then
  begin
    SetPointsForUnderLine(vXOffset, vPoint1, vPoint2);
    AddLine(APolyPoint, TTFPointXMatto3D(vPoint1, APMatrix^),
      TTFPointXMatto3D(vPoint2, APMatrix^));
  end;
  if fmStrikeOut in AFontStyles then
  begin
    SetPointsForStrikeOut(vXOffset, vPoint1, vPoint2);
    AddLine(APolyPoint, TTFPointXMatto3D(vPoint1, APMatrix^),
      TTFPointXMatto3D(vPoint2, APMatrix^));
  end;
end;

function TsgTextGlyph.CreateGlyph(const ACanvas: TCanvas;
  const AIsUnicode: Boolean;  const AKey: Integer): TsgGlyph;
var
  vGlyphSize: Integer;
  vGlyphMetrics: TGlyphMetrics;
  ABuffer: AnsiString;
begin
  Result := TsgGlyph.Create;
  if AIsUniCode then
    vGlyphSize := GetGlyphOutlineW(ACanvas.Handle, AKey, GGO_NATIVE,
      vGlyphMetrics, 0, nil, cnstGlyphOutlineMatrix)
  else
    vGlyphSize := GetGlyphOutline(ACanvas.Handle, AKey, GGO_NATIVE,
      vGlyphMetrics, 0, nil, cnstGlyphOutlineMatrix);
  if vGlyphSize > 0 then
  begin
    SetLength(ABuffer, vGlyphSize);
    if AIsUniCode then
      GetGlyphOutlineW(ACanvas.Handle, AKey, GGO_NATIVE, vGlyphMetrics,
        vGlyphSize, @ABuffer[1], cnstGlyphOutlineMatrix)
    else
      GetGlyphOutline(ACanvas.Handle, AKey, GGO_NATIVE, vGlyphMetrics,
        vGlyphSize, @ABuffer[1], cnstGlyphOutlineMatrix);
    Result.Decompose(@ABuffer[1], vGlyphSize);
    Result.CalcBox;
  end;
  Result.FRealLeft := Result.FBox.Left;
  Result.FRealRight := Result.FBox.Right;
  Result.FBox.Left := 0;
  Result.FBox.Right := vGlyphMetrics.gmCellIncX;
end;

procedure TsgTextGlyph.DrawLine(const ADC: THandle;
  const APMatrix: PFMatrix; const APoint1, APoint2: TsgTTFPoint);
var
  vPointXMat1, vPointXMat2: TPoint;
  vPoly: array [0..1] of TPoint;
  vCount: Integer;
begin
  vPointXMat1 := TTFPointXMatScreen(APoint1, APMatrix^);
  vPointXMat2 := TTFPointXMatScreen(APoint2, APMatrix^);
  vPoly[0] := Point(vPointXMat1.X, vPointXMat1.Y);
  vPoly[1] := Point(vPointXMat2.X, vPointXMat2.Y);
  vCount := 2;
  GDIAdapter.Polyline(vPoly, vCount);
end;

function TsgTextGlyph.GetFontParams(const APMatrix: PFMatrix): TsgFontParams;
var
  vPointZero: TFPoint;
begin
  Result := cnstFontParamsZero;
  vPointZero := FPointXMat(cnstFPointZero, APMatrix^);
  Result.Above := DistanceFPoint(vPointZero,
    FPointXMat(MakeFPoint(FAbove, 0, 0), APMatrix^));
  Result.Below := DistanceFPoint(vPointZero,
    FPointXMat(MakeFPoint(FBelow, 0, 0), APMatrix^));
end;

function TsgTextGlyph.GetGlyphCur(const ADC: THandle;
  const AIsUnicode: Boolean; const AIndex: Integer): TsgGlyph;
var
  vCanvas: TCanvas;
  vLockList: TList;
begin
  vLockList := FGlyphs.LockList;
  try
    Result := GetGlyph(AIndex);
    if Result = nil then
    begin
      vCanvas := TCanvas.Create;
      try
        vCanvas.Handle := ADC;
        vCanvas.Font.Height := cnstHeigthDef;
        AddGlyph(vCanvas, AIsUnicode, AIndex);
        Result := vLockList[AIndex];
      finally
        vCanvas.Free;
      end;
    end;
  finally
    FGlyphs.UnlockList;
  end;
end;

function TsgTextGlyph.GetTextChar(const AIndex: Integer; const ATextA: string;
  ATextW: WideString; const AIsUnicode: Boolean): Integer;
begin
  if AIsUnicode then
    Result := Ord(ATextW[AIndex])
  else
    Result := Ord(ATextA[AIndex]);
end;

function TsgTextGlyph.GetTextLength(const ATextA: string; ATextW: WideString;
  var AIsUnicode: Boolean): Integer;
begin
  Result := Length(ATextW);
  AIsUnicode := Result > 0;
  if not AIsUnicode then
    Result := Length(ATextA);
end;

procedure TsgTextGlyph.SetPointsForAboveLine(const ALength: Double;
  var APoint1, APoint2: TsgTTFPoint);
var
  vGlyphHi, vGlyphLow: TsgGlyph;
begin
  vGlyphHi := GetGlyph(cnstHiChar);
  vGlyphLow := GetGlyph(cnstLowChar);
  APoint1.X := 0;
  APoint1.Y := vGlyphHi.FBox.Top - vGlyphLow.FBox.Bottom;
  APoint2.X := ALength;
  APoint2.Y := APoint1.Y;
end;

procedure TsgTextGlyph.SetPointsForStrikeOut(const ALength: Double;
 var APoint1, APoint2: TsgTTFPoint);
var
  vGlyphHi, vGlyphLow: TsgGlyph;
begin
  vGlyphHi := GetGlyph(cnstHiChar);
  vGlyphLow := GetGlyph(cnstLowChar);
  APoint1.X := 0;
  APoint1.Y := (vGlyphHi.FBox.Top + vGlyphLow.FBox.Bottom) * 0.5;
  APoint2.X := ALength;
  APoint2.Y := APoint1.Y;
end;

procedure TsgTextGlyph.SetPointsForUnderLine(const ALength: Double;
  var APoint1, APoint2: TsgTTFPoint);
var
  vGlyphLow: TsgGlyph;
begin
  vGlyphLow := GetGlyph(cnstLowChar);
  APoint1.X := 0;
  APoint1.Y := vGlyphLow.FBox.Bottom;
  APoint2.X := ALength;
  APoint2.Y := APoint1.Y;
end;

constructor TsgTextGlyph.Create;
var
  vLockList: TList;
begin
  inherited Create;
  FKoef := 0;
  FFillText := True;
  FGlyphs := TsgThreadContainerList.Create;
  vLockList := FGlyphs.LockList;
  try
    vLockList.Capacity := cnstGlyphsCount + 1;
    vLockList.Count := cnstGlyphsCount;
    FillChar(vLockList.List[0], cnstGlyphsCount shl 2, 0);
  finally
    FGlyphs.UnlockList;
  end;
  FGlyphsUnicode := nil;
end;

destructor TsgTextGlyph.Destroy;
var
  vLockList: TList;
begin
  vLockList := FGlyphs.LockList;
  try
    ClearList(vLockList);
  finally
    FGlyphs.UnlockList;
  end;
  FGlyphs.Free;
  if FGlyphsUniCode <> nil then
    FGlyphsUniCode.Free;
  inherited Destroy;
end;

procedure TsgTextGlyph.ClearPointsInGplyphs;
var
  I: Integer;
  vLockList: TList;
begin
  vLockList := FGlyphs.LockList;
  try
    for I := vLockList.Count - 1 downto 0 do
      if vLockList[I] <> nil then
        TsgGlyph(vLockList[I]).ClearPoints;
  finally
    FGlyphs.UnlockList;
  end;
end;

procedure TsgTextGlyph.DrawTextExtW(ADC: THandle;
  const AFontStyles: TmvFontStyles; const AText: string;
  const ATextW: WideString; const AMatrix: PFMatrix);
var
  vGlyph: TsgGlyph;
  I, vGlyphKey, vLength: Integer;
  vXOffset: Double;
  vIsUnicode: Boolean;
  vP1, vP2: TsgTTFPoint;
begin
  GDIAdapter.DC := ADC;
  GDIAdapter.SetPolyFillMode(WINDING);
  //SetPolyFillMode(ACanvas.Handle, WINDING);
  vXOffset := 0;
  vLength := GetTextLength(AText, ATextW, vIsUnicode);
  for I := 1 to vLength do
  begin
    vGlyphKey := GetTextChar(I, AText, ATextW, vIsUnicode);
    vGlyph := GetGlyphCur(ADC, vIsUnicode, vGlyphKey);
    vGlyph.Draw(ADC, vXOffset, AMatrix, FFillText);
    vXOffset := vXOffset + (vGlyph.FBox.Right - vGlyph.FBox.Left);
  end;
  if fmUnderline in AFontStyles then
  begin
    SetPointsForUnderLine(vXOffset, vP1, vP2);
    DrawLine(ADC, AMatrix, vP1, vP2);
  end;
  if fmStrikeOut in AFontStyles then
  begin
    SetPointsForStrikeOut(vXOffset, vP1, vP2);
    DrawLine(ADC, AMatrix, vP1, vP2);
  end;
end;

{  DrawTextW

   ACanvas - provides an abstract drawing space for objects that must render
            their own images
   AText - the text in ANSI codings
   ATextW - the text in UNICODE
   AMatrix - pointer to a TFMatrix structure specifying a transformation matrix
             for the character

   This procedure draws text. If UNICODE text is empty than ANSI is being used
   for drawing of the text.                                                    }
procedure TsgTextGlyph.DrawTextW(ADC: THandle; const AText: string;
  const ATextW: WideString; const APMatrix: PFMatrix);
var
  vGlyph: TsgGlyph;
  I, vGlyphKey, vLength: Integer;
  vXOffset: Double;
  vIsUnicode: Boolean;
begin
  InitDrawGlyphsParams;
  vLength := GetTextLength(AText, ATextW, vIsUnicode);
  SetPolyFillMode(ADC, WINDING);
  vXOffset := 0;
  for I := 1 to vLength do
  begin
    vGlyphKey := GetTextChar(I, AText, ATextW, vIsUnicode);
    vGlyph := GetGlyph(vGlyphKey);
    vGlyph.Draw(ADC, vXOffset, APMatrix, FFillText);
    vXOffset := vXOffset + (vGlyph.FBox.Right - vGlyph.FBox.Left);
  end;
end;

//This function long becaus has operator 'case'
procedure TsgTextGlyph.InitKoef(ACanvas: TCanvas);
var
  otm: array [0..2] of TOutlineTextmetric;
begin
  GetOutlineTextMetrics(ACanvas.Handle, cnstSizeOfOutlineTextmetric, @otm[0]);
  case otm[0].otmPanoseNumber.bFamilyType of
    PAN_FAMILY_TEXT_DISPLAY:
      begin
        case otm[0].otmPanoseNumber.bXHeight of
          PAN_NO_FIT:  SetKoef(ACanvas, cnstSymbols[3]);
        else
          SetKoef(ACanvas, cnstSymbols[2]);
        end;
      end;
    PAN_FAMILY_SCRIPT:
      begin
        case otm[0].otmPanoseNumber.bArmStyle of
          PAN_STRAIGHT_ARMS_HORZ:  SetKoef(ACanvas, cnstSymbols[2]);
          PAN_STRAIGHT_ARMS_DOUBLE_SERIF:  SetKoef(ACanvas, cnstSymbols[1]);
        else
          SetKoef(ACanvas, cnstSymbols[2]);
        end;
      end;
    PAN_FAMILY_DECORATIVE:
      begin
        case otm[0].otmPanoseNumber.bArmStyle of
          PAN_BENT_ARMS_HORZ:  SetKoef(ACanvas, cnstSymbols[4]);
        else
          SetKoef(ACanvas, cnstSymbols[0]);
        end;
      end;
    PAN_FAMILY_PICTORIAL:
      begin
        case otm[0].otmPanoseNumber.bArmStyle of
          PAN_NO_FIT:  FKoef := cnstHeigthDef / otm[0].otmTextMetrics.tmAscent;
        else
          SetKoef(ACanvas, cnstSymbols[0]);
        end;
      end;
  else
    SetKoef(ACanvas, cnstSymbols[2]);
  end;
  FAbove := Abs(otm[0].otmAscent);
  FBelow := Abs(otm[0].otmDescent);
end;
//delete in future version
function TsgTextGlyph.GetBox(const AText: string; const APMatrix: PFMatrix;
  const APFontParams: PsgFontParams): TFRect;
begin
  Result := GetBoxW(AText, '', APMatrix, APFontParams);
end;

function TsgTextGlyph.GetBoxW(const AText: string; const ATextW: WideString;
  const APMatrix: PFMatrix; const APFontParams: PsgFontParams): TFRect;
var
  I, vGlyphKey, vLength: Integer;
  vOffset: TsgTTFPoint;
  vRez: TsgTTFRect;
  vIsUnicode: Boolean;
begin
  vOffset := cnstTTFPointZero;
  vRez := cnstTTFBadRect;
  vLength := GetTextLength(AText, ATextW, vIsUnicode);
  for I := 1 to vLength do
  begin
    vGlyphKey := GetTextChar(I, AText, ATextW, vIsUnicode);
    GetGlyph(vGlyphKey).UnionBoxAndMakeOffset(vRez, vOffset);
  end;
  Result := MakeFRect(vRez.Left, vRez.Top, 0, vRez.Right, vRez.Bottom, 0);
  TransRectCorners(Result, APMatrix^);
  if APFontParams <> nil then
  begin
    if vLength > 0 then
      APFontParams^ := GetFontParams(APMatrix)
    else
      APFontParams^ := cnstFontParamsZero;
  end;
end;

function TsgTextGlyph.GetGlyphParams(const AChar: Char; const AFontStyles: {$IFDEF SGFPC}Integer{$ELSE}Byte{$ENDIF};
  const APMatrix: PFMatrix; const AList: TList; const APBox: PFRect): Boolean;
var
  vGlyph: TsgGlyph;
begin
  Result := False;
  vGlyph := GetGlyph(Integer(AChar));
  if vGlyph <> nil then
  begin
    GetGlyphParamsInternal(vGlyph, TmvFontStyles(AFontStyles),
      APMatrix, AList, APBox);
    Result := True;
  end;
end;

function TsgTextGlyph.GetPolyPolylineW(const AText: string;
  const ATextW: WideString;  const AFontStyles: {$IFDEF SGFPC}Integer{$ELSE}Byte{$ENDIF};
  const APMatrix: PFMatrix; const AList, ABounds: TList;
  const AEpsilon: PFPoint = nil): Integer;
var
  vListOfGlyphKeys: TList;
begin
  vListOfGlyphKeys := nil;
  try
    Result := AddPolyPointOfText(AText, ATextW, vListOfGlyphKeys,
      TmvFontStyles(AFontStyles), APMatrix, AList, AEpsilon);
    if ABounds <> nil then
      AddBoundariesByGlyphs(vListOfGlyphKeys, APMatrix, ABounds);
  finally
    if vListOfGlyphKeys <> nil then
      vListOfGlyphKeys.Free;
  end;
end;

procedure TsgTextGlyph.LoadedW(const AText: string; const ATextW: WideString;
  const AFont: TFont);
var
  I, vGlypKey, vLength: LongInt;
  vDC: HDC;
  vCanvas: TCanvas;
  vIsUnicode: Boolean;
begin
  vLength := GetTextLength(AText, ATextW, vIsUnicode);
  vDC := GetDC(0);
  try
    vCanvas := TCanvas.Create;
    try
      vCanvas.Lock;
      try
        vCanvas.Handle := vDC;
        try
          vCanvas.Font := AFont;
          vCanvas.Font.Height := cnstHeigthDef;
          AddGlyph(vCanvas, False, cnstHiChar);
          AddGlyph(vCanvas, False, cnstLowChar);
          for I := 1 to vLength do
          begin
            vGlypKey := GetTextChar(I, AText, ATextW, vIsUnicode);
            AddGlyph(vCanvas, vIsUnicode, vGlypKey);
          end;
          if FKoef <= 0 then
            InitKoef(vCanvas);
        finally
          vCanvas.Handle := 0;
        end;
      finally
        vCanvas.Unlock;
      end;
    finally
      vCanvas.Free;
    end;
  finally
    ReleaseDC(0, vDC);
  end;
end;

procedure TsgTextGlyph.LoadedW(const AText: string; const ATextW: WideString;
  const AFontName: string; const AFontStyle: TFontStyles;
  const ACharSet: TFontCharset = cnstCharSetDef);
var
  vFont: TFont;
begin
  vFont := TFont.Create;
  try
    vFont.Name := AFontName;
    vFont.Style := AFontStyle;
    vFont.Charset := ACharSet;
    LoadedW(AText, ATextW, vFont);
  finally
    vFont.Free;
  end;
end;

procedure TsgTextGlyph.SetFontParams(const AFont: TFont);
begin
  SetFontParams(GetNameOfFont(AFont), AFont.Style);
end;

procedure  TsgTextGlyph.SetFontParams(const AFontName: string;
  const AFontStyle: TFontStyles);
begin
  FFontName := AFontName;
  FFontStyle := AFontStyle;
end;

initialization
  cnstGlyphOutlineMatrix.eM11.value := 1;
  cnstGlyphOutlineMatrix.eM22.value := 1;
  DrawGlyphPts := nil;
  DrawGlyphPtsCount := nil;
  Generator := nil;
  SetQualityApproximation(cnstDefaultQualityApproximation);
  InitRegKeyMicrosoftWindows;
  InitDirOfWinFonts;
  @GetFontResourceInfo := GetProcAddress(GetModuleHandle(gdi32), 'GetFontResourceInfoW');
  TableFonts := TsgTableFonts.Create;
  ContainerOfTextGlyphs := TsgContainerOfTextGlyphs.Create;
  GDIAdapter := TsgGDIAdapter.Create;

finalization
  FreeAndNil(ContainerOfTextGlyphs);
  FreeAndNil(DrawGlyphPts);
  FreeAndNil(DrawGlyphPtsCount);
  FreeAndNil(GDIAdapter);
  FreeAndNil(TableFonts);
  FreeAndNil(Generator);
  FreeFontList;

end.
