{************************************************************}
{                   Delphi VCL Extensions                    }
{                                                            }
{                   CAD export interface                     }
{                                                            }
{      Copyright (c) 2002-2014 SoftGold software company     }
{                                                            }
{************************************************************}

unit CADExport;
{$INCLUDE SGDXF.INC}
//{$DEFINE DEMO}
interface

uses Windows, Classes, Graphics, SysUtils, MVFont, DXFConv, SHX, TTF,
  CADImage, sgConsts, sgBitmap, sgFunction, sgXMLParser, ActiveX;

//For working with SaveToStream the definition sgFR should be uncommented.
//This is necessary for Fast Report Add-in.
//{$DEFINE sgFR}

type
  PsgExportParams = ^TsgExportParams;
  TsgExportParams = record
    Version: TsgDWGVersion;     // TsgDWGVersion
    PageWidth: Double;    // mm
    PageHeight: Double;   // mm
    Margin: Double;       // mm
    DrawMode: Integer;    // color/bw/gray
    BackgroundColor: Integer;
    DefaultColor: Integer;
    NullWidth: Double;    // mm
    LineWeightScale: Double;
    SaveLineWeight: Boolean;
    Quality: Double;
    LayoutExportMode: Integer;
    LayoutNameExportMode: string;
    Title, Author, Subjct, Keywords: string;
    LineWeights: string;  // Namevalueseprated commatext
    UseVectorLineWeight: Boolean;
    UseExtentsFromPlotSettings: Boolean;
    HPGLXScale: Double;
    IsConvertImageToOLE: Boolean;
  end;

const
  DefIsConvertImageToOLE = True;

  DefExportParams: TsgExportParams = (
    Version: acR2004;
    PageWidth: 210;       // mm
    PageHeight: 297;      // mm
    Margin: 5;            // mm
    DrawMode: 0;          // color
    BackgroundColor: clWhite;
    DefaultColor: clBlack;
    NullWidth: 0.3;       // mm
    SaveLineWeight: True;
    Quality: 0.025;
    LayoutExportMode: 3;  //TsgLayoutExportMode.lemAllPaperSpaces
    LayoutNameExportMode: '';
    Title: '';
    Author: '';
    Subjct: '';
    Keywords: '';
    LineWeights: '';
    UseVectorLineWeight: False;
    HPGLXScale: 40;
    IsConvertImageToOLE: DefIsConvertImageToOLE);

