{************************************************************}
{                   Delphi VCL Extensions                    }
{                                                            }
{                     SHX fonts class                        }
{                                                            }
{      Copyright (c) 2002-2013 SoftGold software company     }
{                                                            }
{************************************************************}
unit SHX;
{$INCLUDE SGDXF.INC}
interface

uses
  Classes, SysUtils, sgConsts, IniFiles, MVFont, sgFunction
{$IFDEF SGDEL_XE4}
  , AnsiStrings
{$ENDIF}
  ;

type
   PsgSHXRecord = ^TsgSHXRecord;
   TsgSHXRecord = record
     ShapeNumber: Word;   // shape number
     DefBytes: Word ;     // number of data bytes in shape, 2000 max
     ShapeName: string;   // pointer to shapename
     BytesPos: Cardinal;  // position of SapeBytes in the file
     ShapeBytes: PAnsiChar;
     ShapePoly:  TList;
     ShapePolyVert:  TList;   // for Vertical text
     Xoff, Yoff, Scaleoff: Double;
     FirstDown, LastDown:  Double;
     Top, Bottom: Double;
   end;

  TsgTextGeneration = (ttNormal, ttBackward, ttUpSideDown);


  PsgSHXVertex = ^TsgSHXVertex;
  TsgSHXVertex = record
    X, Y: Double;
    Bulge: Double;
    PenDown: Boolean;
  end;

  PsgTextStyle = ^TsgTextStyle;
  TsgTextStyle = record
    FontPath: string;
    BigFontPath: string;
    Name: string;
    TextGeneration: TsgTextGeneration;
    ObliqueAngle: Double;
    Width: Double;
    Vertical: Boolean;
    UpSideDown: Boolean;
    Backwards:  Boolean;
    FontIndex: Integer;
    BigFontIndex: Integer;
    FontExists: Boolean;
  end;

  TsgSHXKinds = (tkNormSHX, tkBigSHX, tkUnicodeSHX, tkUndefined);

  TsgSHXFont = class
  private
    FIsShape: Boolean;
    FLineFeed: Double;
    FAbove: Integer;
    FBelow: Integer;
    FName: string;
    FNumChars: Word;
    FKind: TsgSHXKinds;
    FModes: Byte;
    FEmbtype: Byte;
    FEncoding: Byte;
    FShapes: TList;
    NBigFontRanges: word;
    FExtndBig : boolean;
    FCharHeight: byte;
    FCharWidth: byte;
    BigFontRanges: array [1..64,1..2] of Word;
    FixedTable: array [1..255] of Byte;
    procedure ClearFixedTable;
    procedure CleareShapes;
    function ConvertPolyToShape(ShapeBytes: PAnsiChar; ShapePoly: TList): Word;
    function FindShape(var N: Word; var Name: string): Boolean;
    function FindSymbol(N: word): Integer;
    function GetName: string;
    function SetShapeName(P: PsgSHXRecord): Integer;
    procedure ParseBigSHX(AStream: TStream);
    procedure ParseNormSHX(AStream: TStream);
    procedure ParseUnicodeSHX(AStream: TStream);
    procedure ReadUnicodeSHX(N: Word);
    procedure ReadNormSHX(N: Word);
    procedure ReadBigSHX(N: Word);
    procedure PrepareShapes;
    function ProcessSymb(N: Word; var InsX, InsY, Scale: Double;
      Vert, Backward: Boolean; Poly: TList): Boolean;
    function SubSymb(N: Word; var InsX, InsY, Scale: Double; Vert, Backward: Boolean;
      Poly: TList): Boolean;
    function ExtSubSymb(N: Word; var InsX, InsY, Scale : Double;
       CharWidth, CharHeight : byte;
       Vert, Backward: Boolean; Poly: TList): Boolean;
    function GetAbove: Integer;
    function GetLineFeed: Double;
    function GetBelow: Integer;
    function GetNumChars: Word;
    function GetLoaded: Boolean;
    function GetShapes: TList;
  protected
    function BigFontInRange( c : byte): boolean;
    function BigFontWordInRange( c : word): boolean;
    function HasPairSymbol(ASym1, ASym2: Byte): Boolean;
    function HasPairSymbolWord(ASymbol: Word): Boolean;
  public
    constructor Create(const AFontPath: string);
    destructor Destroy; override;
    procedure AddNewShape(ShapeNumber: Word; const ShapeName: string; ShapePoly: TList);
    procedure SaveAs(const FName: string);
    function GetSymbol(Symb: Word; InX, InY: Double; Vert, Backward, Underscore, Overscore: Boolean;
      Poly: TList; var OutX, OutY: Double): Boolean;
    function GetScaledSymbol(Symb: Word; InX, InY, Scale: Double; Vert, Backward, Underscore, Overscore: Boolean;
      Poly: TList; var OutX, OutY: Double): Boolean;
    function Load: Boolean;
    property LineFeed: Double read GetLineFeed;
    property Above: Integer read GetAbove;
    property Below: Integer read GetBelow;
    property Loaded: Boolean read GetLoaded;
    property Name: string read GetName;
    property NumChars: Word read GetNumChars;
    property Shapes: TList read GetShapes;
  end;

{$IFNDEF SGDEL_6}
  THashedStringList = class(TsgStringList);
{$ENDIF}

  TsgSHXFontList = class
  private
    FDefaultFontName: string;
    FDefaultFont:  TsgSHXFont;
    FDefaultFontPath: string;
    FFonts: THashedStringList;
    FShapeFonts: TStringList;
    FStyles: TStringList;
    FSearchPath: TStringList;
    FMissedFonts: Tstringlist;
    FSubstFonts:Tstringlist;
    function GetDefaultFont: TsgSHXFont;
    function GetFonts: TStringList;
    function GetSearchPath: TStringList;
    function GetMissedFonts: TStringList;
    function GetStyles: TStringList;
    function GetDefaultFontPath: string;
    procedure SetDefaultFontPath(const Value: string);
  public
    constructor Create(const ASearchPath, ADefault: string);
    destructor  Destroy; override;
    function AddStyle(const AName, AFontName, ABigFontName: string; AVertical, AUpSideDown,
      ABackwards: Boolean; AObliqueAngle, AWidth: Double):PsgTextStyle;

    function AddFont(const AFontName: string):TsgSHXFont;
    function AddNewFont(const AFontName: string):TsgSHXFont;
    procedure SetSubstFonts(ASubstFonts: TStrings);
    property DefaultFont: TsgSHXFont read GetDefaultFont;
    property DefaultFontPath: string read GetDefaultFontPath write SetDefaultFontPath;
    property Fonts: TStringList read GetFonts;
    property Styles: TStringList read GetStyles;
    property SearchPath: TStringList read GetSearchPath;
    property MissedFonts: TStringList read GetMissedFonts;
  end;


procedure GetSHXText(ASHXStyles: TsgSHXFontlist; const Style: string; Text: sgRawByteString;
  WideText: WideString; CodePage: Integer; Poly: TList;
  Fstyle: TmvFontStyles;
  var Above, Below, Left, Bottom, Right, Top: Double);

procedure DrawSHXText(ASHXStyles: TsgSHXFontlist; const Font: string; Text: sgRawByteString;
  WideText: WideString; CodePage: Integer; Vertical, Backward: Boolean; Poly: TList;
  Fstyle: TmvFontStyles;
   var Above, Below, Left, Bottom, Right, Top: Double);

procedure GetSHXTextFromStyle(ASHXStyles: TsgSHXFontlist; PStyle : PsgTextStyle; Text: sgRawByteString;
          WideText: WideString; CodePage: Integer; Vertical, Backward: Boolean; Poly: TList;
          Fstyle: TmvFontStyles;
           var Above, Below, Left, Bottom, Right, Top: Double);

procedure GetSHXTextBox(ASHXStyles: TsgSHXFontlist; const Style: string;
  const Text: sgRawByteString; const WideText: WideString; CodePage: Integer; Vertical: Boolean;
  Fstyle: TmvFontStyles;
  var Above, Below, Width, Height, RealLeft, RealBottom, RealRight, RealTop,
  After: Double);

procedure DrawSHXTextBox(ASHXStyles: TsgSHXFontlist;  const Font: string;
  const Text: sgRawByteString; const WideText: WideString; CodePage: Integer; Vertical: Boolean;
  Fstyle: TmvFontStyles;
  var Above, Below, Width, Height, RealLeft, RealBottom, RealRight, RealTop,
  After: Double);

procedure GetSHXTextBoxFromStyle(ASHXStyles: TsgSHXFontlist; PStyle : PsgTextStyle;
   const Text: sgRawByteString; const WideText: WideString; CodePage: Integer; Vertical: Boolean;
   Fstyle: TmvFontStyles;
   var Above, Below, Width, Height, RealLeft, RealBottom, RealRight, RealTop,
   After: Double);

function IsUnicodeSHX(ASHXStyles: TsgSHXFontlist; PStyle: PsgTextStyle; const AFontName: string): Boolean;

procedure SHXFreePoly(var Poly: TList);

function FindShape(ASHXStyles: TsgSHXFontlist; var ShapeNumber: Word; var ShapeName, FontName: string): Boolean;

procedure RefreshHashLists;

function GetSHXKind(const AStream: TStream; var ASHXKind: TsgSHXKinds): Boolean; overload;
function GetSHXKind(const AFileName: string; var ASHXKind: TsgSHXKinds): Boolean; overload;
// for tkNormSHX only
function IsShapeSHX(const AStream: TStream): Boolean; overload;
function IsShapeSHX(const AFileName: string): Boolean; overload;

implementation

uses
  Math, Windows;

const
  cnstXOffsetKoef = 0.150;
  cnstYOffsetKoef = 0.200;
  MAX_SHAPE_LEN = 2000 + 1;
  MAX_FONTNAME_LEN = 129;
  head1: PAnsiChar = 'AutoCAD-86 shapes 1.1';
  head2: PAnsiChar = 'AutoCAD-86 shapes 1.0';
  head3: PAnsiChar = 'AutoCAD-86 bigfont 1.0';
  head4: PAnsiChar = 'AutoCAD-86 unifont 1.0';

var
  DirExistsList: TStringList = nil;
  FileExistsList: TStringList = nil;

function CreateList: TStringList;
begin
  Result := TStringList.Create;
  Result.Sorted := True;
  Result.Duplicates := dupIgnore;
end;

function GetItemExists(var AStringList: TStringList; const AName: string;
  var AResult: Boolean): Boolean;
var
  vIndex: Integer;
begin
  Result := False;
  if AStringList = nil then
  begin
    AStringList := TStringList.Create;
    AStringList.Sorted := True;
    AStringList.Duplicates := dupIgnore
  end;
  vIndex := AStringList.IndexOf(AName);
  if vIndex > -1 then
  begin
    AResult := Boolean(AStringList.Objects[vIndex]);
    Result := True;
  end;
end;

function GetSHXKind(const AFileName: string; var ASHXKind: TsgSHXKinds): Boolean;
var
  vStream: TStream;
begin
  ASHXKind := tkUndefined;
  vStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
  try
    Result := GetSHXKind(vStream, ASHXKind);
  finally
    vStream.Free;
  end;
end;

function GetSHXKind(const AStream: TStream; var ASHXKind: TsgSHXKinds): Boolean;
var
  vLen: Integer;
  vHeader: array[0 .. MAX_FONTNAME_LEN] of AnsiChar;
