{************************************************************}
{                   Delphi VCL Extensions                    }
{                                                            }
{                      DXF Export                            }
{                 Export via a metafile                      }
{                                                            }
{      Copyright (c) 2002-2013 SoftGold software company     }
{                                                            }
{************************************************************}

{$R-}
unit DXFExport;
{$INCLUDE SGDXF.INC}

interface

uses Windows, SysUtils, Classes, Math, Graphics, sgConsts, sgFunction, sgLists

  {$IFDEF SGPROTECT}
    ,Dialogs
  {$ENDIF}
  {$IFDEF PowerCAD}
    ,Dialogs
  {$ENDIF}
  {$IFDEF SGDEL_XE3}
  , System.Types, System.UITypes
  {$ENDIF}
  ;

var
  AlternativeBlack: Bool;
  OffsetX: Single = 0;
  OffsetY: Single = 0;

const
  DXF_BYBLOCK   = 0;
  DXF_RED       = 1;
  DXF_YELLOW    = 2;
  DXF_LIME      = 3;
  DXF_AQUA      = 4;
  DXF_BLUE      = 5;
  DXF_FUCHSIA   = 6;
  DXF_BLACK     = 7;
  DXF_GRAY      = 8;// DXF_GRAY = 252;
  DXF_SILVER    = 9;
  DXF_OLIVE     = 44;
  DXF_GREEN     = 74;
  DXF_TEAL      = 135;
  DXF_NAVY      = 154;
  DXF_PURPLE    = 224;
  DXF_MAROON    = 14;
  DXF_WHITE     = 255;
  DXF_BYLAYER   = 256;
  // Added colors
  DXF_ALTERNATIVEBLACK = 250;// for replacement of a DXF_BLACK
  DXF_DKGRAY    = 251;// dark gray
  DXF_LTGRAY    = 254;// light gray