type
  TsgLayoutExportMode = (lemModel, lemAllLayouts, lemLayoutByName, lemAllPaperSpaces, lemCurrentLayout);

  TsgApplyBlocksProc = procedure(ABlock: TsgDXFBlock; const AName: string;
    Data: Pointer; ACurrPaperSpaceIndex: Integer = -1) of object;

  TsgSHXFontsProc = function: TsgSHXFontList of object;
  TsgRgnProc = procedure(P: PRect; Count: Integer) of object;
  TsgLayoutProc = procedure(Index: Integer; ALayout: TsgDXFLayout) of object;

  TsgCADBasePolyLineAccess = class(TsgCADBasePolyline);


  // Obsolete type
  TScaling = record
    Offset: TFPoint;
    Scale: TFPoint;
    DX: Integer;
    DY: Integer;
  end;

  PsgCanvasParams = ^TsgCanvasParams;
  TsgCanvasParams = record
    Brush: TBrush;
    Font: TFont;
    Pen: TPen;
  end;

  PsgViewPortCanvasParams = ^TsgViewPortCanvasParams;
  TsgViewPortCanvasParams = record
    HDC: HDC;
    CanvasParams: TsgCanvasParams;
  end;

  TsgCalcCoordsStruct = record
    XScaled: Extended;
    YScaled: Extended;
    X: TsgFloat;
    Y: TsgFloat;
    Rot: TFMatrix;
    RealLayoutCenter: TFPoint;
    NullCoord: Integer;
  end;

  TsgDistanceUnits = (duNone, duInch, duMM);
  TsgAngularUnits = (auNone);
  TsgMeasurement = record
    DistanceUnits: TsgDistanceUnits;
    AngularUnits: TsgAngularUnits;
  end;

  TsgCommonExportParams = class
  private
    procedure InitDefaultCommonExportParams(AStgMed: PStgMedium = nil);
    function GetSaveFileName: string;
    procedure SetSaveFileName(const Value: string);
  public
    Destination: TStgMedium;
    Format: TsgExportFormat;
    Cliping: TsgClipping;
    CADExportParams: TsgExportParams;
    RasterExportParams: TsgRastrExportParams;
    constructor Create;
    destructor Destroy; override;
    procedure Assign(const AObject: TsgCommonExportParams);
    function FromNode(const AExportParamsNode: TsgNode; AStgMed: PStgMedium = nil): Boolean;
    function FromString(const AExportParam: string; AStgMed: PStgMedium = nil): Boolean;
    function IsDestinationClipBoard: Boolean;
    function IsDestinationFile: Boolean;
    procedure SetDefaultParams;
    property SaveFileName: string read GetSaveFileName write SetSaveFileName;
  end;

  TsgCADExport = class(TInterfacedPersistent, IStreamPersist)
  protected
    FOnProgress: TProgressEvent;
    FSGBlock: TsgDXFBlock;
    procedure SaveToStreamCustom(S: TStream); virtual; abstract;
    procedure AfterExport(const S: TStream); virtual;
    procedure BeforeExport(const S: TStream); virtual;
    function ExpSGInsert(const ALayout: TsgDXFLayout): TList;
    procedure DoError(Error: Boolean; const ErrorMessage: string); overload;
    procedure DoError(Error: Boolean; const ErrorMessage: string;
      const Args: array of const); overload;
    function GetSourceId: UInt64;
    procedure LoadSGBlock; virtual;
    function GetConverter: TsgDXFConverter; virtual;
    function GetExportExceptionClass: ExceptClass; virtual;
    procedure InitializeVersionData(const AIsTrial: Boolean;
      const AMessage: string; AppId: string = '');
    procedure LoadFromStream(S: TStream); virtual;
    procedure Progress(Stage: TProgressStage; PercentDone: Byte); virtual;
    property Converter: TsgDXFConverter read GetConverter;
  public
    constructor Create(ACADImage: TsgCADImage); virtual;
    destructor Destroy; override;
    procedure ApplyParams(const AExportParams: TsgExportParams); virtual;
    procedure SaveToStream(S: TStream); virtual;
    procedure SaveToFile(const AFileName: String); virtual;
    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
  end;

  TsgCADExportClass = class of TsgCADExport;

  TsgSimpleExport = class(TsgCADExport)
  private
    FCADImage: TsgCADImage;  //evg
    FParams: TsgCADIterate;
    FColor: TColor;
    FCount: Integer;
    FCurrent: Integer;
    FStep: Integer;
    FCurrentStep: Integer;
    FFillColor: TColor;
    FGDI: TsgGDIAdapter;
    FLayoutExportMode: TsgLayoutExportMode;
    FLayoutNameExportMode: string;
    FXScale: Double;
    FXSize: Integer;
    FPenWidth: Double;
    FUsePlotSetting: Boolean;
    FLayoutsExportCount: Integer;
    procedure CntLayout(Index: Integer; ALayout: TsgDXFLayout);
    procedure CntSGBlock;
    function DrawInsert(Sender: TObject): Integer;
    procedure EnterInsert(Sender: TObject);
    procedure EnterViewport(Sender: TObject);
    procedure EnterXRef(Sender: TObject);
    function GetBackgroundColor: TColor;
    function GetBorderSize: TsgBorderSize;
    function GetBorderType: TsgBorderType;
    function GetDefaultColor: Integer;
    function GetDimensionsVisible: Boolean;
    function GetDrawMode: TsgDXFDrawMode;
    function GetExtent: TFRect;
    function GetIsShowLineWeight: Boolean;
    function GetIsWithoutBorder: Boolean;
    function GetLayout(Index: Integer): TsgDXFLayout;
    function GetLayoutsCount: Integer;
    function GetLayoutsExportCount: Integer;
    function GetPenWidth: Double;
    function GetTTFMode: TsgTTFMode;
    function GetLineWeightScale: TsgFloat;
    function GetNullWidth: Double;
    function GetTextVisible: Boolean;
    function IncCount(Entity: TsgDXFEntity): Integer;
    procedure Iterate(Proc: TsgLayoutProc);
    procedure PolyPolygon(var Points; var Counts; Count: Integer);
    procedure PolyPolyline(const Points; const Counts; Count: Integer);
    procedure SetBackgroundColor(Value: TColor);
    procedure SetBorderType(Value: TsgBorderType);
    procedure SetColor;
    procedure SetDefaultColor(const Value: Integer);
    procedure SetDimensionsVisible(AVisible: Boolean);
    procedure SetDrawMode(const Value: TsgDXFDrawMode);
    procedure SetFColor;
    procedure SetIsShowLineWeight(Value: Boolean);
    procedure SetIsWithoutBorder(Value: Boolean);
    procedure SetLayoutExportMode(const Value: TsgLayoutExportMode);
    procedure SetLineWeightScale(Value: TsgFloat);
    procedure SetNullWidth(Value: Double);
    procedure SetTextVisible(AVisible: Boolean);
    procedure SetTTFMode(const Value: TsgTTFMode);
    procedure SetUsePlotSetting(const Value: Boolean);
  protected
    procedure ExpCloseFigure; virtual;
    procedure ExpLayout(Index: Integer; ALayout: TsgDXFLayout); virtual;
    function DoFinish(Entity: TsgDXFEntity): Integer; virtual;
    procedure ExpClipRgn(P: PRect; Count: Integer); virtual;
    procedure ExpFillRgn(P: PRect; Count: Integer); virtual;
    procedure ExpImage(const R: TRect; AImage: TGraphic); virtual;
    procedure ExpImageUV(const APoint1, APoint2, APoint3,  APoint4: TPoint;
      AImage: TGraphic); virtual;
    procedure ExpPixel(APoint: TPoint; AColor: TColor); virtual;
    procedure ExpPolygon(const Points; Count: Integer); virtual;
    procedure ExpPolyline(const Points; Count: Integer); virtual;
    procedure ExpPolyPolygon(const Points; const Counts; Count: Integer); virtual;
    procedure ExpPolyPolyline(const Points; const Counts; Count: Integer); virtual;
    procedure ExpRestoreDC; virtual;
    procedure ExpSaveDC; virtual;
    procedure ExpProgress; virtual;
    procedure ExpSetColor(AColor: TColor; AColorType: TsgColorType); virtual;
    procedure ExpSetPenMiterLimit(ANewLimit: Single); virtual;
    procedure ExpSetPenGeometric(AStyle: DWORD); virtual;
    //procedure ExpSetColorBrush(AColor: TColor);
    procedure ExpSetFont(AFont: TFont); virtual;
    procedure ExpSetPenWidth(AWidth: Double); virtual;
    function GetClippingRect: TFRect; virtual;
    function GetConverter: TsgDXFConverter; override;
    function GetCurrentLayout: TsgDXFLayout;
    function GetExportRect: TRect; virtual;
    function GetFillColor: TColor; virtual;
    function GetLineScale: Double; virtual;
    function GetMmToPixelX: Double; virtual;
    function GetStrokeColor: TColor; virtual;
    function Flipping: Boolean; virtual;
    function HasClippingRect: Boolean;
    procedure PageEnd(N: Integer); virtual;
    procedure PageStart(N: Integer); virtual;
    procedure Progress(Stage: TProgressStage; PercentDone: Byte); override;
    function RotPict(AGraphic: TGraphic; Angle: Integer): Boolean; virtual;
    procedure SaveToStreamCustom(S: TStream); override;
    procedure SetCurrentLayout(const ALayout: TsgDXFLayout);
    procedure SetFillColor(AColor: TColor); virtual;
    procedure SetStrokeColor(AColor: TColor); virtual;
    function IsGreatImage(const AImage: TGraphic): Boolean; virtual;
    function InitializeIterateParams: PsgCADIterate; virtual;
    property ClippingRect: TFRect read GetClippingRect;
    property CADImage: TsgCADImage read FCADimage;
  public
    constructor Create(ACADImage: TsgCADImage); override;
    destructor Destroy; override;
    procedure ApplyParams(const AExportParams: TsgExportParams); override;
    function AbsHeight: Extended;
    function AbsWidth: Extended;
    procedure GetExtents;
    function GetFPoint(const P: TFPoint): TFPoint;
    function GetPoint(const P: TFPoint): TPoint;
    procedure SaveToStream(S: TStream); override;
    property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor;
    property BorderSize: TsgBorderSize read GetBorderSize;//FBorderSize write FBorderSize;
    property BorderType: TsgBorderType read GetBorderType write SetBorderType;
    property CurrentLayout: TsgDXFLayout read GetCurrentLayout write SetCurrentLayout;
    property DefaultColor: Integer read GetDefaultColor write SetDefaultColor;
    property DimensionsVisible: Boolean read GetDimensionsVisible write SetDimensionsVisible;
    property DrawMode: TsgDXFDrawMode read GetDrawMode write SetDrawMode;
    property Extents: TFRect read GetExtent;
    property IsShowLineWeight: Boolean read GetIsShowLineWeight write SetIsShowLineWeight;
    property IsWithoutBorder: Boolean read GetIsWithoutBorder write SetIsWithoutBorder;
    property LayoutExportMode: TsgLayoutExportMode read FLayoutExportMode write SetLayoutExportMode;
    property LayoutNameExportMode: string read FLayoutNameExportMode write FLayoutNameExportMode;
    property Layouts[Index: Integer]: TsgDXFLayout read GetLayout;
    property LayoutsCount: Integer read GetLayoutsCount;
    property LayoutsExportCount: Integer read FLayoutsExportCount;
    property PenWidth: Double read GetPenWidth;
    property TTFMode: TsgTTFMode read GetTTFMode write SetTTFMode;
    property LineWeightScale: TsgFloat read GetLineWeightScale write SetLineWeightScale;
    property NullWidth: Double read GetNullWidth write SetNullWidth;
    property TextVisible: Boolean read GetTextVisible write SetTextVisible;
    property XScale: Double read FXScale write FXScale;
    property XSize: Integer read FXSize write FXSize;
    property UsePlotSetting: Boolean read FUsePlotSetting write SetUsePlotSetting;
end;

var
  Drawing: TsgSimpleExport;
  MinDXFSize: Integer;

procedure ClearStgMed(var AStgMedium: TStgMedium);