begin
  ASHXKind := tkUndefined;
  Result := True;
  try
    AStream.Read(vHeader, MAX_FONTNAME_LEN);
    vLen := {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrLen(head1);
    if ({$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrLComp(vHeader , head1, vLen) = 0) or ({$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrLComp(vHeader, head2, vLen) = 0) then
      ASHXKind := tkNormSHX
    else
      if {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrLComp(vHeader, head3, {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrLen(head3)) = 0 then
        ASHXKind := tkBigSHX
      else
        if {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrLComp(vHeader, head4, {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrLen(head4)) = 0 then
          ASHXKind := tkUnicodeSHX
        else
          Result := False;
  except
    Result := False;
  end;
end;

function IsShapeSHX(const AStream: TStream): Boolean;
var
  I: Integer;
  vNumChars: Word;
  ShapeNumber: Cardinal;
begin
  Result := True;
  AStream.Seek($1C, soFromBeginning);
  AStream.Read(vNumChars, SizeOf(vNumChars));
  I := 0;
  while (I < vNumChars) and Result do
  begin
    AStream.Read(ShapeNumber, SizeOf(ShapeNumber));
    if Word(ShapeNumber) = 0 then
      Dec(Result)
    else
      Inc(I);
  end;
end;

function IsShapeSHX(const AFileName: string): Boolean;
var
  vStream: TStream;
begin
  vStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
  try
    Result := IsShapeSHX(vStream);
  finally
    vStream.Free;
  end;
end;

function IsDirExists(const ADirectory: string): Boolean;
var
  vFileAtrs: Integer;
begin
  if not GetItemExists(DirExistsList, ADirectory, Result) then
  begin
    vFileAtrs := GetFileAttributes(PChar(ADirectory));
    Result := (vFileAtrs <> -1) and (FILE_ATTRIBUTE_DIRECTORY and vFileAtrs <> 0);
    DirExistsList.AddObject(ADirectory, TObject(Result));
  end;
end;

function sgFileExists(const AFileName: string): Boolean;
begin
  if not GetItemExists(FileExistsList, AFileName, Result) then
  begin
    Result := FileExists(AFileName);
    FileExistsList.AddObject(AFileName, TObject(Result));
  end;
end;

procedure RefreshHashLists;
var
  I: Integer;
  vValues: TStringList;
begin
  vValues := TStringList.Create;
  try
    if DirExistsList <> nil then
    begin
      vValues.Assign(DirExistsList);
      DirExistsList.Clear;
      for I := 0 to vValues.Count - 1 do
        IsDirExists(vValues[I]);
    end;
    if FileExistsList <> nil then
    begin
      vValues.Assign(FileExistsList);
      FileExistsList.Clear;
      for I := 0 to vValues.Count - 1 do
        sgFileExists(vValues[I]);
    end;
  finally
    vValues.Free;
  end;
end;

procedure SetsgFileExists(const AFileName: string; const AValue: Boolean);
var
  vIndex: Integer;
begin
  if FileExistsList <> nil then
  begin
    vIndex := FileExistsList.IndexOf(AFileName);
    if vIndex > -1 then
      FileExistsList.Objects[vIndex] := TObject(AValue);
  end;
end;

function Max(A,B: Extended): Extended;
begin
  if A > B then
    Result := A
  else
    Result := B;
end;

function Min(A,B: Extended): Extended;
begin
  if A < B then
    Result := A
  else
    Result := B;
end;

function SymbolCompare(Item1,Item2:pointer) : integer;
begin
  if PsgSHXRecord(Item1).ShapeNumber > PsgSHXRecord(Item2).ShapeNumber then Result := 1
  else if PsgSHXRecord(Item1).ShapeNumber = PsgSHXRecord(Item2).ShapeNumber then Result := 0
  else Result := -1;
end;

function Find(AStringList: TStringList; const S: string;
  var Index: Integer): Boolean;
var
  I: Integer;
  CS, TS: string;
begin
  Result := False;
  Index := -1;
  CS := AnsiUpperCase(S);
  TS := ExtractFileName(CS);
  if CS <> TS then
  begin
    for I := 0 to AStringList.Count - 1 do
      if AnsiUpperCase(AStringList[I]) = CS then
      begin
        Result := True;
        Index := I;
        Exit;
      end;
  end
  else
  begin
    CS := ChangeFileExt(CS, '.SHX');
    for I := 0 to AStringList.Count - 1 do
      if ExtractFileName(AnsiUpperCase(AStringList[I])) = CS then
      begin
        Result := True;
        Index := I;
        Exit;
      end;
  end;
end;

procedure SHXFreePoly(var Poly: TList);
var J : integer;
begin
  if Poly = nil then Exit;
  for J := 1 to  Poly.Count do
    Dispose(Poly[J-1]);
  Poly.Free;;
  Poly := nil;
end;

function TextToWidestring(Font, BigFont : TsgSHXFont; const Text: sgRawByteString;
  const WideText: WideString;var IsBig: Boolean): WideString;
var
  I,K: Integer;
  N: word;
begin
  Result := '';
  IsBig := False;
  if Text <> '' then
  begin
    K := Length(Text);
    if (BigFont<>nil) and (not BigFont.FExtndBig) then
    begin
      I := 1;
      while I <= K do
      begin
        if (I < K) and BigFont.HasPairSymbol(Ord(Text[I]), Ord(Text[I+1])) then
        begin
           N := 256 * Ord(Text[I])  +  Ord(Text[I+1]);
           Result := Result + '1';
           Result := Result + WideString(WideChar(n));
           I := I + 2;
           IsBig := True;
        end
        else
        begin
           Result := Result + '0';
           Result := Result + WideString(WideChar(Text[I]));
           inc(I);
        end;
     end
    end
    else
      for I := 1 to K do
      begin
        Result := Result + '0';
        Result := Result + WideString(WideChar(Text[I]));
      end
  end
  else
  begin
    K := length(WideText);
    if  (BigFont<>nil)  and (not BigFont.FExtndBig) then
    begin
      i:=1;
      while I <= K do
      begin
        if BigFont.HasPairSymbolWord(Word(WideText[I])) then
        begin
          Result := Result + '1';
          Result := Result + WideString(WideText[I]);
          I := I + 1;
          IsBig := True;
        end
        else
        begin
          Result := Result + '0';
          Result := Result + WideString(WideText[I]);
          inc(I);
        end;
     end
    end
    else
       for I := 1 to K do
       begin
         Result := Result + '0';
         Result := Result + WideString(WideText[I]);
       end
  end;
end;

{$IFDEF SGDEL_2009}
function ChangeUnicodeSymbolsCodes(AFont, ABigFont: TsgSHXFont;
  AText: WideString; CodePage: Integer): WideString;
var
  I, K, res: Integer;
  S: AnsiString;
begin
  K := Length(AText);
  if (ABigFont <> nil)  and (not ABigFont.FExtndBig) then
  begin
    I := 1;
    while I <= K do
    begin
      res := WideCharToMultiByte(CodePage, 0, @AText[I], 1, nil, 0, '*', nil);
      if res > 0 then
      begin
        SetLength(S, res);
        SetCodePage(RawByteString(S), CodePage, False);
        WideCharToMultiByte(CodePage, 0, @AText[I], 1, @S[1], res, '*', nil);
      end;
      if ABigFont.BigFontInRange(Ord(S[1])) then
        if Length(S) > 1 then
          Result := Result + Char(Word(256 * Ord(S[1]) + Ord(S[2])))
        else
          Result := Result + Char(Word(Ord(S[1])))
      else
        Result := Result + AText[I];
      inc(I);
   end
  end
  else
    Result := AText;
end;
{$ENDIF}

function BigFontOnly(Font, BigFont : TsgSHXFont; const Text: sgRawByteString;
  const WideText: WideString): Boolean;
var
  I,K: Integer;
begin
  Result := False;
  if BigFont=nil then Exit;
  if Text <> '' then
  begin
    K := Length(Text);
    if not BigFont.FExtndBig then
    begin
      I := 1;
      while I < K do
      begin
        if BigFont.HasPairSymbol(Ord(Text[I]), Ord(Text[I + 1])) then
        begin
          Result := True;
          Exit;
        end
        else
          Inc(I);
     end
    end
  end
  else
  begin
    K := Length(WideText);
    if not BigFont.FExtndBig then
    begin
      I := 1;
      while I <= K do
      begin
        if BigFont.HasPairSymbolWord(Word(WideText[I])) then
        begin
          Result := True;
          Exit;
        end
        else
          Inc(I);
      end
    end;
  end;
end;

procedure SetAboveBellow(const Font, BigFont: TsgSHXFont; const Big: Boolean;
  var Above, Below: Double);
begin
  if (not Big) or (BigFont=nil)  then
  begin
    Above := Font.FAbove;
    Below := Font.FBelow;
  end
  else
  begin
    Above := BigFont.FAbove;
    Below := BigFont.FBelow;
    if Above = 0 then
      Above := Font.Above;
    if Below = 0 then
      Below := Font.Below;
  end;
end;

procedure ProcTextBox(Font, BigFont : TsgSHXFont; const Text: sgRawByteString;
  const WideText: WideString; Vertical: Boolean;
  Fstyle : TmvFontStyles;
  var Above, Below, Width, Height, RealLeft, RealBottom, RealRight, RealTop,
  After: Double);
var
  I, K, J: Integer;
  N: Word;
  XX, XXD, DXL, DXM, DXR, X, Y, Sn, Sb, SW: Double;
  P: PsgSHXRecord;
  Poly: TList;
  WT: WideString;
  FFont: TsgSHXFont;
  Fbig: Boolean;
  Underscore, Overscore: Boolean;
begin
  Above := 0;
  Below := 0;
  Width := 0;
  Height := 0;
  RealLeft := 0;
  RealBottom := 0;
  RealRight := 0;
  RealTop := 0;
  After := 0;
  SW := 1;

  Underscore := fmUnderline in FStyle;
  Overscore  := fmStrikeOut in FStyle;
  if (Text='') and (WideText='') then Exit;
  WT := TextToWidestring(Font,BigFont, Text,WideText, Fbig);
  if Fbig then Sb :=  BigFont.Above / Font.Above
  else Sb := 1;
  K := Length(WT) div 2;
  XX := 0;
  XXD := 0;
  if not Vertical then
  begin
    RealBottom := 1e5;
    RealTop := -1e5;


    for I := 1 to K do
    begin
      Sn := 1;
      N:= Word(WT[I*2]);
      if (WT[i*2-1]='0') or (BigFont=nil) then
      begin
        FFont := Font;
        if Fbig then Sn := Sb;
      end
      else
        FFont := BigFont;
      J := FFont.FindSymbol(N);
      if J < 0 then
      begin
        J := Font.FindSymbol(Ord('?'));
        FFont := Font;
      end;
      if J < 0 then continue;
      P := FFont.FShapes[J];
      Poly := P^.ShapePoly;
      if (Poly = nil) then
      begin
         X := 0;
         Y := 0;
         Poly := Tlist.Create;
         if not FFont.GetSymbol(J, X, Y, Vertical, False, Underscore, Overscore, Poly, X, Y) then
         begin
           SHXFreePoly(Poly);
           Continue;
         end
         else SHXFreePoly(Poly);
      end;
      if (P^.Xoff<0) and (Abs(P^.Xoff)>1E-2) then
      begin
        RealBottom := Min(RealBottom, P^.Bottom * Sn);
        if Underscore then RealBottom := Min(RealBottom, (-cnstYOffsetKoef*Font.Above)*Sn);
        RealTop := Max(RealTop, P^.Top * Sn);
        if Overscore then RealTop := Max(RealTop, Font.Above * (1 + cnstYOffsetKoef)*Sn);
        {if (P^.Xoff>= 0) then  XX := 1 else}
        SW := -1;
        if (N = 32) and (I = 1) then
        begin
          DXR := Max(0,P^.Xoff) * Sn;
          DXL := Min(0,P^.Xoff) * Sn;
          if DXR > 0  then
          begin
             RealLeft := 0;
             RealRight := DXR;
             After := RealRight;
          end
          else
            RealLeft := DXL;
        end
        else
        if (N = 32) and (I = K) then
        begin
          DXR := Max(0,P^.Xoff) * Sn;
          DXL := Min(0,P^.Xoff) * Sn;
          if DXR > 0  then
          begin
            RealRight := RealRight + DXR;
            After :=  RealRight;
          end
          else    RealLeft := RealLeft + DXL;
        end
        else  if I = K then
        begin
          DXM := P^.Xoff * Sn;
          DXR := P^.LastDown * Sn;
          if DXM>0 then
          begin
            RealRight := RealRight + DXR;
            After := RealRight +Max(DXM,DXR);
          end
          else
          begin
            DXL := P^.FirstDown * Sn;
            RealLeft := RealLeft + DXL;
          end;
        end
        else
        begin
          DXM := P^.Xoff * Sn;
          if DXM < 0 then RealLeft := RealLeft + DXM
          else  RealRight := RealRight + DXM;
        end;
      end
      else
      begin
        SW := 1;
        if (N = 32) and ((I = 1) or (I = K)) then
        begin
          DXR := P^.Xoff * Sn;
          DXL := 0;
          DXM := DXR ;
        end
        else
        begin
          DXM := P^.LastDown * Sn;
          DXR := Max(P^.Xoff * Sn, DXM);
          DXL := P^.FirstDown * Sn;
        end;
        if I = 1 then
        begin
          RealLeft := DXL ;
          XX := DXR ;
          XXD := DXR ;
          After := XX;
          RealRight := DXM;
        end
        else if I = K then
        begin
          XX := XX + DXR ;
          XXD := XXD + DXM;
          RealRight := XXD;
          After := XX;
        end
        else
        begin
          XX := XX + DXR;
          XXD := XXD + DXR;
        end;
        RealBottom := Min(RealBottom, P^.Bottom * Sn);
        if Underscore then RealBottom := Min(RealBottom, (-cnstYOffsetKoef*Font.Above)*Sn);
        RealTop := Max(RealTop, P^.Top * Sn);
        if Overscore then RealTop := Max(RealTop, Font.Above * (1 + cnstYOffsetKoef)*Sn);
      end;
    end;
    if SW<0 then Width := (RealRight - RealLeft)*SW
    else Width := XXD;
    Height := RealTop - RealBottom;
  end
  else
  begin
    RealLeft := 1e05;
    RealRight := -1e05;
    for I := 1 to K do
    begin
      Sn := 1;
      N:= Word(WT[I*2]);
      if WT[i*2-1]='0' then
      begin
        FFont := Font;
        if Fbig then Sn := Sb;
      end
      else
        FFont := BigFont;
      J := Font.FindSymbol(N);
      if J < 0 then
      begin
        J := Font.FindSymbol(Ord('?'));
        FFont := Font;
      end;
      if J < 0 then continue;
      P := FFont.FShapes[J];
      Poly := P^.ShapePolyVert;
      if Poly = nil then
      begin
         X := 0;
         Y := 0;
         Poly := Tlist.Create;
         if not FFont.GetSymbol(J, X, Y, Vertical, False,Underscore, Overscore, Poly, X, Y) then
         begin
           SHXFreePoly(Poly);
           Continue;
         end
         else SHXFreePoly(Poly);
      end;
      RealLeft := Min(RealLeft, P^.FirstDown*Sn);
      RealRight := Max(RealRight, P^.LastDown*Sn);
      RealBottom := RealBottom + P^.Yoff;
    end;
    Width := RealRight - RealLeft;
    Height := RealTop - RealBottom;
  end;
  SetAboveBellow(Font, BigFont, FBig, Above, Below);
end;

procedure GetSHXTextBox(ASHXStyles: TsgSHXFontlist; const Style: string;
  const Text: sgRawByteString; const WideText: WideString; CodePage: Integer; Vertical: Boolean;
  FStyle: TmvFontStyles;
  var Above, Below, Width, Height, RealLeft, RealBottom, RealRight, RealTop,
  After: Double);
var
  I: Integer;
  vFnt, vBigFnt: TsgSHXFont;
  St: PsgTextStyle;
  vConvString: WideString;
begin
  I := -1;
  if not Find(ASHXStyles.Styles, Style, I) then Exit;
  St := PsgTextStyle(ASHXStyles.Styles.Objects[I]);

  vFnt := ASHXStyles.Fonts.Objects[St.FontIndex] as TsgSHXFont;
  if vFnt = nil then
  begin
    vFnt := TsgSHXFont.Create(St.FontPath);
    ASHXStyles.Fonts.AddObject(St.FontPath, vFnt);
    if not vFnt.Load then Exit;
  end
  else
    if not vFnt.Loaded then
    begin
      vFnt.FName := St.FontPath;
      if not vFnt.Load then Exit;
    end;
  if St.BigFontIndex < 0 then vBigFnt := nil
  else
  begin
    vBigFnt := ASHXStyles.Fonts.Objects[St.BigFontIndex] as TsgSHXFont;
    if vBigFnt = nil then
    begin
      vBigFnt := TsgSHXFont.Create(St.BigFontPath);
      ASHXStyles.Fonts.AddObject(St.BigFontPath, vFnt);
      if not vBigFnt.Load then Exit;
    end
    else
      if not vBigFnt.Loaded then
      begin
        vBigFnt.FName := St.BigFontPath;
        if not vBigFnt.Load then Exit;
      end;
   end;
{$IFDEF SGDEL_2009}
  vConvString := ChangeUnicodeSymbolsCodes(vFnt, vBigFnt, WideText, CodePage);
{$ELSE}
  vConvString := WideText;
{$ENDIF}
  ProcTextBox(vFnt,vBigFnt, Text, vConvString, St.Vertical, FStyle,
    Above, Below, Width, Height, RealLeft, RealBottom, RealRight, RealTop, After);
end;

procedure GetSHXTextBoxFromStyle(ASHXStyles: TsgSHXFontlist; PStyle : PsgTextStyle;
   const Text: sgRawByteString; const WideText: WideString; CodePage: Integer; Vertical: Boolean;
   FStyle: TmvFontStyles;
   var Above, Below, Width, Height, RealLeft, RealBottom, RealRight, RealTop,
   After: Double);
var
  vFnt, vBigFnt: TsgSHXFont;
  vConvString: WideString;
begin
  vFnt := ASHXStyles.Fonts.Objects[Pstyle.FontIndex] as TsgSHXFont;
  if vFnt = nil then
  begin
    vFnt := TsgSHXFont.Create(Pstyle.FontPath);
    ASHXStyles.Fonts.AddObject(Pstyle.FontPath, vFnt);
    if not vFnt.Load then Exit;
  end
  else
    if not vFnt.Loaded then
    begin
      vFnt.FName := Pstyle.FontPath;
      if not vFnt.Load then Exit;
    end;
  if Pstyle.BigFontIndex < 0 then vBigFnt := nil
  else
  begin
    vBigFnt := ASHXStyles.Fonts.Objects[Pstyle.BigFontIndex] as TsgSHXFont;
    if vBigFnt = nil then
    begin
      vBigFnt := TsgSHXFont.Create(Pstyle.BigFontPath);
      ASHXStyles.Fonts.AddObject(Pstyle.BigFontPath, vFnt);
      if not vBigFnt.Load then Exit;
    end
    else
      if not vBigFnt.Loaded then
      begin
        vBigFnt.FName := Pstyle.BigFontPath;
        if not vBigFnt.Load then Exit;
      end;
   end;
{$IFDEF SGDEL_2009}
  vConvString := ChangeUnicodeSymbolsCodes(vFnt, vBigFnt, WideText, CodePage);
{$ELSE}
  vConvString := WideText;
{$ENDIF}
  ProcTextBox(vFnt,vBigFnt, Text, vConvString, Pstyle.Vertical,  Fstyle,
    Above, Below, Width, Height, RealLeft, RealBottom, RealRight, RealTop, After);
end;


procedure DrawSHXTextBox(ASHXStyles: TsgSHXFontlist;  const Font: string;
  const Text: sgRawByteString; const WideText: WideString; CodePage: Integer; Vertical: Boolean;
  Fstyle: TmvFontStyles;
  var Above, Below, Width, Height, RealLeft, RealBottom, RealRight, RealTop,
  After: Double);
var
  I, J: Integer;
  vFnt: TsgSHXFont;
  S: string;
  vConvString: WideString;
begin
  S := '';
  Find(ASHXStyles.Fonts, Font, I);
  if I < 0 then
  begin
    for J := 0 to ASHXStyles.SearchPath.Count - 1 do
    begin
      if sgFileExists(ASHXStyles.SearchPath[J] + AnsiUpperCase(Font)) then
      begin
        S := ASHXStyles.SearchPath[J] + AnsiUpperCase(Font);
        Break;
      end;
    end;
    if S = '' then
      S := ASHXStyles.DefaultFontPath;
    vFnt := TsgSHXFont.Create(S);
    if not vFnt.Load then
    begin
      vFnt.Free;
      Exit;
    end;
    ASHXStyles.Fonts.AddObject(AnsiUpperCase(Font), vFnt);
  end
  else
    vFnt := ASHXStyles.Fonts.Objects[I] as TsgSHXFont;
  if vFnt = nil then Exit;
{$IFDEF SGDEL_2009}
  vConvString := ChangeUnicodeSymbolsCodes(vFnt, nil, WideText, CodePage);
{$ELSE}
  vConvString := WideText;
{$ENDIF}
  ProcTextBox(vFnt, nil, Text, vConvString, Vertical, Fstyle,
    Above, Below, Width, Height, RealLeft, RealBottom, RealRight, RealTop, After);
end;


procedure ProcText(Font, BigFont : TsgSHXFont; const Text: sgRawByteString;
  const WideText: WideString; Vertical: Boolean; Backward: Boolean;
  Fstyle: TmvFontStyles;
  var X, Y: Double; Poly: TList; var Fbig: boolean);
var
  I,K: Integer;
  N: word;
  IsBig: boolean;
  Underscore, Overscore: Boolean;
begin
  Underscore := fmUnderline in Fstyle;
  Overscore  := fmStrikeOut in Fstyle;
  X := 0;
  Y := 0;
  Fbig := False;
  IsBig := False;
  if (BigFont<>nil) then IsBig := BigFontOnly(Font,BigFont, Text,WideText);
  if Text <> '' then
  begin
    K := Length(Text);
    if (BigFont<>nil) and (not BigFont.FExtndBig) then
    begin
      I := 1;
      while I <= K do
      begin
        if (I < K) and BigFont.HasPairSymbol(Ord(Text[I]), Ord(Text[I+1])) then
        begin
          if I < K then
          begin
             N := 256 * Ord(Text[I])  +  Ord(Text[I+1]);
             I := I + 2;
             Fbig := True;
             if not BigFont.GetSymbol(N, X, Y, Vertical, Backward, Underscore, Overscore, Poly, X, Y) then
               Font.GetScaledSymbol(Ord('?'), X, Y, BigFont.Above / Font.Above,
                 Vertical, Backward, Underscore, Overscore, Poly, X, Y)
          end
          else begin
            inc(I);
            if IsBig then
            begin
              N := Ord(Text[I-1]);
              if not Font.GetScaledSymbol(N, X, Y, BigFont.Above / Font.Above,  Vertical,Backward, Underscore, Overscore, Poly, X, Y)
              then Font.GetScaledSymbol(Ord('?'), X, Y, BigFont.Above / Font.Above, Vertical, Backward, Underscore, Overscore, Poly, X, Y)
            end
            else
            begin
              N := Ord(Text[I-1]);
             if not Font.GetSymbol(N, X, Y, Vertical,  Backward, Underscore, Overscore, Poly, X, Y) then
                Font.GetSymbol(Ord('?'), X, Y, Vertical,  Backward, Underscore, Overscore, Poly, X, Y);
            end;
          end;
        end
        else
        begin
            inc(I);
            if IsBig then
            begin
              N := Ord(Text[I-1]);
              if not Font.GetScaledSymbol(N, X, Y, BigFont.Above / Font.Above,  Vertical,Backward, Underscore, Overscore, Poly, X, Y)
              then Font.GetScaledSymbol(Ord('?'), X, Y, BigFont.Above / Font.Above, Vertical, Backward, Underscore, Overscore, Poly, X, Y)
            end
            else
            begin
              N := Ord(Text[I-1]);
             if not Font.GetSymbol(N, X, Y, Vertical,  Backward, Underscore, Overscore, Poly, X, Y) then
                Font.GetSymbol(Ord('?'), X, Y, Vertical,  Backward, Underscore, Overscore, Poly, X, Y);
            end;
        end
     end
    end
    else
    for I := 1 to K do
    begin
      N := Ord(Text[I]);
      if not Font.GetSymbol(N, X, Y, Vertical, Backward, Underscore, Overscore, Poly, X, Y) then
        Font.GetSymbol(Ord('?'), X, Y, Vertical, Backward, Underscore, Overscore, Poly, X, Y)
    end;
  end
  else
  begin
    K := length(WideText);
    if  (BigFont<>nil)  and (not BigFont.FExtndBig) then
    begin
      i:=1;
      while I <= K do
      begin
        if BigFont.HasPairSymbolWord(Word(WideText[I])) then
        begin
           N := Word(WideText[I]);
           I := I + 1;
           Fbig := True;
           if not BigFont.GetSymbol(N, X, Y, Vertical, Backward, Underscore, Overscore, Poly, X, Y) then
             Font.GetScaledSymbol(Ord('?'), X, Y, BigFont.Above / Font.Above,
              Vertical, Backward, Underscore, Overscore, Poly, X, Y)
        end
        else
        begin
          N := Word(WideText[I]);
          if IsBig then
          begin
            if not Font.GetScaledSymbol(N, X, Y, BigFont.Above / Font.Above,
               Vertical, Backward, Underscore, Overscore, Poly, X, Y) then
               Font.GetScaledSymbol(Ord('?'), X, Y, BigFont.Above / Font.Above,
                 Vertical, Backward, Underscore, Overscore, Poly, X, Y);
          end
          else
          begin
            if not Font.GetSymbol(N, X, Y, Vertical, Backward, Underscore,
              Overscore, Poly, X, Y) then
              Font.GetSymbol(Ord('?'), X, Y, Vertical, Backward, Underscore,
                Overscore, Poly, X, Y);
          end;
          inc(I);
        end;
     end
    end
    else
    for I := 1 to Length(WideText) do
    begin
      N := Word(WideText[I]);
      if not Font.GetSymbol(N, X, Y, Vertical, Backward, Underscore, Overscore, Poly, X, Y) then
        Font.GetSymbol(Ord('?'), X, Y, Vertical, Backward, Underscore, Overscore, Poly, X, Y);
    end;
  end;
end;

function FindShape(ASHXStyles: TsgSHXFontlist; var ShapeNumber: Word;
  var ShapeName, FontName: string): Boolean;
var
  I: Integer;
  vFnt: TsgSHXFont;
begin
  Result := False;
  if (ASHXStyles.FShapeFonts.Count < 0) then Exit;
  for I := 0 to ASHXStyles.FShapeFonts.Count - 1 do
    if ASHXStyles.FShapeFonts.Objects[I] <> nil then
    begin
      vFnt := ASHXStyles.FShapeFonts.Objects[I] as TsgSHXFont;
      Result := vFnt.FindShape(ShapeNumber, ShapeName);
      if Result then
      begin
        FontName := vFnt.FName;
        Break;
      end;
    end;
end;

procedure GetSHXTextFromStyle(ASHXStyles: TsgSHXFontlist;
   PStyle : PsgTextStyle;Text: sgRawByteString; WideText: WideString;
   CodePage: Integer; Vertical, Backward: Boolean; Poly: TList;
   Fstyle: TmvFontStyles;
   var Above, Below, Left, Bottom, Right, Top: Double);
var
  vFnt, vBigFnt: TsgSHXFont;
  X, Y: Double;
  Fbig: Boolean;
  vConvString: WideString;
begin
  vFnt := ASHXStyles.Fonts.Objects[PStyle.FontIndex] as TsgSHXFont;
  if vFnt = nil then
  begin
    vFnt := TsgSHXFont.Create(PStyle.FontPath);
    ASHXStyles.Fonts.AddObject(PStyle.FontPath, vFnt);
    if not vFnt.Load then Exit;
  end
  else
    if not vFnt.Loaded then
    begin
      vFnt.FName := PStyle.FontPath;
      if not vFnt.Load then Exit;
    end;
  if PStyle.BigFontIndex <0 then
    vBigFnt := nil
  else
  begin
    vBigFnt := ASHXStyles.Fonts.Objects[PStyle.BigFontIndex] as TsgSHXFont;
    if vBigFnt = nil then
    begin
      vBigFnt := TsgSHXFont.Create(PStyle.BigFontPath);
      ASHXStyles.Fonts.AddObject(PStyle.BigFontPath, vBigFnt);
      if not vBigFnt.Load then Exit;
    end
    else
      if not vBigFnt.Loaded then
      begin
        vBigFnt.FName := PStyle.BigFontPath;
        if not vBigFnt.Load then Exit;
      end;
   end;
{$IFDEF SGDEL_2009}
  vConvString := ChangeUnicodeSymbolsCodes(vFnt, vBigFnt, WideText, CodePage);
{$ELSE}
  vConvString := WideText;
{$ENDIF}
  ProcText(vFnt, vBigFnt, Text, vConvString, PStyle.Vertical,
    (PStyle.Backwards or PStyle.UpSideDown),Fstyle, X, Y, Poly, Fbig);
  SetAboveBellow(vFnt, vBigFnt, Fbig, Above, Below);
  Left := 0;
  Bottom := -Below;
  Top := Above;
  Right := X;
end;

procedure GetSHXText(ASHXStyles: TsgSHXFontlist; const Style: string;
  Text: sgRawByteString; WideText: WideString; CodePage: Integer;
  Poly: TList;  Fstyle: TmvFontStyles;
  var Above, Below, Left, Bottom, Right, Top: Double);
var
  I: Integer;
  St: PsgTextStyle;
begin
  I := -1;
  if not Find(ASHXStyles.Styles, Style, I) then Exit;
  St := PsgTextStyle(ASHXStyles.Styles.Objects[I]);
  if St <> nil then
    GetSHXTextFromStyle(ASHXStyles, St, Text, WideText, CodePage, St.Vertical,
      St.Backwards, Poly, Fstyle, Above, Below, Left, Bottom, Right, Top)
end;

procedure DrawSHXText(ASHXStyles: TsgSHXFontlist; const Font: string; Text: sgRawByteString;
  WideText: WideString; CodePage: Integer; Vertical, Backward: Boolean; Poly: TList;
  Fstyle: TmvFontStyles;
  var Above, Below, Left, Bottom, Right, Top: Double);
var
  I, J: Integer;
  vFnt: TsgSHXFont;
  X, Y: Double;
  S: string;
  Fbig: boolean;
  vConvString: WideString;
begin
  S := '';
  Find(ASHXStyles.Fonts, Font, I);
  if I < 0 then
  begin
    for J := 0 to ASHXStyles.SearchPath.Count - 1 do
    begin
      if sgFileExists(ASHXStyles.SearchPath[J] + AnsiUpperCase(Font)) then
      begin
        S := ASHXStyles.SearchPath[J] + AnsiUpperCase(Font);
        Break;
      end;
    end;
    if S = '' then S := ASHXStyles.DefaultFontPath;
    vFnt := TsgSHXFont.Create(S);
    if not vFnt.Load then
    begin
      vFnt.Free;
      Exit;
    end;
    ASHXStyles.Fonts.AddObject(AnsiUpperCase(Font), vFnt);
  end
  else
    vFnt := ASHXStyles.Fonts.Objects[I] as TsgSHXFont;
  if vFnt = nil then Exit;
{$IFDEF SGDEL_2009}
  vConvString := ChangeUnicodeSymbolsCodes(vFnt, nil, WideText, CodePage);
{$ELSE}
  vConvString := WideText;
{$ENDIF}
  ProcText(vFnt, nil, Text, vConvString, Vertical, Backward,Fstyle, X, Y, Poly, Fbig);
  Above := vFnt.Above;
  Below := vFnt.Below;
  Left := 0;
  Bottom := -Below;
  Top := Above;
  Right := X;
end;

function IsUnicodeSHX(ASHXStyles: TsgSHXFontlist; PStyle: PsgTextStyle; const AFontName: string): Boolean;
var
  I: Integer;
  vFnt: TsgSHXFont;
  S, S1: string;
begin
  Result := False;
  S := '';
  if (PStyle <> nil) and (AFontName = '')  then
  begin
    vFnt := ASHXStyles.Fonts.Objects[Pstyle.FontIndex] as TsgSHXFont;
    if vFnt = nil then
    begin
      vFnt := TsgSHXFont.Create(Pstyle.FontPath);
      ASHXStyles.Fonts.AddObject(Pstyle.FontPath, vFnt);
      if not vFnt.Load then Exit;
    end;
    Result := vFnt.FKind = tkUnicodeSHX;
  end
  else
  begin
    Find(ASHXStyles.Fonts, AFontName, I);
    if I < 0 then
    begin
      S1 := AnsiUpperCase(AFontName);
      for I := 0 to ASHXStyles.SearchPath.Count - 1 do
      begin
        if sgFileExists(ASHXStyles.SearchPath[I] + S1) then
        begin
          S := ASHXStyles.SearchPath[I] + S1;
          Break;
        end;
      end;
      if (S = '') and (AnsiPos('\',AFontName )>=0)   then begin
        if sgFileExists(AFontName) then S := AFontName
        else
        begin
          S1 := AnsiUpperCase(ExtractFileName(AFontName));
          for I := 0 to ASHXStyles.SearchPath.Count - 1 do
          begin
            if sgFileExists(ASHXStyles.SearchPath[I] + S1) then
            begin
              S := ASHXStyles.SearchPath[I] + S1;
              Break;
            end;
          end;
        end;
      end;

      if (S = '') then S := ASHXStyles.DefaultFontPath;
      Find(ASHXStyles.Fonts,S,I);
      if I<0 then  begin
        vFnt := TsgSHXFont.Create(S);
        if not vFnt.Load then
        begin
          vFnt.Free;
          Exit;
        end;
        S := AFontName;
        if ExtractFileExt(AFontName) = '' then
          S := S + '.SHX';
         ASHXStyles.Fonts.AddObject(AnsiUpperCase(S), vFnt);
      end
      else
        vFnt := ASHXStyles.Fonts.Objects[I] as TsgSHXFont;
    end
    else
      vFnt := ASHXStyles.Fonts.Objects[I] as TsgSHXFont;
    if vFnt = nil then Exit;
    Result := vFnt.FKind = tkUnicodeSHX;
  end;

end;


constructor TsgSHXFontList.Create(const ASearchPath, ADefault: string);
var
  I, vPos: Integer;
  S, vDir: string;
begin
  FFonts := THashedStringList.Create;
  FFonts.CaseSensitive:=True;
  //FFonts.Sorted:=True;
  FStyles := TStringList.Create;
  FSearchPath := TStringList.Create;
  FShapeFonts := TStringList.Create;
  FMissedFonts := TStringList.Create;
  FSubstFonts := TStringList.Create;
  vDir := AnsiUpperCase(ASearchPath);
  vPos := AnsiPos(';', vDir);
  while vPos > 0 do
  begin
    S := Trim(Copy(vDir, 1, vPos-1));
    if IsDirExists(S) then
    begin
       if S[Length(S)] <> '\' then S := S + '\';
       FSearchPath.Add(S);
     end;
     Delete(vDir, 1, vPos);
     vPos := AnsiPos(';', vDir);
  end;
  S := Trim(vDir);
  if (S <> '') and IsDirExists(S) then
  begin
    if S[Length(S)]<> '\' then S := S + '\';
    FSearchPath.Add(S);
  end;
  FDefaultFontName := AnsiUpperCase(ADefault);
  for I := 0 to FSearchPath.Count - 1 do
  begin
    if sgFileExists(FSearchPath[I] + FDefaultFontName)  then
    begin
      FDefaultFontPath := FSearchPath[I] + FDefaultFontName;

      Break;
    end;
  end;
end;

destructor TsgSHXFontList.Destroy;
var
  I: Integer;
begin
  FSearchPath.Free;
  FShapeFonts.Free;
  FMissedFonts.Free;
  FSubstFonts.Free;
  if FFonts.Count >0 then
  for I := 0 to FFonts.Count - 1 do
    FFonts.Objects[I].Free;
  FFonts.Free;
  if  FStyles.Count >0 then
  for I := 0 to FStyles.Count - 1 do
    Dispose(PsgTextStyle(FStyles.Objects[I]));
  FStyles.Free;
  inherited Destroy;
end;

function TsgSHXFontList.AddFont(const AFontName: string):TsgSHXFont;
begin
  Result := nil;
end;

function TsgSHXFontList.AddNewFont(const AFontName: string):TsgSHXFont;
//var  vFnt: TsgSHXFont;
begin
  Result := nil;
end;

function TsgSHXFontList.AddStyle(const AName, AFontName, ABigFontName: string;
  AVertical, AUpSideDown, ABackwards: Boolean; AObliqueAngle, AWidth: Double):PsgTextStyle;
var
  I: Integer;
  P: PsgTextStyle;
  S, US: string;
  vFnt: TsgSHXFont;
begin
  P := New(PsgTextStyle);
  P^.Name := AnsiUpperCase(AName);
  P^.Vertical:= AVertical;
  P^.UpSideDown:= AUpSideDown;
  P^.Backwards:= ABackwards;
  P^.ObliqueAngle:= AObliqueAngle;
  P^.Width := AWidth;
  P^.FontExists := false;
  S := AFontName;
  if ExtractFileExt(S) = '' then S := S + '.SHX';
  if (FSubstFonts.Count > 0)  then
  begin
     US :=  AnsiUpperCase(S);
     for I := 0 to FSubstFonts.Count -1 do
       if FSubstFonts.Names[I] = US then
       begin
         S := FSubstFonts.Values[US];
         break;
       end;
  end;
  if pos('\',s)>0  then
  begin
    if sgFileExists(S) then
    begin
      P^.FontExists := True;
      P^.FontPath := AnsiUpperCase(S);
    end
    else
      S := ExtractFileName(S);
  end;
  if not P^.FontExists then
  begin
    for I := 0 to FSearchPath.Count - 1 do
    begin
      P^.FontExists := sgFileExists(SearchPath[I] + AnsiUpperCase(S));
      if P^.FontExists then
      begin
        P^.FontPath := SearchPath[I] + AnsiUpperCase(S);
        Break;
      end;
    end;
  end;
  if not P^.FontExists then
  begin
    P^.FontPath := DefaultFontPath;
    US :=  AnsiUpperCase(S);
    if (FMissedFonts.IndexOf(US ) < 0) and
      (ExtractFileExt(US) = '.SHX')
    then  FMissedFonts.Add(US);
  end;
  vFnt := nil;
  if FFonts.Find(P^.FontPath, I) then
    P^.FontIndex := I
  else
  begin
    vFnt := TsgSHXFont.Create(P^.FontPath);
    vFnt.Load;
    P^.FontIndex := FFonts.AddObject(P^.FontPath, vFnt);
  end;
  if (AName = '') and ((vFnt = nil) or vFnt.FIsShape) and (FShapeFonts.IndexOf(AFontName) < 0) then
     FShapeFonts.AddObject(AFontName, vFnt);
  S := ABigFontName;
  if S='' then
  begin
    P^.BigFontIndex := -1;
    P^.BigFontPath := '';
  end
  else
  begin
    if ExtractFileExt(S) = '' then S := S + '.SHX';
    for I :=0 to FSearchPath.Count - 1 do
    begin
      P^.FontExists := sgFileExists(SearchPath[I] + AnsiUpperCase(S));
      if P^.FontExists then
      begin
        P^.BigFontPath := SearchPath[I] + AnsiUpperCase(S);
        Break;
      end;
    end;
    if not P^.FontExists then P^.BigFontPath := DefaultFontPath;
    if FFonts.Find(ABigFontName, I) then
      P^.BigFontIndex := I
    else
    begin
      vFnt := TsgSHXFont.Create(P^.BigFontPath);
      vFnt.Load;
      P^.BigFontIndex := FFonts.AddObject(ABigFontName, vFnt);
    end;
  end;
  Styles.AddObject(AName, TObject(P));
  Result := P;
end;

constructor TsgSHXFont.Create(const AFontPath: string);
begin
  FKind := tkUndefined;
  FName := AFontPath;
  FShapes := TList.Create;
  FAbove := 0;
  FBelow := 0;
  FNumChars := 0;
  FModes := 0;
  FEmbtype := 0;
  FEncoding := 0;
  FLineFeed := 0;
  FIsShape := False;
end;

destructor TsgSHXFont.Destroy;
begin
  CleareShapes;
  FShapes.Free;
  inherited  Destroy;
end;

function TsgSHXFont.FindShape(var N: Word; var Name: string): Boolean;
var
  I: Integer;
  P: PsgSHXRecord;
  Sn: string;
begin
  Result := False;
  if  Name <> '' then Sn := AnsiUpperCase(Name);
  for I := 0 to NumChars - 1 do
  begin
    P := PsgSHXRecord(FShapes[I]);
    if Name = '' then
    begin
       if P.ShapeNumber = N then
       begin
         Result := True;
         Name := P.ShapeName;
         Exit;
       end;
    end
    else
    begin
      if P.ShapeName = Sn then
      begin
         Result := True;
         N := P.ShapeNumber;
         Exit;
      end;
    end;
  end;
end;

procedure TsgSHXFont.ParseNormSHX(AStream: TStream);
var
  I, J, vPos: Integer;
  P: PsgSHXRecord;
  vIsShape: Boolean;
begin
  AStream.Seek($1C, soFromBeginning);
  AStream.Read(FNumChars, SizeOf(FNumChars));
  PrepareShapes;
  for I := 0 to NumChars - 1 do
  begin
    AStream.Read(PsgSHXRecord(FShapes[I])^.ShapeNumber, SizeOf(Word));
    AStream.Read(PsgSHXRecord(FShapes[I])^.DefBytes, SizeOf(Word));
    if PsgSHXRecord(FShapes[I])^.ShapeNumber in [1..255] then
      FixedTable[PsgSHXRecord(FShapes[I])^.ShapeNumber] := i;
  end;
  vPos:= AStream.Position;
  vIsShape := True;
  for I := 0 to NumChars - 1 do
  begin
    P := PsgSHXRecord(FShapes[I]);
    P^.BytesPos := vPos;
    if P^.ShapeNumber = 0 then
    begin
      vIsShape := False;
      P^.ShapeBytes := AnsiStrAlloc(P^.DefBytes);
      AStream.Read(P^.ShapeBytes^, P^.DefBytes);
      J := SetShapeName(P);
      FAbove := Byte(P^.ShapeBytes[J + 1]);
      FBelow := Byte(P^.ShapeBytes[J + 2]);
      FModes := Byte(P^.ShapeBytes[J + 3]);
    end;
    vPos := vPos + P^.DefBytes;
  end;
  if vIsShape then
  begin
    FIsShape := vIsShape;
    for I := 0 to NumChars - 1 do
    begin
      P := PsgSHXRecord(FShapes[I]);
      AStream.Position := P^.BytesPos;
      P^.ShapeBytes := AnsiStrAlloc(P^.DefBytes);
      AStream.Read(P^.ShapeBytes^, P^.DefBytes);
      SetShapeName(P);
      P^.ShapeName := Uppercase(P^.ShapeName);
      if Assigned(P^.ShapeBytes) then {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrDispose(P^.ShapeBytes);
      P^.ShapeBytes := nil;
    end;
  end;
end;

procedure  TsgSHXFont.ReadNormSHX(N: Word);
var
  vStream: TFileStream;
  P: PsgSHXRecord;
begin
  if not sgFileExists(Name) then Exit;
  if N > FShapes.Count - 1 then Exit;
  P := PsgSHXRecord(FShapes[N]);
  try
    vStream := TFileStream.Create(Name, fmOpenRead or fmShareDenyNone);
    try
      vStream.Position := P^.BytesPos;
      if Assigned(P^.ShapeBytes) then {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrDispose(P^.ShapeBytes);
      P^.ShapeBytes := AnsiStrAlloc(P^.DefBytes);
      vStream.Read(P^.ShapeBytes^, P^.DefBytes);
      SetShapeName(P);
    finally
      vStream.Free;
    end;
  except
    SetsgFileExists(Name, False);
  end;
end;

function TsgSHXFont.BigFontWordInRange( c : word): boolean;
type TBB = array [1..2] of byte;
var
  I: integer;   B: byte;
begin
  Result:=True;
  B:= TBB(c)[2];
  for I := 1 to NBigFontRanges do
    if B in [BigFontRanges[I,1]..BigFontRanges[I,2]] then exit;
  Result:=False;
end;

procedure TsgSHXFont.AddNewShape(ShapeNumber: Word; const ShapeName: string;
  ShapePoly: TList);
var
  P: PsgSHXRecord;
  Shape: PAnsiChar;
  L, I: Integer;
begin
  New(P);
  FillChar(P^, SizeOf(TsgSHXRecord), 0);
  P^.ShapeName := ShapeName;
  P^.ShapeBytes := nil;
  P^.ShapePoly := nil;
  P^.ShapePolyVert := nil;
  FShapes.Add(P);
  Inc(FNumChars);
  P^.ShapeNumber := ShapeNumber;
  Shape := AnsiStrAlloc(2200);
  P^.DefBytes := ConvertPolyToShape(Shape, ShapePoly);
  L := Length(ShapeName);
  P^.ShapeBytes := AnsiStrAlloc(P^.DefBytes+L+1);
  for I := 1 to L do
    P^.ShapeBytes[I-1] := AnsiChar(ShapeName[i]);
  P^.ShapeBytes[L] := #0;
  for I := 0 to P^.DefBytes-1 do
    P^.ShapeBytes[L + 1 + I] := Shape[I];
  P^.DefBytes := P^.DefBytes + L +1;
  {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrDispose(Shape);
end;

function TsgSHXFont.BigFontInRange(c: byte): boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 1 to NBigFontRanges do
    if c in [BigFontRanges[I,1]..BigFontRanges[I,2]] then exit;
  Result:=False;
end;

procedure TsgSHXFont.ReadBigSHX(N: Word);
var
  vStream: TFileStream;
  P: PsgSHXRecord;
begin
  if not sgFileExists(Name) then Exit;
  if N > FShapes.Count - 1 then Exit;
  try
    vStream := TFileStream.Create(Name, fmOpenRead or fmShareDenyNone);
    try
      P := PsgSHXRecord(FShapes[N]);
      vStream.Position := P^.BytesPos;
      if Assigned(P^.ShapeBytes) then {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrDispose(P^.ShapeBytes);
      P^.ShapeBytes := AnsiStrAlloc(P^.DefBytes);
      vStream.Read(P^.ShapeBytes^, P^.DefBytes);
      SetShapeName(P);
    finally
      vStream.Free;
    end;
  except
    SetsgFileExists(Name, False);
  end;
end;

procedure  TsgSHXFont.ParseBigSHX(AStream: TStream);
var
  I, J: Integer;
  P: PsgSHXRecord;
  iShapeNumber: Word; 	   // shape number
  iDefByt: Word;	   // number of data bytes in shape, 2000 max
  lFileOffset: Cardinal	;  // file offset to shape specification bytes
  lNextBigShapeHeader: Cardinal;
  lNumberOfShapes : Cardinal;
  lStartOfShapeDefs: Cardinal;
begin
  FExtndBig := False;
  lNumberOfShapes := 0;
  lStartOfShapeDefs := Cardinal($ffffffff);
  AStream.Seek($1B, soFromBeginning);
  AStream.Read(FNumChars, SizeOf(FNumChars));
  AStream.Read(NBigFontRanges, SizeOf(NBigFontRanges));
  for I := 1 to  NBigFontRanges do
  begin
    AStream.Read( BigFontRanges[i,1],SizeOf(word));
    AStream.Read( BigFontRanges[i,2],SizeOf(word));
  end;
  //PrepareShapes;
  while True do begin
    AStream.Read(iShapeNumber, SizeOf(Word));
    AStream.Read(iDefByt, SizeOf(Word));
    AStream.Read(lFileOffset, SizeOf(lFileOffset));
    if (lNumberOfShapes = 0) then
        lStartOfShapeDefs := lFileOffset;

    lNextBigShapeHeader := AStream.Position;
    if (lNextBigShapeHeader > lStartOfShapeDefs ) then Break;
    if (lNumberOfShapes > 0) and (iShapeNumber = 0) then Continue;
    New(P);
    FillChar(P^, SizeOf(TsgSHXRecord), 0);
    P^.ShapeName := '';
    P^.ShapeBytes := nil;
    P^.ShapePoly := nil;
    P^.ShapePolyVert := nil;
    FShapes.Add(P);
    P^.DefBytes := iDefByt;
    P^.BytesPos:= lFileOffset;
    P^.ShapeNumber := iShapeNumber;
    if iShapeNumber = 0 then
    begin
      AStream.seek(lFileOffset, soFromBeginning);
      P^.ShapeBytes := AnsiStrAlloc(P^.DefBytes);
      AStream.Read(P^.ShapeBytes^, P^.DefBytes);
      J := SetShapeName(P);
      if (iDefByt - j -1) = 5 then
      begin
         FExtndBig := True;
         FCharHeight := Byte(P^.ShapeBytes[J + 1]);
         FModes := Byte(P^.ShapeBytes[J + 3]);
         FCharWidth :=  Byte(P^.ShapeBytes[J + 4]);
      end
      else
      begin
        FAbove := Byte(P^.ShapeBytes[J + 1]);
        FBelow := Byte(P^.ShapeBytes[J + 2]);
        FModes := Byte(P^.ShapeBytes[J + 3]);
      end;
      AStream.Position := lNextBigShapeHeader;
    end;
    Inc(lNumberOfShapes);
  end;
  FNumChars := lNumberOfShapes;
  FShapes.Sort(SymbolCompare);
end;

procedure  TsgSHXFont.ParseUnicodeSHX(AStream: TStream);
var
  I, J: Integer;
  P: PsgSHXRecord;
begin
  AStream.Seek($19, soFromBeginning);
  AStream.Read(FNumChars, SizeOf(FNumChars));
  PrepareShapes;
  P := PsgSHXRecord(FShapes[0]);
  AStream.Read(P^.ShapeNumber, SizeOf(Word));
  AStream.Read(P^.DefBytes, SizeOf(Word));
  P^.ShapeBytes := AnsiStrAlloc(P^.DefBytes);
  AStream.Read(P^.ShapeBytes^, P^.DefBytes);
  J := SetShapeName(P);
  FAbove := Byte(P^.ShapeBytes[J + 1]);
  FBelow := Byte(P^.ShapeBytes[J + 2]);
  FModes := Byte(P^.ShapeBytes[J + 3]);
  FEncoding := Byte(P^.ShapeBytes[J + 4]);
  FEmbtype := Byte(P^.ShapeBytes[J + 5]);
  for I := 1 to NumChars - 1 do
  begin
    P := PsgSHXRecord(FShapes[I]);
    AStream.Read(P^.ShapeNumber, SizeOf(Word));
    AStream.Read(P^.DefBytes, SizeOf(Word));
    P^.BytesPos := AStream.Position;
    AStream.Position:= P^.BytesPos + P^.DefBytes;
  end;
  FShapes.Sort(SymbolCompare);
end;

procedure TsgSHXFont.ReadUnicodeSHX(N: Word);
var
  vStream: TFileStream;
  P: PsgSHXRecord;
begin
  if not sgFileExists(Name) then Exit;
  if N > FShapes.Count - 1 then Exit;
  try
    vStream := TFileStream.Create(Name, fmOpenRead or fmShareDenyNone);
    try
      P := PsgSHXRecord(FShapes[N]);
      vStream.Position := P^.BytesPos;
      if Assigned(P^.ShapeBytes) then {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrDispose(P^.ShapeBytes);
      P^.ShapeBytes := AnsiStrAlloc(P^.DefBytes);
      vStream.Read(P^.ShapeBytes^, P^.DefBytes);
      SetShapeName(P);
    finally
      vStream.Free;
    end;
  except
    SetsgFileExists(Name, False);
  end;
end;

function TsgSHXFont.GetScaledSymbol(Symb: Word; InX, InY, Scale: Double;
      Vert, Backward, Underscore, Overscore: Boolean;
      Poly: TList; var OutX, OutY: Double): Boolean;
var
  TempPoly: Tlist;
  V: PsgSHXVertex;
  I: integer;
begin
   TempPoly := TList.Create;
   try
     Result := GetSymbol(Symb, 0, 0, Vert, Backward, Underscore, Overscore,
       TempPoly, OutX, OutY);
     if TempPoly.Count > 0 then
     begin
       for I := 0 to  TempPoly.Count- 1  do
       begin
          V:=TempPoly[I];
          V^.X := InX + V^.X * Scale;
          V^.Y := InY + V^.Y * Scale;
          Poly.Add(V);
       end;
       OutX := InX + OutX * Scale;
       Outy := InY + OutY * Scale;
     end;
   finally
     TempPoly.Free;
   end;
end;

function TsgSHXFont.GetShapes: TList;
begin
  Result := FShapes;
end;

function TsgSHXFont.GetSymbol(Symb: Word; InX, InY: Double; Vert, Backward,
  Underscore, Overscore : Boolean; Poly: TList; var OutX, OutY: Double): Boolean;
var
  Sc, X, Y: Double;
  P: PsgSHXVertex;
begin
  Sc := 1;
  X := InX;
  Y := InY;
  Result := ProcessSymb(Symb, X, Y, Sc, Vert, Backward, Poly);
  if not Result then Exit;
  OutX := X;
  OutY := Y;
  if Underscore then
  begin
    P := New(PsgSHXVertex);
    P^.PenDown:= False;
    P^.X := InX - (OutX - InX) * cnstXOffsetKoef;
    P^.Y :=  - Above * cnstYOffsetKoef;
    P^.Bulge := 0;
    Poly.Add(P);
    P := New(PsgSHXVertex);
    P^.PenDown := True;
    P^.X := OutX - (OutX - InX) * cnstXOffsetKoef;
    P^.Y := InY - Above * cnstYOffsetKoef;
    P^.Bulge := 0;
    Poly.Add(P);
  end;
  if Overscore then
  begin
    P := New(PsgSHXVertex);
    P^.PenDown:= False;
    P^.X := InX - (OutX - InX) * cnstXOffsetKoef;
    P^.Y := InY + Above * (1 + cnstYOffsetKoef);
    P^.Bulge := 0;
    Poly.Add(P);
    P := New(PsgSHXVertex);
    P^.PenDown:= True;
    P^.X := OutX - (OutX - InX) * cnstXOffsetKoef;
    P^.Y := InY + Above * (1 + cnstYOffsetKoef);
    P^.Bulge := 0;
    Poly.Add(P);
  end;
end;

function TsgSHXFont.HasPairSymbol(ASym1, ASym2: Byte): Boolean;
var
  N: Word;
begin
  Result := BigFontInRange(ASym1);
  if not Result then
    Exit;
  N := 256 * ASym1 + ASym2;
  Result := FindSymbol(N) >= 0;
end;

function TsgSHXFont.HasPairSymbolWord(ASymbol: Word): Boolean;
type
  TWordRecord = array [1..2] of Byte;
begin
  Result := HasPairSymbol(TWordRecord(ASymbol)[2], TWordRecord(ASymbol)[1]);
end;

function TsgSHXFont.SetShapeName(P: PsgSHXRecord): Integer;
begin
  Result := 0;
  P^.ShapeName := '';
  while (P^.ShapeBytes[Result] <> Char(0)) and (Result < MAX_FONTNAME_LEN) do
  begin
    P^.ShapeName := P^.ShapeName + string(P^.ShapeBytes[Result]);
    Inc(Result);
  end;
end;

function TsgSHXFont.FindSymbol(N: word): integer;
var
  L, H, I,  SH: Integer;
begin
  Result := -1;
  if N = 0 then
    Exit;
  case FKind of
    tkUndefined:
      Exit;
    tkNormSHX:
      begin
        if N in [1..255] then
        begin
          Result := FixedTable[N];
          if Result = 255 then
            Result := -1;
        end;
      end;
  else
    L := 0;
    H := NumChars - 1;
    while L <= H do
    begin
      I := (L + H) shr 1;
      SH := PsgSHXRecord(FShapes[I]).ShapeNumber;
      if SH < N then
        L := I + 1
      else
      begin
        H := I - 1;
        if SH = N then
        begin
          Result := I;
          Exit;
        end;
      end;
    end;
  end;
end;

function TsgSHXFont.ProcessSymb(N: Word; var InsX, InsY, Scale: Double;
  Vert, Backward: Boolean; Poly: TList): Boolean;
var
  I: Integer;
  P: PsgSHXRecord;
  V, V0: PsgSHXVertex;
  ShapePoly : TList;
  F, NoDown: Boolean;
  PTop, PBottom, PLastDown, PFirstDown: Double;

  procedure ProcessBulge(PV1, PV2: PsgSHXVertex);
  var
    X0, Y0, X1, Y1, X2, Y2, A, A1, BT: Double;
    I, K: Integer;
    SinA, CosA: Extended;
  begin
    if Abs(PV1^.Bulge) < 0.5 then
      K := 4
    else
      K := 14;// for future versions
    A := ArcTan(PV1^.Bulge) * 2;
    A1 := A / (K+1) * 2;
    SinCos(A1, SinA, CosA);

    BT := (1 / PV1^.Bulge - PV1^.Bulge)/2;

    X0 := ((PV1^.X + PV2^.X) - BT * (PV1^.Y - PV2^.Y)) / 2;
    Y0 := ((PV1^.Y + PV2^.Y) + BT * (PV1^.X - PV2^.X)) / 2;

    X1 := PV2^.X;
    Y1 := PV2^.Y;
    for I := 0 to K do
    begin
      X2 := X0 + (X1 - X0) * CosA - (Y1 - Y0) * SinA;
      Y2 := Y0 + (X1 - X0) * SinA + (Y1 - Y0) * CosA;
      PTop :=  Max(PTop, Y2);
      PBottom :=  Min(PBottom, Y2);
      PLastDown := Max(PLastDown, X2);
      PFirstDown := Min(PFirstDown, X2);
      X1 := X2;
      Y1 := Y2;
    end;
  end;
begin
  I := FindSymbol(N);
  Result := (I >= 0) and (I < FShapes.Count);
  if Result then
  begin
    P := FShapes[I];
    N := I;
    if Vert then
      ShapePoly := P^.ShapePolyVert
    else
      ShapePoly := P^.ShapePoly;
    if ShapePoly = nil then
    begin
      ShapePoly := Tlist.Create;
      case FKind of
        tkNormSHX:
          ReadNormSHX(N);
        tkUnicodeSHX:
          ReadUnicodeSHX(N);
        tkBigSHX:
          ReadBigSHX(N);
      end;
      P^.Xoff := 0;
      P^.Yoff := 0;
      P^.ScaleOff :=1;
      if  (FKind = tkBigSHX) and FExtndBig then
        Result := ExtSubSymb(N, P^.Xoff, P^.Yoff, P^.ScaleOff, FCharWidth, FCharHeight,Vert, False, ShapePoly)
      else
        Result := SubSymb(N, P^.Xoff, P^.Yoff, P^.ScaleOff, Vert, False, ShapePoly);
      if not Result then
        SHXFreePoly(ShapePoly)
      else if Vert then
        P^.ShapePolyVert := ShapePoly
      else
        P^.ShapePoly := ShapePoly;

      if Result and (ShapePoly.count > 0) then
      begin
        PTop := -1E5;
        PBottom := 1E5;
        PLastDown:= -1E5;
        PFirstDown:= 1E5;
        V0 :=  PsgSHXVertex(ShapePoly[0]);
        NoDown := True;
        for I := 1 to ShapePoly.count -1 do
        begin
          V := PsgSHXVertex(ShapePoly[I]);
          if V^.PenDown then
          begin
            NoDown := False;
            PLastDown := Max(PLastDown, V0^.X);
            PFirstDown := Min(PFirstDown, V0^.X);
            PTop :=  Max(PTop, V0^.Y);
            PBottom :=  Min(PBottom, V0^.Y);
            PLastDown := Max(PLastDown, V^.X);
            PFirstDown := Min(PFirstDown, V^.X);
            PTop :=  Max(PTop, V^.Y);
            PBottom :=  Min(PBottom, V^.Y);
            end;
            V0 := V;
        end;
        V0 := PsgSHXVertex(ShapePoly[0]);
        for I := 2 to ShapePoly.Count do begin
          V := PsgSHXVertex(ShapePoly[I-1]);
          if V^.PenDown and (V^.Bulge <> 00) then
            ProcessBulge(V,V0);
            V0:=V;
        end;
        if NoDown then
        begin
          P^.FirstDown := 0;
          P^.LastDown := 0;
          P^.Top := 0;
          P^.Bottom := 0;
        end
        else
        begin
          P^.FirstDown := PFirstDown;
          P^.LastDown := PLastDown;
          P^.Top := PTop;
          P^.Bottom := PBottom;
        end;
      end;

      if Assigned(P^.ShapeBytes) then {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrDispose(P^.ShapeBytes);
      P^.ShapeBytes := nil;
    end;

    // Change in future versions
    if ShapePoly = nil then
    begin
       Result := False;
       Exit;
    end;

    if ShapePoly.count >0 then
    begin
      F := (Abs(P^.Top) > 0.9e5);
      for I := 0 to ShapePoly.count -1 do
      begin
        V := New(PsgSHXVertex);
        V.PenDown:= PsgSHXVertex(ShapePoly[I]).PenDown;
        V.Bulge  := PsgSHXVertex(ShapePoly[I]).Bulge;
        V.X := InsX + PsgSHXVertex(ShapePoly[I]).X * Scale;
        V.Y := InsY + PsgSHXVertex(ShapePoly[I]).Y * Scale;
        Poly.Add(V);
      end;
      if F and ( Abs(P^.Top) > 0.9e5) then
      begin
        P^.Top := 0;
        P^.Bottom := 0;
      end;
      InsX := InsX + P^.Xoff * Scale;
      InsY := InsY + P^.Yoff * Scale;
      Scale := Scale *  P^.Scaleoff;
    end
    else
      Result := False;
  end;
end;

function TsgSHXFont.ExtSubSymb(N: Word; var InsX, InsY, Scale : Double;
       CharWidth, CharHeight : byte;
       Vert, Backward: Boolean; Poly: TList): Boolean;
var
  Stack: array[0..4, 0..2] of Double;
  C: Byte;
  Cw: Word;
  Xoff, Yoff: Shortint;
  PenDown, VertOnly, Res, Sf: Boolean;
  I, CStack, Il, Id, Ir, Ia, Nn, O1, O2, So, Eo: Integer;
  CpX, CpY, Xc, Yc, R, X3, Y3, A1, B: Double;
  Iang, Sa, Ea, Soct, Eoctrel, Soff, Eoff: Double;
  Buf: TsgSHXRecord;
  Pfs : PsgSHXRecord;
  BaseX, BaseY, SubWidth, SubHeight: byte;

  procedure MoveCurpos(XOff, YOff: Double);
  var
    P: PsgSHXVertex;
  begin
    CpX := CpX + XOff * Scale;
    CpY := CpY + YOff * Scale;
    P := New(PsgSHXVertex);
    P^.PenDown:= PenDown;
    P^.X := CpX;
    P^.Y := CpY;
    P^.Bulge := 0;
    Poly.Add(P);
  end;

  procedure SetCurpos;
  var
    P: PsgSHXVertex;
  begin
    P := New(PsgSHXVertex);
    P^.PenDown := False;
    P^.X := CpX;
    P^.Y := CpY;
    P^.Bulge := 0;
    Poly.Add(P);
  end;

  procedure SetBulge(X, Y, B: Double);
  var
    P: PsgSHXVertex;
  begin
    P := New(PsgSHXVertex);
    P^.PenDown := PenDown;
    P^.X := X;
    P^.Y := Y;
    P^.Bulge := B;
    Poly.Add(P);
  end;

  function GetByte(var Index: Integer): Byte;
  begin
    Result := Byte(Buf.ShapeBytes[I]);
    Inc(Index);
  end;

begin
  Result := False;
  if N > FShapes.Count - 1 then Exit;
  PenDown := False;
  FillChar(Stack, SizeOf(Stack), 0);
  Pfs := PsgSHXRecord(FShapes[N]);
  Buf := Pfs^;
  Pfs^.Top := -1E5;
  Pfs^.Bottom := 1E5;
  Pfs^.LastDown:= 0;

  CpX := InsX;
  CpY := InsY;
  MoveCurpos(0, 0);

  VertOnly := False;
  CStack := 0;
  I := Length(Buf.Shapename) + 1;;
  PenDown := True;

  while I < Buf.DefBytes do
  begin
    C := GetByte(I);
    if C < 16 then
    begin
      case C of
        0:
          Break; // finish
        1:
          if not VertOnly then
            PenDown := True;
        2:
          if not VertOnly then
            PenDown := False;
        3:
          begin
             C := GetByte(I);
             if (not VertOnly) and (C<>0) then Scale := Scale / C;
           end;
        4:
          begin
            C := GetByte(I);
            if not VertOnly then Scale := Scale * C;
          end;
        5:
          if not VertOnly then
          begin
            Inc(CStack);
            Stack[CStack, 1] := CpX;
            Stack[CStack, 2] := CpY;
          end;
        6:
          if not VertOnly then
          begin
            if CStack > 0 then
            begin
              CpX := Stack[CStack, 1];
              CpY := Stack[CStack, 2];
              Dec(CStack);
              SetCurpos;
            end;
          end;
        7:
          begin  // subshape
            C := GetByte(I);
            if (FKind = tkBigSHX) and FExtndBig then begin
               C := GetByte(I);
               Cw := 256 +c;
               C := GetByte(I);
               Cw := Cw + C;
               BaseX := GetByte(I);
               BaseY:= GetByte(I);
               SubWidth:= GetByte(I);
               SubHeight := GetByte(I);
               CpX := BaseX * Scale;
               Cpy := BaseY  * Scale;
               Result := ExtSubSymb(Cw, CpX, CpY, Scale,SubWidth, SubHeight, Vert, Backward, Poly);
               if not Result then
                Exit;
            end
            else
            begin
              if (FKind = tkUnicodeSHX) or (FKind = tkBigSHX) then
              begin
                  Cw := 256 * C;
                  C := GetByte(I);
                  Cw := Cw + C;
              end
              else
                Cw := C;
              if not vertonly then
              begin
                 Result := ProcessSymb(Cw, CpX, CpY, Scale, Vert, Backward, Poly);
                 if not Result then
                  Exit;
              end;
            end;
          end;
        8:
          begin    // X,Y displacement
            XOff := Shortint(GetByte(I));
            C := GetByte(I);
            YOff := Shortint(C);
            if not VertOnly  then     MoveCurpos(XOff, YOff);
          end;
        9:
          begin
            XOff := Shortint(GetByte(I));
            C := GetByte(I);
            YOff := Shortint(C);
            while (XOff <> 0) or (YOff <> 0) do
            begin
              if not VertOnly then
                MoveCurpos(XOff, YOff);
              XOff := Shortint(GetByte(I));
              C := GetByte(I);
              YOff := Shortint(C);
            end;
          end;
        10:
          begin     //Octant arc
            R := GetByte(I) * Scale;
            C := GetByte(I);
            if not VertOnly then
            begin
              Sf:= Boolean(C and $80);
              if Sf then
                Ia := C - $80
              else
                Ia := C;
              Ia := Abs(Ia);
              O1 := Ia div 16;
              Nn := Ia mod 16;
              if Sf then
                O2 := O1 - Nn
              else
                O2 := O1 + Nn;
              Xc := CpX - R * Cos(O1 * Pi / 4);
              Yc := CpY - R * Sin(O1 * Pi / 4);
              if Nn <> 0 then
              begin
                if Sf then
                  B := - Tan(Nn * Pi / 16)
                else
                  B := Tan(Nn * pi / 16);
                CpX := Xc + R * Cos(O2 * Pi / 4);
                CpY := Yc + R * Sin(O2 * Pi / 4);
                SetBulge(Cpx, CpY, B);
              end
              else
              begin         // full circle
                if Sf then
                begin
                  B := 1;
                  O2 := O1 - 4;
                end
                else
                begin
                  B := -1;
                  O2 := O1 + 4;
                end;
                X3 := CpX;
                Y3 := CpY;
                CpX := Xc + R * Cos(O2 * Pi / 4);
                CpY := Yc + R * Sin(O2 * Pi / 4);
                SetBulge(CpX, CpY, B);
                CpX := X3;
                CpY := Y3;
                SetBulge(CpX, CpY, B);
              end;
            end;
          end;
        11:
          begin    // Fractional arc
            So := GetByte(I);
            Eo := GetByte(I);
            Ir := GetByte(I);
            R := (Ir * 256 + GetByte(I)) * Scale;
            C := GetByte(I);
            if not VertOnly then
            begin
              Sf := Boolean(C and  $80);
              if Sf then
                Ia := C - $80
              else
                Ia := C;
              O1 := Ia div 16;
              O2 := Ia mod 16;
              Soct := 45 * O1;
              if O2=0 then O2 := 8;
              Eoctrel := 45.0 * ( O2 - 1 );
              A1 := So *45.0/256.0;
              Soff := Ceil(A1);
              A1 := Eo * 45.0 / 256.0;
              Eoff := Ceil(A1);
              if (Eoff < 0.9) then  eoff := 45.0;
              if Sf then
                Sa := Soct - Soff
              else
                Sa := Soct + Soff;
              Sa := Sa * Pi / 180;
              A1 := Eoctrel + Eoff;
              if Sf then
                Ea := Soct - A1
              else
                Ea := Soct + A1;
              Ea := Ea * Pi/180;
              Iang := Ea - Sa;
              Cpx := Cpx + R * (Cos(Ea) - Cos(Sa));
              Cpy := Cpy + R * (Sin(Ea) - Sin(Sa));
              B := Tan(0.25 * Iang);
              SetBulge(Cpx, Cpy, B);
            end;
          end;
        12:
          begin // Arc with bulge
            Xoff := Shortint(GetByte(I));
            Yoff := Shortint(GetByte(I));
            C := GetByte(I);
            B := Shortint(C) / 127;
            if not VertOnly then
            begin
               CpX := CpX + Xoff * Scale;
               CpY := CpY + Yoff * Scale;
               SetBulge(CpX, CpY, B);
             end;
          end;
         13:
           repeat //Multiple arc
             Xoff := Shortint(GetByte(I));
             C := GetByte(I);
             Yoff := Shortint(C);
             Res := (Xoff = 0) and (Yoff = 0);
             if Res then Break;

             begin
               C := GetByte(I);
               B := Shortint(C) / 127;
               CpX := CpX + Xoff * Scale;
               CpY := CpY + Yoff * Scale;
               if not VertOnly then   SetBulge(CpX, CpY, B);
             end;
           until Res;
        14: // Only vertical
          VertOnly := not Vert;
      end;
      if C <> 14 then VertOnly := False;
    end
    else
    begin
      if VertOnly  then
      begin
        VertOnly := False;
        Continue;
      end;
      Il := C div 16;
      Id := C mod 16;
      case Id of
        0:
          MoveCurpos(Il, 0);
        1:
          MoveCurpos(Il, Il / 2);
        2:
          MoveCurpos(Il, Il);
        3:
          MoveCurpos(Il / 2, Il);
        4:
          MoveCurpos(0, Il);
        5:
          MoveCurpos(-Il / 2, Il);
        6:
          MoveCurpos(-Il, Il);
        7:
          MoveCurpos(-Il, Il / 2);
        8:
          MoveCurpos(-Il, 0);
        9:
          MoveCurpos(-Il, -Il / 2);
        10:
          MoveCurpos(-Il, -Il);
        11:
          MoveCurpos(-Il / 2, -Il);
        12:
          MoveCurpos(0, -Il);
        13:
          MoveCurpos(Il / 2, -Il);
        14:
          MoveCurpos(Il, -Il);
        15:
          MoveCurpos(Il, -Il / 2);
      end;
    end;
  end;
  Result := True;
  InsX := CpX;
  InsY := CpY;
end;


procedure TsgSHXFont.SaveAs(const FName: string);
var
  I: Integer;
  vStream: TFileStream;
  S: string;
  W, WFirst, WLast: Word;
  P: PsgSHXRecord;
begin
  vStream := TFileStream.Create(FName, fmCreate);
  try
    vStream.Write(head1^,{$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrLen(head2));
    S := #13#10#$1A;
    W := NumChars;
    WFirst := PsgSHXRecord(FShapes[0])^.ShapeNumber;
    WLast := PsgSHXRecord(FShapes[W-1])^.ShapeNumber;
    vStream.Write(S[1], 3);
    vStream.Write(WFirst, SizeOf(Word));
    vStream.Write(WLast, SizeOf(Word));
    vStream.Write(W, SizeOf(NumChars));
    P := nil;
    for I := 0 to NumChars - 1 do
    begin
      P := PsgSHXRecord(FShapes[I]);
      vStream.Write(P^.ShapeNumber, SizeOf(Word));
      vStream.Write(P^.DefBytes , SizeOf(Word));
    end;
    for I := 0 to NumChars - 1 do
      vStream.Write(P^.ShapeBytes^, P^.DefBytes);
    S := 'EOF';
    vStream.Write(S[1], 3);
  finally
    vStream.Free;
  end;
end;

function TsgSHXFont.SubSymb(N: Word; var InsX, InsY, Scale: Double;
  Vert, Backward: Boolean; Poly: TList): Boolean;
var
  Stack: array[0..4, 0..2] of Double;
  C: Byte;
  Cw: Word;
  Xoff, Yoff: Shortint;
  PenDown, VertOnly, Res, Sf: Boolean;
  I, CStack, Il, Id, Ir, Ia, Nn, O1, O2, So, Eo: Integer;
  CpX, CpY, Xc, Yc, R, X3, Y3, A1, B: Double;
  Iang, Sa, Ea, Soct, Eoctrel, Soff, Eoff: Double;
  Buf: TsgSHXRecord;
  Pfs: PsgSHXRecord;

  procedure MoveCurpos(XOff, YOff: Double);
  var
    P: PsgSHXVertex;
  begin
    CpX := CpX + XOff * Scale;
    CpY := CpY + YOff * Scale;
    P := New(PsgSHXVertex);
    P^.PenDown:= PenDown;
    P^.X := CpX;
    P^.Y := CpY;
    P^.Bulge := 0;
    Poly.Add(P);
  end;

  procedure SetCurpos;
  var
    P: PsgSHXVertex;
  begin
    P := New(PsgSHXVertex);
    P^.PenDown := False;
    P^.X := CpX;
    P^.Y := CpY;
    P^.Bulge := 0;
    Poly.Add(P);
  end;

  procedure SetBulge(X, Y, B: Double);
  var
    P: PsgSHXVertex;
  begin
    P := New(PsgSHXVertex);
    P^.PenDown := PenDown;
    P^.X := X;
    P^.Y := Y;
    P^.Bulge := B;
    Poly.Add(P);
  end;

  function GetByte(var Index: Integer): Byte;
  begin
    Result := Byte(Buf.ShapeBytes[I]);
    Inc(Index);
  end;

begin
  Result := False;
  if N > FShapes.Count - 1 then Exit;
  PenDown := False;
  FillChar(Stack, SizeOf(Stack), 0);
  Pfs:=  PsgSHXRecord(FShapes[N]);
  Buf := Pfs^;
  Pfs^.Top := -1E5;
  Pfs^.Bottom := 1E5;
  Pfs^.LastDown:= 0;

  CpX := InsX;
  CpY := InsY;
  MoveCurpos(0, 0);

  VertOnly := False;
  CStack := 0;
  I := Length(Buf.Shapename) + 1;;
  PenDown := True;

  while I < Buf.DefBytes do
  begin
    C := GetByte(I);
    if C < 16 then
    begin
      case C of
        0:
          Break; // finish
        1:
          if not VertOnly then
            PenDown := True;
        2:
          if not VertOnly then
            PenDown := False;
        3:
          begin
             C := GetByte(I);
             if (not VertOnly) and (C<>0) then Scale := Scale / C;
           end;
        4:
          begin
            C := GetByte(I);
            if not VertOnly then Scale := Scale * C;
          end;
        5:
          if not VertOnly then
          begin
            Inc(CStack);
            Stack[CStack, 1] := CpX;
            Stack[CStack, 2] := CpY;
          end;
        6:
          if not VertOnly then
          begin
            if CStack > 0 then
            begin
              CpX := Stack[CStack, 1];
              CpY := Stack[CStack, 2];
              Dec(CStack);
              SetCurpos;
            end;
          end;
        7:
          begin  // subshape
            C := GetByte(I);
            if (FKind = tkUnicodeSHX) or (FKind = tkBigSHX) then
            begin
                Cw := 256 * C;
                C := GetByte(I);
                Cw := Cw + C;
            end
            else
              Cw := C;
            if not vertonly then
            begin
              Result := ProcessSymb(Cw, CpX, CpY, Scale, Vert, Backward, Poly);
              if not Result then
                Exit;
            end;
          end;
        8:
          begin    // X,Y displacement
            XOff := Shortint(GetByte(I));
            C := GetByte(I);
            YOff := Shortint(C);
            if not VertOnly  then     MoveCurpos(XOff, YOff);
          end;
        9:
          begin
            XOff := Shortint(GetByte(I));
            C := GetByte(I);
            YOff := Shortint(C);
            while (XOff <> 0) or (YOff <> 0) do
            begin
              if not VertOnly then
                MoveCurpos(XOff, YOff);
              XOff := Shortint(GetByte(I));
              C := GetByte(I);
              YOff := Shortint(C);
            end;
          end;
        10:
          begin     //Octant arc
            R := GetByte(I) * Scale;
            C := GetByte(I);
            if not VertOnly then
            begin
              Sf:= Boolean(C and $80);
              if Sf then
                Ia := C - $80
              else
                Ia := C;
              Ia := Abs(Ia);
              O1 := Ia div 16;
              Nn := Ia mod 16;
              if Sf then
                O2 := O1 - Nn
              else
                O2 := O1 + Nn;
              Xc := CpX - R * Cos(O1 * Pi / 4);
              Yc := CpY - R * Sin(O1 * Pi / 4);
              if Nn <> 0 then
              begin
                if Sf then
                  B := - Tan(Nn * Pi / 16)
                else
                  B := Tan(Nn * pi / 16);
                CpX := Xc + R * Cos(O2 * Pi / 4);
                CpY := Yc + R * Sin(O2 * Pi / 4);
                SetBulge(Cpx, CpY, B);
              end
              else
              begin         // full circle
                if Sf then
                begin
                  B := 1;
                  O2 := O1 - 4;
                end
                else
                begin
                  B := -1;
                  O2 := O1 + 4;
                end;
                X3 := CpX;
                Y3 := CpY;
                CpX := Xc + R * Cos(O2 * Pi / 4);
                CpY := Yc + R * Sin(O2 * Pi / 4);
                SetBulge(CpX, CpY, B);
                CpX := X3;
                CpY := Y3;
                SetBulge(CpX, CpY, B);
              end;
            end;
          end;
        11:
          begin    // Fractional arc
            So := GetByte(I);
            Eo := GetByte(I);
            Ir := GetByte(I);
            R := (Ir * 256 + GetByte(I)) * Scale;
            C := GetByte(I);
            if not VertOnly then
            begin
              Sf := Boolean(C and  $80);
              if Sf then
                Ia := C - $80
              else
                Ia := C;
              O1 := Ia div 16;
              O2 := Ia mod 16;
              Soct := 45 * O1;
              if O2=0 then O2 := 8;
              Eoctrel := 45.0 * ( O2 - 1 );
              A1 := So *45.0/256.0;
              Soff := Ceil(A1);
              A1 := Eo * 45.0 / 256.0;
              Eoff := Ceil(A1);
              if (Eoff < 0.9) then  eoff := 45.0;
              if Sf then
                Sa := Soct - Soff
              else
                Sa := Soct + Soff;
              Sa := Sa * Pi / 180;
              A1 := Eoctrel + Eoff;
              if Sf then
                Ea := Soct - A1
              else
                Ea := Soct + A1;
              Ea := Ea * Pi/180;
              Iang := Ea - Sa;
              Cpx := Cpx + R * (Cos(Ea) - Cos(Sa));
              Cpy := Cpy + R * (Sin(Ea) - Sin(Sa));
              B := Tan(0.25 * Iang);
              SetBulge(Cpx, Cpy, B);
            end;
          end;
        12:
          begin // Arc with bulge
            Xoff := Shortint(GetByte(I));
            Yoff := Shortint(GetByte(I));
            C := GetByte(I);
            B := Shortint(C) / 127;
            if not VertOnly then
            begin
               CpX := CpX + Xoff * Scale;
               CpY := CpY + Yoff * Scale;
               SetBulge(CpX, CpY, B);
             end;
          end;
         13:
           repeat //Multiple arc
             Xoff := Shortint(GetByte(I));
             C := GetByte(I);
             Yoff := Shortint(C);
             Res := (Xoff = 0) and (Yoff = 0);
             if Res then Break;

             begin
               C := GetByte(I);
               B := Shortint(C) / 127;
               CpX := CpX + Xoff * Scale;
               CpY := CpY + Yoff * Scale;
               if not VertOnly then   SetBulge(CpX, CpY, B);
             end;
           until Res;
        14: // Only vertical
          VertOnly := not Vert;
      end;
      if C <> 14 then VertOnly := False;
    end
    else
    begin
      if VertOnly then
      begin
        VertOnly := False;
        Continue;
      end;
      Il := C div 16;
      Id := C mod 16;
      case Id of
        0:
          MoveCurpos(Il, 0);
        1:
          MoveCurpos(Il, Il / 2);
        2:
          MoveCurpos(Il, Il);
        3:
          MoveCurpos(Il / 2, Il);
        4:
          MoveCurpos(0, Il);
        5:
          MoveCurpos(-Il / 2, Il);
        6:
          MoveCurpos(-Il, Il);
        7:
          MoveCurpos(-Il, Il / 2);
        8:
          MoveCurpos(-Il, 0);
        9:
          MoveCurpos(-Il, -Il / 2);
        10:
          MoveCurpos(-Il, -Il);
        11:
          MoveCurpos(-Il / 2, -Il);
        12:
          MoveCurpos(0, -Il);
        13:
          MoveCurpos(Il / 2, -Il);
        14:
          MoveCurpos(Il, -Il);
        15:
          MoveCurpos(Il, -Il / 2);
      end;
    end;
  end;
  Result := True;
  InsX := CpX;
  InsY := CpY;
end;


function TsgSHXFont.GetName: string;
begin
  Result := FName;
end;

function TsgSHXFont.Load: Boolean;
var
  vStream: TFileStream;
begin
  Result := False;
  if not sgFileExists(FName) then Exit;
  try
    vStream := TFileStream.Create(FName, fmOpenRead or fmShareDenyNone);
    try
      if GetSHXKind(vStream, FKind) then
      begin
        ClearFixedTable;
        CleareShapes;
        case FKind of
          tkNormSHX:
            ParseNormSHX(vStream);
           tkBigSHX:
             ParseBigSHX(vStream);
           tkUnicodeSHX:
             ParseunicodeSHX(vStream);
        end;
      end;
    finally
      vStream.Free;
    end;
    Result := True;
  except
    FKind := tkUndefined;
    SetsgFileExists(FName, False);
  end;
end;

procedure TsgSHXFont.CleareShapes;
var
  I, J: Integer;
  P: PsgSHXRecord;
begin
  for I := 0 to FShapes.Count - 1 do
  begin
    P := PsgSHXRecord(FShapes[I]);
    if Assigned(P^.ShapeBytes) then
      {$IFDEF SGDEL_XE4}AnsiStrings.{$ENDIF}StrDispose(P^.ShapeBytes);
    P^.ShapeName := '';
    if Assigned(P^.ShapePoly) then
    begin
      for J := 1 to P^.ShapePoly.Count do
        Dispose(P^.ShapePoly[J-1]);
      P^.ShapePoly.Free;
    end;
    Dispose(P);
  end;
  FShapes.Clear;
end;

procedure TsgSHXFont.ClearFixedTable;
begin
  FillChar(FixedTable, SizeOf(FixedTable), $FF);
end;

function TsgSHXFont.ConvertPolyToShape(ShapeBytes: PAnsiChar;
  ShapePoly: TList): Word;
var
  Index: Integer;
  Sm, Sd, S0, XX, YY: ShortInt;
  Pendown: Boolean;
  I: Integer;
  P: PsgSHXVertex;
  X, Y, DX, DY, Dmax, R: Double;

  procedure Push(V:  Shortint);
  begin
    ShapeBytes[Index]:=AnsiChar(V);
    Inc(Index);
  end;

  procedure CMD(C, V:  Shortint);
  begin
    ShapeBytes[Index]:=AnsiChar(C);
    Inc(Index);
    ShapeBytes[Index]:=AnsiChar(V);
    Inc(Index);
  end;

begin
  P := ShapePoly[0];
  X := P^.X;
  Y := P^.Y;
  Dmax := 0;
  Index := 0;
  for I := 1 to ShapePoly.Count - 1 do
  begin
    P := ShapePoly[I];
    DMax := Max(DMax, Abs(P^.X - X));
    DMax := Max(DMax, Abs(P^.Y - Y));
    X := P^.X;
    Y := P^.Y;
  end;
  if DMax > 127 then
  begin
    S0 := 127;
    DMax := DMax / S0;
    CMD(4, S0);
  end
  else
    S0 := 0;
  R := DMax / 127;
  Sm := ShortInt(Round(R * 100));
  Sd := 100;
  if S0 > 0 then
    R := R * 127;
  CMD(4, Sm);
  CMD(3, Sd);
  P := ShapePoly[0];
  X := P^.X;
  Y := P^.Y;
  Pendown := not P^.PenDown;
  for I := 1 to ShapePoly.Count - 1 do
  begin
    P := ShapePoly[I];
    if Pendown <> P^.PenDown  then
    begin
      Pendown :=  P^.PenDown;
      if Pendown then
        Push(1)
      else
        Push(2);
    end;
    DX :=  P^.X - X;
    DY :=  P^.Y - Y;
    X :=   P^.X;
    Y :=   P^.Y;
    XX := ShortInt(Round( DX / R));
    YY := ShortInt(Round (DY / R));
    if Abs(P^.Bulge) < 0.000001 then
    begin
      Push(8);
      CMD(XX, YY);
    end
    else
    begin
      Push(12);
      CMD(XX, YY);
      Push(ShortInt(Round(P^.Bulge*127)));
    end;
  end;
  Push(0);
  Result := Index;
end;

procedure TsgSHXFont.PrepareShapes;
var
  I : Integer;
  P: PsgSHXRecord;
begin
  for I := 0 to FNumChars - 1 do
  begin
    New(P);
    FShapes.Add(P);
    FillChar(P^, SizeOf(TsgSHXRecord), 0);
    P^.ShapeName := '';
    P^.ShapeBytes := nil;
    P^.ShapePoly := nil;
    P^.ShapePolyVert := nil;
  end;
end;

function TsgSHXFontList.GetDefaultFont: TsgSHXFont;
begin
  Result := FDefaultFont;
end;

function TsgSHXFontList.GetFonts: TStringList;
begin
  Result := FFonts;
end;

function TsgSHXFontList.GetSearchPath: TStringList;
begin
  Result := FSearchPath;
end;

function TsgSHXFontList.GetMissedFonts: TStringList;
begin
  Result := FMissedFonts;
end;
procedure TsgSHXFontList.SetSubstFonts(ASubstFonts: TStrings);
begin
   FSubstFonts.Assign(ASubstFonts);
end;


function TsgSHXFontList.GetStyles: TStringList;
begin
  Result := FStyles;
end;

function TsgSHXFontList.GetDefaultFontPath: string;
begin
  Result := FDefaultFontPath;
end;

function TsgSHXFont.GetAbove: Integer;
begin
  Result := FAbove;
end;

function TsgSHXFont.GetLineFeed: Double;
var
  A, B, W, H, L, BT, R, T, AF: Double;
begin
  Result := FLineFeed;
  if FLineFeed <> 0 then  Exit;
  ProcTextBox(Self,nil, #10, '', False,[], A, B, W, H, L, BT, R, T, AF);
  Result := H;
end;

function TsgSHXFont.GetBelow: Integer;
begin
  Result := FBelow;
end;

function TsgSHXFont.GetNumChars: Word;
begin
  Result := FNumChars;
end;

function TsgSHXFont.GetLoaded: Boolean;
begin
  Result := FKind <> tkUndefined;
end;

procedure TsgSHXFontList.SetDefaultFontPath(const Value: string);
begin
  FDefaultFontPath := Value;
end;

initialization
  FileExistsList := nil;
  DirExistsList := nil;

finalization
  FreeAndNil(FileExistsList);
  FreeAndNil(DirExistsList);

end.