type
  PexpPoint = ^TexpPoint;
  TexpPoint = TFPoint;//TdxfPoint= for previous version

  PLine = ^TLine;
  TLine = record
    x1, y1, x2, y2: Integer;
  end;

  PRectangle = ^TRectangle;
  TRectangle = record
    X1, Y1, X2, Y2: Integer;
  end;

  // types for TsgDXFArc
  TsgArcType = (atCircle, atEllipse);

  TsgAutoCADVersion = (R14, R2000);

  TsgDimensionType = (dtRotated, dtAligned, dtAngular, dtDiameter, dtRadius,
    dtAngular3Point, dtOrdinate);

  PsgDimensionStyle = ^TsgDimensionStyle;
  TsgDimensionStyle = record
    Arrow1: TsgDimArrowType;
    Arrow2: TsgDimArrowType;
    ArrowBlock1: Integer;
    ArrowBlock2: Integer;
    ArrowSize: Single;
    ExtLineExt: Single;
    ExtLineOffset: Single;
    TextHeight: Single;
    TextOffset: Single;
    // more fields in future versions
  end;

  // types for TsgDXFHatch
  TsgHatchBoundaryType = (hbtPolyPolyline, hbtSpline, hbtCircle, hbtEllipse);
  // types for Hatch island detection style
  TsgHatchIslandDetectionStyle = (hidsNormal, hidsOuter, hidsIgnore);
  TsgHatchPatternType = (hptUserDefined, hptPredefined, hptCustom);

  PdxfHatchPatternData = ^TdxfHatchPatternData;
  TdxfHatchPatternData = record
    Angle: Single;
    BasePointX, BasePointY: Single;
    OffsetX, OffsetY: Single;
    // this type only for test version!!!
    NumOfDashLengts: Integer;
    DashLengths: TsgSingleList;//(TList of Single values)
  end;

  TsgDXFExport = class;

  TPenStyles = set of TPenStyle;
  PdxfExportData = ^TdxfExportData;
  TdxfExportData = packed record
    Tag: Word;              // classindex, DXF_LINE, DXF_SOLID etc.
    Count: Word;            // number of child entities
    Flags: Byte;            // flags byte
    Style: Byte;            // style (pen, brush...)
    SelfType: Byte;         // SelfType defines type of this entity
    Color: LongWord;         // color of entity RGB
    StyleObject: Pointer;   // = 0 (nil) if not style for this object
    Thickness: Single;      // thickness of lines
    Rotation: Single;       // rotation angle (TEXT, INSERT)
    GlobalWidth: Single;    // global width for LWPOLYLINE
    Text: string;//PChar;   // text string (TEXT), block name (INSERT)
    Point: TexpPoint;       // coordinates of the first point
    Point1: TexpPoint;      // coordinates of the second point
    Point2: TexpPoint;      // coordinates of the third point
    Point3: TexpPoint;      // coordinates of the fourth point
    case Integer of
    0: (Radius, StartAngle, EndAngle: Single);// for arcs
    1: (Block: THandle; Scale: TexpPoint);    // for Inserts
    2: (HAlign,VAlign: Byte; RWidth, RHeight, FHeight, FScale: Single);  // for Text
    3: (Points: TList);     //  Points of PolyLine
    4: (Bold, Italic: Byte; FName: PChar);
    5: (PolyPoints: TList);
  end;

  TsgGDI = class
  public
    constructor Create(P: Pointer); virtual;
  end;

  TsgGDIClass = class of TsgGDI;
  TsgMetafile = class;

  TsgFont = class(TsgGDI)
  private
    FName: string;
    FCharSet: Byte;
    FHeight: Integer;
    FWidth: Integer;
    FEscapement: Integer;
    FBold: Boolean;
    FItalic: Boolean;
    FUnderline: Boolean;
    function GetOffsetX: Double;
    function GetOffsetY: Double;
  public
    constructor Create(P: Pointer); override;
    property OffsetX: Double read GetOffsetX;
    property OffsetY: Double read GetOffsetY;
  end;

  TsgPen = class(TsgGDI)
  private
    FColor: Integer;
    FWidth: Integer;
    FStyle: TPenStyle;
  public
    constructor Create(P: Pointer); override;
  end;

  TsgBrush = class(TsgGDI)
  private
    FColor: Integer;
    FHatchStyle: TsgHatchStyle;
  public
    constructor Create(P: Pointer); override;
    property HatchStyle: TsgHatchStyle read FHatchStyle;
  end;

  TsgExtPen = class(TsgPen)
  private
    FBrush: TsgBrush;
  public
    constructor Create(P: Pointer); override;
    destructor Destroy; override;
    property Brush: TsgBrush read FBrush;
  end;

  TsgExpDXFFigure = class
  private
    FLayer: string;
    function GetColor: LongWord;  // Return RGB color
    procedure SetLayer(const Value: string);
  protected
    FData: TdxfExportData;
    procedure ParseToLines(NewElemes: TList); virtual;
    function IntersecRect(ARect: TRectangle): Boolean; virtual;
    procedure CopyPoints(const AList: TList); virtual;
  public
    procedure ExportBlockAsDXF(ADXFExport: TsgDXFExport); virtual;
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); virtual; abstract;
    constructor Create(const AData: TdxfExportData); virtual;
    property Color: LongWord read GetColor;
    property Layer: string read FLayer write SetLayer;
  end;

  TsgRegion = class
  private
    FBoundsRect: TRect;
    FIsClipping: Boolean;
    FHRGN: HRGN;
    FParentMetaFile: TsgMetafile;
    FPoints: TList;
    FRectCount: Cardinal;
    function GetIsRect: Boolean;
  public
    constructor Create(AParentMetaFile: TsgMetafile);
    destructor Destroy; override;
    procedure Assign(ASource: TsgRegion);
    procedure InitFromData(APRgnData: PRgnData);
    procedure InitFromRect(ARect: TRect; AOther: TsgRegion);
    procedure Clear;
    property IsClipping: Boolean read FIsClipping write FIsClipping;
    property IsRect: Boolean read GetIsRect;
    property Points: TList read FPoints;
  end;

  TsgExpDXFPath = class(TsgExpDXFFigure)
  private
  protected
    FFigureList: TList;
    function GetActBoundary(): TList;
  public
    constructor Create(const AData: TdxfExportData);override;
    destructor Destroy; override;
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
    procedure AddEntity(AExpDFXEntity: TsgExpDXFFigure);
    procedure BeginFigure;
    procedure CloseFigure;
    procedure GenereateData(var AData: TdxfExportData);
    property ActBoundary: TList read GetActBoundary;
    property FigureList: Tlist read FFigureList;
  end;

  TsgMetafile = class
  private
    FHDC: HDC;
    FAlign: Cardinal;
    FBrush: TsgBrush;
    FCanvas: TCanvas;
    FClipRgn: TsgRegion;
    FData: TdxfExportData;
    FPath: TsgExpDXFPath;
    FIsConstructionPath: Boolean;
    FDfltPen: TsgPen;
    FDfltBrush: TsgBrush;
    FEXForm: TXForm;
    FFont: TsgFont;
    FMapMode: Cardinal;
    FMapModeKoef: Single;
    FObjects: TList;
    FOwner: TsgDXFExport;
    FPen: TsgPen;
    FPenPos: TPoint;
    FMetafileXRatio: Double;
    FSavedDCStatus: TList;
    FStyles: TPenStyles;
    FText: string;
    FTextColor: Integer;
    FViewExt: TSize;
    FViewOrg: TPoint;
    FWinExt: TSize;
    FWinOrg: TPoint;
    FXForm: TXForm;
    function FUpdateCP: Boolean;
    function GetPoint(const APt: TPoint): TPoint;
    function GetRect(const ARct: TRect): TRect;
    function GetSignYExt: Integer;
    function SetCircle(const R: TRect): Boolean;
    procedure Arc(P: PEMRArc; Move: Boolean);
    procedure AngleArc(P: PEMRAngleArc);
    procedure BeginPath(P: PEMRBeginPath);
    procedure EndPath(P: PEMREndPath);
    procedure FillPath(P: PEMRFillPath);
    procedure StrokeAndFillPath(P: PEMRStrokeAndFillPath);
    procedure StrokePath(P: PEMRStrokePath);
    procedure ClearData;
    procedure CloseFigure(P: PEMRCloseFigure);
    procedure DeleteObject(P: Pointer);
    procedure DoInvertYPts;
    procedure FillRGN(P: Pointer);
    procedure Ellipse(P: PEMRRectangle);
    procedure ExtSelectClipRGN(P: Pointer);
    procedure IntersectClipRect(P: PEMRIntersectClipRect);
    procedure LineTo(P: PEMRLineTo);
    procedure ModifyWorldTransform(P: PEMRModifyWorldTransform);
    procedure MoveCP;
    procedure MoveTo(P: PEMRLineTo);
    procedure NewGDI(AClass: TsgGDIClass; P: Pointer);
    procedure Pie(P: PEMRPie);
    procedure Polyline(P: Pointer; const Is16, IsBezier, Move, Close: Boolean);
    procedure PolyPolyline(P: PEMRPolyPolyline16; Close: Boolean);
    procedure PtToDXF(const P: TPoint; var ADXFPt: TexpPoint);
    procedure Rectangle(P: PEMRRectangle);
    procedure RestoreDC(P: PEMRRestoreDC);
    procedure RoundRect(P: PEMRRoundRect);
    procedure SaveDC(P: PEMRSaveDC);
    procedure SelectObject(P: Pointer);
    procedure SetDataPts;
    procedure SetDPtoLP(var ADevicePt: TPoint);
    procedure SetLPtoDP(var ALogPt: TPoint);
    procedure SetLType(Style: TPenStyle);
    procedure SetMapMode(AMode: Cardinal);
    procedure SetPen;
    procedure SetPixel(P: PEMRSetPixelV);
    procedure SetPt(var APt: TexpPoint);
    procedure SetOnlyPt(var APt: TexpPoint);
    procedure SetTextAlign(P: PEMRSetTextAlign);
    procedure SetWinExt(AExtent: TSize);
    procedure SetViewExt(AExtent: TSize);
    //procedure SetBkColor(P: PEMRSetBkColor);
    procedure SetWorldTransform(P: PEMRSetWorldTransform);
    procedure TextOut(P: PEMRExtTextOut);
  public
    constructor Create(AOwner: TsgDXFExport);
    destructor Destroy; override;
    procedure ProcessMetafile(Metafile: TMetafile);
    property Owner: TsgDXFExport read FOwner;
    property XForm: TXForm read FXForm;
    property IsConstructionPath: Boolean read FIsConstructionPath;
    property Path: TsgExpDXFPath read FPath;
  end;

  TsgExpDXFArc = class(TsgExpDXFFigure)
  private
    FType: TsgArcType;
    function GetEndAngle: Single;
    function GetPoint: TexpPoint;
    function GetRadius: Single;
    function GetStartAngle: Single;
    procedure SetEndAngle(const Value: Single);
    procedure SetPoint(const Value: TexpPoint);
    procedure SetRadius(const Value: Single);
    procedure SetStartAngle(const Value: Single);
  protected
    function IntersecRect(ARect: TRectangle): Boolean; override;
    procedure ParseToLines(NewElemes: TList); override;
    procedure CopyPoints(const AList: TList); override;
  public
    constructor Create(const AData: TdxfExportData); override;
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
    property Point: TexpPoint read GetPoint write SetPoint;
    property Radius: Single read GetRadius write SetRadius;
    property StartAngle: Single read GetStartAngle write SetStartAngle;
    property EndAngle: Single read GetEndAngle write SetEndAngle;
  end;

  { TsgExpDXFDimension

    Point - definition point for line with arrow;
    Point1 - other definition point;
    Point2 - other definition point, only for linear and angular dimensions;
    Point3 - middle point of dimension text;
    SelfType - dimension type;
    Text - optional (default is the measurement).   }
  TsgExpDXFDimension = class(TsgExpDXFFigure)
  private
    FType: TsgDimensionType;
    FStyle: TsgDimensionStyle;
  public
    constructor Create(const AData: TdxfExportData); override;
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
  end;

  TsgExpDXFEllipse = class(TsgExpDXFFigure)
  private
    FEllipse: Boolean;
    function GetLeftTop: TexpPoint;
    function GetRightBottom: TexpPoint;
  protected
    function IntersecRect(ARect: TRectangle): Boolean; override;
    procedure ParseToLines(NewElemes: TList); override;
  public
    procedure ExportBlockAsDXF(ADXFExport: TsgDXFExport); override;
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
    property LeftTop: TexpPoint read GetLeftTop;
    constructor CreateEx(AData: TdxfExportData; AEllipse: boolean);
    property RightBottom: TexpPoint read GetRightBottom;
  end;

  TsgExpDXFLine = class(TsgExpDXFFigure)
  private
    function GetEndPoint: TexpPoint;
    function GetStartPoint: TexpPoint;
    procedure SetEndPoint(const Value: TexpPoint);
    procedure SetStartPoint(const Value: TexpPoint);
  protected
    procedure CopyPoints(const AList: TList); override;
  public
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
    property StartPoint: TexpPoint read GetStartPoint write SetStartPoint;
    property EndPoint: TexpPoint read GetEndPoint write SetEndPoint;
  end;

  TsgExpDXFBlock = class
  private
    FName: string;
    FBlockRecordHandle: Integer;
    FContent: TStringList;
  public
    constructor Create(AName: string; ABlockRecordHandle: Integer);
    destructor Destroy; override;
  end;

  TsgExpDXFLayer = class
  private
    procedure SetColor(const Value: Integer);
    procedure SetFlags(const Value: Byte);
    procedure SetLinetypeName(const Value: string);
    procedure SetLineWeight(const Value: Integer);
    procedure SetName(const Value: string);
  protected
    FName: string;
    FLinetypeName: string;
    FFlags: Byte;// bit coded
    FColor: Integer;
    FLineWeight: Integer;
  public
    constructor Create(AName: string);
    procedure ExportAsDXF(ADXFExport: TsgDXFExport);
    property Name: string read FName write SetName;
    property Flags: Byte read FFlags write SetFlags;
    property Color: Integer read FColor write SetColor;
    property LinetypeName: string read FLinetypeName write SetLinetypeName;
    property LineWeight:  Integer read FLineWeight write SetLineWeight;
  end;

  TsgExpDXFTextStyle = class
  private
    FName: string;
    FFlag: Integer;
    FFixedHeight: Single;
    FWidthFactor: Single;
    FObliqueAngle: Single;
    FGenerationFlags: Integer;
    FLastHeightUsed: Single;
    FPrimaryFontName: string;
    FBigFontName: string;
  public
    constructor Create(AName: string);
    procedure ExportAsDXF(ADXFExport: TsgDXFExport);
    property Name: string read FName write FName;
    property WidthFactor: Single read FWidthFactor write FWidthFactor;
  end;

  TsgExpDXFPolyline = class(TsgExpDXFFigure) // mostly as rectangle now
  private
    FList: TList;
    function GetPointCount: Integer;
    function GetPoint(AIndex: Integer): TexpPoint;
  protected
    FPoints: TList;
    function IntersecRect(ARect: TRectangle): Boolean; override;
    procedure ParseToLines(NewElemes: TList); override;
  public
    procedure Clear;
    procedure ClearPoints;
    procedure BeginPolygonFromRect;
    procedure EndPolygonFromRect;
    procedure AddRect(ARect: TRect);
    constructor CreateEx(const AData: TdxfExportData; AIndex: Integer);
    destructor Destroy; override;
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
    property PointCount: Integer read GetPointCount;
    property Point[AIndex: Integer]: TexpPoint read GetPoint;
  end;

  TsgExpDXFLeader = class(TsgExpDXFPolyline)
    //constructor CreateEx(const AData: TdxfExportData; AIndex: Integer);
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
  end;

  TsgExpDXFPolyBezier = class(TsgExpDXFPolyLine)
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
  end;

  TsgExpDXFPixel = class(TsgExpDXFFigure)
  public
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
  end;

  TsgExpDXFRectangle = class(TsgExpDXFFigure)
  private
    function GetLeftTop: TexpPoint;
    procedure SetLeftTop(const Value: TexpPoint);
    function GetRightBottom: TexpPoint;
    procedure SetRightBottom(const Value: TexpPoint);
  protected
    function IntersecRect(ARect: TRectangle): Boolean; override;
    procedure ParseToLines(NewElemes: TList); override;
  public
    procedure AddRect(ARect: TRect);
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
    property LeftTop: TexpPoint read GetLeftTop write SetLeftTop;
    property RightBottom: TexpPoint read GetRightBottom write SetRightBottom;
  end;

  TsgExpDXFText = class(TsgExpDXFFigure)
  public
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
  end;

  TsgExpDXFMText = class(TsgExpDXFFigure)
  protected
    function IntersecRect(ARect: TRectangle): Boolean; override;
    procedure ParseToLines(NewElemes: TList); override;
    procedure ParseToTexts(ARect: TRectangle; NewElemes: TList);
  public
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
  end;

  TsgExpDXFHatch = class(TsgExpDXFFigure)
  private
    FIslandDetectionStyle: TsgHatchIslandDetectionStyle;
    FPatternAngle: Single;
    FPatternData: TList;
    FPatternScale: Single;
    FPatternType: TsgHatchPatternType;
    FStyle: TsgHatchStyle;
    FBoundaryType: TsgHatchBoundaryType;
    function GetPoint(BndIndex, AIndex: Integer): TexpPoint;
    function GetBndAmount: Integer;
    procedure SetPatternName(const Value: string);
    procedure SetStyle(const AData: TdxfExportData);
    procedure FreeBoundaries;
    procedure FreePatternData;
    procedure SetPatternData(const Value: TList);
  protected
    // List of boundaries, each boundary is also List of TexpPoint
    FBoundaries: TList;
    FBndAmount: Integer;
    FPatternName: string;
  public
    constructor Create(const AData: TdxfExportData); override;
    destructor Destroy; override;
    function GetPointsNumber(BndIndex: Integer): Integer;
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
    property BoundaryType: TsgHatchBoundaryType read FBoundaryType;
    property IslandDetectionStyle: TsgHatchIslandDetectionStyle read FIslandDetectionStyle write FIslandDetectionStyle;
    property PatternAngle: Single read FPatternAngle write FPatternAngle;
    property PatternData: TList read FPatternData write SetPatternData;
    property PatternName: string read FPatternName write SetPatternName;
    property PatternScale: Single read FPatternScale write FPatternScale;
    property PatternType: TsgHatchPatternType read FPatternType write FPatternType;
    property Points[BndIndex, AIndex: Integer]: TexpPoint read GetPoint;
    property BndAmount: Integer read GetBndAmount;
    property Style: TsgHatchStyle read FStyle;
  end;

  TsgExpDXFSolid = class(TsgExpDXFFigure)
  public
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
  end;

  TsgExpDXF3DFace = class(TsgExpDXFFigure)
  public
    procedure ExportAsDXF(ADXFExport: TsgDXFExport); override;
  end;

  TsgDXFExportClass = class of TsgDXFExport;

  TsgDXFExport = class(TInterfacedPersistent, IStreamPersist)
  private
    FAdditionalEntitiesIndex: Integer;
    FAutoCADVer: TsgAutoCADVersion;
    FAutoCADPalette: TsgCADPalett;
    FBezierAsPolylines: Boolean;
    FBlkRecs: TStringList;
    FBlock: string;
    FBlockMode: Boolean;
    FBlocks: TList;
    FCurrent: TStringList;
    FCurrentLayer: TsgExpDXFLayer;
    FCanvas: TCanvas;
    FDefaultHatchPatternScale: Single;
    FDefaultLTypeScale: Single;
    FDimensionCounter: Integer;
    FEntities: TStringList;
    FFiguresList: TList;
    FHandle: Integer;
    FCodePage: Integer;
    FIsParseWhite: Boolean;
    FLayers: TList;
    FLimMin: TexpPoint;
    FLimMax: TexpPoint;
    FLTypes: TStringList;
    FMetafile: TsgMetafile;
    FMillimetres: Boolean;
    FNameCurrentLayer: string;
    FOffset: Single;
    FPenWidthRatio: Extended;
    FTextStyles: TList;
    FTmp: TMetafile;
    FUndefinedInserts: TStringList;
    FUnitSize: Double;
    FUse01MM: Boolean;
    FUseMetafileFontName: Boolean;
    FUseMetafileRatio: Boolean;
    FUseUnicode: Boolean;
    function GetCanvas: TCanvas;
    function GetBlockByName(AName: string): TsgExpDXFBlock;
    function GetTextStyleByFontName(const APrimaryFontName: string): TsgExpDXFTextStyle;
    function GetTextStyleNameByWidthfactor(AWidthfactor: Single): string;
    function MM(Value: Extended): Extended;
    function AddName(const AName, ASub: string): Integer;
    function AddHandle: Integer;
    procedure AddDimensionStyle(const AppName: string;
      const ADimStyle: TsgDimensionStyle);
    procedure AddInt(Code,Value: Integer);
    procedure AddFloat(Code: Integer; Value: Extended);
    procedure AddEntity(AEntity: TsgExpDXFFigure);
    procedure AddString(Code: Integer; const AString: string;
     const AConvert: Boolean = False);
    procedure Add3DPoint(Code: Integer; const P: TexpPoint);
    procedure AddPoint(Code: Integer; const P: TexpPoint);
    procedure AddVertex(const P: TexpPoint);
    procedure AddColor(const Data: TdxfExportData);
    procedure AddLTypeScale;
    procedure AddThickness(const Data: TdxfExportData);
    procedure BeginPoly(const Data: TdxfExportData; ACount: Integer);
    procedure BeginLeader(const Data: TdxfExportData; ACount: Integer);
    function GetCodePage: Integer;
    function GetStrAutoCADVer: string;
    function GetStrCodePage: string;
    procedure SetIsParseWhite(const Value: Boolean);
    procedure SetUse01MM(const Value: Boolean);
    procedure SetAutoCADVer(const Value: TsgAutoCADVersion);
    procedure SetCurrentLayer(const Value: TsgExpDXFLayer);
    function GetFiguresCount: Integer;
  protected
    property AdditionalEntitiesIndex: Integer read FAdditionalEntitiesIndex write FAdditionalEntitiesIndex;
    property FiguresCount: Integer read GetFiguresCount;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    // Point - definition point for line with arrow
    // Point1 (Point2) - other definition points (only for linear and angular dimensions)
    // SelfType - dimension type
    // Text - optional (default is the measurement)
    procedure AddDimension(var Data: TdxfExportData);
    // Point
    procedure AddPixel(var Data: TdxfExportData);
    // Point - start point, Point1 - end point
    procedure AddLine(var Data: TdxfExportData);
    // Point - bottom left, Point1 - top right
    procedure AddRectangle(var Data: TdxfExportData);
    // Points, Count, Flags = closed
    procedure AddPolyLine(var AData: TdxfExportData; AIndex: Integer);
    procedure AddLeader(var AData: TdxfExportData; AIndex: Integer);
    procedure AddPolyBezier(var AData: TdxfExportData; AIndex: Integer);
    // Point - center, Radius
    procedure AddCircle(var Data: TdxfExportData);
    // Point - center, Radius, StartAngle, EndAngle
    procedure AddArc(var Data: TdxfExportData);
    // Point - center, Point1 - endpoint of major axis, Radius - ratio minor/major, StartAngle, EndAngle
    procedure AddEllipse(var Data: TdxfExportData);
    // In Data Are necessary: Color, Flags
    // (if Boundaries=nil, then boundary in Data.Points)
    procedure AddHatch(var Data: TdxfExportData);
    procedure AddHatchEx(var Data: TdxfExportData; APatternData: TList;
      APatternName: string; AIslandDetectionStyle: TsgHatchIslandDetectionStyle;
      APatternType: TsgHatchPatternType);
    // Text, Point, Point1, FHeight, FScale, Rotation, HAlign, VAlign
    procedure AddText(var Data: TdxfExportData);
    procedure AddLType(const Name: string; const Parts: array of Single);
    procedure AddMText(var Data: TdxfExportData);
    procedure AddSolid(var Data: TdxfExportData);
    procedure AddXRef(Data: TdxfExportData);
    procedure BeginBlock(const Name: string);
    procedure BeginBlockWithXref(const Name, XrefPath: string);
    procedure Clear;
    procedure EndBlock;
    procedure EndDraw;
    function ColorToDXF(Value: Cardinal): LongWord;
    // Text = Blockname, Point, Scale, Rotation
    procedure Insert(const Data: TdxfExportData);
    procedure LoadFromMetafile(Metafile: TMetafile);
    procedure LoadFromFile(const AFileName: string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure SetLayerByString(Name: string);
    property AutoCADVer: TsgAutoCADVersion read FAutoCADVer write SetAutoCADVer;
    property BezierAsPolylines: Boolean read FBezierAsPolylines write FBezierAsPolylines;
    property Block: string read FBlock;
    property Canvas: TCanvas read GetCanvas;
    property CurrentLayer: TsgExpDXFLayer read FCurrentLayer write SetCurrentLayer;
    property DefaultLTypeScale: Single read FDefaultLTypeScale write FDefaultLTypeScale;
    property DefaultHatchPatternScale: Single read FDefaultHatchPatternScale write FDefaultHatchPatternScale;
    property IsParseWhite: Boolean read FIsParseWhite write SetIsParseWhite;
    property Layers: TList read FLayers write FLayers;
    property Millimetres: Boolean read FMillimetres write FMillimetres;
    property Offset: Single read FOffset write FOffset;
    property PenWidthRatio: Extended read FPenWidthRatio write FPenWidthRatio;
    property UndefinedInserts: TStringList read FUndefinedInserts;
    property UnitSize: Double read FUnitSize write FUnitSize;
    property Use01MM: Boolean read FUse01MM write SetUse01MM;
    property UseMetafileFontName: Boolean read FUseMetafileFontName write FUseMetafileFontName;// not documented, only for internal using (!)
    property UseMetafileRatio: Boolean read FUseMetafileRatio write FUseMetafileRatio;
    property UseUnicode: Boolean read FUseUnicode write FUseUnicode;
  end;


function FontToStr(Font: TFont; const S: String): String;
function GetPourStr(const S: string): string;
function MakeExpPoint(const X, Y, Z: Double): TexpPoint;

implementation

const
  cnstDegreeOfSpline = 3;
  cnstAmount = 4;

  SHeader: array[0..3] of string =
   ('  0',
    'SECTION',
    '  2',
    'HEADER'
   );

  STablesLTYPE: array[0..47] of string =
   ('  0',
    'ENDSEC',
    '  0',
    'SECTION',
    '  2',
    'TABLES',
    '  0',
    'TABLE',
    '  2',
    'VPORT',
    '  5',
    '  1',
    '100',
    'AcDbSymbolTable',
    '  0',
    'ENDTAB',
    '  0',
    'TABLE',
    '  2',
    'LTYPE',
    '  5',
    '  2',
    '100',
    'AcDbSymbolTable',
    '  0',
    'LTYPE',
    '  5',
    '  3',
    '100',
    'AcDbSymbolTableRecord',
    '100',
    'AcDbLinetypeTableRecord',
    '  2',
    'BYBLOCK',
    ' 70',
    '     0',
    '  0',
    'LTYPE',
    '  5',
    '  4',
    '100',
    'AcDbSymbolTableRecord',
    '100',
    'AcDbLinetypeTableRecord',
    '  2',
    'BYLAYER',
    ' 70',
    '     0');

  STablesLAYER: array[0..11] of string =
   ('  0',
    'ENDTAB',
    '  0',
    'TABLE',
    '  2',
    'LAYER',
    '  5',
    ' 1A',
    '330',
    '  0',
    '100',
    'AcDbSymbolTable');

  STablesSTYLE: array[0..35] of string =
    ('  0',
    'ENDTAB',
    '  0',
    'TABLE',
    '  2',
    'STYLE',
    '  5',
    '  5',
    '100',
    'AcDbSymbolTable',
    '  0',
    'STYLE',
    '  5',
    '  6',
    '100',
    'AcDbSymbolTableRecord',
    '100',
    'AcDbTextStyleTableRecord',
    '  2',
    'STANDARD',
    ' 70',
    '     0',
    ' 40',
    '0.0',
    ' 41',
    '1.0',
    ' 50',
    '0.0',
    ' 71',
    '     0',
    ' 42',
    '10.0',
    '  3',
    'txt',
    '  4',
    '');// no bigfont

  STablesVIEW: array[0..41] of string = (
    '  0',
    'ENDTAB',
    '  0',
    'TABLE',
    '  2',
    'VIEW',
    '  5',
    '  7',
    '100',
    'AcDbSymbolTable',
    '  0',
    'ENDTAB',
    '  0',
    'TABLE',
    '  2',
    'UCS',
    '  5',
    '  8',
    '100',
    'AcDbSymbolTable',
    '  0',
    'ENDTAB',
    '  0',
    'TABLE',
    '  2',
    'APPID',
    '  5',
    '  9',
    '100',
    'AcDbSymbolTable',
    '  0',
    'APPID',
    '  5',
    '  A',
    '100',
    'AcDbSymbolTableRecord',
    '100',
    'AcDbRegAppTableRecord',
    '  2',
    'ACAD',
    ' 70',
    '0');

  STablesDIMSTYLE_R14: array[0..25] of string =
    ('  0',
    'ENDTAB',
    '  0',
    'TABLE',
    '  2',
    'DIMSTYLE',
    '  5',
    '  B',
    '100',
    'AcDbSymbolTable',
    '  0',
    'DIMSTYLE',
    '105',
    ' 1B',
    '330',
    'B',
    '100',
    'AcDbSymbolTableRecord',
    '100',
    'AcDbDimStyleTableRecord',
    '  2',
    'STANDARD',
    ' 70',
    '    0',
    '340',
    '  6'
    );

  STablesDIMSTYLE_R2000: array[0..31] of string =
    ('  0',
    'ENDTAB',
    '  0',
    'TABLE',
    '  2',
    'DIMSTYLE',
    '  5',
    '  B',
    '100',
    'AcDbSymbolTable',
    ' 70',
    '     1',
    '100',
    'AcDbDimStyleTable',
    ' 71',
    '     0',
    '  0',
    'DIMSTYLE',
    '105',
    ' 1B',
    '330',
    'B',
    '100',
    'AcDbSymbolTableRecord',
    '100',
    'AcDbDimStyleTableRecord',
    '  2',
    'STANDARD',
    ' 70',
    '    0',
    '340',
    '  6'
    );

  STablesBLOCK_RECORD: array[0..29] of string =
    ('  0',
    'ENDTAB',
    '  0',
    'TABLE',
    '  2',
    'BLOCK_RECORD',
    '  5',
    '  C',
    '100',
    'AcDbSymbolTable',
    '  0',
    'BLOCK_RECORD',
    '  5',
    '  D',
    '100',
    'AcDbSymbolTableRecord',
    '100',
    'AcDbBlockTableRecord',
    '  2',
    '*MODEL_SPACE',
    '  0',
    'BLOCK_RECORD',
    '  5',
    '  E',
    '100',
    'AcDbSymbolTableRecord',
    '100',
    'AcDbBlockTableRecord',
    '  2',
    '*PAPER_SPACE');

  SBlocks: array[0..59] of string =
   ('  0',
    'ENDTAB',
    '  0',
    'ENDSEC',
    '  0',
    'SECTION',
    '  2',
    'BLOCKS',
    '  0',
    'BLOCK',
    '  5',
    '  F',
    '330',
    '  D',
    '100',
    'AcDbEntity',
    '  8',
    '0',
    '100',
    'AcDbBlockBegin',
    '  2',
    '*MODEL_SPACE',
    ' 70',
    '     0',
    '  0',
    'ENDBLK',
    '  5',
    ' 10',
    '100',
    'AcDbEntity',
    '  8',
    '0',
    '100',
    'AcDbBlockEnd',
    '  0',
    'BLOCK',
    '  5',
    ' 11',
    '330',
    '  E',
    '100',
    'AcDbEntity',
    '  8',
    '0',
    '100',
    'AcDbBlockBegin',
    '  2',
    '*PAPER_SPACE',
    ' 70',
    '     0',
    '  0',
    'ENDBLK',
    '  5',
    ' 12',
    '100',
    'AcDbEntity',
    '  8',
    '0',
    '100',
    'AcDbBlockEnd');

  SObjects_R14: array[0..85] of string =
  (
    '  0',
    'ENDSEC',
    '  0',
    'SECTION',
    '  2',
    'OBJECTS',
    '  0',
    'DICTIONARY',
    '  5',
    '13',
    '100',
    'AcDbDictionary',
    '  3',
    'ACAD_GROUP',
    '350',
    '14',
    '  3',
    'ACAD_MLINESTYLE',
    '350',
    '15',
    '  0',
    'DICTIONARY',
    '  5',
    '14',
    '102',
    '{ACAD_REACTORS',
    '330',
    '13',
    '102',
    '}',
    '100',
    'AcDbDictionary',
    '  0',
    'DICTIONARY',
    '  5',
    '15',
    '102',
    '{ACAD_REACTORS',
    '330',
    '13',
    '102',
    '}',
    '100',
    'AcDbDictionary',
    ' 3',
    'STANDARD',
    '350',
    '16',
    '  0',
    'MLINESTYLE',
    '  5',
    '16',
    '102',
    '{ACAD_REACTORS',
    '330',
    '15',
    '102',
    '}',
    '100',
    'AcDbMlineStyle',
    '  2',
    'STANDARD',
    ' 70',
    '     0',
    '  3',
    ' ',
    ' 62',
    '   256',
    ' 51',
    '90.0',
    ' 52',
    '90.0',
    ' 71',
    '     2',
    ' 49',
    '0.5',
    ' 62',
    '   256',
    '  6',
    'BYLAYER',
    ' 49',
    '-0.5',
    ' 62',
    '   256',
    '  6',
    'BYLAYER'
  );

  SObjects_R2000: array[0..103] of string = (
    '  0',
    'ENDSEC',
    '  0',
    'SECTION',
    '  2',
    'OBJECTS',
    '  0',
    'DICTIONARY',
    '  5',
    ' 13',
    '330',
    '0',
    '100',
    'AcDbDictionary',
    '281',
    '     1',
    '  3',
    'ACAD_GROUP',
    '350',
    ' 14',
    ' 3',
    'ACAD_MLINESTYLE',
    '350',
    ' 16',
    '  3',
    'ACAD_PLOTSETTINGS',
    '350',
    ' 17',
    '  3',
    'ACAD_PLOTSTYLENAME',
    '350',
    ' 18',
    '  0',
    'DICTIONARY',
    '  5',
    ' 14',
    '330',
    ' 13',
    '100',
    'AcDbDictionary',
    '281',
    '     1',
    '  0',
    'DICTIONARY',
    '  5',
    ' 16',
    '330',
    ' 13',
    '100',
    'AcDbDictionary',
    '281',
    '     1',
    '  0',
    'DICTIONARY',
    '  5',
    ' 17',
    '102',
    '{ACAD_REACTORS',
    '330',
    ' 13',
    '102',
    '}',
    '330',
    ' 13',
    '100',
    'AcDbDictionary',
    '281',
    '     1',
    '  0',
    'ACDBDICTIONARYWDFLT',
    '  5',
    ' 18',
    '102',
    '{ACAD_REACTORS',
    '330',
    ' 13',
    '102',
    '}',
    '330',
    ' 13',
    '100',
    'AcDbDictionary',
    '281',
    '     1',
    '  3',
    'Normal',
    '350',
    ' 19',
    '100',
    'AcDbDictionaryWithDefault',
    '340',
    ' 19',
    '  0',
    'ACDBPLACEHOLDER',
    '  5',
    ' 19',// HardPointer in LAYER
    '102',
    '{ACAD_REACTORS',
    '330',
    ' 18',
    '102',
    '}',
    '330',
    ' 18'
    );

  SEndOfDXF: array[0..3] of string = (
    '  0',
    'ENDSEC',
    '  0',
    'EOF');

type
  PPointArray = ^TPointArray;
  TPointArray = array[0..0] of TSmallPoint;
  PIntArray = ^TIntArray;
  TIntArray = array[0..0] of Integer;

  TsgPointPosition = (ppINSIDE, ppOUTSIDE, ppBOUNDARY);
  TsgEdgeType = (etTOUCHING, etCROSSING, etINESSENTIAL);

  PsgSavedDCStatus = ^TsgSavedDCStatus;
  TsgSavedDCStatus = record
    XSavedForm: TXForm;
    Align: Cardinal;
    PenPos: TPoint;
    Pen: TsgPen;
    Brush: TsgBrush;
    Font: TsgFont;
    TextColor: Integer;
    MapMode: Cardinal;
    ViewExt: TSize;
    ViewOrg: TPoint;
    WinExt: TSize;
    WinOrg: TPoint;
    ClipRgn: TsgRegion;
  end;


function AddExpPointInList(const AList: TList; const APoint: TexpPoint): PexpPoint;
begin
  New(Result);
  AList.Add(Result);
  Result^ := APoint;
end;

function HasSymbolCharset(const AFaceName: string): Boolean;
var
  LFont: TLogFont;
  DC: HDC;
  vParam: Cardinal;

  function FontsProc(lpelf: PEnumLogFontEx; lpntm: PNewTextMetric;
    FontType: Cardinal; Param: PCardinal): Integer; stdcall;
  begin
    if lpelf^.elfLogFont.lfCharSet = SYMBOL_CHARSET then
    begin
      Param^ := 1;
      Result := 0;
    end
    else
      Result := 1;
  end;

begin
  FillChar(LFont, SizeOf(TLogFont), 0);
  StrCopy(LFont.lfFaceName, PChar(AFaceName));
  LFont.lfCharSet := DEFAULT_CHARSET;
  DC := GetDC(0);
  try
    vParam := 0;
    EnumFontFamiliesEx(DC, LFont, @FontsProc, LPARAM(@vParam), 0);
  finally
    ReleaseDC(0, DC);
    Result := vParam <> 0;
  end;
end;

procedure BuildSplineByKnots(AControlPoints: TList;
  AKnots: TsgSingleList; APolyPoints: TList; const AIncT: Double);

  function Normalize(const N, I: Integer; Param: Double): Double;
  var
    V1, D1, V2, D2: Double;
  begin
    if N = 0 then
    begin
      if (Single(AKnots[I]) <= Param) and (Param < Single(AKnots[I + 1])) then
        Result := 1
      else
        Result := 0;
    end
    else
    begin
      D1 := Single(AKnots[I + N]) - Single(AKnots[I]);
      V1 := (Param - Single(AKnots[I])) * Normalize(N - 1, I, Param);
      if D1 = 0 then
        V1 := 0
      else
        V1 := V1 / D1;
      D2 := Single(AKnots[I + N + 1]) - Single(AKnots[I + 1]);
      V2 := (Single(AKnots[I + N + 1]) - Param) * Normalize(N - 1, I + 1, Param);
      if D2 = 0 then
        V2 := 0
      else
        V2 := V2 / D2;
      Result := V1 + V2;
    end;
  end;

  function GetNURBS(Index: Integer; Param: Double): TexpPoint;
  var
    I: Integer;
    Ni: Double;
    vCtrl: TexpPoint;
  begin
    Result := MakeExpPoint(0, 0, 1);
    for I := Index - 3 to Index do
    begin
      Ni := Normalize(3, I, Param);
      vCtrl := PFPoint(AControlPoints[I])^;
      Result.X := Result.X + vCtrl.X * Ni;
      Result.Y := Result.Y + vCtrl.Y * Ni;
      Result.Z := Result.Z + vCtrl.Z * Ni;
    end;
  end;

var
  IncTNorm: Double;
  P: PFPoint;
  T: Double;
  I, vControlCount: Integer;
begin
    vControlCount := AControlPoints.Count;
    while AKnots.Count - vControlCount < 4 do
      AKnots.Add(AKnots.Last);
    New(P);
    P^ := PFPoint(AControlPoints[0])^;
    APolyPoints.Add(P);
    for I := 3 to vControlCount - 1 do
    begin
      T := Single(AKnots[I]);
      IncTNorm := AIncT * Abs(Single(AKnots[I + 1]) - Single(AKnots[I]));
      while T < Single(AKnots[I + 1]) do
      begin
        New(P);
        P^ := GetNURBS(I, T);
        APolyPoints.Add(P);
        T := T + IncTNorm;
      end;
    end;
    New(P);
    P^ := PFPoint(AControlPoints[vControlCount - 1])^;
    APolyPoints.Add(P);
end;

function MakeExpPoint(const X, Y, Z: Double): TexpPoint;
begin
  Result.X := X;
  Result.Y := Y;
  Result.Z := Z;
end;

function MakeExportFromFPoint(const AFPoint: TFPoint): TexpPoint;
begin
  Result.X := AFPoint.X;
  Result.Y := AFPoint.Y;
  Result.Z := AFPoint.Z;
end;

{ ClipLine

  Cuts an interior of a line by rectangle. }
procedure ClipLine(ALine: TLine; ARect: TRectangle; AParsedLines: TList);

  function GetYByX(X: Integer): Integer;
  begin
    Result := MaxInt;
    if ((ALine.x1 > X) and (ALine.x2 < X)) or
      ((ALine.x1 < X) and (ALine.x2 > X)) then
      Result := ALine.y1 + (ALine.y2 - ALine.y1) * (X - ALine.x1) div
          (ALine.x2 - ALine.x1);
    if (Result < ARect.Y1) or (Result > ARect.Y2) then
      Result := MaxInt;
  end;

  function GetXByY(Y: Integer): Integer;
  begin
    Result := MaxInt;
    if ((ALine.y1 > Y) and (ALine.y2 < Y)) or
      ((ALine.y1 < Y) and (ALine.y2 > Y)) then
      Result := ALine.x1 + (ALine.x2 - ALine.x1) * (Y - ALine.y1)
        div (ALine.y2 - ALine.y1);
    if (Result < ARect.X1) or (Result > ARect.X2) then
      Result := MaxInt;
  end;

var
  vInt: Integer;
  P: PLine;
begin
  vInt := GetYByX(ARect.X1); // left
  if vInt <> MaxInt then
  begin
    New(P);
    P^ := ALine;
    if P.x1 < ARect.X1 then
    begin
      P.x2 := ARect.X1;
      P.y2 := vInt;
    end
    else
    begin
      P.x1 := ARect.X1;
      P.y1 := vInt;
    end;
    AParsedLines.Add(P);
  end;

  vInt := GetYByX(ARect.X2); // right
  if vInt <> MaxInt then
  begin
    New(P);
    P^ := ALine;
    if P.x1 > ARect.X2 then
    begin
      P.x2 := ARect.X2;
      P.y2 := vInt;
    end
    else
    begin
      P.x1 := ARect.X2;
      P.y1 := vInt;
    end;
    AParsedLines.Add(P);
  end;

  vInt := GetXByY(ARect.Y1); // top
  if vInt <> MaxInt then
  begin
    New(P);
    P^ := ALine;
    if P.y1 < ARect.Y1 then
    begin
      P.y2 := ARect.Y1;
      P.x2 := vInt;
    end
    else
    begin
      P.y1 := ARect.Y1;
      P.x1 := vInt;
    end;
    AParsedLines.Add(P);
  end;

  vInt := GetXByY(ARect.Y2); // bottom
  if vInt <> MaxInt then
  begin
    New(P);
    P^ := ALine;
    if P.y1 > ARect.Y2 then
    begin
      P.y2 := ARect.Y2;
      P.x2 := vInt;
    end
    else
    begin
      P.y1 := ARect.Y2;
      P.x1 := vInt;
    end;
    AParsedLines.Add(P);
  end;
  if AParsedLines.Count = 0 then
    if not PtInRect(Rect(ARect.X1 + 1, ARect.Y1 + 1, ARect.X2, ARect.Y2),
      Point(ALine.x1, ALine.y1)) then
    begin
      New(P);
      P^ := ALine;
      AParsedLines.Add(P);
    end;
end;

function BadRect: TRect;
begin
  Result := Rect(10000, 10000, -10000, -10000);
end;

procedure ExpandRect(var R: TRect; const P: TPoint);
begin
  if R.Left > P.X then
    R.Left := P.X;
  if R.Top > P.Y then
    R.Top := P.Y;
  if R.Right < P.X then
    R.Right := P.X;
  if R.Bottom < P.Y then
    R.Bottom := P.Y;
end;

function IsRectInsideRect(ABigR, ASmallR: TRect): Boolean;
begin
  Result := (ABigR.Left <= ASmallR.Left) and (ABigR.Right >= ASmallR.Right)
    and (ABigR.Top <= ASmallR.Top) and (ABigR.Bottom >= ASmallR.Bottom);
end;

function IsLineOutsideRect(APt1, APt2: TPoint; ARect: TRect): Boolean;
begin
  Result := ((APt1.X < ARect.Left) and (APt2.X < ARect.Left))
    or ((APt1.X > ARect.Right) and (APt2.X > ARect.Right))
    or ((APt1.Y < ARect.Top) and (APt2.Y < ARect.Top))
    or ((APt1.Y > ARect.Bottom) and (APt2.Y > ARect.Bottom));
end;

{  EdgeType

   APoint - point for definition of the type

   Defines edge type. }
function EdgeType(APoint, org, dest: TFPoint): TsgEdgeType;
begin
  case (PointClassify(APoint, org, dest)) of
    pcLEFT:
      begin
        if (org.Y < APoint.Y) and (APoint.Y <= dest.Y) then
          Result := etCROSSING
        else
          Result := etINESSENTIAL;
      end;
    pcRIGHT:
      begin
        if (dest.Y < APoint.Y) and (APoint.Y <= org.Y) then
          Result := etCROSSING
        else
          Result := etINESSENTIAL;
      end;
    pcBETWEEN, pcORIGIN, pcDESTINATION:
      Result := etTOUCHING;
    else
      Result := etINESSENTIAL;
  end;
end;

{ TruncateLine

  ABoundaries - list of list of boundaries; each list is boundary,
                i.e. elements=(TList of PPoint)
  A, B - two points of the line
  ATruncatedLines - list for writing Truncated lines (elements=PFPoint)

  Truncates lines by boundary.                                                 }
procedure TruncateLine(const ABoundaries: TList; AFirst, ASecond: TPoint; ATruncatedLines: TList);
type
  TsgBoundaryPointOrder = (bpNext, bpPrev);
var
  I, K, N, vCounter, PrevCount, parityA, parityB: Integer;
  isUseYSort, boundA, boundB, isAddedA, isAddedB: Boolean;
  r, s, denom: Double;
  vPrevPtClassify, vNextPtClassify: TsgPointClassify;
  vBoundary: TList;
  IntPt: TPoint;
  PIntPt: PPoint;
  A, B, C, D, CrossingPt: TFPoint;
  Pt: PFPoint;

  procedure DefineABPosition;
  begin
    if boundA = False then
      case (EdgeType(A, C, D)) of
        etTOUCHING:
          boundA := True;
        etCROSSING:
          parityA := 1 - parityA;
      end;
    if boundB = False then
      case (EdgeType(B, C, D)) of
        etTOUCHING:
          boundB := True;
        etCROSSING:
          parityB := 1 - parityB;
      end;
  end;

  function BoundaryPoint(AIndex: Integer; AOrd: TsgBoundaryPointOrder): TFPoint;
  var
    vPoint: TPoint;
  begin
    // Boundary last point is equal boundary first pount
    if AOrd = bpNext then
    begin
      if AIndex+1 <= vBoundary.Count - 1 then
        vPoint := PPoint(vBoundary[AIndex+1])^
      else
        vPoint := PPoint(vBoundary[(AIndex+1) mod (vBoundary.Count-1)])^;
    end
    else
    begin
      if AIndex-1 >= 0 then
        vPoint := PPoint(vBoundary[AIndex-1])^
      else
        vPoint := PPoint(vBoundary[vBoundary.Count - AIndex - 2])^;
    end;
    Result := MakeFPoint(vPoint.X, vPoint.Y, 0);
  end;

  function IsLineBetweenBoundaryLines(CrossPt, LinePt: TFPoint; Boundary1Pt, Boundary2Pt: TFPoint): Boolean;
    function GetAngle(BegPt, EndPt: TFPoint): Double;
    begin
      Result := ArcTan2(EndPt.Y - BegPt.Y, EndPt.X - BegPt.X);
    end;
  var
    vBoundary1Ang, vBoundary2Ang, vLineAng, vLineAng2, vTempAng, vDAng : Double;
  begin
    vBoundary1Ang := GetAngle(CrossPt, Boundary1Pt);
    vBoundary2Ang := GetAngle(CrossPt, Boundary2Pt);
    vLineAng := GetAngle(CrossPt, LinePt);
    if vLineAng > 0 then
      vLineAng2 := vLineAng - Pi
    else
      vLineAng2 := vLineAng + Pi;
    if vBoundary2Ang < vBoundary1Ang then
    begin
      vTempAng := vBoundary1Ang;
      vBoundary1Ang := vBoundary2Ang;
      vBoundary2Ang := vTempAng;
    end;
    vDAng := vBoundary2Ang - vBoundary1Ang;
    if Abs(vDAng - Pi) < fAccuracy then
      Result := True
    else
      if vDAng < Pi then
        if ((vLineAng > vBoundary1Ang) and (vBoundary2Ang > vLineAng))
          or ((vLineAng2 > vBoundary1Ang) and (vBoundary2Ang > vLineAng2)) then
          Result := True
        else
          Result := False
      else
        if (vLineAng < vBoundary1Ang) or (vBoundary2Ang < vLineAng)
          or (vLineAng2 < vBoundary1Ang) or (vBoundary2Ang < vLineAng2) then
          Result := True
        else
          Result := False;
  end;
begin
  r := -1;
  s := -1;
  A := MakeFPoint(AFirst.X, AFirst.Y, 0);
  B := MakeFPoint(ASecond.X, ASecond.Y, 0);
  for I := 0 to ABoundaries.Count - 1 do
  begin
    vBoundary := TList(ABoundaries[I]);
    parityA := 0;
    parityB := 0;
    boundA := False;
    boundB := False;
    isAddedA := False;
    isAddedB := False;
    isUseYSort := False;
    if (PPoint(vBoundary[0])^.X <> PPoint(vBoundary[vBoundary.Count-1])^.X)
      or (PPoint(vBoundary[0])^.Y <> PPoint(vBoundary[vBoundary.Count-1])^.Y) then
    begin
      New(PIntPt);
      PIntPt^ := PPoint(vBoundary[0])^;
      vBoundary.Add(PIntPt);
    end;
    PrevCount := ATruncatedLines.Count;// previous number of points
    for N := 0 to vBoundary.Count - 2 do
    begin
      IntPt := PPoint(vBoundary[N])^;
      C := MakeFPoint(IntPt.X, IntPt.Y, 0);
      IntPt := PPoint(vBoundary[N+1])^;
      D := MakeFPoint(IntPt.X, IntPt.Y, 0);
      denom := (B.X - A.X)*(D.Y - C.Y) - (B.Y - A.Y)*(D.X - C.X);
      // Segments are not parallel
      if Abs(denom) > fAccuracy then
      begin
        try
          r := ( (A.Y - C.Y)*(D.X - C.X) - (A.X - C.X)*(D.Y - C.Y) ) / denom;
          s := ( (A.Y - C.Y)*(B.X - A.X) - (A.X - C.X)*(B.Y - A.Y) ) / denom;
        except
          DefineABPosition;
          Continue;
        end;
        // Segments intersected
        if (r >= 0.0 - fAccuracy) and (r <= 1.0 + fAccuracy) and
           (s >= 0.0 - fAccuracy) and (s <= 1.0 + fAccuracy) then
        begin
          CrossingPt := MakeFPoint(A.X + r*(B.X - A.X), A.Y + r*(B.Y - A.Y), 0);
          // Crossing-point is equal first (here "last" will be equal "first" in
          // the next boundary line) point of a boundary line
          if (Abs(CrossingPt.X - C.X) < fAccuracy) and (Abs(CrossingPt.Y - C.Y) < fAccuracy) then
          begin
            DefineABPosition;
            Continue;
          end;
          if ((Abs(CrossingPt.X - D.X) < fAccuracy) and (Abs(CrossingPt.Y - D.Y) < fAccuracy)) and
            not (((Abs(CrossingPt.X - A.X) < fAccuracy) and (Abs(CrossingPt.Y - A.Y) < fAccuracy))
            or ((Abs(CrossingPt.X - B.X) < fAccuracy) and (Abs(CrossingPt.Y - B.Y) < fAccuracy))) then
          begin
            if IsLineBetweenBoundaryLines(CrossingPt, A, C, BoundaryPoint(N+1, bpNext)) = False then
            begin
              vPrevPtClassify := PointClassify(C, A, B);
              //if (vPrevPtClassify <> pcLeft) and (vPrevPtClassify <> pcRight) then
              //  EExternalException.Create('(vPrevPtClassify <> pcLeft) and (vPrevPtClassify <> pcRight)');
              K := N + 1;
              vCounter := 0;
              repeat
                vNextPtClassify := PointClassify(BoundaryPoint(K+vCounter, bpNext), A, B);
                if (vNextPtClassify = pcLEFT) or (vNextPtClassify = pcRIGHT) then
                begin
                  if vPrevPtClassify <> vNextPtClassify then
                  begin
                    New(Pt);
                    Pt^ := CrossingPt;
                    ATruncatedLines.Add(Pt);
                  end;
                  Break;
                end;
                Inc(vCounter);
              until vCounter = vBoundary.Count - 2;
              DefineABPosition;
              Continue;
            end;
          end;
          if (Abs(CrossingPt.X - A.X) < fAccuracy) and (Abs(CrossingPt.Y - A.Y) < fAccuracy) then
            isAddedA := True;
          if (Abs(CrossingPt.X - B.X) < fAccuracy) and (Abs(CrossingPt.Y - B.Y) < fAccuracy) then
            isAddedB := True;
          if (PrevCount <> ATruncatedLines.Count) and (CrossingPt.Y <> PFPoint(ATruncatedLines[ATruncatedLines.Count-1])^.Y) then
            isUseYSort := True;
          New(Pt);
          Pt^ := CrossingPt;
          ATruncatedLines.Add(Pt);
        end;
      end;
      DefineABPosition;
    end;
    // Point inside the boundary if (parity > 0)
    if ((boundA = True) or (parityA > 0)) and not isAddedA then
    begin
      Pt := CreatePFPoint2DProc(A.X, A.Y, 0.0);
      ATruncatedLines.Add(Pt);
      //ATruncatedLines.Insert(0, Pt);
    end;
    if ((boundB = True) or (parityB > 0)) and not isAddedB then
    begin
      Pt := CreatePFPoint2DProc(B.X, B.Y, 0.0);
      ATruncatedLines.Add(Pt);
    end;
    // Sorting of the added coordinates of points of last AB-line
    if (ATruncatedLines.Count > 0) and (PrevCount < ATruncatedLines.Count - 1) then
    begin
      QSortListBounds(ATruncatedLines, ProcCompareFPointByX, PrevCount, ATruncatedLines.Count - 1);
      if isUseYSort then
        QSortListBounds(ATruncatedLines, ProcCompareFPointByY, PrevCount, ATruncatedLines.Count - 1);
    end;
    // Clearing invalid part of ATruncatedLines list
    if (ATruncatedLines.Count - PrevCount) mod 2 <> 0 then
    begin
      if PrevCount <> 0 then
      begin
        K := PrevCount;
        PrevCount := ATruncatedLines.Count - 1;
        for N := K to PrevCount do
        begin
          Dispose(ATruncatedLines[K]);
          ATruncatedLines.Delete(K);
        end;
      end
      else
      begin
        PrevCount := ATruncatedLines.Count - 1;
        for N := 0 to PrevCount do
        begin
          Dispose(ATruncatedLines[0]);
          ATruncatedLines.Delete(0);
        end;
      end;
    end;
  end;
end;

{ TruncateLines

  ABoundaries - list of Boundaries (each list is boundary, elements=PPoint)
  ALines - list of lines-coords (elements=PPoint)
  ATruncatedLines - list for writing Truncated lines (elements=PFPoint)

  Truncates lines by boundary.                                                 }
procedure TruncateLines(const ABoundaries: TList; ALines, ATruncatedLines: TList);
var
  I: Integer;
begin
  if (ALines.Count < 3) then
    raise EListError.Create('TruncateLines: (ALines.Count < 3)');
  I := 0;
  while I <= ALines.Count - 2 do
  begin
    TruncateLine(ABoundaries, PPoint(ALines[I])^, PPoint(ALines[I+1])^, ATruncatedLines);
    Inc(I, 2);
  end;
end;

function GetPourStr(const S: string): string;
begin
  Result := Copy(S, Pos(';', S) + 1, Length(S));
  if Copy(Result, 1, 2) = '\L' then
    Result := Copy(Result, 3, Length(Result));
end;

function IsSquare(const R: TRect): Boolean;
begin
  Result := Abs(Abs(R.Right - R.Left) - Abs(R.Bottom - R.Top)) <= 1;
end;

procedure DoPureRect(var ARect: TRect);
begin
  if ARect.Left > ARect.Right then
    SwapInts(ARect.Right, ARect.Left);
  if ARect.Top > ARect.Bottom then
    SwapInts(ARect.Top, ARect.Bottom);
  //IncreaseRect(ARect);
end;

function MFProc(DC: HDC; HTable,P: Pointer; N: Integer; MF: TsgMetafile): Integer; stdcall;
begin
  Result := 1;
  MF.FData.Text := '';
  FillChar(MF.FData, SizeOf(MF.FData), 0);

  case PEMR(P).iType of
    (* Between begin and end the following functions can be used
    AngleArc Arc ArcTo Chord CloseFigure Ellipse ExtTextOut
    LineTo MoveToEx Pie PolyBezier PolyBezierTo PolyDraw
    Polygon Polyline PolylineTo PolyPolygon PolyPolyline
    Rectangle RoundRect TextOut
    *)
    EMR_BEGINPATH:       MF.BeginPath(P);
    EMR_ENDPATH:         MF.EndPath(P);
    EMR_FILLPATH:        MF.FillPath(P);
    EMR_STROKEANDFILLPATH: MF.StrokeAndFillPath(P);
    EMR_STROKEPATH:        MF.StrokePath(P);
    EMR_POLYLINE:         MF.Polyline(P, False, False, False, False);
    EMR_POLYLINETO:       MF.Polyline(P, False, False, True,  False);
    EMR_POLYBEZIER:       MF.Polyline(P, False, True,  False, False);
    EMR_POLYBEZIERTO:     MF.Polyline(P, False, True,  True,  False);
    EMR_POLYGON:          MF.Polyline(P, False, False, False, True);
    EMR_POLYLINE16:       MF.Polyline(P, True,  False, False, False);
    EMR_POLYLINETO16:     MF.Polyline(P, True,  False, True,  False);
    EMR_POLYBEZIER16:     MF.Polyline(P, True,  True, False, False);
    EMR_POLYBEZIERTO16:   MF.Polyline(P, True,  True, True, False);
    EMR_POLYGON16:        MF.Polyline(P, True,  False, False, True);
    EMR_POLYPOLYLINE16:   MF.PolyPolyline(PEMRPolyPolyline16(P),False);
    EMR_POLYPOLYGON16:    MF.PolyPolyline(PEMRPolyPolyline16(P),True);
    EMR_CLOSEFIGURE:    MF.CloseFigure(PEMRCloseFigure(P));
    EMR_ANGLEARC:       MF.AngleArc(PEMRAngleArc(P));
    EMR_ELLIPSE:        MF.Ellipse(PEMRRectangle(P));
    EMR_RECTANGLE:      MF.Rectangle(PEMRRectangle(P));
    EMR_ROUNDRECT:      MF.RoundRect(PEMRRoundRect(P));
    EMR_ARC:            MF.Arc(PEMRArc(P),False);
    EMR_CHORD:          MF.Arc(PEMRArc(P),False);
    EMR_PIE:            MF.Pie(PEMRPie(P));
    EMR_MOVETOEX:       MF.MoveTo(PEMRLineTo(P));
    EMR_LINETO:         MF.LineTo(PEMRLineTo(P));
    EMR_ARCTO:          MF.Arc(PEMRArc(P),True);
    EMR_SETPIXELV:           MF.SetPixel(PEMRSetPixelV(P));
    EMR_EXTTEXTOUTW:         MF.TextOut(PEMRExtTextOut(P));
    EMR_SETTEXTALIGN:        MF.SetTextAlign(PEMRSetTextAlign(P));
    EMR_SETTEXTCOLOR:        MF.FTextColor := PEMRSetTextColor(P).crColor;
    //EMR_SETBKCOLOR:     MF.SetBkColor(P);
    //EMR_SETBKMODE:         vMode := PEMRSetBkMode(P).iMode;
    EMR_SAVEDC:     MF.SaveDC(PEMRSaveDC(P));
    EMR_RESTOREDC:  MF.RestoreDC(PEMRRestoreDC(P));
    EMR_SELECTOBJECT:   MF.SelectObject(P);
    EMR_DELETEOBJECT:   MF.DeleteObject(P);
    EMR_CREATEPEN:            MF.NewGDI(TsgPen,P);
    EMR_EXTCREATEPEN:         MF.NewGDI(TsgExtPen,P);
    EMR_EXTCREATEFONTINDIRECTW:     MF.NewGDI(TsgFont,P);
    EMR_CREATEBRUSHINDIRECT:        MF.NewGDI(TsgBrush,P);
    //EMR_CREATEMONOBRUSH:  ShowMessage('EMR_CREATEMONOBRUSH');//add here code for Hatch with bmp-pattern
    EMR_INTERSECTCLIPRECT: MF.IntersectClipRect(P);
    EMR_EXTSELECTCLIPRGN: MF.ExtSelectClipRGN(P);
    EMR_FILLRGN:          MF.FillRGN(P);
    EMR_SETWORLDTRANSFORM:
      MF.SetWorldTransform(PEMRSetWorldTransform(P));
    EMR_MODIFYWORLDTRANSFORM:
      MF.ModifyWorldTransform(PEMRModifyWorldTransform(P));
    EMR_SETWINDOWORGEX:
      MF.FWinOrg := PEMRSetWindowOrgEx(P).ptlOrigin;
    EMR_SETVIEWPORTORGEX:
      MF.FViewOrg := PEMRSetViewportOrgEx(P).ptlOrigin;
    EMR_SETWINDOWEXTEX:
      MF.SetWinExt(PEMRSetWindowExtEx(P).szlExtent);
    EMR_SETVIEWPORTEXTEX:
      MF.SetViewExt(PEMRSetViewportExtEx(P).szlExtent);
    EMR_SETMAPMODE:
      MF.SetMapMode(PEMRSetMapMode(P).iMode);
  end;
end;

procedure OffsetDXFPoint(var ADXFPt: TexpPoint);
begin
  ADXFPt.X := ADXFPt.X + OffsetX;
  ADXFPt.Y := ADXFPt.Y + OffsetY;
end;

function FontToStr(Font: TFont; const S: string): string;
begin
  Result := ';' + S;
  if fsItalic in Font.Style then
    Result := '|i1' + Result;
  if fsBold in Font.Style then
    Result := '|b1' + Result;
  Result := '\f' + Font.Name + Result;
end;

{  IncreaseRect

   Increasing Rect.BottomRight on 1 pixel (API problem).        }
procedure IncreaseRect(var ARect: TRect);
begin
  if ARect.Right > ARect.Left then
    ARect.Right := ARect.Right + 1
  else
    ARect.Left := ARect.Left + 1;
  if ARect.Bottom > ARect.Top then
    ARect.Bottom := ARect.Bottom + 1
  else
    ARect.Top := ARect.Top + 1;
end;

{ TsgGDI }

constructor TsgGDI.Create(P: Pointer);
begin
end;

constructor TsgFont.Create(P: Pointer);
  procedure DoFontName(const AName: string);
  begin
    FName := AName;
    // Replace raster font name to TrueType
    if Pos(UpperCase(FName), 'MS SANS SERIF') <> 0 then
      FName := 'Microsoft Sans Serif';
    if FCharSet = SYMBOL_CHARSET then
      if not HasSymbolCharset(FName) then
        FName := 'Wingdings';
  end;
begin
  if P = nil then Exit;
  with PEMRExtCreateFontIndirect(P).elfw.elfLogFont do
  begin
    FCharSet := lfCharSet;
    FHeight := lfHeight;
    FWidth := lfWidth;
    FEscapement := lfEscapement;
    FBold := lfWeight >= 700;
    FItalic := lfItalic <> 0;
    FUnderline := lfUnderline <> 0;
    DoFontName(lfFaceName);
  end;
end;

function TsgFont.GetOffsetX: Double;
begin
  Result := Abs(FHeight) * 0.1975 * Sin(Radian(0.1* FEscapement));
end;

function TsgFont.GetOffsetY: Double;
begin
  Result := Abs(FHeight) * 0.1975 * Cos(Radian(0.1* FEscapement));
end;

constructor TsgPen.Create(P: Pointer);
begin
  FColor := clBlack;// -1 in previous version
  if P = nil then Exit;
  with PEMRCreatePen(P).lopn do
  begin
    FColor := lopnColor;
    FWidth := lopnWidth.X;
    FStyle := TPenStyle(lopnStyle);
  end;
end;

constructor TsgExtPen.Create(P: Pointer);
var
  vBruch: EMRCREATEBRUSHINDIRECT;
begin
  FColor := clBlack;
  if P = nil then Exit;
  with PEMRExtCreatePen(P).elp do
  begin
    FColor := elpColor;
    FWidth := elpWidth;
    FStyle := TPenStyle(elpPenStyle and PS_STYLE_MASK);
  end;
  vBruch.emr := PEMRExtCreatePen(P).emr;
  vBruch.ihBrush := 0;
  vBruch.lb.lbStyle := PEMRExtCreatePen(P).elp.elpBrushStyle;
  vBruch.lb.lbColor := PEMRExtCreatePen(P).elp.elpColor;
  vBruch.lb.lbHatch := PEMRExtCreatePen(P).elp.elpHatch;
  FBrush := TsgBrush.Create(@vBruch);
end;

constructor TsgBrush.Create(P: Pointer);
begin
  FColor := clBlack;// -1 in previous version
  if P = nil then Exit;
  with PEMRCreateBrushIndirect(P).lb do
  begin
    FColor := lbColor;
    FHatchStyle:= hsSolid;// default value (BS_SOLID in case)
    case lbStyle of
      {BS_NULL:// = BS_HOLLOW
      begin
        ShowMessage('BS_NULL, lbStyle= ($'+IntToHex(lbStyle, 8)+')');
      end;}
      BS_HATCHED:
        begin
          case lbHatch of
            HS_HORIZONTAL:      //  -----
              FHatchStyle:= hsHorizontal;
            HS_VERTICAL:        //  |||||
              FHatchStyle:= hsVertical;
            HS_FDIAGONAL:       //  /////
              FHatchStyle:= hsFDiagonal;
            HS_BDIAGONAL:       //  \\\\\
              FHatchStyle:= hsBDiagonal;
            HS_CROSS:           //  +++++
              FHatchStyle:= hsCross;
            HS_DIAGCROSS:       //  xxxxx
              FHatchStyle:= hsDiagCross;
          end;
        end;
      {
      BS_PATTERN:
      begin
        ShowMessage('BS_PATTERN, lbStyle= ($'+IntToHex(lbStyle, 8)+')');
      end;
      BS_INDEXED:
      begin
        ShowMessage('BS_INDEXED, lbStyle= ($'+IntToHex(lbStyle, 8)+')');
      end;
      BS_DIBPATTERN:
      begin
        ShowMessage('BS_DIBPATTERN, lbStyle= ($'+IntToHex(lbStyle, 8)+')');
      end;
      BS_DIBPATTERNPT:
      begin
        ShowMessage('BS_DIBPATTERNPT, lbStyle= ($'+IntToHex(lbStyle, 8)+')');
      end;
      BS_PATTERN8X8:
      begin
        ShowMessage('BS_PATTERN8X8, lbStyle= ($'+IntToHex(lbStyle, 8)+')');
      end;
      BS_DIBPATTERN8X8:
      begin
        ShowMessage('BS_DIBPATTERN8X8, lbStyle= ($'+IntToHex(lbStyle, 8)+')');
      end;
      BS_MONOPATTERN:
      begin
        ShowMessage('BS_MONOPATTERN, lbStyle= ($'+IntToHex(lbStyle, 8)+')');
      end;
      else
      begin
        ShowMessage('WARNING!'#13'In "TsgBrush.Create" brush style is not correct.'#13'Colors can be converted incorrectly.');
      end;
      }
    end;
  end;
end;

{ TsgMetafile }

constructor TsgMetafile.Create(AOwner: TsgDXFExport);
begin
  FAlign := TA_LEFT + TA_TOP;
  FOwner := AOwner;
  FObjects := TList.Create;
  FDfltBrush := TsgBrush.Create(nil);
  FDfltPen := TsgPen.Create(nil);
  FPen := FDfltPen;
  FBrush := nil;
  FFont := nil;
  FPath := nil;
  FIsConstructionPath := False;
  FCanvas := TCanvas.Create;
  FCanvas.Handle := GetDC(0);
  FEXForm.eM11 := 1;  FEXForm.eM12 := 0;
  FEXForm.eM21 := 0;  FEXForm.eM22 := 1;
  FEXForm.eDx  := 0;  FEXForm.eDy  := 0;
  FXForm := FEXForm;
  FMapMode := MM_TEXT;
  FMapModeKoef := -1;// for MM_TEXT mapmode
  FTextColor := clBlack;
  FViewExt.cx := 1;
  FViewExt.cy := 1;
  FViewOrg := Point(0, 0);
  FWinExt.cx := 1;
  FWinExt.cy := 1;
  FWinOrg := Point(0, 0);
  FSavedDCStatus := TList.Create;
  FClipRgn := TsgRegion.Create(Self);
  FMetafileXRatio := 1;
end;

destructor TsgMetafile.Destroy;
var
  I: Integer;
begin
  FDfltBrush.Free;
  FDfltPen.Free;
  FreeAndNil(FPath);
  ReleaseDC(0, FCanvas.Handle);
  FCanvas.Free;
  for I := 0 to FObjects.Count - 1 do
    TObject(FObjects[I]).Free;
  FObjects.Free;
  ClearData;
  FClipRgn.Free;
  for I := 0 to FSavedDCStatus.Count-1 do
  begin
    PsgSavedDCStatus(FSavedDCStatus[I])^.ClipRgn.Free;
    Dispose(FSavedDCStatus[I]);
  end;
  FSavedDCStatus.Free;
end;

function TsgMetafile.FUpdateCP: Boolean;
begin
  Result := FAlign and TA_UPDATECP <> 0;
end;

(*
procedure TsgMetafile.SetBkColor(P: PEMRSetBkColor);
begin
  if FBrush <> nil then
  begin
    FBrush.FColor := PEMRSetBkColor(P).crColor;
  end;
end;
*)

function TsgMetafile.SetCircle(const R: TRect): Boolean;
var
  vRect: TRect;
  PX, PY: TexpPoint;
  vExpandedRect: TFRect;

  function GetFPoint(const AX, AY: Integer): TFPoint;
  begin
    Result.X := AX * FXForm.eM11 + AY * FXForm.eM21 + FXForm.eDx;
    Result.Y := AX * FXForm.eM12 + AY * FXForm.eM22 + FXForm.eDy;
    Result.Z := 0;
  end;

  function GetFRect(const ARct: TRect): TFRect;
  begin
    Result := MakeFRect(1E20, -1E20, 1E20, -1E20, 1E20, -1E20);// BadRect
    ExpandFRect(Result, GetFPoint(ARct.Left, ARct.Top));
    ExpandFRect(Result, GetFPoint(ARct.Left, ARct.Bottom));
    ExpandFRect(Result, GetFPoint(ARct.Right, ARct.Bottom));
    ExpandFRect(Result, GetFPoint(ARct.Right, ARct.Top));
  end;

  function VectorLength(AexpPoint: TexpPoint): Extended;
  begin
    try
      Result := Sqrt(AexpPoint.X*AexpPoint.X + AexpPoint.Y*AexpPoint.Y);
    except
      Result := 0.0;
    end;
  end;

  procedure DoAxes(AX, AY: Double);
  begin
    PX := MakeFPoint(AX * FXForm.eM11, FMapModeKoef*AX * FXForm.eM12, 0);
    PY := MakeFPoint(AY * FXForm.eM21, FMapModeKoef*AY * FXForm.eM22, 0);
    SetOnlyPt(PX);
    SetOnlyPt(PY);
  end;
begin
  vRect := R;
  //if ((R.Right-R.Left)/2 - (R.Right-R.Left) shr 1) > 0 then IncreaseRect(vRect);
  Result := True;//IsSquare(vRect);
  vExpandedRect := GetFRect(vRect);
  FData.Point.X := (vExpandedRect.Left + vExpandedRect.Right) / 2;
  FData.Point.Y := FMapModeKoef*(vExpandedRect.Top + vExpandedRect.Bottom) / 2;
  FData.Point.Z := 0;
  //FData.Point := GetFPoint((vRect.Left + vRect.Right) / 2, -(vRect.Top + vRect.Bottom) / 2);
  SetPt(FData.Point);
  DoAxes(Abs(vRect.Right - vRect.Left) / 2, Abs(vRect.Bottom - vRect.Top) / 2);
  FData.Point2 := MakeExpPoint(VectorLength(PX), VectorLength(PY), 0);
  if Abs(FData.Point2.X-FData.Point2.Y) > 1 then
  begin// ellipse (accuracy for integer GDI-coordinates)
    Result := False;
    if FData.Point2.X > FData.Point2.Y then
    begin
      FData.Point1 := PX;
      FData.Radius := FData.Point2.Y/FData.Point2.X;
    end
    else
    begin
      FData.Point1 := PY;
      FData.Radius := FData.Point2.X/FData.Point2.Y;
    end
  end
  else // circle
    FData.Radius := FData.Point2.X;
  FData.StartAngle := 0;
  FData.EndAngle := 360;// 359
end;

procedure TsgMetafile.SetPen;
const P: array[TPenStyle] of string =
  ('', '_DASH', '_DOT', '_DASHDOT', '_DASHDOTDOT', '', ''
  {$IFDEF SGDEL_2006}, '', ''{$ENDIF});
begin
  if FPen <> nil then
  begin
    FData.Color := FPen.FColor;
    FData.Thickness := FPen.FWidth;
    if Integer(FPen.FStyle) > 6 then
    begin
      SetLType(psDash);
      FData.Text := '_DASH';
    end
    else
    begin
      SetLType(FPen.FStyle);
      FData.Text := P[FPen.FStyle];
    end;
  end;
end;

procedure TsgMetafile.SetDataPts;
begin
  SetPt(FData.Point);
  SetPt(FData.Point1);
end;

procedure TsgMetafile.SetDPtoLP(var ADevicePt: TPoint);
begin
  ADevicePt.X := Round(FViewOrg.X {- FWinOrg.X} + ADevicePt.X * (FWinExt.cx / FViewExt.cx));
  ADevicePt.Y := Round(FViewOrg.Y {+ FWinOrg.Y} + ADevicePt.Y * (FWinExt.cy / FViewExt.cy));
end;

procedure TsgMetafile.SetLPtoDP(var ALogPt: TPoint);
begin
  ALogPt.X := Round(FViewOrg.X {+ FWinOrg.X} + ALogPt.X * (FViewExt.cx / FWinExt.cx));
  ALogPt.Y := Round(FViewOrg.Y {+ FWinOrg.Y} + ALogPt.Y * (FViewExt.cy / FWinExt.cy));
end;

procedure TsgMetafile.SetPt(var APt: TexpPoint);
begin
  OffsetDXFPoint(APt);
  APt.X := APt.X + FViewOrg.X - FWinOrg.X;
  APt.Y := APt.Y + FViewOrg.Y - FWinOrg.Y;
  SetOnlyPt(APt);
end;

procedure TsgMetafile.SetOnlyPt(var APt: TexpPoint);
begin
  if FMapMode <> MM_TEXT then
  begin
    APt.X := APt.X * (FViewExt.cx / FWinExt.cx);
    APt.Y := APt.Y * (FViewExt.cy / FWinExt.cy);
  end;
  APt.X := APt.X * FMetafileXRatio;
end;

procedure TsgMetafile.SetLType(Style: TPenStyle);
begin
  if Style in FStyles then Exit;
  Include(FStyles, Style);
  case Style of
    psDash:             Owner.AddLType('_DASH',[8,-2]);
    psDot:              Owner.AddLType('_DOT', [2,-2]);
    psDashDot:          Owner.AddLType('_DASHDOT', [8,-2,2,-2]);
    psDashDotDot:       Owner.AddLType('_DASHDOTDOT', [8,-2,2,-2,2,-2])
  end;
end;

procedure TsgMetafile.SetMapMode(AMode: Cardinal);
begin
  FMapMode := AMode;
  if (AMode = MM_ISOTROPIC) or (AMode = MM_ANISOTROPIC) or (AMode = MM_TEXT) then
    FMapModeKoef := -1
  else
    FMapModeKoef := 1;
  if (AMode <> MM_ISOTROPIC) and (AMode <> MM_ANISOTROPIC) then
  begin
    FViewExt.cx := 1;
    FViewExt.cy := 1;
    FViewOrg := Point(0, 0);
    FWinExt.cx := 1;
    FWinExt.cy := 1;
    FWinOrg := Point(0, 0);
  end;
end;

procedure TsgMetafile.SetWinExt(AExtent: TSize);
begin
  if (FMapMode <> MM_TEXT) and (FMapMode <> MM_HIMETRIC)
    and (FMapMode <> MM_LOENGLISH) and (FMapMode <> MM_LOMETRIC)
    and (FMapMode <> MM_HIENGLISH) and (FMapMode <> MM_TWIPS) then
  begin
    if (AExtent.cx = 0) or (AExtent.cy = 0) then
    begin
      FWinExt.cx := 1;
      FWinExt.cy := 1;
      FViewExt.cx := 1;
      FViewExt.cy := 1;
    end
    else
      FWinExt := AExtent;
  end;
end;

procedure TsgMetafile.SetViewExt(AExtent: TSize);
begin
  if (FMapMode <> MM_TEXT) and (FMapMode <> MM_HIMETRIC)
    and (FMapMode <> MM_LOENGLISH) and (FMapMode <> MM_LOMETRIC)
    and (FMapMode <> MM_HIENGLISH) and (FMapMode <> MM_TWIPS) then
  begin
    if (AExtent.cx = 0) or (AExtent.cy = 0) then
    begin
      FViewExt.cx := 1;
      FViewExt.cy := 1;
      FWinExt.cx := 1;
      FWinExt.cy := 1;
    end
    else
      FViewExt := AExtent;
  end;
end;

procedure TsgMetafile.MoveCP;
var
  DC: Integer;
  S,C: Extended;
  Sz: TSize;
  F: TFont;
  Pt: TPoint;
begin
  if FFont = nil then Exit;
  F := TFont.Create;
  F.Name := FFont.FName;
  F.Height := FFont.FHeight;
  DC := GetDC(0);
  Windows.SelectObject(DC, F.Handle);
  GetTextExtentPoint(DC, PChar(FText), Length(FText), Sz);
  ReleaseDC(0,DC);
  F.Free;
  Pt.X := Sz.cx;
  Pt.Y := 0;
  if FFont.FEscapement <> 0 then
  begin
    SinCos(FFont.FEscapement * Pi / 1800, S, C);
    Pt.Y := Round(Pt.X * S);
    Pt.X := Round(Pt.X * C);
  end;
  Inc(FPenPos.X, Pt.X);
  Dec(FPenPos.Y, Pt.Y);
end;

procedure TsgMetafile.DeleteObject(P: Pointer);
var
  I, Cnt: DWORD;
begin
  I := PEMRDeleteObject(P).ihObject;
  Cnt := FObjects.Count;
  if I < Cnt then // in fact FPen, FBrush, FFont refer to this object
  begin
    if (FSavedDCStatus.Count>0) and ((FObjects[I] = PsgSavedDCStatus(FSavedDCStatus.Last)^.Pen)
      or (FObjects[I] = PsgSavedDCStatus(FSavedDCStatus.Last)^.Brush) or (FObjects[I] = PsgSavedDCStatus(FSavedDCStatus.Last)^.Font)) then
      Exit;
    if (FObjects[I] = FPen) then
      FPen := nil
    else
      if (FObjects[I] = FBrush) then
        FBrush := nil
      else
        if (FObjects[I] = FFont) then
          FFont := nil;
    TObject(FObjects[I]).Free;
    FObjects[I] := nil; //FObjects.Delete(I);
  end;
end;

procedure TsgMetafile.SelectObject(P: Pointer);
var
  I, Cnt: Cardinal;
  GDI: TsgGDI;
begin
  I := PEMRSelectObject(P).ihObject;
  case I of
    Cardinal($80000000): //ENHMETA_STOCK_OBJECT + WHITE_BRUSH:
    begin
      FDfltBrush.FColor := clDXFWhite;
      FBrush := FDfltBrush;
    end;
    Cardinal($80000001): //ENHMETA_STOCK_OBJECT + LTGRAY_BRUSH:
    begin
      FDfltBrush.FColor := clDXFLTGRAY;
      FBrush := FDfltBrush;
    end;
    Cardinal($80000002): //ENHMETA_STOCK_OBJECT + GRAY_BRUSH:
    begin
      FDfltBrush.FColor := clDXFGray;
      FBrush := FDfltBrush;
    end;
    Cardinal($80000003): //ENHMETA_STOCK_OBJECT + DKGRAY_BRUSH:
    begin
      FDfltBrush.FColor := clDXFDKGray;
      FBrush := FDfltBrush;
    end;
    Cardinal($80000004): //ENHMETA_STOCK_OBJECT + BLACK_BRUSH:
      FBrush := FDfltBrush;
    Cardinal($80000005): // ENHMETA_STOCK_OBJECT + NULL_BRUSH:
      FBrush := nil;
    Cardinal($80000006): // ENHMETA_STOCK_OBJECT + WHITE_PEN:
    begin
      FDfltPen.FColor := clDXFWhite;
      FPen := FDfltPen;
    end;
    Cardinal($80000007): // ENHMETA_STOCK_OBJECT + BLACK_PEN:
      FPen := FDfltPen;
    Cardinal($80000008): // ENHMETA_STOCK_OBJECT + NULL_PEN:
      FPen := nil;
    else
    begin
      Cnt := FObjects.Count;
      if (I >= Cnt) {or (I < 0)} then
        Exit
      else
      begin
        GDI := TsgGDI(FObjects[PEMRSelectObject(P).ihObject]);
        if GDI is TsgExtPen then
        begin
          FPen := TsgPen(GDI);
          //FBrush := TsgExtPen(GDI).Brush;
        end
        else if GDI is TsgPen then
          FPen := TsgPen(GDI)
        else
          if GDI is TsgFont then
            FFont := TsgFont(GDI)
          else
            if GDI is TsgBrush then
              FBrush := TsgBrush(GDI);
      end;
    end;
  end;
end;

procedure TsgMetafile.FillPath(P: PEMRFillPath);
begin
  if FBrush <> nil then
  begin
    FPath.GenereateData(FData);
    FData.Color :=  FBrush.FColor;
    FData.Style := Byte(FBrush.FHatchStyle);
    Owner.AddHatch(FData);
  end;
end;

procedure TsgMetafile.FillRGN(P: Pointer);
var
  vFillRgn: TsgRegion;
  Pt: PexpPoint;
  I, K: Integer;

  procedure SetBrush(ABrushHandleIndex: Cardinal);
  var
    GDI: TsgGDI;
    vBrush: TsgBrush;
    Cnt: Cardinal;
  begin
    Cnt := FObjects.Count;
    if (ABrushHandleIndex < Cnt) and (ABrushHandleIndex > 0) then
    begin
      GDI := TsgGDI(FObjects[ABrushHandleIndex]);
      vBrush := nil;
      if GDI is TsgBrush then
        vBrush := TsgBrush(GDI);
      if vBrush <> nil then
      begin
        FData.Color := vBrush.FColor;
        FData.Style := Byte(vBrush.FHatchStyle);
        FData.SelfType := Byte(hbtPolyPolyline);
      end;
    end;
  end;

  procedure AddPoint(AList: TList; APoint: TPoint);
  begin
    Pt := CreatePFPoint2DProc(APoint.X, FMapModeKoef*APoint.Y, 0);
    SetPt(Pt^);
    AList.Add(Pt);
  end;
begin
  ClearData;
  vFillRgn := TsgRegion.Create(Self);
  try
    SetBrush(PEMRFillRgn(P)^.ihBrush);
    vFillRgn.InitFromData(PRgnData(@PEMRFillRgn(P).RgnData));
    FData.Count := vFillRgn.FPoints.Count;
    FData.Points := TList.Create;
    // Single Hatch for all "polygons" of the region
    for I := 0 to vFillRgn.FPoints.Count - 1 do
    begin
      FData.Points.Add(TList.Create);
      for K := 0 to TList(vFillRgn.FPoints[I]).Count - 1 do
        AddPoint(TList(FData.Points[I]), PPoint(TList(vFillRgn.FPoints[I])[K])^);
      if (PPoint(TList(vFillRgn.FPoints[I])[0])^.X <> PPoint(TList(vFillRgn.FPoints[I])[TList(vFillRgn.FPoints[I]).Count - 1])^.X)
        and (PPoint(TList(vFillRgn.FPoints[I])[0])^.Y <> PPoint(TList(vFillRgn.FPoints[I])[TList(vFillRgn.FPoints[I]).Count - 1])^.Y) then
        AddPoint(TList(FData.Points[I]), PPoint(TList(vFillRgn.FPoints[I])[0])^);
    end;
    FOwner.AddHatch(FData);
  finally
    ClearData;
    vFillRgn.Free;
  end;
end;

procedure TsgMetafile.ExtSelectClipRGN(P: Pointer);
begin
  FClipRgn.InitFromData(PRgnData(@PEMRExtSelectClipRgn(P).RgnData));
end;

procedure TsgMetafile.IntersectClipRect(P: PEMRIntersectClipRect);
begin
  FClipRgn.InitFromRect(PEMRIntersectClipRect(P)^.rclClip, FClipRgn);
end;

procedure TsgMetafile.NewGDI(AClass: TsgGDIClass; P: Pointer);
var
  I: Integer;
begin
  I := PEMRSelectObject(P).ihObject;
  if FObjects.Count <= I then
    FObjects.Count := I + 1;
  TObject(FObjects[I]).Free;
  FObjects[I] := AClass.Create(P);
end;

procedure TsgMetafile.MoveTo(P: PEMRLineTo);
begin
  FPenPos := GetPoint(P.ptl);
end;

procedure TsgMetafile.LineTo(P: PEMRLineTo);
var
  vList: TList;
  I: Integer;
  vPt: TPoint;
  procedure DoLine;
  begin
    if FClipRgn.IsClipping then
    begin
      vPt := GetPoint(P.ptl);
      if not IsLineOutsideRect(FPenPos, vPt, FClipRgn.FBoundsRect) then
      begin
        vList := TList.Create;
        TruncateLine(FClipRgn.FPoints, FPenPos, vPt, vList);
        I := 0;
        while I <= vList.Count - 2 do
        begin
          FData.Point := MakeExportFromFPoint(PFPoint(vList[I])^);
          FData.Point1 := MakeExportFromFPoint(PFPoint(vList[I+1])^);
          DoInvertYPts;
          Owner.AddLine(FData);
          Inc(I, 2);
        end;
        FreeRecordList(vList);
      end;
    end
    else
    begin
      PtToDXF(FPenPos, FData.Point);
      PtToDXF(GetPoint(P.ptl), FData.Point1);
      SetDataPts;
      Owner.AddLine(FData);
    end;
  end;
begin
  if (FIsConstructionPath = True) then
  begin
    if (FPen <> nil) and (FPen.FStyle <> psClear) then
      SetPen;
    DoLine;
    MoveTo(P);// change Pen position (FPenPos)
  end else
  if (FPen <> nil) then
  begin
    if (FPen.FStyle <> psClear) then
    begin
      SetPen;
      DoLine;
    end;
    MoveTo(P);// change Pen position (FPenPos)
  end;
end;

procedure TsgMetafile.SetPixel(P: PEMRSetPixelV);
var
  vPt: TPoint;
begin
  vPt := P.ptlPixel;
  SetLPtoDP(vPt);
  if FClipRgn.IsClipping and (FClipRgn.FHRGN <> 0) and ((PtInRegion(FClipRgn.FHRGN, vPt.X, vPt.Y)) = False) then
    Exit;
  FData.Color := P.crColor;
  PtToDXF(GetPoint(P.ptlPixel), FData.Point);
  SetPt(FData.Point);
  Owner.AddPixel(FData);
end;

procedure TsgMetafile.PtToDXF(const P: TPoint; var ADXFPt: TexpPoint);
begin
  ADXFPt.X := P.X;
  ADXFPt.Y := FMapModeKoef*P.Y;
  ADXFPt.Z := 0.0;
end;

procedure TsgMetafile.Rectangle(P: PEMRRectangle);
var
  Pt: PexpPoint;
  vList: TList;
  vRect: TRect;

  procedure DoRect;
    procedure DoLine(APt1, APt2: TPoint);
    var
      I: Integer;
    begin
      if not IsLineOutsideRect(APt1, APt2, FClipRgn.FBoundsRect) then
      begin
        TruncateLine(FClipRgn.FPoints, APt1, APt2, vList);
        I := 0;
        while I <= vList.Count - 2 do
        begin
          FData.Point := MakeExportFromFPoint(PFPoint(vList[I])^);
          FData.Point1 := MakeExportFromFPoint(PFPoint(vList[I+1])^);
          DoInvertYPts;
          Owner.AddLine(FData);
          Inc(I, 2);
        end;
        ClearRecordList(vList);
      end;
    end;
  begin
    if FClipRgn.IsClipping then
    begin
      vList := TList.Create;
      DoLine(GetPoint(vRect.TopLeft), GetPoint(Point(vRect.Right, vRect.Top)));
      DoLine(GetPoint(Point(vRect.Right, vRect.Top)), GetPoint(vRect.BottomRight));
      DoLine(GetPoint(vRect.BottomRight), GetPoint(Point(vRect.Left, vRect.Bottom)));
      DoLine(GetPoint(Point(vRect.Left, vRect.Bottom)), GetPoint(vRect.TopLeft));
      FreeRecordList(vList);
    end
    else
    begin
      FData.Color := FPen.FColor;
      Owner.AddRectangle(FData);
    end;
  end;

  procedure DoHatch;
  var
    I, K: Integer;
  begin
    if FClipRgn.IsClipping then
    begin
      // ...
      // here code for parsing hatch by rect
      // ...
      vRect := P.rclBox;
      DoPureRect(vRect);
      if IsRectInsideRect(vRect, FClipRgn.FBoundsRect) then
      begin
        FData.Count := 1;
        FData.Points := TList.Create;
        FData.Points.Add(TList.Create);
        // Hatch for each "polygon" of the region
        for I := 0 to FClipRgn.FPoints.Count - 1 do
        begin
          for K := 0 to TList(FClipRgn.FPoints[I]).Count - 1 do
          begin
            Pt := CreatePFPoint2DProc(PPoint(TList(FClipRgn.FPoints[I])[K])^.X,
              FMapModeKoef * PPoint(TList(FClipRgn.FPoints[I])[K])^.Y, 0);
            SetPt(Pt^);
            TList(FData.Points[0]).Add(Pt);
          end;
          if (PPoint(TList(FClipRgn.FPoints[I])[0])^.X <> PPoint(TList(FClipRgn.FPoints[I])[TList(FClipRgn.FPoints[I]).Count - 1])^.X)
            and (PPoint(TList(FClipRgn.FPoints[I])[0])^.Y <> PPoint(TList(FClipRgn.FPoints[I])[TList(FClipRgn.FPoints[I]).Count - 1])^.Y)
            then
          begin
            Pt := CreatePFPoint2DProc(PPoint(TList(FClipRgn.FPoints[I])[0])^.X,
              FMapModeKoef * PPoint(TList(FClipRgn.FPoints[I])[0])^.Y, 0);
            SetPt(Pt^);
            TList(FData.Points[0]).Add(Pt);
          end;
          FOwner.AddHatch(FData);
          ClearRecordList(TList(FData.Points[0]));
        end;
      end;
    end
    else
    begin
      FData.Count := 1;
      FData.Points := TList.Create;
      FData.Points.Add(TList.Create);
      New(Pt);
      Pt^ := FData.Point;
      TList(FData.Points[0]).Add(Pt);
      Pt := CreatePFPoint2DProc(FData.Point1.X, FData.Point.Y, 0);
      TList(FData.Points[0]).Add(Pt);
      New(Pt);
      Pt^ := FData.Point1;
      TList(FData.Points[0]).Add(Pt);
      Pt := CreatePFPoint2DProc(FData.Point.X, FData.Point1.Y, 0);
      TList(FData.Points[0]).Add(Pt);
      Owner.AddHatch(FData);
    end;
  end;
begin
  ClearData;
  SetPen;
  vRect := P.rclBox;
  IncreaseRect(vRect);
  PtToDXF(GetPoint(vRect.TopLeft), FData.Point);
  PtToDXF(GetPoint(vRect.BottomRight), FData.Point1);
  SetDataPts;
  if FIsConstructionPath = True then
  begin
    if (FPen <> nil) then
      DoRect;
  end
  else
  begin
    if FBrush <> nil then
    begin
      FData.Color := FBrush.FColor;
      FData.Style := Byte(FBrush.FHatchStyle);
      FData.SelfType := Byte(hbtPolyPolyline);
      DoHatch;
    end;
    // To not draw border, when same color fill
    if (FPen <> nil) and ((FBrush = nil) or (FBrush.FHatchStyle <> hsSolid) or (FPen.FColor <> FBrush.FColor)) then
      DoRect;
  end;
  ClearData;
end;

procedure TsgMetafile.Ellipse(P: PEMRRectangle);
var
  vHbt: TsgHatchBoundaryType;

  procedure DoHatch;
  begin
    if FBrush <> nil then
    begin
      FData.Color := FBrush.FColor;
      FData.Style := Byte(FBrush.FHatchStyle);
      FData.SelfType := Byte(vHbt);
      Owner.AddHatch(FData);
    end;
  end;
begin
  SetPen;
  if (P.rclBox.Right = P.rclBox.Left) or (P.rclBox.Bottom = P.rclBox.Top) then
    Exit;
  if SetCircle(P.rclBox) then
  begin
    Owner.AddCircle(FData);
    vHbt := hbtCircle;
  end
  else
  begin
    Owner.AddEllipse(FData);
    vHbt := hbtEllipse;
  end;
  if FIsConstructionPath = False then
    DoHatch;
end;

procedure TsgMetafile.EndPath(P: PEMREndPath);
begin
  FIsConstructionPath := False;
end;

procedure TsgMetafile.RoundRect(P: PEMRRoundRect);
  procedure DoPt(var DP: TexpPoint; X,Y: Integer);
  begin
    PtToDXF(Point(X,Y), DP);
    SetPt(DP);
  end;
var
  W, H: Integer;
  Pt: PexpPoint;
  rclBox: TRect;
begin
  ClearData;
  rclBox := GetRect(P.rclBox);
  W := (rclBox.Right - rclBox.Left) shr 1;
  H := (rclBox.Bottom - rclBox.Top) shr 1;

  if W > P.szlCorner.cx shr 1 then W := P.szlCorner.cx shr 1;
  if H > P.szlCorner.cy shr 1 then H := P.szlCorner.cy shr 1;
  with rclBox do
  begin
    FData.Count := 1;
    FData.Points := TList.Create;
    FData.Points.Add(TList.Create);
    New(Pt);
    DoPt(Pt^, Left+W, Top);
    TList(FData.Points[0]).Add(Pt);
    New(Pt);
    DoPt(Pt^, Right-W, Top);
    TList(FData.Points[0]).Add(Pt);
    New(Pt);
    DoPt(Pt^, Right, Top+H);
    TList(FData.Points[0]).Add(Pt);
    New(Pt);
    DoPt(Pt^, Right, Bottom-H);
    TList(FData.Points[0]).Add(Pt);
    New(Pt);
    DoPt(Pt^, Right-W, Bottom);
    TList(FData.Points[0]).Add(Pt);
    New(Pt);
    DoPt(Pt^, Left+W, Bottom);
    TList(FData.Points[0]).Add(Pt);
    New(Pt);
    DoPt(Pt^, Left, Bottom-H);
    TList(FData.Points[0]).Add(Pt);
    New(Pt);
    DoPt(Pt^, Left, Top+H);
    TList(FData.Points[0]).Add(Pt);
  end;
  SetPen;
  FData.Flags := 1;
  FData.Count := 1;
  Owner.AddPolyLine(FData, 0);
  ClearData;
end;

procedure TsgMetafile.AngleArc(P: PEMRAngleArc);
var
  vTmp: Double;
begin
  SetPen;
  PtToDXF(GetPoint(P.ptlCenter), FData.Point);
  FData.Radius := P.nRadius;
  FData.StartAngle := P.eStartAngle;
  FData.EndAngle := P.eStartAngle + P.eSweepAngle;
  if P.eSweepAngle < 0 then
  begin
    vTmp := FData.EndAngle;
    FData.EndAngle := FData.StartAngle;
    FData.StartAngle := vTmp;
  end;
  SetDataPts;
  Owner.AddArc(FData);
end;

procedure TsgMetafile.Arc(P: PEMRArc; Move: Boolean);
var
  vPt: TexpPoint;

  function AngleCircle(const A: TPoint): Extended;
  begin
    vPt := MakeExpPoint(A.X, FMapModeKoef*A.Y, 0);
    SetPt(vPt);
    Result := 180 / Pi * ArcTan2(vPt.Y - FData.Point.Y, vPt.X - FData.Point.X);
  end;

  function AngleEllipse(const A: TPoint): Extended;
  var
    X, Y: Extended;
  begin
    vPt := MakeExpPoint(A.X, FMapModeKoef*A.Y, 0);
    SetPt(vPt);
    X := vPt.X - FData.Point.X;
    Y := vPt.Y - FData.Point.Y;
    //vAngle := Degree(ArcTan2(FData.Point1.Y, FData.Point1.X));
    if FData.Point2.X < FData.Point2.Y then
      Result := ArcTan2(FData.Radius*Y, X) + Pi/2
    else
      Result := -ArcTan2(FData.Radius*X, Y) + Pi/2;
  end;
begin
  SetPen;
  if (P.rclBox.Right = P.rclBox.Left) or (P.rclBox.Bottom = P.rclBox.Top) then
    Exit;
  if SetCircle(P.rclBox) then
  begin
    // Default StartAngle=0 and EndAngle=360
    if not ((P.ptlStart.X=P.ptlEnd.X) and (P.ptlStart.Y=P.ptlEnd.Y)) then
    begin
      FData.StartAngle := AngleCircle(GetPoint(P.ptlStart));
      FData.EndAngle := AngleCircle(GetPoint(P.ptlEnd));
    end;
    FData.SelfType := Byte(atCircle);
  end
  else
  begin
    if not ((P.ptlStart.X=P.ptlEnd.X) and (P.ptlStart.Y=P.ptlEnd.Y)) then
    begin
      FData.StartAngle := AngleEllipse(GetPoint(P.ptlStart));
      FData.EndAngle := AngleEllipse(GetPoint(P.ptlEnd));
    end
    else
    begin
      // StartAngle=0 and EndAngle=2*Pi for full Ellipse
      FData.StartAngle := 0;
      FData.EndAngle := 2*Pi;
    end;
    FData.SelfType := Byte(atEllipse);
  end;
  Owner.AddArc(FData);
end;

procedure TsgMetafile.BeginPath(P: PEMRBeginPath);
begin
  FIsConstructionPath := True;
  if FPath <> nil then
    FreeAndNil(FPath);
  FPath := TsgExpDXFPath.Create(FData);
end;

procedure TsgMetafile.Polyline(P: Pointer; const Is16, IsBezier, Move,Close: Boolean);
var
  I, Count: Integer;
  vRect: TRect;

  procedure AddPoint(AList: TList; const APoint: TPoint);
  var
    Pt: PexpPoint;
  begin
    New(Pt);
    PtToDXF(APoint, Pt^);
    SetPt(Pt^);
    TList(FData.Points[0]).Add(Pt);
    ExpandRect(vRect, APoint);
  end;

  function DoPoint(AIndex: Integer): TPoint;
  begin
    if Is16 then
      Result := GetPoint(SmallPointToPoint(PEMRPolyline16(P)^.apts[AIndex]))
    else
      Result := GetPoint(PEMRPolyline(P)^.aptl[AIndex]);
  end;

  procedure DoPolyline;
  var
    J: Integer;
    vCurPoint, vPrevPoint: TPoint;
    vList: TList;
  begin
    if FClipRgn.IsClipping and not (FClipRgn.IsRect and IsRectInsideRect(FClipRgn.FBoundsRect, vRect)) then
    begin
      vList := TList.Create;
      for J := 0 to Count do
      begin
        vCurPoint := DoPoint(J);
        if (J <> 0) then
        begin
          vPrevPoint := DoPoint(J-1);
          if not IsLineOutsideRect(vPrevPoint, vCurPoint, FClipRgn.FBoundsRect) then
          begin
            TruncateLine(FClipRgn.FPoints, vPrevPoint, vCurPoint, vList);
            I := 0;
            while I <= vList.Count - 2 do
            begin
              FData.Point := MakeExportFromFPoint(PFPoint(vList[I])^);
              FData.Point1 := MakeExportFromFPoint(PFPoint(vList[I+1])^);
              DoInvertYPts;
              FOwner.AddLine(FData);
              Inc(I, 2);
            end;
            ClearRecordList(vList);
          end;
        end;
      end;
      FreeRecordList(vList);
    end
    else
    begin
      FOwner.AddPolyLine(FData, 0);
    end;
  end;

  procedure DoHatch;
  begin
    if FClipRgn.IsClipping and not (FClipRgn.IsRect and IsRectInsideRect(FClipRgn.FBoundsRect, vRect)) then
    begin
      // ...
      // here code for parsing hatch by polyline
      // ...
    end
    else
    begin
      FOwner.AddHatch(FData);
    end;
  end;
begin
  ClearData;
  SetPen;
  if not (((FPen <> nil) and (not Close or (FBrush = nil)
    or (FBrush.FHatchStyle <> hsSolid) or (FPen.FColor <> FBrush.FColor)))
    or ((FBrush <> nil) and Close)) then
    Exit;
  if Is16 then
    Count := PEMRPolyline16(P)^.cpts - 1
  else
    Count := PEMRPolyline(P)^.cptl - 1;
  vRect := BadRect;
  FData.Flags := Ord(Close);
  FData.Count := 1;
  FData.Points := TList.Create;
  FData.Points.Add(TList.Create);
  if Move then
  begin
    AddPoint(FData.Points[0], FPenPos);
    if Close then
      I := 0
    else
      I := Count;
    FPenPos := DoPoint(I);
  end;
  for I := 0 to Count do
    AddPoint(FData.Points[0], DoPoint(I));
  if FIsConstructionPath = True then
  begin
    if (FPen <> nil) then
    begin
      FData.Color := FPen.FColor;
      if IsBezier then
        FOwner.AddPolyBezier(FData, 0)
      else
        DoPolyline;
      end;
  end
  else
  begin
    if (FBrush <> nil) and Close then
    begin
      FData.Color := FBrush.FColor;
      FData.Style := Byte(FBrush.FHatchStyle);
      FData.SelfType := Byte(hbtPolyPolyline) + Ord(IsBezier and (((Count - 3) mod 3) = 0));
      DoHatch;
    end;
    // To not draw border, when same color fill
    if (FPen <> nil) and (not Close or (FBrush = nil)
      or (FBrush.FHatchStyle <> hsSolid) or (FPen.FColor <> FBrush.FColor)) then
    begin
      FData.Color := FPen.FColor;
      if IsBezier then
        FOwner.AddPolyBezier(FData, 0)
      else
        DoPolyline;
      end;
  end;
  ClearData;
end;

procedure TsgMetafile.PolyPolyline(P: PEMRPolyPolyline16; Close: Boolean);
var
  J, K, Count: Integer;
  Pt: PexpPoint;
  P1: PIntArray;
  P2: PPointArray;

  function DoPoint(APtArr: PPointArray; AIndex: Integer): TPoint;
  begin
    Result := GetPoint(SmallPointToPoint(APtArr^[AIndex]));
  end;

  procedure DoPolyline;
  var
    I, J, K: Integer;
    vCurPoint, vPrevPoint: TPoint;
    vList: TList;
  begin
    P1 := @(P^.aPolyCounts);
    PAnsiChar(P2) := PAnsiChar(P1) + P^.nPolys * SizeOf(DWORD);
    vList := TList.Create;
    for K := 0 to P.nPolys - 1 do
    begin
      FData.Count := 1;
      Count := P1^[K];
      for J := 0 to Count - 1 do
      begin
        vCurPoint := DoPoint(P2, J);
        if (J <> 0) then
        begin
          vPrevPoint := DoPoint(P2, J-1);
          if not IsLineOutsideRect(vPrevPoint, vCurPoint, FClipRgn.FBoundsRect) then
          begin
            TruncateLine(FClipRgn.FPoints, vPrevPoint, vCurPoint, vList);
            I := 0;
            while I <= vList.Count - 2 do
            begin
              FData.Point := MakeExportFromFPoint(PFPoint(vList[I])^);
              FData.Point1 := MakeExportFromFPoint(PFPoint(vList[I+1])^);
              DoInvertYPts;
              FOwner.AddLine(FData);
              Inc(I, 2);
            end;
            ClearRecordList(vList);
          end;
        end;
      end;
      Inc(PAnsiChar(P2), Count * SizeOf(TSmallPoint));
    end;
    FreeRecordList(vList);
  end;

  procedure DoHatch;
  begin
    if FClipRgn.IsClipping then
    begin
      // ...
      // here code for parsing hatch by polyline
      // ...
      FOwner.AddHatch(FData);
    end
    else
    begin
      FOwner.AddHatch(FData);
    end;
  end;
begin
  if P^.nPolys = 0 then
    Exit;
  SetPen;
  ClearData;
  FData.Points := TList.Create;
  FData.Count := P^.nPolys;
  FData.Flags := Ord(Close);
  P1 := @(P^.aPolyCounts);
  PAnsiChar(P2) := PAnsiChar(P1) + P^.nPolys * SizeOf(DWORD);
  for K := 0 to P.nPolys - 1 do
  begin
    FData.Points.Add(TList.Create);
    Count := P1^[K];
    for J := 0 to Count - 1 do
    begin
      New(Pt);
      PtToDXF(DoPoint(P2, J), Pt^);
      SetPt(Pt^);
      TList(FData.Points[K]).Add(Pt);
    end;
    Inc(PAnsiChar(P2), Count * SizeOf(TSmallPoint));
  end;
  if FIsConstructionPath = True then
  begin
    if (FPen <> nil) then
    begin
      FData.Color := FPen.FColor;
      if not FClipRgn.IsClipping then
        for J := 0 to FData.Points.Count - 1 do
          FOwner.AddPolyLine(FData, J)
      else
        DoPolyLine;
    end;
  end
  else
  begin
    // Adding Hatch
    if (FBrush <> nil) and Close then
    begin
      FData.Color := FBrush.FColor;
      FData.Style := Byte(FBrush.FHatchStyle);
      FData.SelfType := Byte(hbtPolyPolyline);
      DoHatch;
    end;
    // Adding polylines
    if (FPen <> nil) and (not Close or (FBrush = nil)
      or (FBrush.FHatchStyle <> hsSolid) or (FPen.FColor <> FBrush.FColor)) then
    begin
      FData.Color := FPen.FColor;
      if not FClipRgn.IsClipping then
        for J := 0 to FData.Points.Count - 1 do
          FOwner.AddPolyLine(FData, J)
      else
        DoPolyLine;
    end;
  end;
  ClearData;
end;

{ TsgMetafile.ClearData

  Clearing Data.Points-list.       }
procedure TsgMetafile.ClearData;
begin
  FData.Text := '';
  FreeRecordListOfList(FData.Points);
  //FillChar(FData, SizeOf(FData), 0);
end;

procedure TsgMetafile.CloseFigure(P: PEMRCloseFigure);
var
  vPoly: TsgExpDXFPolyline;
  Pt: PexpPoint;
begin
  if FIsConstructionPath = True then
    FPath.CloseFigure;
  if (FOwner.FFiguresList.Count > 0)
    and (TsgExpDXFFigure(FOwner.FFiguresList.Last).ClassType = TsgExpDXFPolyline) then
  begin
    vPoly := TsgExpDXFPolyline(FOwner.FFiguresList.Last);
    if (vPoly <> nil) and (vPoly.FPoints.Count > 0) then
    begin
      New(Pt);
      Pt^ := PexpPoint(vPoly.FPoints.First)^;
      vPoly.FPoints.Add(Pt);
      vPoly.FData.Count := vPoly.FPoints.Count;
    end;
  end;
end;

procedure TsgMetafile.TextOut(P: PEMRExtTextOut);
var
  L, I: DWORD;
  ChL, ChR: Integer;
  Pt, PtTemp: TPoint;
//  vRect: TRect;
  IsUnicode: Boolean;
  WStr: WideString;
  vOffsetX, vOffsetY: Double;

  function GetTextHeight(AHeight: Integer): Double;
  var
    vDXFPt: TexpPoint;
  begin
    vDXFPt := MakeExpPoint(0, Abs(AHeight) * FXForm.eM22 * 0.605, 0);
    SetOnlyPt(vDXFPt);
    Result := Abs(vDXFPt.Y);
  end;

  function GetTextScale(AHeight: Integer; AWidth: Integer): Double;
  var
    vDXFPt: TexpPoint;
  begin
    vDXFPt := MakeExpPoint(Abs(AWidth) * FXForm.eM11 / 0.64, 0, 0);
    SetOnlyPt(vDXFPt);
    Result := Abs(vDXFPt.X)/GetTextHeight(AHeight);
  end;

begin
  if FUpdateCP then
    Pt := FPenPos
  else
    Pt := GetPoint(P^.emrtext.ptlReference);
  L := P^.emrtext.nChars;
  if L = 0 then
    Exit;
//  vRect := P^.rclBounds;
  Inc(PAnsiChar(P), P^.emrtext.offString);
  FText := PWideChar(P);
  if FClipRgn.IsClipping and (FClipRgn.FHRGN <> 0) then
  begin
    PtTemp := Pt;
    SetLPtoDP(PtTemp);
    if PtInRegion(FClipRgn.FHRGN, PtTemp.X, PtTemp.Y) = False then
      Exit;
//    if not RectInRegion(FClipRgn.FHRGN, vRect) then Exit;
  end;
  PtToDXF(Pt, FData.Point);
  FData.Color := FTextColor;
  if FFont <> nil then
  begin
    //FData.FHeight := Abs(FFont.FHeight {* FXForm.eM22}) * 0.605;
    //FData.FScale := FFont.FWidth / FData.FHeight / 0.64;
    FData.FHeight := GetTextHeight(FFont.FHeight);
    FData.FScale := GetTextScale(FFont.FHeight, FFont.FWidth);
    if FData.FScale <= fAccuracy then
      FData.FScale := 1.0;
    FData.Rotation := FFont.FEscapement / 10;
    FData.Flags := Ord(FFont.FItalic);
    vOffsetX := FFont.OffsetX;
    vOffsetY := FFont.OffsetY;
  end
  else
  begin
    FData.FHeight := 11;
    vOffsetX := 3;
    vOffsetY := 3;
  end;
  FData.HAlign := 0;// topleft as default
  case FAlign of
    TA_CENTER:   FData.HAlign := 1;
    TA_RIGHT:    FData.HAlign := 2;
    TA_BASELINE, TA_BOTTOM:   FData.HAlign := 6;
    (TA_CENTER or TA_BOTTOM): FData.HAlign := 7;
    (TA_RIGHT or TA_BOTTOM):  FData.HAlign := 8;
  end;
  if (FAlign = 0) and (Owner.AutoCADVer = R14) then
  begin// for TEXT only
    FData.VAlign := 3;
    FData.Point.Y := FData.Point.Y - vOffsetY * GetSignYExt;
    FData.Point1 := FData.Point;
    FData.Point.X := FData.Point.X;
    FData.Point.Y := FData.Point.Y - FData.FHeight * GetSignYExt;
  end
  else
    if (FAlign = TA_BASELINE) or (FAlign and TA_BOTTOM = 0) then
    begin
      FData.Point.X := FData.Point.X + vOffsetX;
      FData.Point.Y := FData.Point.Y - vOffsetY * GetSignYExt;
    end;

  FText := '';
  WStr := Copy(PWideChar(P), 1, L);
  IsUnicode := False;
  if (FOwner = nil) or FOwner.UseUnicode then
    for I := 1 to L do
    begin
      ChL := Integer(WStr[I]) and $FF00 shr 8;
      ChR := Integer(WStr[I]) and $00FF;
      if not IsUnicode and ((ChL <> 0) or (ChR >= 128)) then// ASCII=($0000-$007F)
        IsUnicode := True;
      //if (FFont <> nil) and (CompareStr(FFont.FName, 'Symbol') = 0) then FText := FText + Char(ChR) else
      FText := FText + '\U+' + IntToHex(ChL, 2) + IntToHex(ChR, 2);
    end;
  if IsUnicode = False then
  begin
    FText := WStr;
    ReplaceAnsi(FText, '\', '\\');
  end;
  if FFont <> nil then
    FCanvas.Font.Height := FFont.FHeight
  else
    FCanvas.Font.Height := Round(FData.FHeight);
  FData.RWidth := FCanvas.TextWidth(FText);
  if FUpdateCP then MoveCP;
  SetDataPts;
  if (FFont <> nil) then
  begin
    if FFont.FUnderline then
      FText := '\L' + FText;
    if FOwner.UseMetafileFontName and (Owner.AutoCADVer <> R14) then
    begin
      // Unicode or 'Symbol' is no italic and no bold (for correct viewing in AutoCAD)
      if IsUnicode then
        FText := '|b0|i0;' + FText //|c2 for 'Symbol' correct in AutoCAD
      else
      begin
        FText := ';' + FText;
        if FFont.FBold then
          FText := '|b1' + FText
        else
          FText := '|b0' + FText;
        if FFont.FItalic then
          FText := '|i1' + FText
        else
          FText := '|i0' + FText;
      end;
      FText := '{\f' + FFont.FName + FText+'}';
    end;
  end;
  FData.Text := FText;
  if Owner.AutoCADVer = R14 then
  begin
    FData.StyleObject := Owner.GetTextStyleByFontName(FFont.FName);
    Owner.AddText(FData)
  end
  else
    Owner.AddMText(FData);
end;

procedure TsgMetafile.SetTextAlign(P: PEMRSetTextAlign);
begin
  FAlign := P.iMode;
end;

{ TsgMetafile.SetWorldTransform

  Sets a 2D-linear transformation between world space and page space
  for the specified device context.                                  }
procedure TsgMetafile.SetWorldTransform(P: PEMRSetWorldTransform);
begin
  FXForm := P.xform;
end;

procedure TsgMetafile.StrokeAndFillPath(P: PEMRStrokeAndFillPath);
begin
  FillPath(P);
  StrokePath(P);
end;

procedure TsgMetafile.StrokePath(P: PEMRStrokePath);
var
  I,J: Integer;
  vList: TList;
begin
  if FPath <> nil then
  begin
    if (FPen <> nil) and (FPen.FStyle <> psClear) then
    begin
      for I := 0 to FPath.FigureList.Count - 1 do
      begin
        vList := FPath.FigureList[I];
        for J := 0 to vList.Count - 1 do
        begin
          Owner.AddEntity(vList[J]);
        end;
      end;
    end;
  end;
end;

{ TsgMetafile.ModifyWorldTransform

  Changes the world transformation for a device context using the
  specified mode.                                                    }
procedure TsgMetafile.ModifyWorldTransform(P: PEMRModifyWorldTransform);
var
  vXForm: TXForm;
begin
  case P.iMode of
    MWT_IDENTITY:
      FXForm := FEXForm;
    MWT_LEFTMULTIPLY:
    begin // modify * current
      vXForm := FXForm;
      FXForm.eM11 := vXForm.eM11 * P.xform.eM11 + vXForm.eM12 * P.xform.eM21;
      FXForm.eM12 := vXForm.eM11 * P.xform.eM12 + vXForm.eM12 * P.xform.eM22;
      FXForm.eM21 := vXForm.eM21 * P.xform.eM11 + vXForm.eM22 * P.xform.eM21;
      FXForm.eM22 := vXForm.eM21 * P.xform.eM12 + vXForm.eM22 * P.xform.eM22;
      FXForm.eDx := vXForm.eDx + P.xform.eDx;
      FXForm.eDy := vXForm.eDy + P.xform.eDy;
    end;
    MWT_RIGHTMULTIPLY:
    begin // current * modify
      vXForm := FXForm;
      FXForm.eM11 := P.xform.eM11 * vXForm.eM11 + P.xform.eM12 * vXForm.eM21;
      FXForm.eM12 := P.xform.eM11 * vXForm.eM12 + P.xform.eM12 * vXForm.eM22;
      FXForm.eM21 := P.xform.eM21 * vXForm.eM11 + P.xform.eM22 * vXForm.eM21;
      FXForm.eM22 := P.xform.eM21 * vXForm.eM12 + P.xform.eM22 * vXForm.eM22;
      FXForm.eDx := vXForm.eDx + P.xform.eDx;
      FXForm.eDy := vXForm.eDy + P.xform.eDy;
    end
    else
      FXForm := P.xform;
  end;
end;

{ TsgMetafile.SaveDC

  Saves a basic parameters for current metafile.    }
procedure TsgMetafile.SaveDC(P: PEMRSaveDC);
var
  vPSavedDCStatus: PsgSavedDCStatus;
begin
  New(vPSavedDCStatus);
  vPSavedDCStatus^.XSavedForm := FXForm;
  vPSavedDCStatus^.Align := FAlign;
  vPSavedDCStatus^.TextColor := FTextColor;
  vPSavedDCStatus^.PenPos := FPenPos;
  vPSavedDCStatus^.Pen := FPen;
  vPSavedDCStatus^.Brush := FBrush;
  vPSavedDCStatus^.Font := FFont;
  vPSavedDCStatus^.MapMode := FMapMode;
  vPSavedDCStatus^.ViewExt := FViewExt;
  vPSavedDCStatus^.ViewOrg := FViewOrg;
  vPSavedDCStatus^.WinExt := FWinExt;
  vPSavedDCStatus^.WinOrg := FWinOrg;
  vPSavedDCStatus^.ClipRgn := TsgRegion.Create(Self);
  vPSavedDCStatus^.ClipRgn.Assign(FClipRgn);
  FSavedDCStatus.Add(vPSavedDCStatus);
end;

{ TsgMetafile.RestoreDC

  Restores a basic parameters for current metafile.    }
procedure TsgMetafile.RestoreDC(P: PEMRRestoreDC);
var
  vPSavedDCStatus: PsgSavedDCStatus;
begin
  if FSavedDCStatus.Count > 0 then
  begin
    vPSavedDCStatus := PsgSavedDCStatus(FSavedDCStatus.Last);
    FAlign := vPSavedDCStatus^.Align;
    FTextColor := vPSavedDCStatus^.TextColor;
    FPenPos := vPSavedDCStatus^.PenPos;
    FXForm := vPSavedDCStatus^.XSavedForm;
    FViewExt := vPSavedDCStatus^.ViewExt;
    FViewOrg := vPSavedDCStatus^.ViewOrg;
    FWinExt := vPSavedDCStatus^.WinExt;
    FWinOrg := vPSavedDCStatus^.WinOrg;
    FPen := vPSavedDCStatus^.Pen;
    FBrush := vPSavedDCStatus^.Brush;
    FFont := vPSavedDCStatus^.Font;
    SetMapMode(vPSavedDCStatus^.MapMode);
    FClipRgn.Assign(vPSavedDCStatus^.ClipRgn);
    vPSavedDCStatus^.ClipRgn.Free;
    Dispose(vPSavedDCStatus);
    FSavedDCStatus.Delete(FSavedDCStatus.Count-1);
  end;
end;

procedure TsgMetafile.ProcessMetafile(Metafile: TMetafile);
var
  emfh: TEnhMetaHeader;
  vMFRatioX, vMFRatioY: Double;
begin
  if FOwner.UseMetafileRatio and (GetEnhMetaFileHeader(Metafile.Handle, sizeof(emfh), @emfh) > 0) then
  begin
    (* For future versions
    vMFRatioX := Metafile.Width/(emfh.rclBounds.Right-emfh.rclBounds.Left);
    vMFRatioY := Metafile.Height/(emfh.rclBounds.Bottom-emfh.rclBounds.Top);
    vMFRatioX := (emfh.rclFrame.Right - emfh.rclFrame.Left)/(emfh.rclBounds.Right-emfh.rclBounds.Left);
    vMFRatioY := (emfh.rclFrame.Bottom - emfh.rclFrame.Top)/(emfh.rclBounds.Bottom-emfh.rclBounds.Top); *)
    vMFRatioX := Metafile.Width/(emfh.rclFrame.Right - emfh.rclFrame.Left);
    vMFRatioY := Metafile.Height/(emfh.rclFrame.Bottom - emfh.rclFrame.Top);
    FMetafileXRatio := vMFRatioX / vMFRatioY;
  end;
  EnumEnhMetaFile(FHDC, Metafile.Handle, @MFProc, Self, Rect(0,0,0,0));
end;

function TsgMetafile.GetPoint(const APt: TPoint): TPoint;
begin
  Result.X := Round(APt.X * FXForm.eM11 + APt.Y * FXForm.eM21 + FXForm.eDx);
  Result.Y := Round(APt.X * FXForm.eM12 + APt.Y * FXForm.eM22 + FXForm.eDy);
end;

function TsgMetafile.GetRect(const ARct: TRect): TRect;
  procedure ExpRct(const X, Y: Integer);
  begin
    ExpandRect(Result, GetPoint(Point(X, Y)));
  end;
begin
  Result := BadRect;
  ExpRct(ARct.Left, ARct.Top);
  ExpRct(ARct.Left, ARct.Bottom);
  ExpRct(ARct.Right, ARct.Bottom);
  ExpRct(ARct.Right, ARct.Top);
  //Result.TopLeft := GetPoint(ARct.TopLeft);
  //Result.BottomRight := GetPoint(ARct.BottomRight);
end;

procedure TsgMetafile.DoInvertYPts;
begin
  FData.Point.Y := FMapModeKoef * FData.Point.Y;
  FData.Point1.Y := FMapModeKoef * FData.Point1.Y;
  SetDataPts;
end;

function TsgMetafile.GetSignYExt: Integer;
  function Sign(const AValue: Extended): Integer;
  begin
    Result := 0;
    if AValue < 0 then
      Result := -1
    else if AValue > 0 then
      Result := 1;
  end;
begin
  Result := 1;
  if (FWinExt.cy <> 0) then
  begin
    Result := Sign(FViewExt.cy / FWinExt.cy);
    if Result = 0 then
      Result := 1;
  end;
end;

procedure TsgMetafile.Pie(P: PEMRPie);
  function GetCornerPoint(ACenterPt, ARadPt: TexpPoint; ARatio, AAngle: Single;
    AArcType: TsgArcType): TexpPoint;
  var
    X, Y, C, S, ACos, ASin, A: Extended;
  begin
    if AArcType = atCircle then
    begin
      SinCos(Radian(AAngle), S, C);
      Result.X := ACenterPt.X + ARatio * C;
      Result.Y := ACenterPt.Y + ARatio * S;
    end
    else
    begin
      SinCos(AAngle, S, C);
      A := Sqrt(ARadPt.X * ARadPt.X + ARadPt.Y * ARadPt.Y);
      if A > 1E-10 then
      begin
        ACos := ARadPt.X / A;
        ASin := ARadPt.Y / A;
      end
      else
      begin
        ASin := 1.0;
        ACos := 0.0;
      end;
      X := A * C;
      Y := A * ARatio * S;
      Result.X := ACenterPt.X + X * ACos - Y * ASin;
      Result.Y := ACenterPt.Y + X * ASin + Y * ACos;
    end;
    Result.Z := 0;
  end;
var
  vRadPt: TexpPoint;
begin
  Arc(PEMRArc(P), False);
  vRadPt := FData.Point1;// can change below
  // First line
  FData.Point1 := GetCornerPoint(FData.Point, vRadPt, FData.Radius,
    FData.StartAngle, TsgArcType(FData.SelfType));
  Owner.AddLine(FData);
  // Second line
  FData.Point1 := GetCornerPoint(FData.Point, vRadPt, FData.Radius,
    FData.EndAngle, TsgArcType(FData.SelfType));
  Owner.AddLine(FData);
end;

{ TsgDXFExport }

constructor TsgDXFExport.Create;
begin
  inherited Create;
  FAdditionalEntitiesIndex := -1;
  FAutoCADVer := R2000;
  FAutoCADPalette := arrDXFtoRGBColors;
  FBlkRecs := TStringList.Create;
  FBlocks := TList.Create;
  FEntities := TStringList.Create;
  FFiguresList := TList.Create;
  FLayers := TList.Create;
  FLTypes := TStringList.Create;
  FTextStyles := TList.Create;
  FUndefinedInserts := TStringList.Create;
  FCurrent := FEntities;
  FHandle := 32; //in hex=20, last Handle is 1B in hex (see STablesDIMSTYLE...)
  FOffset := 300;
  FUnitSize := 1.0;
  FPenWidthRatio := -1.0;
  FDimensionCounter := 0;
  FLayers.Add(TsgExpDXFLayer.Create('0'));
  SetCurrentLayer(nil);
  FLimMin := MakeExpPoint(1E20, 1E20, 0);
  FLimMax := MakeExpPoint(-1E20, -1E20, 0);
  FMillimetres := True;
  FDefaultHatchPatternScale := 1.0;
  FDefaultLTypeScale := 1.0;
  FUseMetafileFontName := True;
  FCodePage := cnstDefHeadVarStruct.CodePage;
end;

procedure TsgDXFExport.Clear;
begin
  if FMetafile <> nil then
    FMetafile.FStyles := [];
  FBlkRecs.Clear;
  FEntities.Clear;
  FLTypes.Clear;
  FUndefinedInserts.Clear;
  ClearList(FBlocks);
  ClearList(FFiguresList);
  ClearList(FLayers);
  ClearList(FTextStyles);
  FCurrent := FEntities;
  FHandle := 32;
end;

destructor TsgDXFExport.Destroy;
begin
  Clear;
  FCanvas.Free;
  FBlkRecs.Free;
  FBlocks.Free;
  FEntities.Free;
  FLTypes.Free;
  FMetafile.Free;
  FTmp.Free;
  FUndefinedInserts.Free;
  FFiguresList.Free;
  FLayers.Free;
  FTextStyles.Free;
end;

function TsgDXFExport.GetCanvas: TCanvas;
begin
  if FCanvas = nil then
  begin
    FTmp := TMetafile.Create;
    FCanvas := TMetafileCanvas.Create(FTmp, 0);
  end;
  Result := FCanvas;
end;

function TsgDXFExport.GetCodePage: Integer;
begin
  Result := FCodePage;
end;

function TsgDXFExport.AddName(const AName, ASub: string): Integer;
begin
  FCurrent.Add('  0');
  FCurrent.Add(AName);
  Result := AddHandle;
  FCurrent.Add('100');
  if (FCurrent = FLTypes) or (FCurrent = FBlkRecs) then
    FCurrent.Add('AcDbSymbolTableRecord')
  else
  begin
    FCurrent.Add('AcDbEntity');
    FCurrent.Add('  8');
    FCurrent.Add(FNameCurrentLayer);
  end;
  if ASub <> '' then
  begin
    FCurrent.Add('100');
    FCurrent.Add(ASub);
  end;
end;

function TsgDXFExport.AddHandle: Integer;
begin
  Result := FHandle;
  AddString(5, IntToHex(FHandle, 2));
  Inc(FHandle);
end;

procedure TsgDXFExport.AddInt(Code,Value: Integer);
begin
  FCurrent.Add(Format('%3d',[Code]));
  FCurrent.Add(IntToStr(Value));
end;

procedure TsgDXFExport.AddString(Code: Integer; const AString: string;
  const AConvert: Boolean = False);
var
  vStr: string;
  vString: sgUnicodeStr;
begin
{$IFDEF SGDEL_2009}
  vString := AString;
{$ELSE}
  vString := ConvertToWideString(AString, GetCodePage);
{$ENDIF}
  if AConvert then
    vStr := string(StringToACADPresentation(vString, CP_ACP))// AutoCAD always uses system locale (CP_ACP)
  else
    vStr := vString;
  FCurrent.Add(Format('%3d',[Code]));
  FCurrent.Add(vStr);
end;

procedure TsgDXFExport.AddFloat(Code: Integer; Value: Extended);
var DS: Char;
begin
  DS := SetDecimalSeparator('.');
  try
    FCurrent.Add(Format('%3d',[Code]));
    FCurrent.Add(FloatToStr(Value));
  finally
    SetDecimalSeparator(DS);
  end;
end;

procedure TsgDXFExport.Add3DPoint(Code: Integer; const P: TexpPoint);
begin
  AddPoint(Code, P);
  if P.Z <> 0 then
    AddFloat(Code + 20, P.Z);
end;

procedure TsgDXFExport.AddPoint(Code: Integer; const P: TexpPoint);
var
  PX, PY: Extended;
begin
  PX := MM(P.X);
  PY := MM(P.Y);
  AddFloat(Code, PX);
  AddFloat(Code + 10, PY);
  if FCurrent = FEntities then begin
    if FLimMin.X > PX then FLimMin.X := PX;
    if FLimMin.Y > PY then FLimMin.Y := PY;
    if FLimMax.X < PX then FLimMax.X := PX;
    if FLimMax.Y < PY then FLimMax.Y := PY;
  end;
end;

procedure TsgDXFExport.AddVertex(const P: TexpPoint);
begin
//  AddName('VERTEX','AcDbVertex');
  Add3DPoint(10, P);
  //if (P.StartWidth <> 0) or (P.EndWidth <> 0) then
    //AddFloat(40, P.StartWidth);
    //AddFloat(41, P.EndWidth);
end;

procedure TsgDXFExport.AddColor(const Data: TdxfExportData);
var
  vColorIndex: LongWord;
begin
  if (Data.Color <> clDXFByLayer) then
  begin
    vColorIndex := ColorToDXF(Data.Color);
    AddInt(62, vColorIndex);
    if (vColorIndex <> clDXFByBlock) and (vColorIndex <> clDXFByLayer) and
       (vColorIndex <> clDXFBlackWhite) and
       (FAutoCADPalette[vColorIndex] <> Data.Color) then
      AddInt(420, (Data.Color and $FF0000 shr 16) or (Data.Color and $FF00) or (Data.Color and $FF shl 16));
  end;
end;

procedure TsgDXFExport.AddLTypeScale;
begin
  if Abs(Abs(FDefaultLTypeScale) - 1) > fAccuracy then
    AddFloat(48, FDefaultLTypeScale);
end;

procedure TsgDXFExport.AddThickness(const Data: TdxfExportData);
var
  T, I: Integer;
begin
  if Data.Text <> '' then// adding LType
    AddString(6, Data.Text);
  if Ord(FAutoCADVer)< Ord(R2000) then
    Exit;
  try
    if FUse01MM then
      T := Round(Data.Thickness)       // 1 pixel = 0.01 mm
    else
      T := Round(Data.Thickness) * 10; // 1 pixel = 0.1 mm
    // 1 pixel = 1 mm
    if FPenWidthRatio > 0 then
      T := Round(Data.Thickness * 100 * FPenWidthRatio);
  except
    T := 100
  end;
  if T < 5 then
    Exit;
  if T >= 211 then
    T := 211
  else
   for I := 1 to High(sgDXFLineWeights) do
     if T < sgDXFLineWeights[I] then
     begin
       T := sgDXFLineWeights[I-1];
       Break;
     end;
  AddInt(370, T);
end;

procedure TsgDXFExport.AddPixel(var Data: TdxfExportData);
begin
  AddEntity(TsgExpDXFPixel.Create(Data));
end;

procedure TsgDXFExport.AddLine(var Data: TdxfExportData);
begin
  if Assigned(FMetafile) and FMetafile.IsConstructionPath = True then
    FMetafile.Path.AddEntity(TsgExpDXFLine.Create(Data))
  else
    AddEntity(TsgExpDXFLine.Create(Data));
end;

procedure TsgDXFExport.AddRectangle(var Data: TdxfExportData);
begin
  if Assigned(FMetafile) and FMetafile.IsConstructionPath = True then
    FMetafile.Path.AddEntity(TsgExpDXFRectangle.Create(Data))
  else
  AddEntity(TsgExpDXFRectangle.Create(Data));
end;

procedure TsgDXFExport.AddArc(var Data: TdxfExportData);
begin
  if Assigned(FMetafile) and FMetafile.IsConstructionPath = True then
    FMetafile.Path.AddEntity(TsgExpDXFArc.Create(Data))
  else
    AddEntity(TsgExpDXFArc.Create(Data));
end;

procedure TsgDXFExport.AddCircle(var Data: TdxfExportData);
begin
  AddEntity(TsgExpDXFEllipse.CreateEx(Data, False));
end;

procedure TsgDXFExport.AddDimension(var Data: TdxfExportData);
begin
  AddEntity(TsgExpDXFDimension.Create(Data));
end;

procedure TsgDXFExport.AddEllipse(var Data: TdxfExportData);
begin
  if Assigned(FMetafile) and FMetafile.IsConstructionPath = True then
    FMetafile.Path.AddEntity(TsgExpDXFEllipse.CreateEx(Data, True))
  else
    AddEntity(TsgExpDXFEllipse.CreateEx(Data, True));
end;

procedure TsgDXFExport.AddEntity(AEntity: TsgExpDXFFigure);
begin
  AEntity.Layer := FNameCurrentLayer;
  if FBlockMode then
  begin
    AEntity.ExportAsDXF(Self);
    AEntity.Free;
  end
  else
    FFiguresList.Add(AEntity);
end;

procedure TsgDXFExport.AddHatch(var Data: TdxfExportData);
begin
  AddEntity(TsgExpDXFHatch.Create(Data));
end;

procedure TsgDXFExport.AddHatchEx(var Data: TdxfExportData; APatternData: TList;
  APatternName: string; AIslandDetectionStyle: TsgHatchIslandDetectionStyle;
  APatternType: TsgHatchPatternType);
var
  vDXFHatch: TsgExpDXFHatch;
begin
  vDXFHatch := TsgExpDXFHatch.Create(Data);
  vDXFHatch.IslandDetectionStyle := AIslandDetectionStyle;
  vDXFHatch.PatternData := APatternData;
  vDXFHatch.PatternName := APatternName;
  vDXFHatch.PatternType := APatternType;
  AddEntity(vDXFHatch);
end;

procedure TsgDXFExport.AddLeader(var AData: TdxfExportData;
  AIndex: Integer);
begin
  AddEntity(TsgExpDXFLeader.CreateEx(AData, AIndex));
end;

procedure TsgDXFExport.AddMText(var Data: TdxfExportData);
begin
  AddEntity(TsgExpDXFMText.Create(Data));
end;

procedure TsgDXFExport.AddPolyBezier(var AData: TdxfExportData; AIndex: Integer);
begin
  if Assigned(FMetafile) and FMetafile.IsConstructionPath = True then
    FMetafile.Path.AddEntity(TsgExpDXFPolyBezier.CreateEx(AData, AIndex))
  else
    AddEntity(TsgExpDXFPolyBezier.CreateEx(AData, AIndex));
end;

procedure TsgDXFExport.AddPolyLine(var AData: TdxfExportData; AIndex: Integer);
begin
  if Assigned(FMetafile) and FMetafile.IsConstructionPath = True then
    FMetafile.Path.AddEntity(TsgExpDXFPolyline.CreateEx(AData, AIndex))
  else
    AddEntity(TsgExpDXFPolyline.CreateEx(AData, AIndex));
end;

procedure TsgDXFExport.AddSolid(var Data: TdxfExportData);
begin
  AddEntity(TsgExpDXFSolid.Create(Data));
end;

procedure TsgDXFExport.AddText(var Data: TdxfExportData);
begin
  AddEntity(TsgExpDXFText.Create(Data));
end;

(* // For future versions
procedure TsgDXFExport.AddRectangle(const Data: TdxfExportData);
  function FPoint(X,Y: Single): TexpPoint;
  begin
    Result.X := X;
    Result.Y := Y;
    Result.Z := 0;
  end;
begin
  AddName('POLYLINE');
  AddColor(Data);
  AddThickness(Data);
  AddInt(70,1);
  AddInt(66,1);
  AddVertex(Data.Point);
  AddVertex(FPoint(Data.Point1.X, Data.Point.Y));
  AddVertex(Data.Point1);
  AddVertex(FPoint(Data.Point.X, Data.Point1.Y));
  AddName('SEQEND');
end;

procedure TsgDXFExport.AddPolyLine(const Data: TdxfExportData);
var
  P: PexpPoint;
  Count: Integer;
begin
  AddName('POLYLINE');
  AddColor(Data);
  AddThickness(Data);
  AddInt(70, Data.Flags);
  AddInt(66,1);
  P := Data.Points;
  Count := Data.Count;
  while Count > 0 do begin
    AddVertex(P^);
    Inc(P);
    Dec(Count);
  end;
  AddName('SEQEND');
end;
*)

procedure TsgDXFExport.BeginPoly(const Data: TdxfExportData; ACount: Integer);
begin
  AddName('LWPOLYLINE','AcDbPolyline');
  AddColor(Data);
  AddThickness(Data);
  AddLTypeScale;
  AddInt(90, ACount);
  AddInt(70, Data.Flags);
  if Data.GlobalWidth <> 0 then
    AddFloat(43,Data.GlobalWidth);
//  if Data.Thickness <> 0 then AddFloat(43, Data.Thickness);
end;

procedure TsgDXFExport.BeginLeader(const Data: TdxfExportData; ACount: Integer);
begin
  AddName('LEADER', 'AcDbLeader');
  AddColor(Data);
  AddThickness(Data);
  //AddInt(370, Round(Data.Thickness * 100));
  AddString(3, 'Standard');
  AddInt(76, Data.Count);
end;

function TsgDXFExport.GetStrAutoCADVer: string;
begin
  if FAutoCADVer = R14 then
    Result := 'AC1014'
  else
    if FAutoCADVer = R2000 then
      Result := 'AC1015';
end;

function TsgDXFExport.GetStrCodePage: string;
var
  vCodePage: Integer;
begin
  vCodePage := GetCodePage;
  Result := sgDXFCodePageName(vCodePage);
end;

procedure TsgDXFExport.Insert(const Data: TdxfExportData);
begin
  if GetBlockByName(Data.Text) = nil then
  begin
    FUndefinedInserts.Add(Data.Text);
    Exit;
  end;
  AddName('INSERT','AcDbBlockReference');
  FCurrent.Add('  2');
  FCurrent.Add(Data.Text);
  Add3DPoint(10, Data.Point);
  AddColor(Data);
  if Data.Scale.X <> 1.0 then AddFloat(41, Data.Scale.X);
  if Data.Scale.Y <> 1.0 then AddFloat(42, Data.Scale.Y);
  if Data.Rotation <> 0 then AddFloat(50, Data.Rotation);
end;

procedure TsgDXFExport.BeginBlockWithXref(const Name, XrefPath: string);
var
  vBlock: TsgExpDXFBlock;
  vBlkRecHandle: Integer;
begin
  FBlockMode := True;
  FBlock := Name;
  if Name = '' then
    FCurrent := FEntities
  else
  begin
    vBlock := GetBlockByName(Name);
    if vBlock <> nil then
      FCurrent := TStringList(vBlock.FContent)
    else
    begin
      FCurrent := FBlkRecs;
      vBlkRecHandle := AddName('BLOCK_RECORD','AcDbBlockTableRecord');
      FBlkRecs.Add('  2');
      FBlkRecs.Add(Name);
      vBlock := TsgExpDXFBlock.Create(Name, vBlkRecHandle);
      FCurrent := vBlock.FContent;
      FBlocks.Add(vBlock);
      AddName('BLOCK','AcDbBlockBegin');
      AddString(2, Name);
      FCurrent.Add(' 10');
      FCurrent.Add('0');
      FCurrent.Add(' 20');
      FCurrent.Add('0');
      FCurrent.Add(' 70');
      if XrefPath = '' then
        FCurrent.Add('0')
      else
      begin
        FCurrent.Add('4');
        AddString(3, Name);
        AddString(1, XrefPath);
      end;
    end;
  end;
end;

procedure TsgDXFExport.BeginBlock(const Name: string);
begin
  BeginBlockWithXref(Name, '');
end;

procedure TsgDXFExport.EndBlock;
begin
  BeginBlockWithXref('', '');
  FBlockMode := False;
end;

procedure TsgDXFExport.AddLType(const Name: string; const Parts: array of Single);
var
  I: Integer;
  Total: Single;
  Old: TStringList;
begin
  Total := 0;
  for I:=0 to High(Parts) do Total := Total + Abs(Parts[I]);
  Old := FCurrent;
  FCurrent := FLTypes;
  try
    AddName('LTYPE','AcDbLinetypeTableRecord');
    FLTypes.Add('  2');
    FLTypes.Add(Name);
    FLTypes.Add('  3');
    FLTypes.Add('');
    FLTypes.Add(' 70');
    FLTypes.Add('0');
    FLTypes.Add(' 72');
    FLTypes.Add('65');
    FLTypes.Add(' 73');
    FLTypes.Add(IntToStr(High(Parts)+1));
    FLTypes.Add(' 40');
    FLTypes.Add(FloatToStr(Total));
    for I := 0 to High(Parts) do
    begin
      FLTypes.Add(' 49');
      FLTypes.Add(FloatToStr(Parts[I]));
      FLTypes.Add(' 74');
      FLTypes.Add('0');
    end;
  finally
    FCurrent := Old;
  end;
end;

procedure TsgDXFExport.LoadFromMetafile(Metafile: TMetafile);
begin
  if FMetafile = nil then
    FMetafile := TsgMetafile.Create(Self);
  FCurrent := FEntities;//Clear;
  FMetafile.ProcessMetafile(Metafile);
end;

procedure TsgDXFExport.LoadFromStream(Stream: TStream);
var
  MF: TMetafile;
begin
  MF := TMetafile.Create;
  try
    MF.LoadFromStream(Stream);
    LoadFromMetafile(MF);
  finally
    MF.Free;
  end;
end;

procedure TsgDXFExport.LoadFromFile(const AFileName: string);
var
  MF: TMetafile;
begin
  MF := TMetafile.Create;
  try
    MF.LoadFromFile(AFileName);
    LoadFromMetafile(MF);
  finally
    MF.Free;
  end;
end;

procedure TsgDXFExport.EndDraw;
begin
  if FCanvas = nil then Exit;
  try
    FCanvas.Free;
    FCanvas := nil;
    LoadFromMetafile(FTmp);
  finally
    FTmp.Free;
    FTmp := nil;
  end;
end;

{ ColorToDXF
  Converts a 32-bit RGB in 8-bit DXF-color}
function TsgDXFExport.ColorToDXF(Value: Cardinal): LongWord;
  function GetBlackColor: Integer;
  begin
    Result := clDXFBlackWhite;
    if AlternativeBlack then Result := clDXFAlternativeBlack;
  end;
begin
  case Value of
    clWhite:   Result := clDXFWhite;
    clNone, clBlack:
      Result := GetBlackColor;
    clByLayer: Result := clDXFByLayer;
    clByBlock: Result := clDXFByBlock;
    else
      Result := GetCADColor(Value, False, @FAutoCADPalette);
  end;
end;

procedure TsgDXFExport.SaveToStream(Stream: TStream);
var
  I, J, K: Integer;
  S1,Old, Rects: TStringList;
  DXFFigure: TsgExpDXFFigure;
  vElems: TList;
  vRect: TsgExpDXFRectangle;

  procedure AddS(const S: array of string);
  var I: Integer;
  begin
    for I := Low(S) to High(S) do
      FCurrent.Add(S[I]);
  end;

  function ChangeIfCovered(AStr: TStrings; ADXFFigure: TsgExpDXFFigure): TsgExpDXFFigure;
  var
    I: Integer;
    p1, p2: TexpPoint;
    PrevRgn, HideRgn, FigureRgn: HRGN;
    Res: Integer;
    Data: PdxfExportData;
    Count: Integer;
    RGNDATA: PRGNDATA;
    r: TRECT;
    DC: HDC;
    p: PPoint;
  begin
    Result:= ADXFFigure;
    HideRgn := 0;
    FigureRgn := 0;
    Res := 0;
    for I := 0 to AStr.Count - 1 do
    begin
      PrevRgn := CreateRectRgn(Round(TsgExpDXFRectangle(AStr.Objects[I]).LeftTop.X), Round(TsgExpDXFRectangle(AStr.Objects[I]).LeftTop.Y),
        Round(TsgExpDXFRectangle(AStr.Objects[I]).RightBottom.X), Round(TsgExpDXFRectangle(AStr.Objects[I]).RightBottom.Y));
      try
        if HideRgn = 0 then
          HideRgn := CreateRectRgn(1, 1, 1, 1);
        CombineRgn(HideRgn, HideRgn, PrevRgn, RGN_OR);
      finally
        DeleteObject(PrevRgn);
      end;
    end;
    if ADXFFigure is TsgExpDXFLine then
    begin
      DC := CreateDC('DISPLAY', nil, nil, nil);
      BeginPath(DC);
      Rectangle(DC, Round(TsgExpDXFLine(ADXFFigure).StartPoint.X) -1, Round(TsgExpDXFLine(ADXFFigure).StartPoint.Y),
      Round(TsgExpDXFLine(ADXFFigure).EndPoint.X) + 1, Round(TsgExpDXFLine(ADXFFigure).EndPoint.Y));
      EndPath(DC);
      FigureRgn := PathToRegion(DC);
      Res := CombineRgn(FigureRgn, FigureRgn, HideRgn, RGN_DIFF);
      ReleaseDC(0, DC);
    end;

    if ADXFFigure is TsgExpDXFRectangle then
    begin
      FigureRgn := CreateRectRgn(Round(TsgExpDXFRectangle(ADXFFigure).LeftTop.X), Round(TsgExpDXFRectangle(ADXFFigure).LeftTop.Y),
        Round(TsgExpDXFRectangle(ADXFFigure).RightBottom.X), Round(TsgExpDXFRectangle(ADXFFigure).RightBottom.Y));
      Res := CombineRgn(FigureRgn, FigureRgn, HideRgn, RGN_DIFF);
    end;
    if ADXFFigure is TsgExpDXFPolyline then
    begin
      p := AllocMem(TsgExpDXFPolyline(ADXFFigure).PointCount * sizeof(TPoint));
      for I := 0 to TsgExpDXFPolyline(ADXFFigure).PointCount - 1 do
      begin
        p^.X := Round(TsgExpDXFPolyline(ADXFFigure).Point[i].X);
        p^.Y := Round(TsgExpDXFPolyline(ADXFFigure).Point[i].Y);
        Inc(p);
      end;
      Dec(P, TsgExpDXFPolyline(ADXFFigure).PointCount);
      FigureRgn := CreatePolygonRgn(p^, TsgExpDXFPolyline(ADXFFigure).PointCount, WINDING);
      Res := CombineRgn(FigureRgn, FigureRgn, HideRgn, RGN_DIFF);
      FreeMem(p);
    end;
    if (ADXFFigure is TsgExpDXFEllipse) and (not TsgExpDXFEllipse(ADXFFigure).FEllipse) then
    begin
      FigureRgn := CreateEllipticRgn(Round(TsgExpDXFEllipse(ADXFFigure).LeftTop.X), Round(TsgExpDXFEllipse(ADXFFigure).LeftTop.Y),
        Round(TsgExpDXFEllipse(ADXFFigure).RightBottom.X), Round(TsgExpDXFEllipse(ADXFFigure).RightBottom.Y));
      Res := CombineRgn(FigureRgn, FigureRgn, HideRgn, RGN_DIFF);
    end;
    if Res in [SIMPLEREGION, COMPLEXREGION] then
    begin
      Count := GetRegionData(FigureRgn, SizeOf(TRgnData), nil);
      RGNDATA := AllocMem(Count);
      try
        GetRegionData(FigureRgn, Count, RGNDATA);
        New(Data);
        ZeroMemory(Data, SizeOf(TdxfExportData));
        Data.Color := ADXFFigure.Color;
        case Res of
        SIMPLEREGION:
        begin
          r := TRect(Pointer(@RGNDATA.Buffer)^);
          if ADXFFigure is TsgExpDXFLine then
          begin
            p1.X := r.Left + 1;
            p1.Y := r.Top;
            p2.X := r.Right;
            p2.Y := r.Bottom + 1;
            TsgExpDXFLine(ADXFFigure).StartPoint := p1;
            TsgExpDXFLine(ADXFFigure).EndPoint := p2;
          end else
          begin
            Result := TsgExpDXFRectangle.Create(Data^);
            TsgExpDXFRectangle(Result).AddRect(r);
          end;
        end;
        COMPLEXREGION:
        begin
          Result := TsgExpDXFPolyline.Create(Data^);
          TsgExpDXFPolyline(Result).BeginPolygonFromRect();
          try
            for I := 0 to RGNDATA^.rdh.nCount - 1 do
            begin
              r := TRect(Pointer(TsgNativeInt(@RGNDATA.Buffer) + SizeOF(TRECT) * I)^);
              TsgExpDXFPolyline(Result).AddRect(r);
            end;
          finally
            TsgExpDXFPolyline(Result).EndPolygonFromRect();
          end;
        end;
      end;
      finally
        FreeMem(RGNDATA);
      end;
    end else
      if CombineRgn(FigureRgn, FigureRgn, HideRgn, RGN_OR) in [SIMPLEREGION, COMPLEXREGION] then
        Result := nil;
  end;

  function ParseRects(ARect: TsgExpDXFRectangle; ADXFFigure: TsgExpDXFFigure;
    NewElems: TList): Boolean;
  var
    vLine: TLine;
    vRect: TRectangle;
    vList: TList;
    vDXFLine: TsgExpDXFLine;
    I, N: Integer;
    vData: TdxfExportData;
  begin
    Result := False;
    vRect.X1 := Round(ARect.LeftTop.X);
    vRect.Y1 := Round(ARect.LeftTop.Y);
    vRect.X2 := Round(ARect.RightBottom.X);
    vRect.Y2 := Round(ARect.RightBottom.Y);
    if vRect.X2 < vRect.X1 then
      SwapInts(vRect.X1, vRect.X2);
    if vRect.Y2 < vRect.Y1 then
      SwapInts(vRect.Y1, vRect.Y2);
    if (ADXFFigure is TsgExpDXFMText) then
    begin
      if ADXFFigure.IntersecRect(vRect) then
      begin
        TsgExpDXFMText(ADXFFigure).ParseToTexts(vRect, NewElems);
        Result := True;
      end
      else
        NewElems.Add(ADXFFigure);
      Exit;
    end;
    if (ADXFFigure is TsgExpDXFEllipse) or (ADXFFigure is TsgExpDXFArc) or
       (ADXFFigure is TsgExpDXFRectangle) or (ADXFFigure is TsgExpDXFPolyline) then
    begin
      if ADXFFigure.IntersecRect(vRect) then
      begin
        ADXFFigure.ParseToLines(NewElems);
        for I := NewElems.Count - 1 downto 0 do
        begin
          ParseRects(ARect, NewElems[I], NewElems);
          TObject(NewElems[I]).Free;
          NewElems.Delete(I);
        end;
        Result := True;
      end
      else
        NewElems.Add(ADXFFigure);
      Exit;
    end;
    if not (ADXFFigure is TsgExpDXFLine) then
    begin
      NewElems.Add(ADXFFigure);
      Exit;
    end;
    vDXFLine := TsgExpDXFLine(ADXFFigure);
    vLine.x1 := Round(vDXFLine.StartPoint.X);
    vLine.y1 := Round(vDXFLine.StartPoint.Y);
    vLine.x2 := Round(vDXFLine.EndPoint.X);
    vLine.y2 := Round(vDXFLine.EndPoint.Y);
    vList := TList.Create;
    try
      ClipLine(vLine, vRect, vList);
      for N := 0 to vList.Count - 1 do
      begin
        vData := vDXFLine.FData;
        vData.Point.X := PLine(vList[N]).x1;
        vData.Point.Y := PLine(vList[N]).y1;
        vData.Point1.X := PLine(vList[N]).x2;
        vData.Point1.Y := PLine(vList[N]).y2;
        vDXFLine := TsgExpDXFLine.Create(vData);
        vDXFLine.Layer := ADXFFigure.Layer;
        NewElems.Add(vDXFLine);
      end;
    finally
      for N := 0 to vList.Count - 1 do
        Dispose(vList[N]);
      vList.Free;
    end;
    Result := True;
  end;

begin
  S1 := TStringList.Create;
  Rects := TStringList.Create;
  vElems := TList.Create;
  try
    I := 0;
    while I < FFiguresList.Count do
    begin
      if FIsParseWhite and (TObject(FFiguresList.Items[I]) is TsgExpDXFHatch)and
        (TsgExpDXFHatch(FFiguresList.Items[I]).Style = hsSolid) and
        (TsgExpDXFHatch(FFiguresList.Items[I]).Color = clDXFWhite) then
      begin
        // Convert Hatch-boundary to Rect
        if (TsgExpDXFHatch(FFiguresList.Items[I]).BndAmount <> 1) or
           (TsgExpDXFHatch(FFiguresList.Items[I]).GetPointsNumber(0) <> 4) then
        begin
          Inc(I);
          Continue;
        end;
        DXFFigure := TsgExpDXFRectangle.Create(TsgExpDXFHatch(FFiguresList.Items[I]).FData);
        DXFFigure.FData.Point := TsgExpDXFHatch(FFiguresList.Items[I]).GetPoint(0, 0);
        DXFFigure.FData.Point1 := TsgExpDXFHatch(FFiguresList.Items[I]).GetPoint(0, 2);
        TObject(FFiguresList.Items[I]).Free;
        FFiguresList.Items[I] := DXFFigure;

        Rects.AddObject('', FFiguresList.Items[I]);
        vRect := FFiguresList.Items[I];
        for J := I - 1 downto 0 do
        begin
          vElems.Clear;
          if ParseRects(vRect, TsgExpDXFFigure(FFiguresList.Items[J]), vElems) then
          begin
            TsgExpDXFFigure(FFiguresList.Items[J]).Free;
            FFiguresList.Delete(J);
            for K := 0 to vElems.Count - 1 do
              FFiguresList.Insert(J, vElems[K]);
          end;
        end;
        DXFFigure.Free;
        FFiguresList.Remove(DXFFigure);
      end;
      Inc(I);
    end;
  finally
    vElems.Free;
  end;

  for I := 0 to FFiguresList.Count - 1 do
  begin
    if I = AdditionalEntitiesIndex then
    begin
      FUnitSize := 1;
      DXFExport.OffsetX := 0;
      DXFExport.OffsetY := 0;
    end;
    DXFFigure := TsgExpDXFFigure(FFiguresList.Items[I]);
    FNameCurrentLayer := DXFFigure.Layer;
    if DXFFigure <> nil then
      DXFFigure.ExportAsDXF(Self);
  end;

  Old := FCurrent;
  FCurrent := S1;
  try
    AddS(SHeader);
    AddString(9, '$ACADVER');
    AddString(1, GetStrAutoCADVer);
    AddString(9, '$DWGCODEPAGE');
    AddString(1, GetStrCodePage);
    AddString(9, '$HANDSEED');// Next available handle
    AddString(5, IntToHex(FHandle + FTextStyles.Count + FLayers.Count + FBlocks.Count + 1, 2));
    AddString(9, '$LIMMIN');
    AddFloat(10, FLimMin.X);
    AddFloat(20, FLimMin.Y);
    AddString(9, '$LIMMAX');
    AddFloat(10, FLimMax.X);
    AddFloat(20, FLimMax.Y);
    AddString(9, '$MEASUREMENT');
    AddInt(70, Ord(FMillimetres));
    AddS(STablesLTYPE);
    FCurrent.AddStrings(FLTypes);
    AddS(STablesLAYER);
    for I := 0 to FLayers.Count - 1 do
      TsgExpDXFLayer(FLayers[I]).ExportAsDXF(Self);
    AddS(STablesSTYLE);
    for I := 0 to FTextStyles.Count - 1 do
      TsgExpDXFTextStyle(FTextStyles[I]).ExportAsDXF(Self);
    AddS(STablesVIEW);
    if FAutoCADVer = R14 then
      AddS(STablesDIMSTYLE_R14)
    else
      AddS(STablesDIMSTYLE_R2000);
    AddS(STablesBLOCK_RECORD);
    FCurrent.AddStrings(FBlkRecs);
    AddS(SBlocks);
    for I := 0 to FBlocks.Count - 1 do
    begin
      FCurrent.AddStrings(TStringList(TsgExpDXFBlock(FBlocks[I]).FContent));
      AddName('ENDBLK','AcDbBlockEnd');
    end;
    AddS(['  0', 'ENDSEC', '  0', 'SECTION', '  2', 'ENTITIES']);
    FCurrent.AddStrings(FEntities);
    if Ord(FAutoCADVer) >= Ord(R2000) then
      AddS(SObjects_R2000)
    else
      AddS(SObjects_R14);
    AddS(SEndOfDXF);
{$IFDEF SGDEL_2009}
    FCurrent.SaveToStream(Stream, TEncoding.GetEncoding(CP_ACP));
{$ELSE}
    FCurrent.SaveToStream(Stream);
{$ENDIF}
  finally
    FCurrent := Old;
    S1.Free;
    Rects.Free();
  end;
  {$IFDEF SGPROTECT}
    ShowMessage('DXF Export demo - www.cadsofttools.com');
  {$ENDIF}
  {$IFDEF PowerCAD}
    ShowMessage('This feature is supported by DXFExportVCL of CadSoftTools. Please register it from www.cadsofttools.com');
  {$ENDIF}
end;

procedure TsgDXFExport.SaveToFile(const FileName: String);
var S: TFileStream;
begin
  S := TFileStream.Create(FileName,fmCreate);
  try
    SaveToStream(S);
    if FUndefinedInserts.Count > 0 then
      MessageBox(0, PChar('Undefined insert names:'#13#13 + FUndefinedInserts.Text
        + #13'Status: deleted.'), 'WARNING', MB_ICONWARNING);
  finally
    S.Free;
  end;
end;

procedure TsgDXFExport.SetIsParseWhite(const Value: Boolean);
begin
  FIsParseWhite := Value;
end;

procedure TsgDXFExport.SetUse01MM(const Value: Boolean);
begin
  FUse01MM := Value;
end;

procedure TsgDXFExport.SetAutoCADVer(const Value: TsgAutoCADVersion);
begin
  FAutoCADVer := Value;
end;

function TsgDXFExport.MM(Value: Extended): Extended;
begin
  if not Use01MM then
    Result := Value
  else
    Result := Value / 100;
  Result := Result * FUnitSize;
end;

procedure TsgDXFExport.SetCurrentLayer(const Value: TsgExpDXFLayer);
begin
  if Value = nil then
  begin
    FCurrentLayer := FLayers[0];
    FNameCurrentLayer := '0';
  end
  else
  begin
    FCurrentLayer := Value;
    FNameCurrentLayer := FCurrentLayer.Name;
    if FLayers.IndexOf(Value) = -1 then
      FLayers.Add(FCurrentLayer);
  end;
end;

procedure TsgDXFExport.SetLayerByString(Name: string);
var
  I: Integer;
begin
  for I := 0 to FLayers.Count - 1 do
  begin
    if(TsgExpDXFLayer(FLayers.Items[I]).Name = Name) then
      CurrentLayer := TsgExpDXFLayer(Layers.Items[I]);
  end;
end;

procedure TsgDXFExport.AddDimensionStyle(const AppName: string;
  const ADimStyle: TsgDimensionStyle);
var
  vStr: string;
begin
  AddString(1001, AppName);
  AddString(1000, 'DSTYLE');
  AddString(1002, '{');
  if ADimStyle.ArrowBlock1 >= 0 then
  begin
    if FAutoCADVer = R2000 then
    begin
      AddInt(1070, 343);
      AddString(1005, IntToHex(ADimStyle.ArrowBlock1, 2));
    end
    else
    begin
      AddInt(1070, 6);
      vStr := sgDimensionArrowTypeNames[ADimStyle.Arrow1];
      AddString(1000, Copy(vStr, 2, Length(vStr)));
    end;
  end;
  AddInt(1070, 173);
  AddInt(1070,   1);
  if ADimStyle.ArrowBlock2 >= 0 then
  begin
    if FAutoCADVer = R2000 then
    begin
      AddInt(1070, 344);
      AddString(1005, IntToHex(ADimStyle.ArrowBlock2, 2));
    end
    else
    begin
      AddInt(1070, 7);
      vStr := sgDimensionArrowTypeNames[ADimStyle.Arrow2];
      AddString(1000, Copy(vStr, 2, Length(vStr)));
    end;
  end;
  AddInt(1070, 147);
  AddFloat(1040, ADimStyle.TextOffset);
  AddInt(1070, 140);
  AddFloat(1040, ADimStyle.TextHeight);
  AddInt(1070, 42);
  AddFloat(1040, ADimStyle.ExtLineOffset);
  AddInt(1070, 44);
  AddFloat(1040, ADimStyle.ExtLineExt);
  AddInt(1070, 41);
  AddFloat(1040, ADimStyle.ArrowSize);
  AddString(1002, '}');
end;

function TsgDXFExport.GetBlockByName(AName: string): TsgExpDXFBlock;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FBlocks.Count - 1 do
    if UpperCase(AName) = UpperCase(TsgExpDXFBlock(FBlocks[I]).FName) then
      Result := TsgExpDXFBlock(FBlocks[I]);
end;

function TsgDXFExport.GetTextStyleByFontName(const APrimaryFontName: string): TsgExpDXFTextStyle;
var
  I: Integer;
begin
  Result := nil;
  if (APrimaryFontName = '') then
    Exit;
  for I := 0 to FTextStyles.Count - 1 do
    if AnsiUpperCase(TsgExpDXFTextStyle(FTextStyles[I]).FPrimaryFontName) = AnsiUpperCase(APrimaryFontName) then
    begin
      Result := TsgExpDXFTextStyle(FTextStyles[I]);
      Exit;
    end;
  Result := TsgExpDXFTextStyle.Create('SG_STYLE_' + IntToStr(FTextStyles.Count));
  Result.FPrimaryFontName := APrimaryFontName;
  FTextStyles.Add(Result);
end;

function TsgDXFExport.GetTextStyleNameByWidthfactor(AWidthfactor: Single): string;
var
  I: Integer;
  vTextStyle: TsgExpDXFTextStyle;
begin
  Result := STablesSTYLE[19];
  if (Abs(AWidthfactor-1) <= fAccuracy) or ((Abs(AWidthfactor) <= fAccuracy)) then
    Exit;
  for I := 0 to FTextStyles.Count - 1 do
    if Abs(TsgExpDXFTextStyle(FTextStyles[I]).FWidthFactor - AWidthfactor) <= fAccuracy then
    begin
      Result := TsgExpDXFTextStyle(FTextStyles[I]).Name;
      Exit;
    end;
  vTextStyle := TsgExpDXFTextStyle.Create('SG_STYLE_' + IntToStr(FTextStyles.Count));
  vTextStyle.FWidthFactor := AWidthfactor;
  FTextStyles.Add(vTextStyle);
  Result := TsgExpDXFTextStyle(FTextStyles.Last).Name;
end;

procedure TsgDXFExport.AddXRef(Data: TdxfExportData);
var
  vBlockName: string;
begin
  vBlockName := ChangeFileExt(ExtractFileName(Data.Text), '');
  BeginBlockWithXref(vBlockName, Data.Text);
  EndBlock;
  // Other parameters of the Data define an INSERT
  Data.Text := vBlockName;
  Insert(Data);
end;

function TsgDXFExport.GetFiguresCount: Integer;
begin
  Result := FFiguresList.Count;
end;

{ TsgExpDXFFigure }

procedure TsgExpDXFFigure.CopyPoints(const AList: TList);
var
  I: Integer;
begin
  if FData.Count > 0 then
    for I := 0 to FData.Points.Count - 1 do
      CopyLists(AList, FData.Points[I], cmAppend);
end;

constructor TsgExpDXFFigure.Create(const AData: TdxfExportData);
begin
  FData := AData;
  FLayer := '0';
end;

procedure TsgExpDXFFigure.ExportBlockAsDXF(ADXFExport: TsgDXFExport);
begin

end;

function TsgExpDXFFigure.GetColor: LongWord;
begin
  Result := FData.Color;
end;

procedure TsgExpDXFFigure.ParseToLines(NewElemes: TList);
begin
end;

function TsgExpDXFFigure.IntersecRect(ARect: TRectangle): Boolean;
begin
  Result := False;
end;

procedure TsgExpDXFPolyline.BeginPolygonFromRect;
begin
  FList := TList.Create();
end;

procedure TsgExpDXFPolyline.EndPolygonFromRect;
var
  I: Integer;
begin
  if FList = nil then
    Exception.Create('BeginPolygonFromRect method has not called before');
  for I := FList.Count - 1 downto 0 do
  begin
    AddRect(TRect(FList.Items[i]^));
  end;
  for I := 0 to FList.Count - 1 do
  begin
    Dispose(FList.Items[i]);
  end;
  FList.Free;
  FList := nil;
end;

procedure TsgExpDXFPolyline.AddRect(ARect: TRect);
  function min(APar1, APar2: Single): Single;
  begin
    if APar1 > APar2 then
      Result := APar2
    else
      Result := APar1;
  end;

  function max(APar1, APar2: Single): Single;
  begin
    if APar1 > APar2 then
      Result := APar1
    else
      Result := APar2;
  end;

var
  i, j, k: Integer;
  p: PRect;
  Pt: PexpPoint;
begin
  if GetPointCount = 0 then
  begin
    ClearPoints;
    FPoints := TList.Create;
    AddExpPointInList(FPoints,MakeExpPoint(Round(ARect.Left), ARect.Top,0));
    AddExpPointInList(FPoints,MakeExpPoint(ARect.Right, ARect.Top,0));
    AddExpPointInList(FPoints,MakeExpPoint(ARect.Right, ARect.Bottom,0));
    AddExpPointInList(FPoints,MakeExpPoint(ARect.Left, ARect.Bottom,0))
  end
  else
  begin
    for i := 0 to GetPointCount - 2 do
    begin
      // We add four points
      for k := 1 to 4 do
      begin
        New(Pt);
        FPoints.Add(Pt);
      end;
      if ((PexpPoint(FPoints[i])^.X = ARect.Left) and (PexpPoint(FPoints[i+1])^.X = ARect.Left)) and
         (not (((PexpPoint(FPoints[i])^.Y <= ARect.Top) and (PexpPoint(FPoints[i+1])^.Y <= ARect.Bottom)) or
         ((PexpPoint(FPoints[i])^.Y >= ARect.Top) and (PexpPoint(FPoints[i+1])^.Y >= ARect.Bottom)))) then
      begin
        for j := i + 1 to GetPointCount - 1 do
          PexpPoint(FPoints[GetPointCount - 1 + 4 - (j - i - 1)])^ := PexpPoint(FPoints[GetPointCount - 1 - (j - i - 1)])^;
        PexpPoint(FPoints[i + 1])^.X := ARect.Right;
        PexpPoint(FPoints[i + 1])^.Y := ARect.Bottom;
        PexpPoint(FPoints[i + 2])^.X := ARect.Left;
        PexpPoint(FPoints[i + 2])^.Y := ARect.Bottom;
        PexpPoint(FPoints[i + 3])^.X := ARect.Left;
        PexpPoint(FPoints[i + 3])^.Y := ARect.Top;
        PexpPoint(FPoints[i + 4])^.X := ARect.Right;
        PexpPoint(FPoints[i + 4])^.Y := ARect.Top;
        Exit;
      end;
      if ((PexpPoint(FPoints[i])^.Y = ARect.Top) and (PexpPoint(FPoints[i+1])^.Y = ARect.Top)) and
         (not (((PexpPoint(FPoints[i])^.X <= ARect.Left) and (PexpPoint(FPoints[i+1])^.X <= ARect.Right)) or
         ((PexpPoint(FPoints[i])^.X >= ARect.Left) and (PexpPoint(FPoints[i+1])^.X >= ARect.Right)))) then
      begin
        for j := i + 1 to GetPointCount - 1 do
          PexpPoint(FPoints[GetPointCount - 1 + 4 - (j - i - 1)])^ := PexpPoint(FPoints[GetPointCount - 1 - (j - i - 1)])^;
        PexpPoint(FPoints[i + 1])^.X := ARect.Right;
        PexpPoint(FPoints[i + 1])^.Y := ARect.Top;
        PexpPoint(FPoints[i + 2])^.X := ARect.Right;
        PexpPoint(FPoints[i + 2])^.Y := ARect.Bottom;
        PexpPoint(FPoints[i + 3])^.X := ARect.Left;
        PexpPoint(FPoints[i + 3])^.Y := ARect.Bottom;
        PexpPoint(FPoints[i + 4])^.X := ARect.Left;
        PexpPoint(FPoints[i + 4])^.Y := ARect.Top;
        Exit;
      end;
      if ((PexpPoint(FPoints[i])^.X = ARect.Right) and (PexpPoint(FPoints[i+1])^.X = ARect.Right)) and
      (not (((PexpPoint(FPoints[i])^.Y <= ARect.Top) and (PexpPoint(FPoints[i+1])^.Y <= ARect.Bottom)) or
      ((PexpPoint(FPoints[i])^.Y >= ARect.Top) and (PexpPoint(FPoints[i])^.Y >= ARect.Bottom)))) then
      begin
        for j := i + 1 to FData.Count - 1 do
          PexpPoint(FPoints[GetPointCount - 1 + 4 - (j - i - 1)])^ := PexpPoint(FPoints[GetPointCount - 1 - (j - i - 1)])^;
        PexpPoint(FPoints[i + 1])^.X := ARect.Left;
        PexpPoint(FPoints[i + 1])^.Y := ARect.Top;
        PexpPoint(FPoints[i + 2])^.X := ARect.Right;
        PexpPoint(FPoints[i + 2])^.Y := ARect.Top;
        PexpPoint(FPoints[i + 3])^.X := ARect.Right;
        PexpPoint(FPoints[i + 3])^.Y := ARect.Bottom;
        PexpPoint(FPoints[i + 4])^.X := ARect.Left;
        PexpPoint(FPoints[i + 4])^.Y := ARect.Bottom;
        Exit;
      end;
      if ((PexpPoint(FPoints[i])^.Y = ARect.Bottom) and (PexpPoint(FPoints[i+1])^.Y = ARect.Bottom)) and
         (not (((min(PexpPoint(FPoints[i])^.X, PexpPoint(FPoints[i+1])^.X) >= ARect.Left) and (min(PexpPoint(FPoints[i])^.X, PexpPoint(FPoints[i+1])^.X) >= ARect.Right)) or
         ((max(PexpPoint(FPoints[i])^.X, PexpPoint(FPoints[i+1])^.X) <= ARect.Left) and (max(PexpPoint(FPoints[i])^.X, PexpPoint(FPoints[i+1])^.X) <= ARect.Right)))) then
      begin
        for j := i + 1 to GetPointCount - 1 do
          PexpPoint(FPoints[GetPointCount - 1 + 4 - (j - i - 1)])^ := PexpPoint(FPoints[GetPointCount - 1 - (j - i - 1)])^;
        PexpPoint(FPoints[i + 1])^.X := ARect.Left;
        PexpPoint(FPoints[i + 1])^.Y := ARect.Bottom;
        PexpPoint(FPoints[i + 2])^.X := ARect.Left;
        PexpPoint(FPoints[i + 2])^.Y := ARect.Top;
        PexpPoint(FPoints[i + 3])^.X := ARect.Right;
        PexpPoint(FPoints[i + 3])^.Y := ARect.Top;
        PexpPoint(FPoints[i + 4])^.X := ARect.Right;
        PexpPoint(FPoints[i + 4])^.Y := ARect.Bottom;
        Exit;
      end;
    end;
    if FList = nil then
      Exception.Create('BeginPolygonFromRect method has not called before');
    New(p);
    p^ := ARect;
    FList.Add(p)
  end;
end;

procedure TsgExpDXFPolyline.Clear;
begin
  FData.Count := 0;
end;

constructor TsgExpDXFPolyline.CreateEx(const AData: TdxfExportData; AIndex: Integer);
var
  I: Integer;
  Pt: PexpPoint;
begin
  inherited Create(AData);
  FData.Point.X := 0;  FData.Point.Y := 0;
  FData.Point1.X := 0; FData.Point1.Y := 0;
  if (AData.Count > 0) and (AIndex< AData.Count) then
  begin
    ClearPoints;
    FData.Count := AData.Points.Count;
    FPoints := TList.Create;
    for I := 0 to TList(AData.Points[AIndex]).Count - 1 do
    begin
      New(Pt);
      Pt^ := PexpPoint(TList(AData.Points[AIndex])[I])^;
      if Pt^.X < FData.Point.X then FData.Point.X := Pt^.X;
      if Pt^.Y < FData.Point.Y then FData.Point.Y := Pt^.Y;
      if Pt^.X > FData.Point1.X then FData.Point1.X := Pt^.X;
      if Pt^.Y > FData.Point1.Y then FData.Point1.Y := Pt^.Y;
      FPoints.Add(Pt);
    end;
  end;
end;

procedure TsgExpDXFPolyline.ClearPoints;
var
  I: Integer;
begin
  if FPoints = nil then
    Exit;
  for I := 0  to FPoints.Count - 1 do
    Dispose(PexpPoint(FPoints[I]));
  FPoints.Free;
  FPoints := nil;
end;

destructor TsgExpDXFPolyline.Destroy;
begin
  ClearPoints;
  inherited;
end;

procedure TsgExpDXFPolyline.ExportAsDXF(ADXFExport: TsgDXFExport);
var
  I: Integer;
begin
  ADXFExport.BeginPoly(FData, FPoints.Count);
  for I := 0 to FPoints.Count - 1 do
    ADXFExport.AddVertex(PexpPoint(FPoints[I])^);
end;

function TsgExpDXFPolyline.IntersecRect(ARect: TRectangle): Boolean;
var
  vTmpRect: TRect;
  vRect: TRectangle;
begin
  inherited IntersecRect(ARect);
  vRect.X1 := Round(FData.Point.X);
  vRect.Y1 := Round(FData.Point.Y);
  vRect.X2 := Round(FData.Point1.X);
  vRect.Y2 := Round(FData.Point1.Y);
  if vRect.X2 < vRect.X1 then
    SwapInts(vRect.X1, vRect.X2);
  if vRect.Y2 < vRect.Y1 then
    SwapInts(vRect.Y1, vRect.Y2);
  Result := IntersectRect(vTmpRect, Rect(ARect.X1, ARect.Y1, ARect.X2, ARect.Y2),
    Rect(vRect.X1, vRect.Y1, vRect.X2, vRect.Y2));
end;

procedure TsgExpDXFPolyline.ParseToLines(NewElemes: TList);
var
  Line: TsgExpDXFLine;
  I: Integer;
begin
  inherited;
  for I := 0 to GetPointCount - 1 do
  begin
    Line := TsgExpDXFLine.Create(FData);
    Line.Layer := FLayer;
    NewElemes.Add(Line);
    Line.FData.Point := GetPoint(I);
    if I < GetPointCount - 1 then
      Line.FData.Point1 := GetPoint(I + 1)
    else
      Line.FData.Point1 := GetPoint(0);
  end;
end;

function TsgExpDXFPolyline.GetPointCount: Integer;
begin
  Result := FPoints.Count;
end;

function TsgExpDXFPolyline.GetPoint(AIndex: Integer): TexpPoint;
begin
  Result := PexpPoint(FPoints[AIndex])^;
end;

procedure TsgExpDXFFigure.SetLayer(const Value: string);
begin
  FLayer := Value;
end;

{ TsgExpDXFText }
{
procedure SetTextWithFormat(var AText: TsgDXFText; sFormattedText: String; Size: Integer; Color: TColor);
var
  vFont: TmvExtFont;
  I: Integer;
  sFName: String;
begin
  if AText <> nil then
    AText.Free;
  AText := TsgDXFText.Create;
  AText.Text := GetOnlyText(sFormattedText);
  vFont := TmvExtfont.Create;
  if GetOnlyText(sFormattedText) <> sFormattedText then
  begin
    I := 4;
    sFName := '';
    repeat
      sFName := sFName + sFormattedText[I];
      I := I +1;
    until(sFormattedText[I] = '|');
    vFont.Name := sFName;
    for I := 1 to Length(sFormattedText) - 1 do
    begin
      if sformattedText[I] = '|' then
      begin
        if (sformattedText[I + 1] = 'b') and (sformattedText[I + 2] = '1') then
          vFont.Style := [fmBold] + vFont.Style;
        if (sformattedText[I + 1] = 'i') and (sformattedText[I + 2] = '1') then
          vFont.Style := [fmItalic] + vFont.Style;
      end;
      if (sformattedText[I] = '\') and (sformattedText[I + 1] = 'L') then
          vFont.Style := [fmUnderLine] + vFont.Style;
    end;
  end;
  vFont.Size := Size;
  vfont.Color := Color;
  AText.Font.Assign(vFont);
end;
}
procedure TsgExpDXFText.ExportAsDXF(ADXFExport: TsgDXFExport);
begin
  ADXFExport.AddName('TEXT','AcDbText');
  ADXFExport.AddColor(FData);
  ADXFExport.Add3DPoint(10, FData.Point);
  ADXFExport.AddFloat(40, ADXFExport.MM(FData.FHeight));
  if FData.FScale <> 0 then ADXFExport.AddFloat(41, FData.FScale);
  if FData.Rotation <> 0 then ADXFExport.AddFloat(50, FData.Rotation);
  if FData.Flags <> 0 then ADXFExport.AddFloat(51, 15.0);
  if FData.StyleObject <> nil then
    ADXFExport.AddString(7, TsgExpDXFTextStyle(FData.StyleObject).Name);
  if (FData.HAlign <> 0) or (FData.VAlign <> 0) then
  begin
    if FData.HAlign <> 0 then
      ADXFExport.AddInt(72, FData.HAlign);
    ADXFExport.Add3DPoint(11, FData.Point1);
  end;
  ADXFExport.AddString(1, FData.Text, True);
  ADXFExport.FCurrent.Add('100');
  ADXFExport.FCurrent.Add('AcDbText');
  if FData.VAlign <> 0 then
    ADXFExport.AddInt(73, FData.VAlign);
end;

procedure TsgExpDXFMText.ExportAsDXF(ADXFExport: TsgDXFExport);
begin
  ADXFExport.AddName('MTEXT','AcDbMText');
  ADXFExport.AddColor(FData);
  ADXFExport.Add3DPoint(10, FData.Point);
  ADXFExport.AddFloat(40, ADXFExport.MM(FData.FHeight));
  if FData.Rotation <> 0 then
    ADXFExport.AddFloat(50, FData.Rotation);
  if FData.HAlign <> 0 then
    ADXFExport.AddInt(71, FData.HAlign + 1);
  ADXFExport.AddString(1, FData.Text, True);
  ADXFExport.AddString(7, ADXFExport.GetTextStyleNameByWidthfactor(FData.FScale));
  ADXFExport.AddInt(73, 2);// 2 = Exact (taller characters will not override)
end;

function TsgExpDXFMText.IntersecRect(ARect: TRectangle): Boolean;
var
  vRect: TRectangle;
  vTmpRect: TRect;
begin
  inherited IntersecRect(ARect);
  if FData.Rotation = 0 then // left to right
  begin
    vRect.X1 := Round(FData.Point.X);
    vRect.Y1 := Round(FData.Point.Y);
    vRect.X2 := vRect.X1 + Round(FData.RWidth);
    vRect.Y2 := vRect.Y1 - Round(FData.FHeight);
  end;
  if FData.Rotation = 90 then // bottom to top
  begin
    vRect.X1 := Round(FData.Point.X);
    vRect.Y1 := Round(FData.Point.Y);
    vRect.X2 := vRect.X1 + Round(FData.FHeight);
    vRect.Y2 := vRect.Y1 + Round(FData.RWidth);
  end;
  if FData.Rotation = 270 then // top to bottom
  begin
    vRect.X1 := Round(FData.Point.X);
    vRect.Y1 := Round(FData.Point.Y);
    vRect.X2 := vRect.X1 - Round(FData.FHeight);
    vRect.Y2 := vRect.Y1 - Round(FData.RWidth);
  end;
  if vRect.X2 < vRect.X1 then
    SwapInts(vRect.X1, vRect.X2);
  if vRect.Y2 < vRect.Y1 then
    SwapInts(vRect.Y1, vRect.Y2);
  Result := IntersectRect(vTmpRect, Rect(ARect.X1, ARect.Y1, ARect.X2, ARect.Y2),
    Rect(vRect.X1, vRect.Y1, vRect.X2, vRect.Y2));
//  Result := Result and (ARect.Y1 < FData.Point.Y + 1);
//  Result := Result and (ARect.Y2 > FData.Point.Y + FData.FHeight - 1);
  //Result := False; // temprorary
end;

procedure TsgExpDXFMText.ParseToLines(NewElemes: TList);
begin
  inherited;

end;

procedure TsgExpDXFMText.ParseToTexts(ARect: TRectangle; NewElemes: TList);
var
  vInt, I: Integer;
  S, vS, vSfnt: string;
  vData: TdxfExportData;
  vElem: TsgExpDXFFigure;
  vKoef: Double;
begin
  inherited;
  if FData.Rotation = 0 then // left to right
  begin
    vData := FData;
    if ARect.X1 > vData.Point.X then // left cutting
    begin
      S := GetPourStr(vData.Text);
      vSfnt := Copy(vData.Text, 1 , Length(vData.Text) - Length(S));
      vInt := Round(Length(S) *
        ((ARect.X1 - vData.Point.X) / vData.RWidth));
      for I := 1 to vInt do
        vS := vS + S[I];
      S := vSfnt + vS;
      vData.RWidth := vData.RWidth * vInt / Length(S);
      vData.Text := S;
      vElem := TsgExpDXFMText.Create(vData);
      NewElemes.Add(vElem);
    end;
    vData := FData;
    vS := '';
    if ARect.X2 < vData.Point.X + vData.RWidth then // right cutting
    begin
      S := GetPourStr(vData.Text);
      vSfnt := Copy(vData.Text, 1 , Length(vData.Text) - Length(S));
      vKoef := (vData.Point.X + vData.RWidth - ARect.X2) / vData.RWidth;
      vInt := Round(Length(S) * vKoef);
      vData.Point.X := vData.Point.X + (vData.RWidth - vData.RWidth * vKoef);
      for I := Length(S) downto Length(S) - vInt + 1 do
        vS := S[I] + vS;
      S := vSfnt + vS;
      vData.RWidth := vData.RWidth * vInt / Length(S);
      vData.Text := S;
      vElem := TsgExpDXFMText.Create(vData);
      NewElemes.Add(vElem);
    end;
  end;
  if FData.Rotation = 90 then // bottom to top
  begin
    vData := FData;
    if ARect.X1 > vData.Point.X then // left cutting
    begin
      S := GetPourStr(vData.Text);
      vSfnt := Copy(vData.Text, 1 , Length(vData.Text) - Length(S));
      vInt := Round(Length(S) *
        ((ARect.X1 - vData.Point.X) / vData.RWidth));
      for I := 1 to vInt do
        vS := vS + S[I];
      S := vSfnt + vS;
      vData.RWidth := vData.RWidth * vInt / Length(S);
      vData.Text := S;
      vElem := TsgExpDXFMText.Create(vData);
      NewElemes.Add(vElem);
    end;
    vData := FData;
    vS := '';
    if ARect.X2 < vData.Point.X + vData.RWidth then // right cutting
    begin
      S := GetPourStr(vData.Text);
      vSfnt := Copy(vData.Text, 1 , Length(vData.Text) - Length(S));
      vKoef := (vData.Point.X + vData.RWidth - ARect.X2) / vData.RWidth;
      vInt := Round(Length(S) * vKoef);
//      vData.Point.X := vData.Point.X + (vData.RWidth - vData.RWidth * vKoef);
      vData.Point.Y := vData.Point.Y + (vData.RWidth - vData.RWidth * vKoef);
      for I := Length(S) downto Length(S) - vInt + 1 do
        vS := S[I] + vS;
      S := vSfnt + vS;
      vData.RWidth := vData.RWidth * vInt / Length(S);
      vData.Text := S;
      vElem := TsgExpDXFMText.Create(vData);
      NewElemes.Add(vElem);
    end;
  end;
  if FData.Rotation = 270 then // top to bottom
  begin
    vData := FData;
    if ARect.Y2 < vData.Point.Y then // top cutting
    begin
      S := GetPourStr(vData.Text);
      vSfnt := Copy(vData.Text, 1 , Length(vData.Text) - Length(S));
      vInt := Round(Length(S) *
        ((vData.Point.Y - ARect.Y2) / vData.RWidth));
      for I := 1 to vInt do
    vS := vS + S[I];
      vData.RWidth := vData.RWidth * vInt / Length(S);
      S := vSfnt + vS;
      vData.Text := S;
      vElem := TsgExpDXFMText.Create(vData);
      NewElemes.Add(vElem);
    end;
    vData := FData;
    vS := '';
    if ARect.Y1 > vData.Point.Y - vData.RWidth then // right cutting
    begin
      S := GetPourStr(vData.Text);
      vSfnt := Copy(vData.Text, 1 , Length(vData.Text) - Length(S));
      vKoef := (vData.RWidth - vData.Point.Y + ARect.Y1) / vData.RWidth;
      vInt := Round(Length(S) * vKoef);
      vData.Point.Y := vData.Point.Y - (vData.RWidth - vData.RWidth * vKoef);
      for I := Length(S) downto Length(S) - vInt + 1 do
    vS := S[I] + vS;
      vData.RWidth := vData.RWidth * vInt / Length(S);
      S := vSfnt + vS;
      vData.Text := S;
      vElem := TsgExpDXFMText.Create(vData);
      NewElemes.Add(vElem);
    end;
  end;
end;

{ TsgExpDXFLine }

procedure TsgExpDXFLine.CopyPoints(const AList: TList);
begin
  if FData.Count > 0 then
    inherited CopyPoints(AList)
  else
  begin
    AddFPointInList(AList, Fdata.Point);
    AddFPointInList(AList, Fdata.Point1);
  end;
end;

procedure TsgExpDXFLine.ExportAsDXF(ADXFExport: TsgDXFExport);
begin
  ADXFExport.AddName('LINE','AcDbLine');
  ADXFExport.AddColor(FData);
  ADXFExport.AddThickness(FData);
  ADXFExport.AddLTypeScale;
  ADXFExport.Add3DPoint(10, FData.Point);
  ADXFExport.Add3DPoint(11, FData.Point1);
end;

function TsgExpDXFLine.GetEndPoint: TexpPoint;
begin
  Result := FData.Point1;
end;

function TsgExpDXFLine.GetStartPoint: TexpPoint;
begin
  Result := FData.Point;
end;

procedure TsgExpDXFLine.SetEndPoint(const Value: TexpPoint);
begin
  FData.Point1 := Value;
end;

procedure TsgExpDXFLine.SetStartPoint(const Value: TexpPoint);
begin
  FData.Point := Value;
end;

constructor TsgExpDXFEllipse.CreateEx(AData: TdxfExportData; AEllipse: boolean);
begin
  inherited Create(AData);
  FEllipse := AEllipse;
end;

procedure TsgExpDXFEllipse.ExportAsDXF(ADXFExport: TsgDXFExport);
begin
  if not FEllipse then
  begin
    ADXFExport.AddName('CIRCLE','AcDbCircle');
    ADXFExport.AddColor(FData);
    ADXFExport.AddThickness(FData);
    ADXFExport.AddLTypeScale;
    ADXFExport.Add3DPoint(10, FData.Point);
    ADXFExport.AddFloat(40, ADXFExport.MM(FData.Radius));
  end
  else
  begin
    ADXFExport.AddName('ELLIPSE','AcDbEllipse');
    ADXFExport.AddColor(FData);
    ADXFExport.AddThickness(FData);
    ADXFExport.AddLTypeScale;
    ADXFExport.Add3DPoint(10, FData.Point);
    ADXFExport.Add3DPoint(11, FData.Point1);
    ADXFExport.AddFloat(40, FData.Radius);
  end;
end;

procedure TsgExpDXFEllipse.ExportBlockAsDXF(ADXFExport: TsgDXFExport);
{var
  Blk: string;
  SY,DX,DY: Double;
  P: TexpPoint;
  BlData: TdxfExportData;}
begin
  if FEllipse then
  begin
  end;
end;

function TsgExpDXFEllipse.GetLeftTop: TexpPoint;
begin
  if FEllipse then
  begin
    Result.X := FData.Point.X;
    Result.Y := FData.Point.Y;
  end else
  begin
    Result.X := FData.Point.X - FData.Radius;
    Result.Y := FData.Point.Y - FData.Radius;
  end;
end;

function TsgExpDXFEllipse.GetRightBottom: TexpPoint;
begin
  if FEllipse then
  begin
    Result.X := FData.Point.X + FData.Scale.X * 10;
    Result.Y := FData.Point.Y - FData.Scale.Y * 10;
  end
  else
  begin
    Result.X := FData.Point.X + FData.Radius;
    Result.Y := FData.Point.Y + FData.Radius;
  end;
end;

function TsgExpDXFEllipse.IntersecRect(ARect: TRectangle): Boolean;
var
   A, B: Extended;
   vTmpRect: TRect;
begin
  inherited IntersecRect(ARect);
  if not FEllipse then
  begin
    A := FData.Radius;
    B := A;
  end
  else
  begin
    A := Abs(FData.Point1.X - FData.Point.X);
    B := Abs(FData.Point1.Y - FData.Point.Y);
    if A = 0 then A := B * FData.Radius;
    if B = 0 then B := A * FData.Radius;
  end;
  Result := IntersectRect(vTmpRect, Rect(ARect.X1, ARect.Y1, ARect.X2, ARect.Y2),
    Rect(Round(FData.Point.X - A), Round(FData.Point.Y - B),
         Round(FData.Point.X + A), Round(FData.Point.Y + B)));
end;

procedure TsgExpDXFEllipse.ParseToLines(NewElemes: TList);
const
  NSegs = 16; // Number of segments for full ellipse
var
  CX,CY,A,B,AStart,AEnd,Delta: Double;
  S,C: Extended;        // Sin and Cos of current angle
  I,N: Integer;
  P: TexpPoint;
  Line: TsgExpDXFLine;
begin
  CX := FData.Point.X;
  CY := FData.Point.Y;
  if not FEllipse then
  begin
    A := FData.Radius;
    B := A;
  end
  else
  begin
    A := Abs(FData.Point1.X);
    B := Abs(FData.Point1.Y);
    if A=0 then A := B * FData.Radius;
    if B=0 then B := A * FData.Radius;
  end;
  AStart := FData.StartAngle * Pi / 180;         // Start angle
  AEnd := FData.EndAngle * Pi / 180;            // End angle     if AEnd <= AStart then AEnd := AEnd + 2*Pi;
  N := Round((AEnd-AStart)/Pi*NSegs);   // Real number of segments depends on arc angle
  if N < 4 then N := 4;
  Delta := (AEnd - AStart) / (N - 1);
  for I:=0 to N - 2 do
  begin
    Line := TsgExpDXFLine.Create(FData);
    Line.Layer := FLayer;
    NewElemes.Add(Line);
    SinCos(AStart,S,C);
    P.X := CX + A*C;                    // Current segment X
    P.Y := CY + B*S;                    // Current segment Y
    Line.FData.Point := P;
    AStart := AStart + Delta;           // Next segment
    SinCos(AStart,S,C);
    P.X := CX + A*C;                    // Current segment X
    P.Y := CY + B*S;                    // Current segment Y
    Line.FData.Point1 := P;
  end;
end;

{ TsgExpDXFArc }

procedure AddFPointList(const AList: TList; const APoint: TFPoint);
begin
  AddFPointInList(AList, APoint);
end;

procedure TsgExpDXFArc.CopyPoints(const AList: TList);
var
  vGenerator: TsgGeneratorShapeEdge;
begin
  if FData.Count > 0 then
    inherited CopyPoints(AList)
  else
  begin
    vGenerator := TsgGeneratorShapeEdge.Create;
    try
      //vGenerator.NumberCirclePart := 5;
      vGenerator.SetListAndProc(AList, @AddFPointList);
      vGenerator.CreateCircularArc(FData.Point, FData.Radius,
        FData.StartAngle, FData.EndAngle);
    finally
      vGenerator.Free;
    end;
  end;
end;

constructor TsgExpDXFArc.Create(const AData: TdxfExportData);
begin
  inherited Create(AData);
  FType := TsgArcType(AData.SelfType);
end;

procedure TsgExpDXFArc.ExportAsDXF(ADXFExport: TsgDXFExport);
begin
  case FType of
    atCircle:
      begin
        ADXFExport.AddName('ARC','AcDbCircle');
        ADXFExport.AddColor(FData);
        ADXFExport.AddThickness(FData);
        ADXFExport.AddLTypeScale;
        ADXFExport.Add3DPoint(10, FData.Point);
        ADXFExport.AddFloat(40, ADXFExport.MM(FData.Radius));
        ADXFExport.FCurrent.Add('100');
        ADXFExport.FCurrent.Add('AcDbArc');
        ADXFExport.AddFloat(50, FData.StartAngle);
        ADXFExport.AddFloat(51, FData.EndAngle);
      end;
    atEllipse:
      begin
        ADXFExport.AddName('ELLIPSE','AcDbEllipse');
        ADXFExport.AddColor(FData);
        ADXFExport.AddThickness(FData);
        ADXFExport.AddLTypeScale;
        ADXFExport.Add3DPoint(10, FData.Point);
        ADXFExport.Add3DPoint(11, FData.Point1);
        ADXFExport.AddFloat(40, FData.Radius);
        if Abs(FData.StartAngle - FData.EndAngle) > fAccuracy then
        begin
          ADXFExport.AddFloat(41, FData.StartAngle);
          ADXFExport.AddFloat(42, FData.EndAngle);
        end;
      end;
  end;
end;

function TsgExpDXFArc.GetEndAngle: Single;
begin
  Result := FData.EndAngle;
end;

function TsgExpDXFArc.GetPoint: TexpPoint;
begin
  Result := FData.Point;
end;

function TsgExpDXFArc.GetRadius: Single;
begin
  Result := FData.Radius;
end;

function TsgExpDXFArc.GetStartAngle: Single;
begin
  Result := FData.StartAngle;
end;

procedure TsgExpDXFArc.SetEndAngle(const Value: Single);
begin

end;

procedure TsgExpDXFArc.SetPoint(const Value: TexpPoint);
begin

end;

procedure TsgExpDXFArc.SetRadius(const Value: Single);
begin

end;

procedure TsgExpDXFArc.SetStartAngle(const Value: Single);
begin

end;

function TsgExpDXFArc.IntersecRect(ARect: TRectangle): Boolean;
  {check intersect in 4 zones - topleft, topright, bottomleft and bottomright}
var
   vTmpRect: TRect;
begin
  inherited IntersecRect(ARect);
  Result := IntersectRect(vTmpRect, Rect(ARect.X1, ARect.Y1, ARect.X2, ARect.Y2),
    Rect(Round(FData.Point.X - FData.Radius), Round(FData.Point.Y  - FData.Radius),
         Round(FData.Point.X  + FData.Radius), Round(FData.Point.Y  + FData.Radius)));
end;

procedure TsgExpDXFArc.ParseToLines(NewElemes: TList);
const
  NSegs = 16; // Number of segments for full ellipse
var
  CX,CY,A,B,AStart,AEnd,Delta: Double;
  S,C: Extended;        // Sin and Cos of current angle
  I,N: Integer;
  P: TexpPoint;
  Line: TsgExpDXFLine;
begin
  CX := FData.Point.X;
  CY := FData.Point.Y;
  A := FData.Radius;
  B := A;
  AStart := FData.StartAngle * Pi / 180;         // Start angle
  AEnd := FData.EndAngle * Pi / 180;            // End angle
  if AEnd <= AStart then AEnd := AEnd + 2*Pi;
  N := Round((AEnd-AStart)/Pi*NSegs);   // Real number of segments depends on arc angle
  if N < 4 then N := 4;
  Delta := (AEnd-AStart)/(N-1);
  for I:=0 to N-2 do begin
    Line := TsgExpDXFLine.Create(FData);
    Line.Layer := FLayer;
    NewElemes.Add(Line);
    SinCos(AStart,S,C);
    P.X := CX + A*C;                    // Current segment X
    P.Y := CY + B*S;                    // Current segment Y
    Line.FData.Point := P;
    AStart := AStart + Delta;           // Next segment
    SinCos(AStart,S,C);
    P.X := CX + A*C;                    // Current segment X
    P.Y := CY + B*S;                    // Current segment Y
    Line.FData.Point1 := P;
  end;
end;

{ TsgExpDXFBezier }

{  Bezier curve which added to DXF as cubic SPLINE with a null amount
   of fit-points.

   Important:
     this class "draws" cubic Bezier curves on DXF drawing by using the
     endpoints and control points specified by the Points parameter (on
     analogy with Win32 API PolyBezier function). The first curve is
     drawn from the first point to the fourth point by using the second
     and third points as control points. Each subsequent curve in the
     sequence needs exactly three more points: the ending point of the
     previous curve is used as the starting point, the next two points in
     the sequence are control points, and the third is the ending point.

   Description:
      Data.Points - points of the bezier curve.                            }

procedure TsgExpDXFPolyBezier.ExportAsDXF(ADXFExport: TsgDXFExport);
const
  // Bezier constants
  cnstNumberOfFitPoints = 0;
  cnstKnotTolerance = 0.0000001;
  cnstControlPointTolerance = 0.0000001;
var
  vKnot, vInc: Single;
  vNumberOfControlPoints, I, J: Integer;
  vControlPoints, vPolyPoints: TList;
  vKnots: TsgSingleList;
begin
  if ((FPoints.Count - 4) mod 3) <> 0 then // ERROR
  begin
    inherited ExportAsDXF(ADXFExport);
    Exit;
  end;
  // SPLINE
  vNumberOfControlPoints := FPoints.Count - 1 + (Math.Floor(FPoints.Count/3));
  vInc := 1.0 / vNumberOfControlPoints;
  if not ADXFExport.BezierAsPolylines then
  begin
    ADXFExport.AddName('SPLINE', 'AcDbSpline');
    ADXFExport.AddColor(FData);
    ADXFExport.AddThickness(FData);
    ADXFExport.AddLTypeScale;
    ADXFExport.Add3DPoint(210, cnstExtrusion);
    ADXFExport.AddInt(70, 8);// 8= nonclosed curve
    ADXFExport.AddInt(71, cnstDegreeOfSpline);
    ADXFExport.AddInt(72, vNumberOfControlPoints + cnstAmount);
    ADXFExport.AddInt(73, vNumberOfControlPoints);
    ADXFExport.AddInt(74, cnstNumberOfFitPoints);
    ADXFExport.AddFloat(42, cnstKnotTolerance);
    ADXFExport.AddFloat(43, cnstControlPointTolerance);
    // Adding knots
    I := 0;
    vKnot := 0;
    while I < vNumberOfControlPoints do
    begin
      for J := 0 to cnstAmount - 1 do
        ADXFExport.AddFloat(40, vKnot);
      vKnot := vKnot + vInc;
      I := I + cnstAmount;
    end;
    vKnot := 1;
    for J := 0 to cnstAmount - 1 do
      ADXFExport.AddFloat(40, vKnot);
    // Adding control points
    for I := 0 to FPoints.Count - 1 do
    begin
      ADXFExport.Add3DPoint(10, PexpPoint(FPoints[I])^);
      if (I mod 3 = 0) and (I <> 0) and (I <> FPoints.Count - 1) then
        ADXFExport.Add3DPoint(10, PexpPoint(FPoints[I])^);
    end;
  end
  else
  begin
    vControlPoints := TList.Create;
    vControlPoints.Capacity := vNumberOfControlPoints;
    vKnots := TsgSingleList.Create;
    vPolyPoints := TList.Create;
    try
       // Adding knots
       I := 0;
       vKnot := 0;
       while I < vNumberOfControlPoints do
       begin
         for J := 0 to cnstAmount - 1 do
           vKnots.Add(vKnot);
         vKnot := vKnot + vInc;
         I := I + cnstAmount;
       end;
       vKnot := 1;
       for J := 0 to cnstAmount - 1 do
         vKnots.Add(vKnot);
       // Adding control points
       for I := 0 to FPoints.Count - 1 do
       begin
         vControlPoints.Add(PexpPoint(FPoints[I]));
         if (I mod 3 = 0) and (I <> 0) and (I <> FPoints.Count - 1) then
           vControlPoints.Add(PexpPoint(FPoints[I]));
       end;
       BuildSplineByKnots(vControlPoints, vKnots, vPolyPoints, 0.05);
       // POLYLINE
       ADXFExport.AddName('POLYLINE','AcDb2dPolyline');
       ADXFExport.AddColor(FData);
       ADXFExport.AddThickness(FData);
       ADXFExport.AddInt(70, 0);
       ADXFExport.AddInt(66, 1);
       for I := 0 to vPolyPoints.Count - 1 do
       begin
         ADXFExport.AddName('VERTEX','AcDbVertex');
         ADXFExport.AddString(100,'AcDb2dVertex');
         ADXFExport.Add3DPoint(10, PexpPoint(vPolyPoints[I])^);
       end;
       ADXFExport.AddName('SEQEND', '');
    finally
      vControlPoints.Free;
      vKnots.Free;
      vPolyPoints.Free;
    end;
  end;
end;

{ TsgExpDXFRectangle }

procedure TsgExpDXFRectangle.AddRect(ARect: TRect);
begin

end;

procedure TsgExpDXFRectangle.ExportAsDXF(ADXFExport: TsgDXFExport);
begin
  FData.Flags := 1;// closed POLYLINE flag
  ADXFExport.BeginPoly(FData,4);
  ADXFExport.AddVertex(FData.Point);
  ADXFExport.AddVertex(MakeExpPoint(FData.Point1.X, FData.Point.Y, 0));
  ADXFExport.AddVertex(FData.Point1);
  ADXFExport.AddVertex(MakeExpPoint(FData.Point.X, FData.Point1.Y, 0));
end;

function TsgExpDXFRectangle.IntersecRect(ARect: TRectangle): Boolean;
var
  vTmpRect: TRect;
  vRect: TRectangle;
begin
  inherited IntersecRect(ARect);
  vRect.X1 := Round(FData.Point.X);
  vRect.Y1 := Round(FData.Point.Y);
  vRect.X2 := Round(FData.Point1.X);
  vRect.Y2 := Round(FData.Point1.Y);
  if vRect.X2 < vRect.X1 then
    SwapInts(vRect.X1, vRect.X2);
  if vRect.Y2 < vRect.Y1 then
    SwapInts(vRect.Y1, vRect.Y2);
  Result := IntersectRect(vTmpRect, Rect(ARect.X1, ARect.Y1, ARect.X2, ARect.Y2),
    Rect(vRect.X1, vRect.Y1, vRect.X2, vRect.Y2));
end;

procedure TsgExpDXFRectangle.ParseToLines(NewElemes: TList);
var
  Line: TsgExpDXFLine;
begin
  inherited;
  Line := TsgExpDXFLine.Create(FData);
  Line.Layer := FLayer;
  NewElemes.Add(Line);
  Line.FData.Point := FData.Point;      //  |
  Line.FData.Point1 := FData.Point1;    //  |
  Line.FData.Point1.X := FData.Point.X; //  |

  Line := TsgExpDXFLine.Create(FData);
  Line.Layer := FLayer;
  NewElemes.Add(Line);                 //  --------
  Line.FData.Point := FData.Point;
  Line.FData.Point1 := FData.Point1;
  Line.FData.Point1.Y := FData.Point.Y;

  Line := TsgExpDXFLine.Create(FData);
  Line.Layer := FLayer;
  NewElemes.Add(Line);                   //   |
  Line.FData.Point := FData.Point;       //   |
  Line.FData.Point1 := FData.Point1;     //   |
  Line.FData.Point.X := FData.Point1.X;

  Line := TsgExpDXFLine.Create(FData);
  Line.Layer := FLayer;
  NewElemes.Add(Line);
  Line.FData.Point := FData.Point;
  Line.FData.Point1 := FData.Point1;
  Line.FData.Point.Y := FData.Point1.Y;  // --------
end;

function TsgExpDXFRectangle.GetLeftTop: TexpPoint;
begin
  Result := MakeExpPoint(FData.Point1.X, FData.Point.Y, 0);
end;

function TsgExpDXFRectangle.GetRightBottom: TexpPoint;
begin
  Result := MakeExpPoint(FData.Point.X, FData.Point1.Y, 0);
end;

procedure TsgExpDXFRectangle.SetLeftTop(const Value: TexpPoint);
begin
  FData.Point1.X := Value.X;
  FData.Point.Y := Value.Y;
end;

procedure TsgExpDXFRectangle.SetRightBottom(const Value: TexpPoint);
begin
  FData.Point.X := Value.X;
  FData.Point1.Y := Value.Y;
end;

{ TsgExpDXFPixel }

procedure TsgExpDXFPixel.ExportAsDXF(ADXFExport: TsgDXFExport);
begin
  ADXFExport.AddName('POINT','AcDbPoint');
  ADXFExport.AddColor(FData);
  ADXFExport.Add3DPoint(10, FData.Point);
end;

{ TsgExpDXFHatch.Create

  More one boundary.   }
constructor TsgExpDXFHatch.Create(const AData: TdxfExportData);
var
  I, K: Integer;
  Pt: PexpPoint;
begin
  inherited Create(AData);
  SetStyle(AData);
  FPatternAngle := AData.Rotation;
  FPatternScale := AData.Scale.X;
  FPatternType := hptPredefined;
  FBoundaries := nil;
  case FBoundaryType of
    hbtPolyPolyline, hbtSpline:
    begin
      if AData.Count > 0 then
      begin
        FBndAmount := AData.Count;
        FBoundaries := TList.Create;
        for I := 0 to AData.Points.Count - 1 do
        begin
          if (TList(AData.Points[I]).Count) < 3 then
            Continue;
          FBoundaries.Add(TList.Create);
          for K := 0 to TList(AData.Points[I]).Count - 1 do
          begin
            New(Pt);
            Pt^ := PexpPoint(TList(AData.Points[I]).Items[K])^;
            if (FBoundaryType=hbtPolyPolyline) and (K >= 2) and (Pt^.X = PexpPoint(TList(AData.Points[I]).Items[K-2])^.X) and (Pt^.Y = PexpPoint(TList(AData.Points[I]).Items[K-2])^.Y) then
            begin
              Dispose(PexpPoint(Pt));
              Continue;
            end;
            TList(FBoundaries.Last).Add(Pt);
          end;
          if (TList(FBoundaries.Last).Count < 3) then
          begin
            for K := 0 to TList(FBoundaries.Last).Count - 1 do
              Dispose(PexpPoint(TList(FBoundaries.Last).Items[K]));
            TList(FBoundaries.Last).Free;
            FBoundaries.Remove(TList(FBoundaries.Last));
          end;
        end;
      end;
    end;
    hbtCircle:
    begin
      FBndAmount := 1;
    end;
    hbtEllipse:
    begin
      FBndAmount := 1;
    end;
    else
      FBndAmount := 0;
  end;
end;

{ TsgExpDXFHatch.ExportAsDXF

  Exports to DXF of a Hatch-data. }
procedure TsgExpDXFHatch.ExportAsDXF(ADXFExport: TsgDXFExport);
var
  Offset: Single;
  vDashLengths: TsgSingleList;

  procedure AddPatternData;
  const
    Null = 0.00;
  var
    I, J, NumLines: Integer;
    HatchPatternData: array [0..1] of TdxfHatchPatternData;
  begin
    // Hatch pattern type
    ADXFExport.AddInt(76, Ord(FPatternType));
    // Hatch pattern angle
    ADXFExport.AddFloat(52, FPatternAngle);
    // Hatch pattern scale or spacing
    ADXFExport.AddFloat(41, FPatternScale);
    // Hatch pattern double flag (pattern fill only): 0 = not double; 1 = double
    ADXFExport.AddInt(77, 0);
    if (FStyle = hsPatternData) and (FPatternData <> nil) then
    begin
      NumLines := FPatternData.Count;
      ADXFExport.AddInt(78, NumLines);
      // Pattern line data (repeats number of times specified by code 78)
      for I := 0 to NumLines - 1 do
      begin
        ADXFExport.AddFloat(53, PdxfHatchPatternData(FPatternData[I])^.Angle);
        ADXFExport.AddFloat(43, FPatternScale * PdxfHatchPatternData(FPatternData[I])^.BasePointX);
        ADXFExport.AddFloat(44, FPatternScale * PdxfHatchPatternData(FPatternData[I])^.BasePointY);
        ADXFExport.AddFloat(45, FPatternScale * PdxfHatchPatternData(FPatternData[I])^.OffsetX);
        ADXFExport.AddFloat(46, FPatternScale * PdxfHatchPatternData(FPatternData[I])^.OffsetY);
        // Dash length (multiple entries)
        vDashLengths := PdxfHatchPatternData(FPatternData[I])^.DashLengths;
        if vDashLengths <> nil then
        begin
          // Number of dash length items
          ADXFExport.AddInt(79, vDashLengths.Count);
          for J := 0 to vDashLengths.Count - 1 do
            ADXFExport.AddFloat(49, FPatternScale * Single(vDashLengths[J]));
        end;
      end;
    end
    else
    begin
      NumLines := 1;
      HatchPatternData[0].BasePointX := Null;
      HatchPatternData[0].BasePointY := Null;
      HatchPatternData[0].OffsetX := -Offset;
      HatchPatternData[0].OffsetY := Offset;
      HatchPatternData[1].BasePointX := Null;
      HatchPatternData[1].BasePointY := Null;
      HatchPatternData[1].OffsetX := -Offset;
      HatchPatternData[1].OffsetY := Offset;

      case FStyle of

        hsHorizontal:
          begin
            HatchPatternData[0].Angle := Null;
            HatchPatternData[0].OffsetX := Null;
          end;
        hsVertical:
          begin
            HatchPatternData[0].Angle := 90.0;
            HatchPatternData[0].OffsetY := Null;
          end;
        hsFDiagonal:
          begin
            HatchPatternData[0].Angle := 135.0;
            HatchPatternData[0].OffsetY := - HatchPatternData[0].OffsetY;
          end;
        hsBDiagonal:
            HatchPatternData[0].Angle := 45.0;
        hsCross:
          begin
            NumLines := 2;
            HatchPatternData[0].Angle := Null;
            HatchPatternData[0].OffsetX := Null;
            HatchPatternData[1].Angle := 90.0;
          end;
        hsDiagCross:
          begin
            NumLines := 2;
            HatchPatternData[0].Angle := 45.0;
            HatchPatternData[1].Angle := 135.0;
            HatchPatternData[1].OffsetY := - HatchPatternData[0].OffsetY;
          end;
      end;
      // Number of pattern definition lines
      ADXFExport.AddInt(78, NumLines);
      // Pattern line data (repeats number of times specified by code 78)
      for I := 0 to NumLines - 1 do
      begin
        ADXFExport.AddFloat(53, HatchPatternData[I].Angle);
        ADXFExport.AddFloat(43, FPatternScale * HatchPatternData[I].BasePointX);
        ADXFExport.AddFloat(44, FPatternScale * HatchPatternData[I].BasePointY);
        ADXFExport.AddFloat(45, FPatternScale * HatchPatternData[I].OffsetX);
        ADXFExport.AddFloat(46, FPatternScale * HatchPatternData[I].OffsetY);
        // Number of dash length items
        ADXFExport.AddInt(79, 0);
        // Dash length (multiple entries)
        //ADXFExport.AddFloat(49, );
      end;
    end;
  end;

  procedure AddBoundaryPathData;
  var
    I, J, K, vPtsCount, vControlsCount: Integer;
    vInc, vKnot: Double;
  begin
    case FBoundaryType of
      hbtSpline:
        begin
          ADXFExport.AddInt(91, FBoundaries.Count);
          for K := 0 to FBoundaries.Count - 1 do
          begin
            // Each bezier
            vPtsCount := TList(FBoundaries[K]).Count;
            if ((vPtsCount - 4) mod 3) <> 0 then
            begin { ERROR }
              //ShowMessage('Error HATCH: FBoundaries.Count='+ IntToStr(FBoundaries.Count));
            end;
            ADXFExport.AddInt(92, 1);
            ADXFExport.AddInt(93, 1);
            ADXFExport.AddInt(72, 4);
            ADXFExport.AddInt(94, cnstDegreeOfSpline);
            ADXFExport.AddInt(73, 0);
            ADXFExport.AddInt(74, 0);
            vControlsCount := vPtsCount - 1 + (Math.Floor(vPtsCount/3));
            vInc := 1.0 / vControlsCount;
            ADXFExport.AddInt(95, vControlsCount + cnstAmount);
            ADXFExport.AddInt(96, vControlsCount);

            // Adding knots
            I := 0;
            vKnot := 0;
            while I < vControlsCount do
            begin
              for J := 0 to cnstAmount - 1 do
                ADXFExport.AddFloat(40, vKnot);
              vKnot := vKnot + vInc;
              I := I + cnstAmount;
            end;
            vKnot := 1;
            for J := 1 to cnstAmount do
              ADXFExport.AddFloat(40, vKnot);
            // Adding control points
            for I := 0 to vPtsCount - 1 do
            begin
              ADXFExport.AddPoint(10, PexpPoint(TList(FBoundaries[K]).Items[I])^);
              if (I mod 3 = 0) and (I <> 0) and (I <> vPtsCount - 1) then
                ADXFExport.AddPoint(10, PexpPoint(TList(FBoundaries[K]).Items[I])^);
            end;
            ADXFExport.AddInt(97, 0);
          end;
        end;
      hbtPolyPolyline:
        begin
          // Number of boundary paths (loops)
          // (number of figures with this hatch)
          ADXFExport.AddInt(91, FBoundaries.Count);
          for K := 0 to FBoundaries.Count - 1 do
          begin
            ADXFExport.AddInt(92, 1);
            //Hatch boundary path data
            // Line
            ADXFExport.AddInt(93, TList(FBoundaries[K]).Count);// number of polyline vertices
            // Adding boundary (here: line(s))
            for I:= 1 to TList(FBoundaries[K]).Count - 1 do
            begin
              ADXFExport.AddInt(72, 1);// Edge type = Line
              ADXFExport.Add3DPoint(10, PexpPoint(TList(FBoundaries[K]).Items[I-1])^);
              ADXFExport.Add3DPoint(11, PexpPoint(TList(FBoundaries[K]).Items[I])^);
            end;
            // to close
            ADXFExport.AddInt(72, 1);// Edge type = Line
            ADXFExport.Add3DPoint(10, PexpPoint(TList(FBoundaries[K]).Items[TList(FBoundaries[K]).Count - 1])^);
            ADXFExport.Add3DPoint(11, PexpPoint(TList(FBoundaries[K]).Items[0])^);
            {
            // Polyline
            ADXFExport.AddInt(92, 7);

            // Polyline boundary type data (only if boundary = polyline)
            ADXFExport.AddInt(72, 0);// has bulge flag
            ADXFExport.AddInt(73, 1);// is closed flag (first and last points incorporate)
            ADXFExport.AddInt(93, FData.AmountPoints);// number of polyline vertices
            // Adding boundary (here: polyline)
            for I:= 0 to FBndCount - 1 do
            begin
              ADXFExport.AddFloat(10, FBoundaries[I].X);
              ADXFExport.AddFloat(20, FBoundaries[I].Y);
              //ADXFExport.AddFloat(42, 0);// bulge (optional, default = 0)
            end;
            }
            // Number of source boundary objects
            ADXFExport.AddInt(97, 0);
            // Reference to source boundary objects (multiple entries)
            //ADXFExport.AddString(330, '0');// default = 0 - not source
          end;
        end;
      hbtCircle:
        begin
          ADXFExport.AddInt(91, 1);
          ADXFExport.AddInt(92, 1);
          ADXFExport.AddInt(93, 1);
          ADXFExport.AddInt(72, 2);// Edge type = Circular arc
          ADXFExport.Add3DPoint(10, FData.Point);
          ADXFExport.AddFloat(40, ADXFExport.MM(FData.Radius));
          ADXFExport.AddFloat(50, FData.StartAngle);
          ADXFExport.AddFloat(51, FData.EndAngle);
          ADXFExport.AddInt(73, 1);
          ADXFExport.AddInt(97, 0);
        end;
      hbtEllipse:
        begin
          ADXFExport.AddInt(91, 1);
          ADXFExport.AddInt(92, 1);
          ADXFExport.AddInt(93, 1);
          ADXFExport.AddInt(72, 3);// Edge type = Elliptic arc
          ADXFExport.Add3DPoint(10, FData.Point);
          ADXFExport.Add3DPoint(11, FData.Point1);
          ADXFExport.AddFloat(40, FData.Radius);
          ADXFExport.AddFloat(50, FData.StartAngle);
          ADXFExport.AddFloat(51, FData.EndAngle);
          ADXFExport.AddInt(73, 1);
          ADXFExport.AddInt(97, 0);
        end;
    end;
  end;

begin
  if (FBoundaryType = hbtPolyPolyline) and ((FBoundaries = nil)
    or (FBoundaries.Count = 0)) then
    Exit;
  Offset := 0.05;
  // PatternScale not changed
  if FPatternScale <= fAccuracy then
    FPatternScale := ADXFExport.DefaultHatchPatternScale;
  if not ADXFExport.Use01MM then
    Offset := Offset * ADXFExport.FOffset;//100;

  ADXFExport.AddName(sHatchEntity, 'AcDbHatch');
  ADXFExport.AddColor(FData);
  // Elevation point- here FData.Point= [0, 0, 0] (don't call ADXFExport.Add3DPoint!)
  ADXFExport.AddFloat(10, 0);
  ADXFExport.AddFloat(20, 0);
  ADXFExport.AddFloat(30, 0);
  // Extrusion direction- here are set values by default (don't call ADXFExport.Add3DPoint!)
  ADXFExport.AddFloat(210, 0);
  ADXFExport.AddFloat(220, 0);
  ADXFExport.AddFloat(230, 1);
  // Hatch pattern name
  ADXFExport.AddString(2, PatternName);
  // Solid fill flag (solid fill = 1; pattern fill = 0)
  ADXFExport.AddInt(70, FData.Flags);
  // Associativity flag (associative = 1; non-associative = 0)
  ADXFExport.AddInt(71, 0);
  AddBoundaryPathData;
  // Hatch style (Hatch "odd parity" area, normal style default=0)
  ADXFExport.AddInt(75, Ord(FIslandDetectionStyle));
  // Only if pattern = FILL
  if FData.Flags = $00 then
    AddPatternData
  else
    ADXFExport.AddInt(76, 1);// Hatch pattern type  (1 = predefined)
  //ADXFExport.AddFloat(47, 1.0);
  // Number of seed points (usually one point)
  ADXFExport.AddInt(98, 1);
  // Seed point, i.e. point inside area "for filling" (don't call ADXFExport.Add3DPoint!)
  ADXFExport.AddFloat(10, 0);
  ADXFExport.AddFloat(20, 0);
  ADXFExport.AddFloat(30, 0);
end;

procedure TsgExpDXFHatch.SetStyle(const AData: TdxfExportData);
begin
  FBoundaryType := TsgHatchBoundaryType(FData.SelfType);
  FIslandDetectionStyle := hidsNormal;// default value
  FStyle := TsgHatchStyle(FData.Style);
  PatternName := sPatternSOLID;
  FData.Flags := $01;
  if FStyle <> hsSolid then
  begin
    FData.Flags := $00;
    case FStyle of
      hsHorizontal, hsVertical:   PatternName := sPatternLINE;
      hsFDiagonal, hsBDiagonal:   PatternName := sPatternANSI31;
      hsCross:        PatternName := sPatternNET;
      hsDiagCross:    PatternName := sPatternANSI37;
      hsPatternData:  PatternName := 'UserDefined';
    end;
  end;
end;

procedure TsgExpDXFHatch.SetPatternData(const Value: TList);
begin
  FreePatternData;
  FPatternData := Value;
end;

procedure TsgExpDXFHatch.SetPatternName(const Value: string);
begin
  FPatternName := Value;
end;

function TsgExpDXFHatch.GetPoint(BndIndex, AIndex: Integer): TexpPoint;
begin
  Result.X :=  PexpPoint(TList(FBoundaries.Items[BndIndex]).Items[AIndex])^.X;
  Result.Y :=  PexpPoint(TList(FBoundaries.Items[BndIndex]).Items[AIndex])^.Y;
  Result.Z :=  PexpPoint(TList(FBoundaries.Items[BndIndex]).Items[AIndex])^.Z;
end;

function TsgExpDXFHatch.GetBndAmount: Integer;
begin
  Result := FBndAmount;
end;

function TsgExpDXFHatch.GetPointsNumber(BndIndex: Integer): Integer;
begin
  try
    if (FBoundaries <> nil) and (BndIndex < FBoundaries.Count)
      and (FBoundaries[BndIndex] <> nil) then
      Result := TList(FBoundaries[BndIndex]).Count
    else
      Result := 0;
  except
    Result := 0;
  end;
end;

procedure TsgExpDXFHatch.FreeBoundaries;
begin
  FreeRecordListOfList(FBoundaries);
end;

procedure TsgExpDXFHatch.FreePatternData;
var
  I: Integer;
begin
  if FPatternData <> nil then
  begin
    for I := 0 to FPatternData.Count - 1 do
    begin
      if PdxfHatchPatternData(FPatternData[I])^.DashLengths <> nil then
        PdxfHatchPatternData(FPatternData[I])^.DashLengths.Free;
      Dispose(FPatternData[I]);
    end;
    FPatternData.Free;
  end;
end;

destructor TsgExpDXFHatch.Destroy;
begin
  FreeBoundaries;
  FreePatternData;
  inherited;
end;

procedure TsgExpDXF3DFace.ExportAsDXF(ADXFExport: TsgDXFExport);
begin
  ADXFExport.AddName('3DFACE','AcDbFace');
  ADXFExport.AddColor(FData);
  ADXFExport.Add3DPoint(10, FData.Point);
  ADXFExport.Add3DPoint(11, FData.Point1);
  ADXFExport.Add3DPoint(12, FData.Point2);
  ADXFExport.Add3DPoint(13, FData.Point3);
end;

procedure TsgExpDXFSolid.ExportAsDXF(ADXFExport: TsgDXFExport);
begin
  ADXFExport.AddName('SOLID','AcDbTrace');
  ADXFExport.AddColor(FData);
  ADXFExport.Add3DPoint(10, FData.Point);
  ADXFExport.Add3DPoint(11, FData.Point1);
  ADXFExport.Add3DPoint(12, FData.Point2);
  ADXFExport.Add3DPoint(13, FData.Point3);
end;

{ TsgExpDXFLayer }
constructor TsgExpDXFLayer.Create(AName: string);
begin
  FName := AName;
  FFlags := 0;
  FColor := clDXFBlackWhite;
  FLinetypeName := 'Continuous';
  FLineWeight := -3;// default value from enum weights
end;

procedure TsgExpDXFLayer.ExportAsDXF(ADXFExport: TsgDXFExport);
begin
  ADXFExport.AddString(0, 'LAYER');
  ADXFExport.AddHandle;
  ADXFExport.AddString(330, STablesLAYER[7]);
  ADXFExport.AddString(100, 'AcDbSymbolTableRecord');
  ADXFExport.AddString(100, 'AcDbLayerTableRecord');
  ADXFExport.AddString(2, FName);
  ADXFExport.AddInt(70, FFlags);
  ADXFExport.AddInt(62, FColor);
  ADXFExport.AddString(6, FLinetypeName);
  if Ord(ADXFExport.AutoCADVer) > Ord(R14) then
  begin
    ADXFExport.AddInt(370, FLineWeight);
    ADXFExport.AddString(390, SObjects_R2000[95]);
  end;
end;

procedure TsgExpDXFLayer.SetColor(const Value: Integer);
begin
  FColor := Value;
end;

procedure TsgExpDXFLayer.SetFlags(const Value: Byte);
begin
  FFlags := Value;
end;

procedure TsgExpDXFLayer.SetLinetypeName(const Value: string);
begin
  FLinetypeName := Value;
end;

procedure TsgExpDXFLayer.SetLineWeight(const Value: Integer);
begin
  FLineWeight := Value;
end;

procedure TsgExpDXFLayer.SetName(const Value: string);
begin
  FName := Value;
end;

{ TsgExpDXFDimension }

constructor TsgExpDXFDimension.Create(const AData: TdxfExportData);
begin
  inherited Create(AData);
  FType := TsgDimensionType(AData.SelfType);
  // default values
  if FData.StyleObject = nil then
  begin
    FStyle.Arrow1 := datClosedFilled;
    FStyle.Arrow2 := datClosedFilled;
    FStyle.ArrowSize := 0.18;
    FStyle.ExtLineExt := 0.18;
    FStyle.ExtLineOffset := 0.0625;
    FStyle.TextOffset := 0.09;
    FStyle.TextHeight := 0.18;
  end
  else
    FStyle := PsgDimensionStyle(FData.StyleObject)^;
  FStyle.ArrowBlock1 := 0;
  FStyle.ArrowBlock2 := 0;
end;

procedure TsgExpDXFDimension.ExportAsDXF(ADXFExport: TsgDXFExport);
const
  cnstOneSixths = 0.1666666666;
var
  vValue: Single;
  I: Integer;
  vPt1, vPt2: TexpPoint;
  vBlockName, vTextValue: string;
  vData: TdxfExportData;
  vLinesData: array [0..3] of TdxfExportData;
  vArrows: array [0..1] of TdxfExportData;

  procedure AddArrows;
  var
    J: Integer;
  begin
    for J := 0 to 1 do
      if vArrows[J].Text <> '' then
        ADXFExport.Insert(vArrows[J]);
  end;

  function GetArrow(AIndex: Integer; APtTo: TexpPoint; Angle: Single): TexpPoint;
  var
    C, S: Extended;
    vArrowData: TdxfExportData;
    vArrowType: TsgDimArrowType;
    function DoPt(X, Y, Z: Extended): TexpPoint;
    begin
      Result.X := APtTo.X + C * X - S * Y;
      Result.Y := APtTo.Y + S * X + C * Y;
      Result.Z := APtTo.Y + Z;
    end;
  begin
    SinCos(Pi * Angle / 180, S, C);
    // Adding blocks for arrows
    vArrows[AIndex].Point := APtTo;
    vArrows[AIndex].Rotation := Angle;
    vArrows[AIndex].Scale := MakeExpPoint(FStyle.ArrowSize, FStyle.ArrowSize, 1);
    if AIndex = 0 then
    begin
      vArrows[AIndex].Text := sgDimensionArrowTypeNames[FStyle.Arrow1];
      vArrowType := FStyle.Arrow1;
    end
    else
    begin
      vArrows[AIndex].Text := sgDimensionArrowTypeNames[FStyle.Arrow2];
      vArrowType := FStyle.Arrow2;
    end;
    FillChar(vArrowData, SizeOf(vArrowData), 0);
    vArrowData.Color := clDXFByBlock;
    Result := DoPt(-FStyle.ArrowSize, 0, 0);
    if ADXFExport.GetBlockByName(vArrows[AIndex].Text) = nil then// add block
    begin
      ADXFExport.BeginBlock(vArrows[AIndex].Text);
      case vArrowType of
        datNone:
          Result := DoPt(0, 0, 0);
        datOrigin, datOrigin2:
        begin
          vArrowData.Point := MakeExpPoint(0, 0, 0);
          vArrowData.Radius := 0.5;
          ADXFExport.AddCircle(vArrowData);
          if vArrowType = datOrigin then
          begin
            vArrowData.Point := MakeExpPoint(0, 0, 0);
            vArrowData.Point1 := MakeExpPoint(-1, 0, 0);
          end
          else
          begin
            vArrowData.Point := MakeExpPoint(0, 0, 0);
            vArrowData.Radius := 0.25;
            ADXFExport.AddCircle(vArrowData);
            vArrowData.Point := MakeExpPoint(-0.5, 0, 0);
            vArrowData.Point1 := MakeExpPoint(-1, 0, 0);
          end;
          ADXFExport.AddLine(vArrowData);
          Result := DoPt(-0.5*FStyle.ArrowSize, 0, 0);
        end;
        datClosedBlank, datClosed, datOpen:
          begin
            vArrowData.Point := MakeExpPoint(-1, cnstOneSixths, 0);
            vArrowData.Point1 := MakeExpPoint(0, 0, 0);
            ADXFExport.AddLine(vArrowData);
            vArrowData.Point := MakeExpPoint(-1, -cnstOneSixths, 0);
            ADXFExport.AddLine(vArrowData);
            if vArrowType <> datOpen then
            begin
              vArrowData.Point1 := MakeExpPoint(-1, cnstOneSixths, 0);
              ADXFExport.AddLine(vArrowData);
            end;
            if vArrowType <> datClosedBlank then
            begin
              vArrowData.Point := MakeExpPoint(0, 0, 0);
              vArrowData.Point1 := MakeExpPoint(-1, 0, 0);
              ADXFExport.AddLine(vArrowData);
            end;
          end;
        else// closed filled as default
          begin
            vArrowData.Point := MakeExpPoint(-1, -cnstOneSixths, 0);
            vArrowData.Point1 := MakeExpPoint(-1, cnstOneSixths, 0);
            vArrowData.Point2 := MakeExpPoint(0, 0, 0);
            vArrowData.Point3 := vArrowData.Point2;
            ADXFExport.AddSolid(vArrowData);
          end;
      end;
      ADXFExport.EndBlock;
    end
    else
    begin
      case vArrowType of
        datOrigin, datOrigin2:
          Result := DoPt(-0.5*FStyle.ArrowSize, 0, 0);
        else
          Result := DoPt(-FStyle.ArrowSize, 0, 0);
      end;
    end;
    if AIndex = 0 then
      FStyle.ArrowBlock1 := ADXFExport.GetBlockByName(vArrows[AIndex].Text).FBlockRecordHandle
    else
      FStyle.ArrowBlock2 := ADXFExport.GetBlockByName(vArrows[AIndex].Text).FBlockRecordHandle;
  end;

  procedure SetValue;
  begin
    vValue := Sqrt(Sqr(vPt2.X - vPt1.X) + Sqr(vPt2.Y - vPt1.Y) + Sqr(vPt2.Z - vPt1.Z));
    if FData.Text = '' then
      vTextValue := PChar(FloatToStr(vValue))
    else
      vTextValue := FData.Text;
  end;

  procedure SwapExpPoints(var APt1, APt2: TexpPoint);
    procedure Swap(var A,B: Double);
    var
      C: Double;
    begin
      C := A;
      A := B;
      B := C;
    end;
  begin
    Swap(APt1.X, APt2.X);
    Swap(APt1.Y, APt2.Y);
    Swap(APt1.Z, APt2.Z);
  end;
begin
  for I := 0 to 3 do
  begin
    FillChar(vLinesData[I], SizeOf(vLinesData[I]), 0);
    vLinesData[I].Color := clDXFByBlock;
  end;
  for I := 0 to 1 do
  begin
    FillChar(vArrows[I], SizeOf(vArrows[I]), 0);
    vArrows[I].Color := clDXFByBlock;
  end;

  if ((FData.Point.Y < FData.Point1.Y) and (FData.Point.Y > FData.Point2.Y)
     and (FData.Point1.Y > FData.Point2.Y)) or
     ((FData.Point.Y > FData.Point1.Y) and (FData.Point.Y < FData.Point2.Y)
     and (FData.Point1.Y < FData.Point2.Y)) then//  |
  begin
    if FData.Point1.Y < FData.Point2.Y then
      SwapExpPoints(FData.Point1, FData.Point2);
    vPt1 := MakeExpPoint(FData.Point.X, FData.Point1.Y, 0);
    vPt2 := MakeExpPoint(FData.Point.X, FData.Point2.Y, 0);
    SetValue;
    vLinesData[0].Point.Y := vPt1.Y;
    vLinesData[0].Point1.Y := vPt1.Y;
    if vPt1.X < FData.Point1.X then
    begin
      vLinesData[0].Point.X := FData.Point1.X - FStyle.ExtLineOffset;
      vLinesData[0].Point1.X := vPt1.X - FStyle.ExtLineExt;
    end
    else
    begin
      vLinesData[0].Point.X := FData.Point1.X + FStyle.ExtLineOffset;
      vLinesData[0].Point1.X := vPt1.X + FStyle.ExtLineExt;
    end;
    vLinesData[1].Point.Y := vPt2.Y;
    vLinesData[1].Point1.Y := vPt2.Y;
    if vPt2.X < FData.Point1.X then
    begin
      vLinesData[1].Point.X := FData.Point2.X - FStyle.ExtLineOffset;
      vLinesData[1].Point1.X := vPt2.X - FStyle.ExtLineExt;
    end
    else
    begin
      vLinesData[1].Point.X := FData.Point2.X + FStyle.ExtLineOffset;
      vLinesData[1].Point1.X := vPt2.X + FStyle.ExtLineExt;
    end;
    vLinesData[2].Point := GetArrow(0, vPt1, 90);
    vLinesData[3].Point := GetArrow(1, vPt2, 270);
    FData.Point3.X := vLinesData[2].Point.X;
    FData.Point3.Y := 0.5 * (vLinesData[3].Point.Y + vLinesData[2].Point.Y);
    FData.Point3.Z := 0;
    vLinesData[2].Point1.X := FData.Point3.X;
    vLinesData[2].Point1.Y := FData.Point3.Y + 0.5 * FStyle.TextHeight + FStyle.TextOffset;
    vLinesData[3].Point1.X := FData.Point3.X;
    vLinesData[3].Point1.Y := FData.Point3.Y - 0.5 * FStyle.TextHeight - FStyle.TextOffset;
  end
  else {if ((FData.Point.X < FData.Point1.X) and (FData.Point.X > FData.Point2.X)
     and (FData.Point1.X > FData.Point2.X)) or
     ((FData.Point.X > FData.Point1.X) and (FData.Point.X < FData.Point2.X)
     and (FData.Point1.X < FData.Point2.X)) then// ___}
  begin
    if FData.Point1.X < FData.Point2.X then
      SwapExpPoints(FData.Point1, FData.Point2);
    vPt1 := MakeExpPoint(FData.Point1.X, FData.Point.Y, 0);
    vPt2 := MakeExpPoint(FData.Point2.X, FData.Point.Y, 0);
    SetValue;
    vLinesData[0].Point.X := vPt1.X;
    vLinesData[0].Point1.X := vPt1.X;
    if vPt1.Y < FData.Point1.Y then
    begin
      vLinesData[0].Point.Y := FData.Point1.Y - FStyle.ExtLineOffset;
      vLinesData[0].Point1.Y := vPt1.Y - FStyle.ExtLineExt;
    end
    else
    begin
      vLinesData[0].Point.Y := FData.Point1.Y + FStyle.ExtLineOffset;
      vLinesData[0].Point1.Y := vPt1.Y + FStyle.ExtLineExt;
    end;
    vLinesData[1].Point.X := vPt2.X;
    vLinesData[1].Point1.X := vPt2.X;
    if vPt2.Y < FData.Point1.Y then
    begin
      vLinesData[1].Point.Y := FData.Point2.Y - FStyle.ExtLineOffset;
      vLinesData[1].Point1.Y := vPt2.Y - FStyle.ExtLineExt;
    end
    else
    begin
      vLinesData[1].Point.Y := FData.Point2.Y + FStyle.ExtLineOffset;
      vLinesData[1].Point1.Y := vPt2.Y + FStyle.ExtLineExt;
    end;
    vLinesData[2].Point := GetArrow(0, vPt1, 0);
    vLinesData[3].Point := GetArrow(1, vPt2, 180);
    FData.Point3.X := 0.5 * (vLinesData[3].Point.X + vLinesData[2].Point.X);;
    FData.Point3.Y := vLinesData[2].Point.Y;
    FData.Point3.Z := 0;
    vLinesData[2].Point1.X := FData.Point3.X + 0.5 * FStyle.TextHeight*Length(vTextValue) + FStyle.TextOffset;
    vLinesData[2].Point1.Y := FData.Point3.Y;
    vLinesData[3].Point1.X := FData.Point3.X - 0.5 * FStyle.TextHeight*Length(vTextValue) - FStyle.TextOffset;
    vLinesData[3].Point1.Y := FData.Point3.Y;
  end;
  vBlockName := '*D' + IntToStr(ADXFExport.FDimensionCounter);
  Inc(ADXFExport.FDimensionCounter);
  ADXFExport.BeginBlock(vBlockName);
    for I := 0 to 3 do
      ADXFExport.AddLine(vLinesData[I]);
    AddArrows;
    FillChar(vData, SizeOf(vData), 0);
    vData.Color := clDXFByBlock;
    // text
    vData.FHeight := FStyle.TextHeight;
    vData.HAlign := 6;
    vData.Rotation := 0;
    vData.Text := vTextValue;
    vData.Point.X := FData.Point3.X - 0.5 * FStyle.TextHeight*Length(vData.Text);
    vData.Point.Y := FData.Point3.Y - 0.5 * FStyle.TextHeight;
    ADXFExport.AddMText(vData);
    // first point
    vData.Point := FData.Point1;
    ADXFExport.AddPixel(vData);
    // second point
    vData.Point := FData.Point2;
    ADXFExport.AddPixel(vData);
    // third point
    vData.Point := vPt2;
    ADXFExport.AddPixel(vData);
  ADXFExport.EndBlock;

  ADXFExport.AddName('DIMENSION', 'AcDbDimension');
  ADXFExport.AddString(2, vBlockName);
  ADXFExport.AddColor(FData);
  ADXFExport.Add3DPoint(10, vPt2);
  ADXFExport.Add3DPoint(11, FData.Point3);
  ADXFExport.AddInt(70, 33);// only Aligned dimensions
  if Ord(ADXFExport.AutoCADVer) > Ord(R14) then
  begin
    if FData.Text <> '' then
      ADXFExport.AddString(1, FData.Text);
    ADXFExport.AddInt(71, 5);
    ADXFExport.AddFloat(42, vValue);
  end;
  ADXFExport.AddString(3, 'STANDARD');
  ADXFExport.AddString(100, 'AcDbAlignedDimension');
  ADXFExport.Add3DPoint(13, FData.Point1);
  ADXFExport.Add3DPoint(14, FData.Point2);
  //ADXFExport.AddString(100, 'AcDbRotatedDimension');
  if FData.StyleObject <> nil then
    ADXFExport.AddDimensionStyle('ACAD', FStyle);//FData.StyleObject
end;

{ TsgExpDXFBlock }

constructor TsgExpDXFBlock.Create(AName: string;
  ABlockRecordHandle: Integer);
begin
  FName := AName;
  FBlockRecordHandle := ABlockRecordHandle;
  FContent := TStringList.Create;
end;

destructor TsgExpDXFBlock.Destroy;
begin
  inherited Destroy;
  FContent.Free;
end;

{ TsgRegion }
procedure TsgRegion.Assign(ASource: TsgRegion);
var
  vRgnData: PRgnData;
  I, K, Cnt: Integer;
  Sz: DWORD;
  vPt: PPoint;
begin
  if ASource = nil then
    Exit;
  Clear;
  FParentMetaFile := ASource.FParentMetaFile;
  Sz := GetRegionData(ASource.FHRGN, SizeOf(TRgnData), nil);
  vRgnData := AllocMem(Sz);
  try
    Sz := GetRegionData(ASource.FHRGN, Sz, vRgnData);
    if Sz <> 0 then
    begin
      FHRGN := Windows.ExtCreateRegion(nil, Sz, vRgnData^);
      FIsClipping := ASource.FIsClipping;
      FBoundsRect := ASource.FBoundsRect;
      FRectCount := ASource.FRectCount;
      for I := 0 to ASource.Points.Count - 1 do
        if ASource.Points[I] <> nil then
        begin
          FPoints.Add(TList.Create);
          Cnt := TList(ASource.Points[I]).Count - 1;
          for K := 0 to Cnt do
            if TList(ASource.Points[I]).Items[K] <> nil then
            begin
              New(vPt);
              vPt^ := PPoint(TList(ASource.Points[I]).Items[K])^;
              TList(FPoints.Last).Add(vPt);
            end;
        end;
    end;
  finally
    FreeMem(vRgnData);
  end;
end;

procedure TsgRegion.Clear;
begin
  FIsClipping := False;
  FRectCount := 0;
  ClearRecordListOfList(FPoints);
  FPoints.Count := 0;
  if FHRGN <> 0 then
    DeleteObject(FHRGN);
  FHRGN := 0;
end;

constructor TsgRegion.Create(AParentMetaFile: TsgMetafile);
begin
  FParentMetaFile := AParentMetaFile;
  FPoints := TList.Create;
end;

destructor TsgRegion.Destroy;
begin
  FParentMetaFile := nil;
  if FHRGN <> 0 then
    DeleteObject(FHRGN);
  FHRGN := 0;
  FreeRecordListOfList(FPoints);
  inherited Destroy;
end;

procedure TsgRegion.InitFromRect(ARect: TRect; AOther: TsgRegion);
var
  I: Integer;
  vHRGN: HRGN;
  vRgnData: TRgnData;

  procedure AddPoint(AIndex: Integer);
  var
    PPt: PPoint;
  begin
    New(PPt);
    case AIndex of
      0: PPt^ := ARect.TopLeft;
      1: PPt^ := Point(ARect.Right, ARect.Top);
      2: PPt^ := ARect.BottomRight;
      3: PPt^ := Point(ARect.Left, ARect.Bottom);
    end;
    TList(FPoints[0]).Add(PPt);
  end;
begin
  Clear;
  // Apply coordinate transforms (only for InitFromRect)
  ARect.TopLeft := FParentMetaFile.GetPoint(ARect.TopLeft);
  ARect.BottomRight := FParentMetaFile.GetPoint(ARect.BottomRight);
  DoPureRect(ARect);
  if not AOther.IsClipping then
  begin
    FIsClipping := True;
    FRectCount := 1;
    FBoundsRect := ARect;
    FHRGN := CreateRectRgnIndirect(ARect);
    FPoints.Add(TList.Create);
    for I := 0 to 3 do
      AddPoint(I);
    AddPoint(0);// closing boundary
  end
  else
  begin
    vHRGN := CreateRectRgnIndirect(ARect);
    CombineRgn(vHRGN, vHRGN, AOther.FHRGN, RGN_AND);
    GetRegionData(vHRGN, GetRegionData(vHRGN, 0, nil), @vRgnData);
    InitFromData(@vRgnData);
    DeleteObject(vHRGN);
  end;
end;

procedure TsgRegion.InitFromData(APRgnData: PRgnData);
var
  vRgnDataHdr: TRgnDataHeader;
  vRectPrev: TRect;
  vPRect: PRect;
  vRightCoords, vRects: TList;
  I, K: Cardinal;
  isAdded: Boolean;
  //vExpPt: PexpPoint;// for boundary test

  procedure DoNextPoint(const ARectTopPt, ARectBottomPt: TPoint; AListPoints: TList);
  var
    vPt: PPoint;
    Pt: TPoint;
  begin
    New(vPt);
    vPt^ := ARectTopPt;
    FParentMetaFile.SetDPtoLP(vPt^);
//    vPt^ := FParentMetaFile.GetPoint(vPt^);
    if (AListPoints.Count > 0) and (PPoint(AListPoints.Last)^.X = vPt^.X) and (PPoint(AListPoints.Last)^.Y = vPt^.Y) then
    begin
      Dispose(vPt);
      Pt := ARectBottomPt;
      FParentMetaFile.SetDPtoLP(Pt);
      PPoint(AListPoints.Last)^ := Pt;// PPoint(AListPoints.Last)^ := FParentMetaFile.GetPoint(Pt);
    end
    else
    begin
      AListPoints.Add(vPt);
      New(vPt);
      vPt^ := ARectBottomPt;
      FParentMetaFile.SetDPtoLP(vPt^);
//      vPt^ := FParentMetaFile.GetPoint(vPt^);
      AListPoints.Add(vPt);
    end;
  end;
begin
  Clear;
  FIsClipping := False;
  if APRgnData = nil then
    Exit;
  vRgnDataHdr := TRgnDataHeader(APRgnData^.rdh);
  // Wrong region
  try
    if (vRgnDataHdr.nRgnSize=0) or ((4*SizeOf(DWORD)*vRgnDataHdr.nCount) <> vRgnDataHdr.nRgnSize) then
      Exit;
  except
    Exit;
  end;
  FRectCount := vRgnDataHdr.nCount;
  FHRGN := Windows.ExtCreateRegion(nil, SizeOf(TRgnDataHeader) + (SizeOf(TRect) * FRectCount), APRgnData^);
  FBoundsRect := vRgnDataHdr.rcBound;
  FParentMetaFile.SetDPtoLP(FBoundsRect.TopLeft);
  FParentMetaFile.SetDPtoLP(FBoundsRect.BottomRight);
  DoPureRect(FBoundsRect);
  vRightCoords := TList.Create;
  vRects := TList.Create;
  vRects.Add(TList.Create);
  TList(vRects[0]).Add(PRect(@APRgnData.Buffer[0]));
  for I := 1 to FRectCount - 1 do
  begin
    vPRect := PRect(@APRgnData.Buffer[I * SizeOf(TRect)]);
    isAdded := False;
    for K := 0 to vRects.Count - 1 do
    begin
      vRectPrev := PRect(TList(vRects[K]).Last)^;
      if (vPRect^.Top = vRectPrev.Bottom) and (vPRect^.Right > vRectPrev.Left)
        and (vPRect^.Left < vRectPrev.Right) then
      begin
        TList(vRects[K]).Add(vPRect);
        isAdded := True;
        Break;
      end;
    end;
    if not isAdded then
    begin
      vRects.Add(TList.Create);
      TList(vRects.Last).Add(vPRect);
    end;
  end;
  repeat
    if TList(vRects.First).Count <> 0 then
    begin
      FPoints.Add(TList.Create);
      vRightCoords.Add(TList.Create);
      for K := 0 to TList(vRects.First).Count - 1 do
      begin
        vPRect := PRect(TList(vRects.First)[K]);
        // Do left coords of the rect
        DoNextPoint(vPRect^.TopLeft, Point(vPRect^.Left, vPRect^.Bottom), TList(FPoints.Last));
        // Do right coords of the rect
        DoNextPoint(Point(vPRect^.Right, vPRect^.Top), vPRect^.BottomRight, TList(vRightCoords.Last));
      end;
    end;
    TList(vRects.First).Free;
    vRects.Delete(0);
  until vRects.Count = 0;
  // Copy right coords (vRightCoords) to left coords (FPoints)
  // (number of boundaries in list FPoints is equal number in vRightCoords)
  for I := 0 to FPoints.Count - 1 do
  begin
    for K := TList(vRightCoords[I]).Count - 1 downto 0 do
      TList(FPoints[I]).Add(TList(vRightCoords[I]).Items[K]);
    TList(vRightCoords[I]).Free;
  end;
  (*//--------------------------- Test boundary -----------------------------------
  FParentMetaFile.ClearData;
  FParentMetaFile.FData.Color := DXF_RED;
  FParentMetaFile.FData.Points := TList.Create;
  FParentMetaFile.FData.Count := FPoints.Count;
  for I := 0 to FPoints.Count - 1 do
  begin
    FParentMetaFile.FData.Points.Add(TList.Create);
    for K := 0 to TList(FPoints[I]).Count - 1 do
    begin
      New(vExpPt);
      vExpPt^.X := PPoint(TList(FPoints[I])[K])^.X;
      vExpPt^.Y := - PPoint(TList(FPoints[I])[K])^.Y;
      vExpPt^.Z := 0;
      FParentMetaFile.SetPt(vExpPt^);
      TList(FParentMetaFile.FData.Points[I]).Add(vExpPt);
    end;
    New(vExpPt);
    vExpPt^.X := PPoint(TList(FPoints[I])[0])^.X;
    vExpPt^.Y := - PPoint(TList(FPoints[I])[0])^.Y;
    vExpPt^.Z := 0;
    FParentMetaFile.SetPt(vExpPt^);
    TList(FParentMetaFile.FData.Points[I]).Add(vExpPt);
    FParentMetaFile.FOwner.AddPolyLine(FParentMetaFile.FData, FParentMetaFile.FData.Points.Count - 1);
  end;
  FParentMetaFile.ClearData;
  //---------------------------------------------------------------------------- *)
  vRightCoords.Free;
  vRects.Free;
  FIsClipping := True;
end;

function TsgRegion.GetIsRect: Boolean;
begin
  Result := (FRectCount = 1);
end;

{ TsgExpDXFTextStyle }

constructor TsgExpDXFTextStyle.Create(AName: string);
begin
  FBigFontName := '';
  FFixedHeight := 0.0;
  FFlag := 0;
  FGenerationFlags := 0;
  FLastHeightUsed := 10;
  FName := AName;
  FObliqueAngle := 0.0;
  FPrimaryFontName := 'txt';
  FWidthFactor := 1.0;
end;

procedure TsgExpDXFTextStyle.ExportAsDXF(ADXFExport: TsgDXFExport);
begin
  ADXFExport.AddString(0, 'STYLE');
  ADXFExport.AddHandle;
  ADXFExport.AddString(330, STablesSTYLE[7]);
  ADXFExport.AddString(100, 'AcDbSymbolTableRecord');
  ADXFExport.AddString(100, 'AcDbTextStyleTableRecord');

  ADXFExport.AddString(2, FName);
  ADXFExport.AddInt(70, FFlag);
  ADXFExport.AddFloat(40, FFixedHeight);
  ADXFExport.AddFloat(41, FWidthFactor);
  ADXFExport.AddFloat(50, FObliqueAngle);
  ADXFExport.AddInt(71, FGenerationFlags);
  ADXFExport.AddFloat(42, FLastHeightUsed);
  ADXFExport.AddString(3, FPrimaryFontName);
  ADXFExport.AddString(4, FBigFontName);
  //if Ord(ADXFExport.AutoCADVer) > Ord(R14) then
end;

{ TsgExpDXFLeader }

{constructor TsgExpDXFLeader.CreateEx(const AData: TdxfExportData;
  AIndex: Integer);
begin
  inherited CreateEx(AData, AIndex);
  FData.StyleObject := AData.StyleObject;
  FData.Radius := AData.Radius;
end;}

procedure TsgExpDXFLeader.ExportAsDXF(ADXFExport: TsgDXFExport);
var
  I: Integer;
begin
  //inherited ExportAsDXF(ADXFExport);
  ADXFExport.BeginLeader(FData, FPoints.Count);
  for I := 0 to FPoints.Count - 1 do
    ADXFExport.AddVertex(PexpPoint(FPoints[I])^);
  if FData.Radius <> -1 then
  begin
    ADXFExport.AddString(1001, 'ACAD');
    ADXFExport.AddString(1000, 'DSTYLE');
    ADXFExport.AddString(1002, '{');
    ADXFExport.AddInt(1070, 41);
    ADXFExport.AddFloat(1040, FData.Rotation);
    ADXFExport.AddString(1002, '}');
  end;
end;

{ TsgExpDXFPath }

procedure TsgExpDXFPath.AddEntity(AExpDFXEntity: TsgExpDXFFigure);
begin
  ActBoundary.Add(AExpDFXEntity);
end;

procedure TsgExpDXFPath.BeginFigure;
begin
  if FFigureList = nil then
    FFigureList := TList.Create;
  FFigureList.Add(TList.Create);
end;

procedure TsgExpDXFPath.CloseFigure;
begin
  if FFigureList = nil then
    Exit;
  FFigureList.Add(TList.Create);
end;

constructor TsgExpDXFPath.Create(const AData: TdxfExportData);
begin
  inherited Create(AData);
  BeginFigure;
end;

destructor TsgExpDXFPath.Destroy;
begin
  inherited Destroy;
end;

procedure TsgExpDXFPath.ExportAsDXF(ADXFExport: TsgDXFExport);
begin

end;

procedure TsgExpDXFPath.GenereateData(var AData: TdxfExportData);
var
  I, J: Integer;
  vFigure: TList;
begin
  FreeRecordListOfList(AData.Points);
  AData.SelfType := Byte(hbtPolyPolyline);
  AData.PolyPoints := TList.Create;
  for I := 0 to FFigureList.Count - 1 do
  begin
    vFigure := FFigureList[I];
    if vFigure.Count > 0 then
    begin
      AData.PolyPoints.Add(TList.Create);
      for J := 0 to vFigure.Count - 1 do
        TsgExpDXFFigure(vFigure[J]).CopyPoints(AData.PolyPoints.Last);
    end;
  end;
  AData.Count := AData.PolyPoints.Count;
end;

function TsgExpDXFPath.GetActBoundary: TList;
begin
  Result :=  TList(FFigureList.Last);
end;

destructor TsgExtPen.Destroy;
begin
  FreeAndNil(FBrush);
  inherited;
end;

initialization

finalization

end.