implementation
uses
  ComObj, Math, SGLines, sgOle
  {$IFDEF DEMO}
   , Forms
  {$ENDIF};

const
  cnstTrialMessagesCount: Integer = 3;

type
  PTriVertex = ^TTriVertex;
  TTriVertex = record
    X,Y: Integer;
    Red,Green,Blue,Alpha: Word;
  end;
  TGradFill = function(DC: HDC; PV: PTriVertex; NumV: Integer; PMesh: Pointer; NMesh,Mode: Integer): LongBool; stdcall;
  TsgDXFPointAccess = class(TsgDXFPoint);

  TsgExportAdapter = class(TsgGDIAdapter)
  public
    FExport: TsgSimpleExport;
    procedure PolyPolygon(var Points; var Counts; Count: Integer); override;
    procedure PolyPolyline(var Points; var Counts; Count: Integer); override;
    procedure SetPolyFillMode(Mode: Integer); override;
  end;

  TsgDXFInsertProtect = class(TsgDXFInsert)
  private
    FParent: TsgDXFEntity;
  protected
    property Parent: TsgDXFEntity read FParent write FParent;
    destructor Destroy; override;
  end;

  TEntityAccess = class(TsgDXFEntity);
  TBlockAccess = class(TsgDXFBlock);
  TsgCADImageAccess = class(TsgCADImage);

function GetXMLNodeTextAsPixelFormat(const ANode: TsgNodeSample;
  const ADefaultValue: TPixelFormat = pf24bit): TPixelFormat;
begin
  Result := ADefaultValue;
  if Assigned(ANode) then
  begin
    Result := GetPixelFormat(ANode.TextAsInt);
    if Result = pfCustom then
      Result := ADefaultValue;
  end;
end;

function GetXMLNodeTextAsSizeMode(const ANode: TsgNodeSample;
  const ADefaultValue: TSizeMode = smCustom): TSizeMode;
var
  I: TSizeMode;
  vTextValue: string;
begin
  Result := ADefaultValue;
  if Assigned(ANode) then
  begin
    vTextValue := AnsiLowerCase(ANode.TextAsStr);
    for I := smActual to smSame do
    begin
      if vTextValue = AnsiLowerCase(cnstSizeModeName[I]) then
      begin
        Result := I;
        Break;
      end;
    end;
  end;
end;

function GetXMLNodeTextAsVersion(const ANode: TsgNodeSample;
  const ADefaultValue: TsgDWGVersion = acR2004): TsgDWGVersion;
var
  I: TsgDWGVersion;
  vTextValue: string;
begin
  Result := ADefaultValue;
  if Assigned(ANode) then
  begin
    vTextValue := AnsiLowerCase(ANode.TextAsStr);
    for I := acR09 to acR2013 do
    begin
      if vTextValue = AnsiLowerCase(cnstDWGVersionNames[I]) then
      begin
        Result := I;
        Break;
      end;
    end;
  end;
end;

function GetXMLNodeTextAsTiffComprassion(const ANode: TsgNodeSample;
  const ADefaultValue: TsgTIFFCompressionType = ctAuto): TsgTIFFCompressionType;
var
  I: TsgTIFFCompressionType;
  vTextValue: string;
begin
  Result := ADefaultValue;
  if Assigned(ANode) then
  begin
    vTextValue := AnsiLowerCase(ANode.TextAsStr);
    for I := ctLZW to ctNone do
    begin
      if vTextValue = AnsiLowerCase(cnstTiffCompessionName[I]) then
      begin
        Result := I;
        Break;
      end;
    end;
  end;
end;

var
  Adapter: TsgExportAdapter;

{TsgExportAdapter}

{public}

procedure TsgExportAdapter.PolyPolygon(var Points; var Counts; Count: Integer);
begin
  FExport.PolyPolygon(Points,Counts,Count);
end;

procedure TsgExportAdapter.PolyPolyline(var Points, Counts; Count: Integer);
begin
  FExport.PolyPolyline(Points,Counts,Count)
end;

procedure TsgExportAdapter.SetPolyFillMode(Mode: Integer);
begin
end;

{TsgCADExport}

{protected}

function TsgCADExport.GetConverter: TsgDXFConverter;
begin
  Result := nil;
end;


function TsgCADExport.GetExportExceptionClass: ExceptClass;
begin
  Result := Exception;
end;

function TsgCADExport.GetSourceId: UInt64;
begin
  Result := UInt64(GetConverter);
end;

procedure TsgCADExport.InitializeVersionData(const AIsTrial: Boolean;
  const AMessage: string; AppId: string);
var
  vMText: TsgDXFMText;
begin
  FSGBlock.Free;
  FSGBlock := nil;
  if not AIsTrial then Exit;
  if AppId = '' then
    AppId := cnstCompany;
  // Works only for Trial version
  FSGBlock := TsgDXFBlock.Create;
  FSGBlock.Name := AppId;
  vMText := TsgDXFMText.Create;
  vMText.RectWidth := 1 / 2;
  vMText.LineSpacingFactor := 1;
  vMText.Height := 1 / 20;
  vMText.Color := clBlack;
  vMText.Text := AMessage;
  FSGBlock.AddEntity(vMText);
end;

procedure TsgCADExport.LoadFromStream(S: TStream);
begin
end;

procedure TsgCADExport.LoadSGBlock;
var
  I: Integer;
  vIsCrossoverMatrix: Boolean;
begin
  if Assigned(FSGBlock) and Assigned(Converter) then
  begin
    vIsCrossoverMatrix := Converter.IsCrossoverMatrix;
    try
      Converter.IsCrossoverMatrix := True;
      for I := 0 to FSGBlock.Count - 1 do
        TEntityAccess(FSGBlock[I]).Loaded(Converter);
      TEntityAccess(FSGBlock).Loaded(Converter);
    finally
      Converter.IsCrossoverMatrix := vIsCrossoverMatrix;
    end;
  end;
end;

procedure TsgCADExport.Progress(Stage: TProgressStage; PercentDone: Byte);
var R: TRect;
begin
  if Assigned(FOnProgress) then FOnProgress(Self,Stage,PercentDone,False,R,'');
end;

{public}

procedure TsgCADExport.AfterExport(const S: TStream);
var
  vParam: TsgLogParam;
begin
  FillChar(vParam, SizeOf(vParam), 0);
  vParam.Operation := loSave;
  vParam.Obj := S;
  vParam.Id := GetSourceId;
  FileLoging(vParam);
end;

procedure TsgCADExport.ApplyParams(const AExportParams: TsgExportParams);
begin
end;

procedure TsgCADExport.BeforeExport(const S: TStream);
begin
end;

constructor TsgCADExport.Create(ACADImage: TsgCADImage);
begin
{$IFDEF DEMO}
  Application.MessageBox('CAD Export VCL demo - please register at www.cadsofttools.com',
    'CAD Export VCL demo', MB_OK);
{$ENDIF}
{$IFDEF SG_EXPORTDEMO}
  InitializeVersionData(True, 'CAD Export VCL evaluation - www.cadsofttools.com');
{$ENDIF}
end;

destructor TsgCADExport.Destroy;
begin
  FSGBlock.Free;
  inherited Destroy;
end;

procedure TsgCADExport.DoError(Error: Boolean; const ErrorMessage: string);
begin
  if Error then
    raise GetExportExceptionClass.Create(ErrorMessage);
end;

procedure TsgCADExport.DoError(Error: Boolean; const ErrorMessage: string;
  const Args: array of const);
begin
  if Error then
    raise GetExportExceptionClass.CreateFmt(ErrorMessage, Args);
end;

function TsgCADExport.ExpSGInsert(const ALayout: TsgDXFLayout): TList;
const
  cnstBorderScale = 1.1;
var
  I, J, C: Integer;
  vBox: TFRect;
  vDelta, vScale: TFPoint;
  vInsert: TsgDXFInsertProtect;
  vWidth, vHeight: Double;
begin
  Result := nil;
  if Assigned(FSGBlock) and Assigned(ALayout) and (not IsBadRect(FSGBlock.Box)) then
  begin
    C := cnstTrialMessagesCount;

    Result := TList.Create;
    Result.Capacity := C;

    vBox := ALayout.Box;
    vDelta.X := (vBox.Right - vBox.Left) / C;
    vDelta.Y := (vBox.Top - vBox.Bottom) / C;
    vDelta.Z := (vBox.Z2 - vBox.Z1) / C;

    vWidth := (FSGBlock.Box.Right - FSGBlock.Box.Left) * cnstBorderScale;
    vHeight := (FSGBlock.Box.Top - FSGBlock.Box.Bottom) * cnstBorderScale;
    if vWidth = 0 then
      vWidth := 1;
    if vHeight = 0 then
      vHeight := 1;
    vScale := MakeFPoint(vDelta.X / vWidth,  vDelta.Y / vHeight, 1);
    if vScale.X < vScale.Y then
      vScale.Y := vScale.X
    else
      vScale.X := vScale.Y;
    for I := 0 to C - 1 do
      for J := 0 to C - 1 do
      begin
        vInsert := TsgDXFInsertProtect.Create;
        vInsert.Parent := ALayout;
        vInsert.Block := FSGBlock;
        vInsert.Scale := vScale;
        vInsert.Point := MakeFPoint(vBox.Left + I*vDelta.X, vBox.Top - J*vDelta.Y,
          (vBox.Z2 + vBox.Z1) / 2);
        vInsert.Loaded(Converter);
        Result.Add(vInsert);
      end;
  end;
end;

procedure TsgCADExport.SaveToFile(const AFileName: string);
var
  vStream: TFileStream;
begin
  vStream := TFileStream.Create(AFileName, fmCreate);
  try
    SaveToStream(vStream);
  finally
    vStream.Free;
  end;
end;

procedure TsgCADExport.SaveToStream(S: TStream);
begin
  BeforeExport(S);
  try
    SaveToStreamCustom(S);
  finally
    AfterExport(S);
  end;
end;

{TsgSimpleExport}

{private}

procedure TsgSimpleExport.CntLayout(Index: Integer; ALayout: TsgDXFLayout);
begin
  ALayout.Iterate(FCADImage.Converter,IncCount, DoFinish);
end;

procedure TsgSimpleExport.CntSGBlock;
var
  PrevCount: Integer;
  vParams: PsgCADIterate;
begin
  if FSGBlock <> nil then
  begin
    vParams := FCADImage.Converter.Params;
    try
      FCADImage.Converter.Params := InitializeIterateParams;
      PrevCount := FCount;
      FSGBlock.Iterate(FCADImage.Converter, IncCount, DoFinish);
      Inc(FCount, Sqr(cnstTrialMessagesCount) * (FCount - PrevCount));
    finally
      FCADImage.Converter.Params := vParams;
    end;
  end;
end;

function TsgSimpleExport.DrawInsert(Sender: TObject): Integer;
begin
  Result := Integer(TsgDXFInsert(Sender).Block <> nil);
end;

procedure TsgSimpleExport.EnterInsert(Sender: TObject);
begin
end;

procedure TsgSimpleExport.EnterViewport(Sender: TObject);
begin
end;

procedure TsgSimpleExport.EnterXRef(Sender: TObject);
begin
end;

procedure TsgSimpleExport.ExpLayout(Index: Integer; ALayout: TsgDXFLayout);
begin
  FColor := clNone;
  FFillColor := clNone;
  CurrentLayout := ALayout;
  PageStart(Index);
  FCADImage.IsIterator := True;
  try
    FCADImage.DrawRectInt(GetExportRect);  //evg
  finally
    FCADImage.IsIterator := False;
  end;
  PageEnd(Index);
end;

function TsgSimpleExport.GetBackgroundColor: TColor;
begin
  Result := FCADImage.BackgroundColor;
end;

function TsgSimpleExport.GetBorderSize: TsgBorderSize;
begin
  Result := FCADImage.BorderSize;
end;

function TsgSimpleExport.GetBorderType: TsgBorderType;
begin
  Result := FCADImage.BorderType;
end;

function TsgSimpleExport.GetClippingRect: TFRect;
var
  vHeight, vTop: Double;
begin
  if HasClippingRect then
  begin
    Result := FCADImage.ClippingRect^;
    if Flipping then
    begin
      vHeight := FCADImage.Extents.Top - FCADImage.Extents.Bottom;
      vTop := Result.Top;
      Result.Top := vHeight - Result.Bottom;
      Result.Bottom := vHeight - vTop;
    end;
  end
  else
    Result := FCADImage.Extents;
end;

function TsgSimpleExport.GetDefaultColor: Integer;
begin
  Result := FCADImage.DefaultColor;
end;

function TsgSimpleExport.GetDimensionsVisible: Boolean;
begin
  Result := FCADImage.DimensionsVisible;
end;

function TsgSimpleExport.GetDrawMode: TsgDXFDrawMode;
begin
  Result := FCADImage.DrawMode;
end;

function TsgSimpleExport.GetExtent: TFRect;
begin
  Result := FCADImage.GetDrawingExtents;
end;

function TsgSimpleExport.GetIsShowLineWeight: Boolean;
begin
  Result := FCADImage.IsShowLineWeight;
end;

function TsgSimpleExport.GetIsWithoutBorder: Boolean;
begin
  Result := FCADImage.IsWithoutBorder;
end;

function TsgSimpleExport.GetLayout(Index: Integer): TsgDXFLayout;
begin
  Result := FCADImage.Converter.Layouts[Index];
end;

function TsgSimpleExport.GetLayoutsCount: Integer;
begin
  Result := FCADImage.Converter.LayoutsCount;
end;

function TsgSimpleExport.GetLayoutsExportCount: Integer;
var
  I: Integer;
  vSkipExportLayout: Boolean;
begin
  Result := 0;
  if HasClippingRect then
    Inc(Result)
  else
  begin
    for I := 0 to LayoutsCount - 1 do
    begin
      case FLayoutExportMode of
        lemModel: vSkipExportLayout := not Layouts[I].IsModel;
        lemAllLayouts: vSkipExportLayout := Layouts[I].IsModel;
        lemLayoutByName: vSkipExportLayout := CompareText(Layouts[I].Name, FLayoutNameExportMode) <> 0;
        lemAllPaperSpaces: vSkipExportLayout := False;
        lemCurrentLayout: vSkipExportLayout := CurrentLayout <> Layouts[I];
      else
        vSkipExportLayout := True;
      end;
      if not vSkipExportLayout then
        Inc(Result);
    end;
  end;
end;

function TsgSimpleExport.GetPenWidth: Double;
begin
  Result := FPenWidth;
end;

function TsgSimpleExport.GetLineWeightScale: TsgFloat;
begin
  Result := FCADImage.LineWeightScale;
end;

function TsgSimpleExport.GetMmToPixelX: Double;
begin
  Result := 1;
end;

function TsgSimpleExport.GetNullWidth: Double;
begin
  Result := FCADImage.NullWidthExt;
end;

function TsgSimpleExport.GetTextVisible: Boolean;
begin
  Result := FCADImage.TextVisible;
end;

function TsgSimpleExport.GetTTFMode: TsgTTFMode;
begin
  Result := FCADImage.TTFMode;
end;

function TsgSimpleExport.HasClippingRect: Boolean;
begin
  Result := FCADImage.ClippingRect <> nil;
end;

function TsgSimpleExport.IncCount(Entity: TsgDXFEntity): Integer;
begin
  Inc(FCount);
  if Entity is TsgDXFInsert then
    Result := DrawInsert(Entity)
  else
    Result := 0;
end;

function TsgSimpleExport.IsGreatImage(const AImage: TGraphic): Boolean;
const
  cnstMultWidthHeightMax = 5000*5000;
begin
  Result := (AImage is TMetafile) and
    ((AImage.Height * AImage.Width) > cnstMultWidthHeightMax);
end;

function TsgSimpleExport.InitializeIterateParams: PsgCADIterate;
begin
  FillChar(FParams, SizeOf(FParams), 0);
  FParams.Matrix := cnstIdentityMat;
  FParams.DrawMatrix := cnstIdentityMat;
  Result := @FParams;
end;

procedure TsgSimpleExport.Iterate(Proc: TsgLayoutProc);
var
  I: Integer;
  vSkipExportLayout: Boolean;
  vLayouts, vInserts: TList;
  vLayout: TsgDXFLayout;
  vParams: PsgCADIterate;

  procedure AddSGInserts(const ALayout: TsgDXFLayout; const AInserts: TList); {$IFDEF SG_INLINE} inline; {$ENDIF}
  var
    I: Integer;
  begin
    if Assigned(AInserts) then
      for I := 0 to AInserts.Count - 1 do
        ALayout.PaperSpaceBlock.AddEntity(AInserts[I]);
  end;

begin
  vLayouts := TList.Create;
  try
    if HasClippingRect then
      vLayouts.Add(CurrentLayout)
    else
    begin
      for I := 0 to LayoutsCount - 1 do
      begin
        case FLayoutExportMode of
          lemModel: vSkipExportLayout := not Layouts[I].IsModel;
          lemAllLayouts: vSkipExportLayout := Layouts[I].IsModel;
          lemLayoutByName: vSkipExportLayout := CompareText(Layouts[I].Name, FLayoutNameExportMode) <> 0;
          lemAllPaperSpaces: vSkipExportLayout := False;
          lemCurrentLayout: vSkipExportLayout := CurrentLayout <> Layouts[I];
        else
          vSkipExportLayout := True;
        end;
        if not vSkipExportLayout then
          vLayouts.Add(Layouts[I]);
      end;
    end;
    for I := 0 to vLayouts.Count - 1 do
    begin
      vLayout := TsgDXFLayout(vLayouts[I]);
      vInserts := ExpSGInsert(vLayout);
      try
        AddSGInserts(vLayout, vInserts);
        vParams := FCADImage.Converter.Params;
        if not Assigned(vParams) then
          FCADImage.Converter.Params := InitializeIterateParams;
        try
          Proc(I, vLayout);
        finally
          FCADImage.Converter.Params := vParams;
        end;
      finally
        FreeList(vInserts);
      end;
    end;
  finally
    vLayouts.Free;
  end;
end;

procedure TsgSimpleExport.PolyPolygon(var Points; var Counts; Count: Integer);
begin
  if Count=0 then Exit;
  SetColor;
  SetFColor;
  ExpPolyPolygon(Points,Counts,Count);
end;

procedure TsgSimpleExport.PolyPolyline(const Points; const Counts; Count: Integer);
begin
  if Count=0 then Exit;
  SetColor;
  ExpPolyPolyline(Points,Counts,Count);
end;

procedure TsgSimpleExport.SetBackgroundColor(Value: TColor);
begin
  FCADImage.BackgroundColor := Value;
end;

procedure TsgSimpleExport.SetBorderType(Value: TsgBorderType);
begin
  FCADImage.BorderType := Value;
end;

procedure TsgSimpleExport.SetColor;
//var C: TColor;
begin
  //C := ColorToRGB(FCanvas.Pen.Color);
  //if C = FColor then Exit;
  //FColor := C;
  //SetStrokeColor(C);
end;

procedure TsgSimpleExport.SetDefaultColor(const Value: Integer);
begin
  FCADImage.DefaultColor := Value;
end;

procedure TsgSimpleExport.SetDimensionsVisible(AVisible: Boolean);
begin
  FCADImage.DimensionsVisible := AVisible;
end;

procedure TsgSimpleExport.SetDrawMode(const Value: TsgDXFDrawMode);
begin
  FCADImage.DrawMode := Value;
end;


procedure TsgSimpleExport.SetFColor;
begin
  {if FCanvas.Brush.Style = bsClear then Exit;
  C := ColorToRGB(FCanvas.Brush.Color);
  if C = FFillColor then Exit;
  FFillColor := C; }  //evg
  SetFillColor(FFillColor);//evg    there is no sence here!!!
end;

procedure TsgSimpleExport.SetIsShowLineWeight(Value: Boolean);
begin
  FCADImage.IsShowLineWeight := Value;
end;

procedure TsgSimpleExport.SetIsWithoutBorder(Value: Boolean);
begin
  FCADImage.IsWithoutBorder := Value;
end;

procedure TsgSimpleExport.SetLayoutExportMode(const Value: TsgLayoutExportMode);
begin
  FLayoutExportMode := Value;
end;

procedure TsgSimpleExport.SetLineWeightScale(Value: TsgFloat);
begin
  FCADImage.LineWeightScale := Value;
end;

procedure TsgSimpleExport.SetNullWidth(Value: Double);
begin
  FCADImage.NullWidthExt := Value;//??????
end;

procedure TsgSimpleExport.SetTextVisible(AVisible: Boolean);
begin
  FCADImage.TextVisible := AVisible;
end;

{protected}

procedure TsgSimpleExport.ExpCloseFigure;
begin
end;

function TsgSimpleExport.DoFinish(Entity: TsgDXFEntity): Integer;
begin
  Result := 0;
  case Entity.EntType of
    ceInsert, ceDimension, ceMText: EnterInsert(Entity);
    ceViewport:                     EnterViewport(Entity);
    ceXRef:                         EnterXRef(Entity);
  end;
end;

procedure TsgSimpleExport.ExpClipRgn(P: PRect; Count: Integer);
begin
end;

procedure TsgSimpleExport.ExpFillRgn(P: PRect; Count: Integer);
begin
end;

procedure TsgSimpleExport.ExpImage(const R: TRect; AImage: TGraphic);
begin
end;

//
// APoint1 - insert point
// APoint2, APoint3, APoint4 - the following points in a clockwise
//
procedure TsgSimpleExport.ExpImageUV(const APoint1, APoint2, APoint3, APoint4: TPoint;
  AImage: TGraphic);
var
  vR: TRect;
begin
  vR.TopLeft := APoint1;
  vR.BottomRight := APoint1;
  ExpandRect(vR, APoint2);
  ExpandRect(vR, APoint3);
  ExpandRect(vR, APoint4);
  ExpImage(vR, AImage);
end;

procedure TsgSimpleExport.ExpPixel(APoint: TPoint; AColor: TColor);
var
  vPoints: array[0..3] of Integer;
begin
  vPoints[0] := APoint.X;
  vPoints[1] := APoint.Y;
  vPoints[2] := vPoints[0];
  vPoints[3] := vPoints[1];
  ExpPolyline(vPoints, 2);
end;

procedure TsgSimpleExport.ExpPolygon(const Points; Count: Integer);
begin
end;

procedure TsgSimpleExport.ExpPolyline(const Points; Count: Integer);
begin
end;

procedure TsgSimpleExport.ExpPolyPolygon(const Points; const Counts; Count: Integer);
begin
end;

procedure TsgSimpleExport.ExpPolyPolyline(const Points; const Counts; Count: Integer);
begin
end;

procedure TsgSimpleExport.ExpProgress;
begin
  Inc(FCurrent);
  if FCurrent - FCurrentStep >= FStep then
  begin
    FCurrentStep := FCurrent;
    Progress(psRunning, FCurrentStep * 100 div FCount);
  end;
end;

procedure TsgSimpleExport.ExpRestoreDC;
begin
end;

procedure TsgSimpleExport.ExpSaveDC;
begin
end;

procedure TsgSimpleExport.ExpSetColor(AColor: TColor; AColorType: TsgColorType);
begin
 //evg
  case AColorType of
    ctPen:
    begin
      if AColor <> FColor then
      begin
        FColor := AColor;
        SetStrokeColor(AColor);
      end;
    end;
    ctBrush, ctFont:
    begin
      FFillColor := AColor;
      SetFillColor(AColor);
    end;
  end;

   //evg
end;

{
procedure TsgSimpleExport.ExpSetColorBrush(AColor: TColor);                     {
begin
  FFillColor := AColor;
  SetFillColor(AColor);
end;}

procedure TsgSimpleExport.ExpSetFont(AFont: TFont);
begin
//do nothing
end;

procedure TsgSimpleExport.ExpSetPenGeometric(AStyle: DWORD);
begin

end;

procedure TsgSimpleExport.ExpSetPenMiterLimit(ANewLimit: Single);
begin

end;

procedure TsgSimpleExport.ExpSetPenWidth(AWidth: Double);
begin
  FPenWidth := AWidth;
end;

function TsgSimpleExport.Flipping: Boolean;
begin
  Result := False;
end;

function TsgSimpleExport.GetConverter: TsgDXFConverter;
begin
  Result := FCADImage.Converter;
end;

function  TsgSimpleExport.GetCurrentLayout: TsgDXFLayout;
begin
  Result := FCADImage.CurrentLayout;
end;

function TsgSimpleExport.GetExportRect: TRect;
var
  W,H,K,Max: Double;
  R: TFRect;
begin
  R := ClippingRect;
  Result := cnstRectZero;
  W := R.Right - R.Left;
  H := Abs(R.Top - R.Bottom);
  if W < H then
    Max := H
  else
    Max := W;
  if (FXSize > 0) and (Max <> 0) then
     K := FXSize/Max
   else
     K := 1.0;
  K := K * FXScale;
  Result.Right := Floor(K*W);
  Result.Bottom := Floor(K*H);
end;

function TsgSimpleExport.GetFillColor: TColor;
begin
  Result := FFillColor;
end;

function TsgSimpleExport.GetLineScale: Double;
begin
  Result := {30 * }fLineWeightFactor;
end;

function TsgSimpleExport.GetStrokeColor: TColor;
begin
  Result := FColor;
end;

procedure TsgSimpleExport.PageEnd(N: Integer);
begin
end;

procedure TsgSimpleExport.PageStart(N: Integer);
begin
end;

procedure TsgSimpleExport.Progress(Stage: TProgressStage; PercentDone: Byte);
begin
  TTF.GDIAdapter := FGDI;
  try inherited Progress(Stage,PercentDone)
  finally TTF.GDIAdapter := Adapter end;
end;

function TsgSimpleExport.RotPict(AGraphic: TGraphic; Angle: Integer): Boolean;
begin
  Result := AGraphic is TsgBitmap;
  if Result then TsgBitmap(AGraphic).Rotate(Angle);
end;

procedure TsgSimpleExport.SetCurrentLayout(const ALayout: TsgDXFLayout);
begin
  FCADImage.CurrentLayout := ALayout;
end;

procedure TsgSimpleExport.SetFillColor(AColor: TColor);
begin
end;

procedure TsgSimpleExport.SetTTFMode(const Value: TsgTTFMode);
begin
  FCADImage.TTFMode := Value;
end;

procedure TsgSimpleExport.SetUsePlotSetting(const Value: Boolean);
begin
  FUsePlotSetting := Value;
end;

procedure TsgSimpleExport.SetStrokeColor(AColor: TColor);
begin
end;

{public}

constructor TsgSimpleExport.Create(ACADImage: TsgCADImage);
begin
  FCADImage := nil;
  FCADImage := TsgCADImageClass(ACADImage.ClassType).Create;
  FCADImage.Assign(ACADImage);
  FCADImage.ExpPolyline := ExpPolyline;  //evg
  FCADImage.ExpPolyPolyline := ExpPolyPolyline;  //evg
  FCADImage.ExpPolygon := ExpPolygon;  //evg
  FCADImage.ExpPolyPolygon := ExpPolyPolygon;  //evg
  FCADImage.ExpPixel := ExpPixel; //evg
  FCADImage.ExpImage := ExpImage;  //evg
  FCADImage.ExpImageUV := ExpImageUV;
  FCADImage.ExpFillRgn := ExpFillRgn;  //evg
  FCADImage.ExpClipRgn := ExpClipRgn;  //evg
  FCADImage.ExpCloseFigure := ExpCloseFigure;
  FCADImage.ExpSaveDC := ExpSaveDC;  //evg
  FCADImage.ExpRestoreDC := ExpRestoreDC;  //evg
  FCADImage.ExpProgress := ExpProgress;
  FCADImage.ExpSetColor := ExpSetColor;  //evg
  FCADImage.ExpSetPenWidth := ExpSetPenWidth;
  FCADImage.ExpSetFont := ExpSetFont;
  FCADImage.ExpSetPenMiterLimit := ExpSetPenMiterLimit;
  FCADImage.ExpSetPenGeometric := ExpSetPenGeometric;
  //FCADImage.ExpSetColorBrush := ExpSetColorBrush;  //evg
  FCADImage.TTFMode := ttfPolyPolygon; //evg
  FCADImage.mmToPixelX := GetMmToPixelX;
  FCADImage.BackgroundColor := clWhite;
  FCADImage.DefaultColor := clBlack;
  FCADImage.LineWeightScale := 1.0;
  FCADImage.BorderType := btRatio;
  FCADImage.IsShowLineWeight := True;
  FCADImage.ShowImages := True;
  FCADImage.UseWinEllipse := False;
  FCADImage.NullWidthExt := DefExportParams.NullWidth;
  FXScale := 1.0;
  FLayoutExportMode := lemCurrentLayout; //lemAllPaperSpaces;
  FLayoutsExportCount := 0;
  inherited Create(FCADImage);
end;

destructor TsgSimpleExport.Destroy;
begin
  FreeAndNil(FCADImage);
  inherited Destroy;
end;

function TsgSimpleExport.AbsHeight: Extended;
begin
  Result := FCADImage.AbsHeight;
end;

function TsgSimpleExport.AbsWidth: Extended;
begin
  Result := FCADImage.AbsWidth;
end;

procedure TsgSimpleExport.ApplyParams(const AExportParams: TsgExportParams);
begin
  inherited ApplyParams(AExportParams);
  BackgroundColor := AExportParams.BackgroundColor;
  DefaultColor := AExportParams.DefaultColor;
  NullWidth := AExportParams.NullWidth;
  LineWeightScale := AExportParams.LineWeightScale;
  IsShowLineWeight := AExportParams.SaveLineWeight;
  DrawMode := TsgDXFDrawMode(AExportParams.DrawMode);
  LayoutExportMode := TsgLayoutExportMode(AExportParams.LayoutExportMode);
  LayoutNameExportMode := AExportParams.LayoutNameExportMode;
end;

procedure TsgSimpleExport.GetExtents;
begin
  FCADImage.GetExtents;
end;

function TsgSimpleExport.GetFPoint(const P: TFPoint): TFPoint;
begin
  Result := FPointXMat(P,FCADImage.Converter.Params.Matrix);
end;

function TsgSimpleExport.GetPoint(const P: TFPoint): TPoint;
begin
  Result := FCADImage.GetPoint(P);// FPointXMat2DLongint(P, FDraw.Matrix);
end;

procedure TsgSimpleExport.SaveToStream(S: TStream);
begin
  FLayoutsExportCount := GetLayoutsExportCount;
  if FLayoutsExportCount > 0 then
    inherited SaveToStream(S);
end;

procedure TsgSimpleExport.SaveToStreamCustom(S: TStream);
var
  vHasClippingRect: Boolean;
  vClippingRect, vTmpClippingRect: TFRect;
  vCadImagePrinting: TsgPrintMode;
  vCadImageUsePlotSetting: Boolean;
begin
  vCadImagePrinting := CADImage.Printing;
  vCadImageUsePlotSetting := CADImage.UsePlotSetting;
  vHasClippingRect := HasClippingRect;
  try
    CADImage.Printing := pntDirectColor;
    if vHasClippingRect then
    begin
      vTmpClippingRect := FCADImage.ClippingRect^;
      vClippingRect := ClippingRect;
      FCADImage.ClippingRect := @vClippingRect;
    end;
    FCADImage.UsePlotSetting := UsePlotSetting;
    if FCount = 0 then
    begin
      Iterate(CntLayout);
      CntSGBlock;
    end;
    LoadSGBlock;
    Adapter.FExport := Self;
    FGDI := TTF.GDIAdapter;
    TTF.GDIAdapter := Adapter;
    try
      FCurrent := 0;
      FCurrentStep := 0;
      FStep := FCount*5 div 100;
      Progress(psStarting,0);
      Iterate(ExpLayout);
      Progress(psEnding,100);
    finally
      TTF.GDIAdapter := FGDI;
    end;
  finally
    CADImage.Printing := vCadImagePrinting;
    CADImage.UsePlotSetting := vCadImageUsePlotSetting;
    if vHasClippingRect then
      FCADImage.ClippingRect := @vTmpClippingRect;
  end;
end;

{ TsgDXFInsertProtect }

destructor TsgDXFInsertProtect.Destroy;
begin
  if Assigned(FParent) then
    FParent.RemoveEntity(Self);
  inherited Destroy;
end;

{ TsgCommonExportParams }

procedure TsgCommonExportParams.Assign(const AObject: TsgCommonExportParams);
begin
  Destination := AObject.Destination;
  Format := AObject.Format;
  Cliping := AObject.Cliping;
  CADExportParams := AObject.CADExportParams;
  RasterExportParams := AObject.RasterExportParams;
end;

constructor TsgCommonExportParams.Create;
begin
  inherited Create;
  SetDefaultParams;
end;

destructor TsgCommonExportParams.Destroy;
begin
//
  inherited;
end;

function TsgCommonExportParams.FromNode(const AExportParamsNode: TsgNode;
  AStgMed: PStgMedium = nil):  Boolean;
var
  vNode: TsgNodeSample;
  vFileName, vExt: string;
  vFormat: TsgExportFormat;
  vFileNameEmpty: Boolean;
  vNodes: TsgNodeList;
begin
  Result := False;
  InitDefaultCommonExportParams(AStgMed);
  if Assigned(AExportParamsNode) then
  begin
// Common attributes
    vNode := AExportParamsNode.GetAttributeByName(cnstXMLFileName);
    if Assigned(vNode) then
      vFileName := vNode.ValueAsStr
    else
      vFileName := '';
    vExt := ExtractFileExt(vFileName);
    Format := GetExportFormat(vExt);
    vFileNameEmpty := ChangeFileExt(vFileName, '') = '';
    vNode :=  AExportParamsNode.GetAttributeByName(cnstXMLFormat);
    if Assigned(vNode) then
    begin
      vExt := vNode.ValueAsStr;
      if Length(vExt) > 0 then
      begin
        if vExt[1] <> cnstPoint then
          vExt := cnstPoint + vExt;
        vFormat := GetExportFormat(vExt);
        if vFormat <> Format then
        begin
          Format := vFormat;
          vFileName := vFileName + vExt;
        end;
      end;
    end;
    Format := GetExportFormat(vExt);
    if AStgMed = nil then
    begin
      if not vFileNameEmpty then
      begin
        Destination.tymed := TYMED_FILE;
        Destination.lpszFileName := StringToOleStr(vFileName);
      end
      else
        if Format <> efAuto then
        begin
          Destination.tymed := TYMED_ISTREAM;
          IStream(Destination.stm) := TsgStreamAdapter.Create(TMemoryStream.Create, soOwned);
        end;
    end;
    if (AExportParamsNode.ChildNodesCount > 0) then
    begin
      vNodes := AExportParamsNode.Childs;
//  Clipping
      Cliping.ClipMode := GetXMLNodeTextAsInt(
        vNodes[cnstXMLClipMode], 0);
      Cliping.ClipRect := GetXMLNodeTextAsFRect(
        vNodes[cnstXMLClipRect], cnstBadRect);
//  Raster
      RasterExportParams.Width := GetXMLNodeTextAsInt(
        vNodes[cnstXMLWidth], DefRastrExportParams.Width);
      RasterExportParams.Height := GetXMLNodeTextAsInt(
        vNodes[cnstXMLHeight], DefRastrExportParams.Height);
      RasterExportParams.MaxDim := GetXMLNodeTextAsInt(
        vNodes[cnstXMLMaxDim], DefRastrExportParams.MaxDim);
      RasterExportParams.Quality := GetXMLNodeTextAsDouble(
        vNodes[cnstXMLQuality], DefRastrExportParams.Quality);
      RasterExportParams.MeasureInPixels := GetXMLNodeTextAsBool(
        vNodes[cnstXMLMeasureInPixels], DefRastrExportParams.MeasureInPixels);
      RasterExportParams.Transparent := GetXMLNodeTextAsBool(
        vNodes[cnstXMLTransparent], DefRastrExportParams.Transparent);
      RasterExportParams.DPU.X := GetXMLNodeTextAsInt(
        vNodes[cnstXMLDpuX], DefRastrExportParams.DPU.X);
      RasterExportParams.DPU.Y := GetXMLNodeTextAsInt(
        vNodes[cnstXMLDpuX], DefRastrExportParams.DPU.Y);
      RasterExportParams.SizeMode := GetXMLNodeTextAsSizeMode(
        vNodes[cnstXMLSizeMode], DefRastrExportParams.SizeMode);
      RasterExportParams.Compression := GetXMLNodeTextAsTiffComprassion(
        vNodes[cnstXMLCompression], DefRastrExportParams.Compression);
      RasterExportParams.Depth := GetXMLNodeTextAsPixelFormat(
        vNodes[cnstXMLPixelFormat], DefRastrExportParams.Depth);
      RasterExportParams.SaveProportion := GetXMLNodeTextAsBool(
        vNodes[cnstXMLSaveProportion], DefRastrExportParams.SaveProportion);

// CAD
      CADExportParams.Version := GetXMLNodeTextAsVersion(
        vNodes[cnstXMLVersion], DefExportParams.Version);
      CADExportParams.PageWidth := GetXMLNodeTextAsDouble(
        vNodes[cnstXMLPageWidth], DefExportParams.PageWidth);
      CADExportParams.PageHeight := GetXMLNodeTextAsDouble(
        vNodes[cnstXMLPageHeight], DefExportParams.PageHeight);
      CADExportParams.Margin := GetXMLNodeTextAsDouble(
        vNodes[cnstXMLMargin], DefExportParams.Margin);
      CADExportParams.DrawMode := GetXMLNodeTextAsInt(
        vNodes[cnstXMLDrawMode], DefExportParams.DrawMode);
      CADExportParams.BackgroundColor := GetXMLNodeTextAsInt(
        vNodes[cnstXMLBackgroundColor], DefExportParams.BackgroundColor);
      CADExportParams.DefaultColor := GetXMLNodeTextAsInt(
        vNodes[cnstXMLDefaultColor], DefExportParams.DefaultColor);
      CADExportParams.NullWidth := GetXMLNodeTextAsDouble(
        vNodes[cnstXMLNullWidth], DefExportParams.NullWidth);
      CADExportParams.LineWeightScale := GetXMLNodeTextAsDouble(
        vNodes[cnstXMLLineWeightScale], DefExportParams.LineWeightScale);
      CADExportParams.SaveLineWeight := GetXMLNodeTextAsBool(
        vNodes[cnstXMLSaveLineWeight], DefExportParams.SaveLineWeight);
      CADExportParams.Quality := GetXMLNodeTextAsDouble(
        vNodes[cnstXMLQuality], DefExportParams.Quality);
      CADExportParams.LayoutExportMode := GetXMLNodeTextAsInt(
        vNodes[cnstXMLLayoutExportMode], DefExportParams.LayoutExportMode);
      CADExportParams.LayoutNameExportMode := GetXMLNodeTextAsString(
        vNodes[cnstXMLLayoutNameExportMode], DefExportParams.LayoutNameExportMode);
      CADExportParams.Title := GetXMLNodeTextAsString(
        vNodes[cnstXMLTitle], DefExportParams.Title);
      CADExportParams.Author := GetXMLNodeTextAsString(
        vNodes[cnstXMLAuthor], DefExportParams.Author);
      CADExportParams.Subjct := GetXMLNodeTextAsString(
        vNodes[cnstXMLSubjct], DefExportParams.Subjct);
      CADExportParams.Keywords := GetXMLNodeTextAsString(
        vNodes[cnstXMLKeywords], DefExportParams.Keywords);
      CADExportParams.LineWeights := GetXMLNodeTextAsString(
        vNodes[cnstXMLLineWeights], DefExportParams.LineWeights);
      CADExportParams.UseVectorLineWeight := GetXMLNodeTextAsBool(
        vNodes[cnstXMLUseVectorLineWeight], DefExportParams.UseVectorLineWeight);
      CADExportParams.UseExtentsFromPlotSettings := GetXMLNodeTextAsBool(
        vNodes[cnstXMLUseExtentsFromPlotSettings], DefExportParams.UseExtentsFromPlotSettings);
      CADExportParams.HPGLXScale := GetXMLNodeTextAsDouble(
        vNodes[cnstXMLHPGLXScale], DefExportParams.HPGLXScale);
      CADExportParams.IsConvertImageToOLE := GetXMLNodeTextAsBool(
        vNodes[cnstXMLIsConvertImageToOLE], DefExportParams.IsConvertImageToOLE);
    end;
    Result := True;
  end;
end;

function TsgCommonExportParams.FromString(const AExportParam: string;
  AStgMed: PStgMedium = nil): Boolean;
var
  vParser: TsgParser;
  vRoot: TsgNode;
begin
  Result := False;
  vParser := TsgParser.Create;
  try
    InitDefaultCommonExportParams(AStgMed);
    if vParser.LoadFromString(AExportParam) then
    begin
      vRoot := TsgNode(vParser.ROOT.NodeByName[cnstXMLExportParams]);
      Result := FromNode(vRoot, AStgMed)
    end;
  finally
    vParser.Free;
  end;
end;

function TsgCommonExportParams.GetSaveFileName: string;
begin
  if Destination.tymed and TYMED_FILE <> 0 then
    Result := OleStrToString(Destination.lpszFileName)
  else
    Result := '';
end;

procedure TsgCommonExportParams.InitDefaultCommonExportParams(
  AStgMed: PStgMedium = nil);
begin
  if AStgMed <> nil then
    Destination := AStgMed^
  else
  begin
    Destination.tymed := TYMED_NULL;
    Destination.hBitmap := 0;
    Destination.unkForRelease := nil;
  end;
  CADExportParams := DefExportParams;
  RasterExportParams := DefRastrExportParams;
  Format := efAuto;
  Cliping.ClipMode := 0;
  Cliping.ClipRect := cnstFRectZero;
end;

function TsgCommonExportParams.IsDestinationClipBoard: Boolean;
begin
  Result := (Destination.tymed = TYMED_ENHMF) or
    (Destination.tymed = TYMED_GDI);
end;

function TsgCommonExportParams.IsDestinationFile: Boolean;
begin
  Result := Destination.tymed and TYMED_FILE <> 0;
end;

procedure TsgCommonExportParams.SetDefaultParams;
begin
  CADExportParams := DefExportParams;
  RasterExportParams := DefRastrExportParams;
end;

procedure TsgCommonExportParams.SetSaveFileName(const Value: string);
begin
  Destination.tymed := TYMED_FILE;
  Destination.lpszFileName := StringToOleStr(Value);
end;

procedure ClearStgMed(var AStgMedium: TStgMedium);
begin
  if AStgMedium.unkForRelease = nil then
  begin
    if AStgMedium.tymed and TYMED_FILE = 0 then
      ReleaseStgMedium(AStgMedium);
    FillChar(AStgMedium, SizeOf(TStgMedium), 0);
  end;
end;

initialization
  Adapter := TsgExportAdapter.Create;

finalization
  Adapter.Free;

end.
