unit PCDrawing;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, PCPanel, DrawObjects,PCTypesUtils,clipbrd,Printers,
  DrawEngine,PCDrawBox,FileCtrl,PrvForm,GUiStrings,
  Math //02.10.2013
  ,psAPI,
  U_Common_Classes;

const
  //prnDivIndent = 5; //28.11.2011 2;
  prnReservTiling = 2; //06.12.2011

type

  TlistMod = class(TList)
  public
    function RemoveItem(Item: Pointer): Integer;
    Destructor Destroy;override;
  end;
                                      
  TInsertReason = (irCreate,irPaste,irLoad);
  TRulerMode = (rmPage,rmWorld);
  TMapRescale = (rsNever,rsAlways,rsAskUser);

  TMoveEvent = procedure (Sender: Tobject; Figure: TFigure; dx,dy: double) of Object;
  TSnapEvent = Function (Sender: TObject; SnapFigure: TFigure; var x,y: double):Boolean of Object;
  TFigureEvent = Procedure (Sender: TObject; Figure: TFigure; DeltaX: double = -999999; DeltaY: double = -999999) of Object;
  TFigureDeleteEvent = Procedure (Sender:TObject; Figure:TFigure; var CanDelete:Boolean) of Object;
  TInsertEvent = Procedure (Sender:TObject; Reason:TInsertReason) of Object;
  TBeforeInsertEvent = Procedure (Sender:TObject; Figure:TFigure;var InsertState:TInsertState) of Object;
  TUserDrawEvent = procedure (Sender:TObject; CName:String;DC,Figure:Integer;isGrayed:Boolean; var drawed:Boolean) of Object;
  TUserHitEvent = procedure (Sender:TObject; CName:String;Figure:Integer; x,y: Double; var Test,Tested:Boolean) of Object;
  TOnCollectFaces = Procedure (Sender:TObject; var Faces:TList) of Object;
  TOnCollectFigureFaces = Procedure (Sender:TObject;Figure:TFigure; var Faces:TList) of Object;
  TOnCustomUndoEvent = Procedure (Sender:TObject; isRedo:Boolean) of Object;
  TBeforeMoveAllEvent = Procedure(Sender:TObject;var dx,dy:Double) of Object;
  TAfterMoveAllEvent = Procedure(Sender:TObject;dx,dy:Double) of Object;
  TLayerInitData = Procedure(Sender:TObject;Layer:TLayer) of Object;
  TLayerSaveData = Procedure(Sender:TObject;Layer:TLayer;Stream:TStream) of Object;
  TLayerLoadData = Procedure(Sender:TObject;Layer:TLayer;Stream:TStream) of Object;
  TCalibrateLayer = Procedure(Sender:TObject;LayerNbr:Integer;dist:Double;cUnit:Byte) of Object;

  TGetFigureEvent = procedure (Sender: Tobject; var Figure: TFigure; x, y: double) of Object; //#From Oleg# //04.10.2010
  TGetModPointEvent = procedure (Sender: Tobject; var ModPoint: TModPoint; x, y: double) of Object; //#From Oleg# //23.08.2011
  TCheckPrnWithOffsetEvent = function(Sender: Tobject): Boolean of object;

  TPenBrush = Record
    isPen: Bool;
    index: Cardinal;
    PenLog: TLOGPEN;
    BrushLog: TLOGBRUSH;
  end;

  TSavedDc = Record
    Index: Integer;
    Pen: Integer;
    Brush:Integer;
  End;

  (*vbclassexport begin*)
  TPCDrawing = class(TPCDrawBox)
  private
    { Private declarations }
    FOnSelChange: TNotifyEvent;
    FOnObjectInserted: TInsertEvent;
    FOnFigureMoved: TMoveEvent;
    FOnFigureDel: TFigureDeleteEvent;
    FOnAfterFigureDel: TNotifyEvent;
    FOnBeforeUndo: TNotifyEvent;
    FOnAfterUndo: TNotifyEvent;
    FSnapToFigure: TSnapEvent;
    SOnPaint: TNotifyEvent;
    FOnMapScale:TNotifyEvent;
    FOnUserDraw: TuserDrawEvent;
    FonUserHitTest:TUserHitEvent;
    FFigureModify: TFigureEvent;
    FFigureSelect:TFigureEvent;
    FSelection : TList;
    FKeyCommands: Boolean;
    FMapScale : Double;
    FRulerMode: TRulerMode;
    fDefPenColor : TColor;
    fDefBrsColor : TColor;
    fDefPenstyle : TPenStyle;
    fDefPenWidth : integer;
    fDefBrsStyle : TBrushStyle;
    fDefRowStyle : TRowStyle;
    fDeftextHeight: Double;
    fDefTextRatio: Double;
    fDefPLineClosed: Boolean;
    fDefArcStyle: TArcStyle;
    prDpm,bmpDpm,dcDpm,prPageHeight: Extended;
    prBmpRect: TDoubleRect;
    dcCoordx,dcCoordy: integer;
    TileX,TileY,prWorkHeight,MCopyDelta: Double;
    FAutoSelect: Boolean;
    FRescale: TMapRescale;
    CPBlockNames:TStringList;
    CPLists: TList;
    Freed: TList;
    FPictureFolder: String;
    FPenPatList: Tlist;

    FSavePrev: Boolean;
    prevForm: TFrmPrv;
    FRealScale: Boolean;
    FMetricMode:Integer;
    FAngularMode:Integer;
    FOnBeforeClear:TNotifyEvent;
    FOnCollectFaces:TONCollectFaces;
    FOnCollectFigureFaces:TOnCollectFigureFaces;
    FOnObjectSaved: TFigureEvent;

    FSelChangeLocked: Boolean;
    FZoomRect: Boolean;
    fRangeCheck: Boolean;
    fAutoTile: Boolean;
    FFigureGuides: Boolean;
    FOnCustomUndo: TOnCustomUndoEvent;
    FOnUndoRecord: TNotifyEvent;
    FOnBeforeModify: TFigureEvent;
    FOnBeforeMove: TFigureEvent;
    FBeforeMoveAll: TBeforeMoveAllEvent;
    FAfterMoveAll: TAfterMoveAllEvent;
    FLayerInitData: TLayerInitData;
    FLayerLoadData: TLayerLoadData;
    FLayerSaveData: TLayerSaveData;
    FCalibrateLayer: TCalibrateLayer;
    FCustomStreamUpdate: TNotifyEvent;
    FCustomStreamLoaded: TNotifyEvent;
    FWMFPrint: Boolean;
    FNativeFill: Boolean;

    DPIX: double;
    DPIY: double;
    OFFX: double;
    OFFY: double;
    OFFMMX: double;
    OFFMMY: double;

    Procedure SetAutoSelect(Value:Boolean);
    Function GetPenPatCount:Integer;
    Function GetBrushPatCount:Integer;
    Function GetPenPattern(Index:Integer):TPattern;
    Procedure SetRulerMode(Value:TRulerMode);
    procedure SetZoomRect(const Value: Boolean);
    procedure SetRangeCheck(const Value: Boolean);
    procedure SetFigureGuides(const Value: Boolean);
    function GetRecordUndo: Boolean;
   protected
    { Protected declarations }
    //MacroEngine: THalComp;
    // Tolik 24/12/2019 --
    //ModPoints: TList;
    ModPoints: TMyList;
    //

    FUndoList: TList;
    FUndoIdx : Integer;
    FRecordUndo : Boolean;
    FUndoCount: Integer;
    FBeforeFigureInsert:TBeforeInsertEvent;
    FBlinkPaused: Boolean;
    FOnFigureEdit:TfigureEvent;

    FGetFigureToSelect: TGetFigureEvent; //#From Oleg#  //04.10.2010
    FGetModPointToSelect: TGetModPointEvent; //#From Oleg#  //23.08.2011
    FCheckPrnWithOffset: TCheckPrnWithOffsetEvent; //29.11.2011

    FMultiDeselectCount: Integer; //02.04.2012 - Количество вызовов BeginMultiDeselect;
    FModPointsStartIdx: Integer; // позиция, с которой делать IndexOf в ModPoints в режиме Multideselect

    FUpdateCount: Integer; //06.08.2012 - Disable update Counter

    FUpdateCountAdd: Integer;   // Счетчик количества вызовов для CADBeginUpdate. Если FUpdateCountAdd <0, то процедура
                                // CadEndupdate не выполняться и счетчик количества пауз процессов не изменится

    Procedure SetActiveLayer(value: integer);override;
    Procedure CancelActions;virtual;
    Procedure SetCursor(cr:TCursor);override;
    Function GetLayerCount:integer;override;
    Function GetFigureCount:integer;
    Function GetSelCount:integer;
    Procedure SetMapScale(value: double);
    Procedure DoSurfacePaint(Sender: TObject);override;
    Procedure setPenColor(value: TColor);
    Procedure setBrushColor(value: TColor);
    Procedure setPenWidth(value: integer);
    Procedure setPenStyle(value: TPenStyle);
    Procedure setBrushStyle(value: TBrushStyle);
    Procedure setRowStyle(value: TRowStyle);
    Procedure setTextHeight(value: Double);
    Procedure setTextRatio(value: Double);
    Procedure SetPLineClosed(value:Boolean);
    Procedure SetArcStyle(value:TArcStyle);

    Procedure prDeConvertXY(var X,Y,Z: Double);
    Procedure prDeConvertDim(var Dim: Double);
    Procedure prConvertXY(var X,Y,Z: Double);
    Procedure prConvertDim(var Dim: Double);

    Procedure dcConvertXY(var X,Y,Z: Double);
    Procedure dcConvertXYTile(var X,Y,Z: Double); //25.11.2011
    Procedure dcConvertDim(var Dim: Double);
    Procedure dcDeConvertDim(var Dim: Double);
    Procedure blkConvertXY(var X,Y,Z: Double);
    Procedure blkConvertDim(var Dim: Double);
    Procedure prTileConvertXY(var X,Y,Z: Double);
    Procedure bmpConvertXY(var X,Y,Z: Double);
    Procedure bmpConvertDim(var Dim: Double);



    Procedure ROChanged;override;

    Procedure GetDocumentProperties(Stream:TStream);
    Procedure SetDocumentProperties(Stream:TStream);

    Procedure GetLayerData(Stream:TStream);
    Procedure SetLayerData(Stream:TStream);

    Procedure GetGuidesData(Stream: TStream);
    Procedure SetGuidesData(Stream: TStream);

    Procedure GetFiguresData(Stream:TStream);
    Procedure SetFiguresData(Stream:TStream);

    Procedure GetJoinsData(Stream:TStream);
    Procedure SetJoinsData(Stream:TStream);

    Procedure SetDocumentPropertyInt(xCode:Byte; Value:Integer);
    Procedure SetDocumentPropertyStr(xCode:Byte; Value:String);
    Procedure SetDocumentPropertyDbl(xCode:Byte; Value:Double);
    Procedure SetDocumentPropertyBin(xCode:Byte; Value:pByte; xSize:integer);
    Procedure RecordInsertUndo(xFig:Tfigure; aTag:Integer=0);

    Procedure AddFigureToModifyUndo(xAction: TUndoAction;xFig:TFigure);
    Function SnapToFigures(var x,y: double):Boolean;override;
    //22.08.2012 Procedure ResetRegions;override;
    Procedure KillUndoAction(xAction:TUndoAction);virtual;
    Procedure PrintPage;
    Procedure PrintPageAsWmf;
    Procedure TestPrinter;

    Procedure ModifySelection(mm : TModifyMode; value: integer);
    Procedure ModifyTextandFont(mm: TModifyMode; valueI:Double;
                          valueS: string; valueSt: TFontStyles;ValueB:Boolean);
    //Procedure SetInterfaceHandle;virtual;
    //Procedure NilInterfaceHandle;virtual;

    Function GetZAvg(dRect:TDoubleRect):Double;override;
    Procedure GetIsometricBounds(var MinX,MinY,MaxX,MaxY: Double);override;
    Procedure ExitClear;
    function PrepareBitmap(aPdfSave: Boolean = False): TBitmap; //29.02.2012
   public
    { Public declarations }
    PictureFrame: Boolean;
    DrawSurface: Boolean;
    CustomStream : TStream;
    FAnySelected : Boolean;
    CurrentX,CurrentY: Double;

    CurrentShift: TShiftState;
    Layers: TList;
    // Tolik 13/12/2019--
    //Figures: TList;
    Figures: TMyObjectList;
    //
    Faces: TList;
    BrushList: TList;
    TraceFigure : TFigure;
    ClickIndex  : integer;
    evBrushStyle : TEventEngine;
    evPenStyle : TEventEngine;
    evPenWidth : TEventEngine;
    evRowStyle : TEventEngine;
    evPenColor : TEventEngine;
    evBrushColor : TEventEngine;
    evTextColor  : TEventEngine;
    evTextFont   : TEventEngine;
    evTextSize   : TEventEngine;
    evTextCharset: TEventEngine;
    evTextRatio  : TEventEngine;
    evTextBold     : TEventEngine;
    evTextItalic   : TEventEngine;
    evTextUnderline: TEventEngine;
    evTextStrike   : TEventEngine;
    evToolIndex    : TEventEngine;
    evPLineClosed  : TEventEngine;
    evTransparent  : TEventEngine;
    evClipped      : TEventEngine;
    evArcStyle     : TEventEngine;
    evArcSel       : TEventEngine;
    evBmpSel       : TEventEngine;
    evLineSel      : TEventEngine;
    evPLineSel     : TEventEngine;
    evGroupSel     : TEventEngine;
    evAnySel       : TEventEngine;
    evBounded      : TEventEngine;
    evRulerMode    : TEventEngine;
    SlcBitmapCnt   : Integer;
    SlcLineCnt     : Integer;
    SlcPlineCnt    : Integer;
    SlcArcCnt      : Integer;
    SlcCircleCnt   : Integer;
    SlcEllipseCnt  : Integer;
    SlcVertexCnt   : Integer;
    SlcGroupCnt    : Integer;
    SlcRectangleCnt: Integer;
    SlcDimCnt      : Integer;
    FBlinkTimer    : TTimer;
    PlotHeight     : Double;
    PlotCopy       : Integer;

    FIsSelectingFig: Boolean;
    prnDivOverlay: Double; //01.12.2011
    prnDivIndentX, prnDivIndentY: Double; //29.11.2011
    prnScale: Double; //05.12.2011
    ResetRemoveSelection: Boolean;
     //Tolik -- 24/10/2017 --
    FLastFigureId: integer;
    FLastFigureIdOnLoad: integer;
    FBreakedOnQuota: Boolean; // 16/11/20107 Tolik -- флажок для индикации того, что лист поднят не полностью по причине превышения квоты
                              // (или GDI или USER Objects), т.е. практически "битый" лист --
    isDrawingFigures: Boolean; // флаг, что идет отрисовка фигур када
    //
    resAutoCreate: boolean;
    NotExistInCatalog: byte;

    Procedure SyncEnv;override;
    property UpdateCount: Integer read FUpdateCount;

    Procedure InsertUndoAction(xAction:TUndoAction);virtual;
    // **MY**
    function SaveSCSFiguresToFile(FileName: string): Boolean;
    function SavePlanFiguresToFile(FileName: string): Boolean;
    function SaveElSchemeFiguresToFile(FileName: string): Boolean; // Tolik -- 12/02/2021

    Procedure LoadSCSFiguresFromFile(FileName: string);

    Procedure SetSelectionHatch(HStyle:THatchStyle;ForeColor,BackColor:TColor;StepSize:Double);(*vb*)
    Procedure SetSelectionGradient(GStyle:TGradStyle;ForeColor,BackColor:TColor);(*vb*)
    Procedure SetSelectionTexture(TStyle:TTextureStyle;TexSize:Integer);(*vb*)
    Procedure DoSelChange;virtual;
    Function NewLayer(LayerName: string):integer;(*vb*)
    Function DeleteLayer(LayerName: string): boolean;(*vb*)
    Function DeleteLayerWithNbr(LayerNbr: integer): boolean;(*vb*)
    Procedure DeleteAllUserLayers;(*vb*)

    Procedure UnDo;(*vb*)
    Procedure ReDo;(*vb*)

    Procedure ClearUndoList;(*vb*)
    Procedure ShowLayer(LayerNbr:integer);(*vb*)
    Procedure HideLayer(LayerNbr:integer);(*vb*)
    Procedure HideAllLayers;(*vb*)
    Procedure GrayLayer(LayerNbr:integer);(*vb*)
    Procedure ExGrayLayer(LayerNbr:integer);(*vb*)
    Procedure ExHideLayer(LayerNbr:integer);(*vb*)
    Procedure ShowAllLayers;(*vb*)
    Procedure MergeAllLayers;(*vb*)
    Procedure MergeVisibleLayers;(*vb*)
    Function GetLayerInfo(LayerNbr: integer): TLayerInfo;
    Function GetLayer(LayerNbr: integer):TLayer;
    Function GetLayerName(LayerNbr: integer): String;(*vb*)
    Function GetLayerHandle(LayerNbr: integer): Integer;(*vb*)
    Function GetLayerVisible(LayerNbr: integer): Boolean;(*vb*)
    Function GetLayerGrayed(LayerNbr: integer): Boolean;(*vb*)
    Function GetSelectedHandle(index:Integer):TFigHandle;(*vb*)
    // all figure classes
    Function FigureGetHandle(FigureIndex:Integer):Integer;(*vb*)
    Function FigureGetName(FigureHandle:Integer):String;(*vb*)
    Function FigureGetClass(FigureHandle:Integer):String;(*vb*)
    Function FigureGetPointCount(FigureHandle:Integer):Integer;(*vb*)
    Function FigureGetPoint(FigureHandle,pIndex:Integer):TDoublePoint;(*vb*)
    Function FigureGetDCPoint(FigureHandle,pIndex:Integer):TDoublePoint;(*vb*)
    Function FigureGetCenter(FigureHandle:Integer):TDoublePoint;(*vb*)
    Function FigureGetRect(FigureHandle:Integer):TDoubleRect;(*vb*)
    Function FigureGetRadius(FigureHandle:Integer):Double;(*vb*)
    Function FigureGetFontName(FigureHandle:Integer):String;(*vb*)
    Function FigureGetFontBold(FigureHandle:Integer):Boolean;(*vb*)
    Function FigureGetFontItalic(FigureHandle:Integer):Boolean;(*vb*)
    Function FigureGetFontUnderline(FigureHandle:Integer):Boolean;(*vb*)
    Function FigureGetFontStrike(FigureHandle:Integer):Boolean;(*vb*)
    Function FigureGetFontSize(FigureHandle:Integer):Double;(*vb*)
    Function FigureGetFontCharset(FigureHandle:Integer):Integer;(*vb*)
    Function FigureGetFontColor(FigureHandle:Integer):TColor;(*vb*)
    Function FigureGetPenColor(FigureHandle:Integer):TColor;(*vb*)
    Function FigureGetBrushColor(FigureHandle:Integer):TColor;(*vb*)
    Function FigureGetPenStyle(FigureHandle:Integer):TPenStyle;(*vb*)
    Function FigureGetBrushStyle(FigureHandle:Integer):TBrushStyle;(*vb*)
    Function FigureGetRowStyle(FigureHandle:Integer):TRowStyle;(*vb*)
    Function FigureGetPenWidth(FigureHandle:Integer):Integer;(*vb*)
    Function FigureGetInfo(FigureHandle:Integer):String;(*vb*)
    Function FigureGetAngle(FigureHandle:Integer):Double;(*vb*)
    Function FigureGetLayerHandle(FigureHandle:Integer):Integer;(*vb*)
    Function FigureGetDiagonal(FigureHandle:Integer):Boolean;(*vb*)
    Function FigureGetLockMove(FigureHandle:Integer):Boolean;(*vb*)
    Function FigureGetLockModify(FigureHandle:Integer):Boolean;(*vb*)
    Function FigureGetSelected(FigureHandle:Integer):Boolean;(*vb*)
    Function FigureTestPoint(FigureHandle:Integer;TestPoint:TDoublePoint):Boolean;(*vb*)
    Function FigureTestRect(FigureHandle:Integer;TestRect:TDoubleRect):Boolean;(*vb*)
    Function FigureGetRgnHandle(FigureHandle:Integer):Integer;(*vb*)
    Procedure FigureSelect(FigureHandle:Integer);(*vb*)
    Procedure FigureSelectAsRotate(FigureHandle:Integer);(*vb*)
    Procedure FigureDeSelect(FigureHandle:Integer);(*vb*)
    Procedure FigureEdit(FigureHandle:Integer);(*vb*)
    Procedure FigureMove(FigureHandle:Integer;deltax,deltay: Double);(*vb*)
    Procedure FigureRotate(FigureHandle:Integer; Angle:Double);(*vb*)
    Procedure FigureRotateByPoint(FigureHandle:Integer; Angle:Double; cPoint:TDoublePoint);(*vb*)
    Procedure FigureMirror(FigureHandle:Integer; Point1,Point2: TDoublePoint);(*vb*)
    Procedure FigureScale(FigureHandle:Integer; px,py: Double);(*vb*)
    Procedure FigureScaleByPoint(FigureHandle:Integer; px,py: Double; rPoint: TDoublepoint);(*vb*)
    Procedure FigureSetFontName(FigureHandle:Integer;value:String);(*vb*)
    Procedure FigureSetFontBold(FigureHandle:Integer;value:Boolean);(*vb*)
    Procedure FigureSetFontItalic(FigureHandle:Integer;value:Boolean);(*vb*)
    Procedure FigureSetFontUnderline(FigureHandle:Integer;value:Boolean);(*vb*)
    Procedure FigureSetFontStrike(FigureHandle:Integer;value:Boolean);(*vb*)
    Procedure FigureSetFontSize(FigureHandle:Integer;value:Double);(*vb*)
    Procedure FigureSetFontCharset(FigureHandle:Integer;value:Integer);(*vb*)
    Procedure FigureSetFontColor(FigureHandle:Integer;value:TColor);(*vb*)
    Procedure FigureSetPenColor(FigureHandle:Integer;value:TColor);(*vb*)
    Procedure FigureSetBrushColor(FigureHandle:Integer;value:TColor);(*vb*)
    Procedure FigureSetPenStyle(FigureHandle:Integer;value:TPenStyle);(*vb*)
    Procedure FigureSetBrushStyle(FigureHandle:Integer;value:TBrushStyle);(*vb*)
    Procedure FigureSetRowStyle(FigureHandle:Integer;value:TRowStyle);(*vb*)
    Procedure FigureSetPenWidth(FigureHandle:Integer;value:Integer);(*vb*)
    Procedure FigureSetPoint(FigureHandle,pIndex:Integer;fPoint:TDoublePoint);(*vb*)
    Procedure FigureSetInfo(FigureHandle:Integer;value:String);(*vb*)
    Procedure FigureSetAngle(FigureHandle:Integer;value:Double);(*vb*)
    Procedure FigureSetLayerHandle(FigureHandle:Integer;value:Integer);(*vb*)
    Procedure FigureSetDiagonal(FigureHandle:Integer;value:Boolean);(*vb*)
    Procedure FigureSetLockMove(FigureHandle:Integer;value:Boolean);(*vb*)
    Procedure FigureSetLockModify(FigureHandle:Integer;value:Boolean);(*vb*)
    Procedure FigureSetRgnHandle(FigureHandle,Rgn:Integer);(*vb*)
    Function GetDCPoint(p:TDoublePoint):TDoublePoint;(*vb*)
    Function GetDCLen(l:Double):Integer;(*vb*)

    //block - figure grp
    Function FigureGrpGetFigureCount(FigureHandle:Integer):Integer;(*vb*)
    Function FigureGrpGetFigureHandle(FigureHandle,fIndex:Integer):Integer;(*vb*)
    Function FigureGrpGetCombined(FigureHandle:Integer):Boolean;(*vb*)
    Procedure FigureGrpSetCombined(FigureHandle:Integer;Value:Boolean);(*vb*)
    Procedure FigureGrpUngroup(FigureHandle:Integer);(*vb*)
    // block
    Function FigureBlockGetBlockname(FigureHandle:Integer):String;(*vb*)
    // line - polyline
    Function FigureGetJoin1(FigureHandle:Integer):Integer;(*vb*)
    Function FigureGetJoin2(FigureHandle:Integer):Integer;(*vb*)
    Procedure FigureSetJoin1(FigureHandle,JHandle:Integer);(*vb*)
    Procedure FigureSetJoin2(FigureHandle,JHandle:Integer);(*vb*)
    // polyline
    Function FigureGetClosed(FigureHandle:Integer):Boolean;(*vb*)
    Procedure FigureSetClosed(FigureHandle:Integer; Closed:Boolean);(*vb*)
    Function FigureGetControlPoint(FigureHandle,SegmentIndex,pIndex:Integer):TDoublePoint;(*vb*)
    Procedure FigureSetControlPoints(FigureHandle,SegmentIndex:Integer;cPoint1,cPoint2:TDoublePoint);(*vb*)
    Function FigureGetSegmentType(FigureHandle,SegmentIndex:Integer):TSegmentType;(*vb*)
    Procedure FigureSetSegmentType(FigureHandle,SegmentIndex:Integer;SegType:TSegmentType);(*vb*)
    Procedure FigureInvertArcSegment(FigureHandle,SegmentIndex:Integer);(*vb*)
    Procedure FigureConvertPLBezier(FigureHandle:Integer);(*vb*)
    Procedure FigureConvertPLPolyline(FigureHandle:Integer);(*vb*)
    // ellipse
    Function FigureGetElpALen(FigureHandle:Integer):Double;(*vb*)
    Function FigureGetElpBLen(FigureHandle:Integer):Double;(*vb*)
    //arc - elparc
    Function FigureGetArcStyle(FigureHandle:Integer):TArcStyle;(*vb*)
    Procedure FigureSetArcStyle(FigureHandle:Integer;aStyle:TArcStyle);(*vb*)
    Procedure FigureInvertArc(FigureHandle:Integer);(*vb*)
    Function FigureGetArcSAngle(FigureHandle:Integer):Double;(*vb*)
    Function FigureGetArcFAngle(FigureHandle:Integer):Double;(*vb*)
    Procedure FigureSetArcAngles(FigureHandle:Integer; SAngle,FAngle:Double);(*vb*)
    // rich text
    Function FigureGetRichText(FigureHandle:Integer):String;(*vb*)
    Procedure FigureSetRichText(FigureHandle:Integer; rText:String);(*vb*)
    // bpm wmf
    Function FigureGetPictureName(FigureHandle:Integer):String;(*vb*)
    // Bmp Object
    Function FigureGetTransparent(FigureHandle:Integer):Boolean;(*vb*)
    Procedure FigureSetTransparent(FigureHandle:Integer;Value:Boolean);(*vb*)
    Procedure FigureFlipHorz(FigureHandle:Integer);(*vb*)
    Procedure FigureFlipVert(FigureHandle:Integer);(*vb*)
    Procedure FigureSkewBitmap(FigureHandle:Integer);(*vb*)
    Procedure FigureSaveBitmapToFile(FigureHandle:Integer;Fname:String);(*vb*)
    Procedure FigureLoadBitmapFromFile(FigureHandle:Integer;Fname:String);(*vb*)

    // Text
    Function FigureGetText(FigureHandle:Integer):String;(*vb*)
    Procedure FigureSetText(FigureHandle:Integer;Value:String);(*vb*)



    Function DrawUserFigureEvent(Cname:String;DC,Handle:Integer;isGrayed:Boolean):Boolean;(*vb*)
    Function PointInUserFigureEvent(Cname:String;Handle:Integer;x,y:Double; var Test:Boolean):Boolean;(*vb*)

    Constructor Create(AOwner:TComponent);override;
    Procedure OnBlinkTimer(Sender:TObject);
    Procedure GotFocus(Sender:TObject);override;
    Destructor Destroy;override;
    procedure Draw;(*vb*)
    procedure DrawFigures(OnlyVisibles:Boolean);overload;
    procedure TestListFigures(aCheckOverlap: Boolean);
    procedure DrawFigures;overload;(*vb*)
    Procedure DrawSubstrateFigures(OnlyVisibles:Boolean); overload;(*vb*)
    Procedure DrawDetail;

    Procedure DrawFaces;
    Procedure ClearFaces;
    Procedure CollectFaces;override;
    function GetFacadeArea(AResInM: Boolean=true): Double; //07.12.2010 Вернет площадь фасадов

    Procedure DrawSelectedFigures;(*vb*)
    Procedure DrawSelectionPoints;(*vb*)
    Procedure DrawFigureGuides;(*vb*)
    procedure SelectAll(LayerNbr : integer);(*vb*)
    Procedure DeselectAll(LayerNbr : integer);(*vb*)
    Procedure InvertSelection;(*vb*)
    Function GroupSelection:TFigHandle;(*vb*)
    procedure UngroupSelection;(*vb*)

    procedure OrderSelection(Dest : TOrderStyle);(*vb*)
    // my
    procedure OrderFigureToFront(aFigure: TFigure);
    procedure OrderFigureToBack(aFigure: TFigure);

    procedure RemoveSelection;(*vb*)
    Procedure RotateSelectionCenter(Angle: Double);(*vb*)
    Procedure RotateSelection(Angle: Double; rPoint: TDoublePoint);overload;(*vb*)
    Procedure MirrorSelection(Point1,Point2: TDoublePoint; Dupl: boolean);overload;(*vb*)
    Procedure KnifeSelection(Point1,Point2: TDoublePoint);(*vb*)
    Procedure CreateDimLinesOfSelection;(*vb*)
    Procedure ClearDimLinesOfSelection;(*vb*)
    Procedure InterBreakSelection;(*vb*)
    Procedure LockSelectionToMove(Locked:Boolean);(*vb*)
    Procedure LockSelectionToModify(Locked:Boolean);(*vb*)
    Procedure InvertArcsOfSelection;(*vb*)
    Procedure ArrangeArcStyleOfSelection(Value: TArcStyle);(*vb*)
    Procedure CloseSelectedPolyline;(*vb*)
    Procedure OpenSelectedPolyline;(*vb*)
    Procedure SimplfySelectedPolyline;(*vb*)
    Procedure NameSelection;(*vb*)
    Procedure ConvertPLToBezier;(*vb*)
    Procedure ConvertPLToPolyline;(*vb*)
    Procedure FlipImagesOfSelection(FlipMode: TFlipMode);(*vb*)
    Procedure setTransparentOfSelection(Transparent:Boolean);(*vb*)
    Procedure ScaleSelection(percentX,percentY: Double; rPoint: TDoublePoint);overload;(*vb*)
    Procedure ScaleDrawing(percentx,percenty:Double);(*vb*)
    Procedure ModifyFontName(value:String);(*vb*)
    Procedure ModifyFontBold(value:Boolean);(*vb*)
    Procedure ModifyFontItalic(value:Boolean);(*vb*)
    Procedure ModifyFontUnderline(value:Boolean);(*vb*)
    Procedure ModifyFontStrike(value:Boolean);(*vb*)
    Procedure ModifyFontSize(value:Double);(*vb*)
    Procedure ModifyFontCharset(value:Integer);(*vb*)
    Procedure ModifyFontColor(value:TColor);(*vb*)
    Procedure ModifyPenColor(value:TColor);(*vb*)
    Procedure ModifyBrushColor(value:TColor);(*vb*)
    Procedure ModifyPenStyle(value:TPenStyle);(*vb*)
    Procedure ModifyBrushStyle(value:TBrushStyle);(*vb*)
    Procedure ModifyRowStyle(value:TRowStyle);(*vb*)
    Procedure ModifyPenWidth(value:Integer);(*vb*)
    Function IsTextSelected:Boolean;(*vb*)
    Function GetSelectionRect: TDoubleRect;override;(*vb*)
    Function GetDrawingRect:TDoubleRect;override;(*vb*)
    function GetFigureListRect(AFigures: TList): TDoubleRect; //04.08.2011
    Procedure GetSelectionBoundS(var MaxX,MaxY,MinX,MinY: Double);(*vb*)
    Procedure GetDrawingBounds(var MaxX,MaxY,MinX,MinY: Double);(*vb*)
    Procedure AlignSelection(HorzAlign: THorzAligns; VertAlign: TVertAligns);
    procedure Refresh;override;(*vb*)
    Procedure ReDrawSelection;virtual;(*vb*)
    Procedure ReDrawSelectionPoints;virtual;(*vb*)
    procedure ManualRefresh;(*vb*)
    Procedure RefreshSelection;(*vb*)
    Procedure Reselect;(*vb*)
    Function GetSurfaceBitmap:Tbitmap;
    Function GetSurfaceBitmapHandle:Integer;(*vb*)
    Procedure CollectSelectedFigures(var Selecteds:TList);
    Procedure CollectSelectionOrder(var Selecteds:TList);
    Function CheckByPointInt(LayerNbr:Integer;x,y:Integer):TFigure;override;(*vb*)
    Function CheckByPoint(LayerNbr:Integer;x,y:Double): TFigure;
    Function SelectByPoint(LayerNbr:Integer;x,y:Double;shiftpressed: boolean): Boolean;(*vb*)
    Function DoMagicWand(LayerNbr:Integer;x,y:Double):TFigHandle;(*vb*)
    Function SelectByFigure(LayerNbr:Integer;Fig:TFigHandle;shiftpressed: boolean):Boolean;(*vb*)
    Function SelectWithInArea(LayerNbr: integer;area:TDoubleRect;shiftpressed: boolean): Boolean;(*vb*)
    Procedure SelectFigure(FHandle: Integer);(*vb*)
    Procedure DeSelectFigure(FHandle: Integer);(*vb*)
    Procedure MoveSelection(deltax,deltay: Double);(*vb*)
    Procedure MoveAll(deltax,deltay: Double);(*vb*)
    Procedure MoveAllSilent(deltax,deltay: Double);(*vb*)
    Procedure DuplicateSelection(deltax,deltay: Double);(*vb*)
    Procedure DuplicateSelectionAsBezier(deltax,deltay: Double);(*vb*)
    Procedure ConvertSelectionToBezier;(*vb*)
    Procedure ArrayRectSelection(distanceX,distanceY: Double;col,row: integer);(*vb*)
    Procedure ArrayPolarSelection(cpoint: TDoublePoint; angle: Double);(*vb*)
    function GetSelectionBlock: TBlock;
    function GetSelectionBlockDuplicate: TBlock;
    Procedure MakeSelectionBlock(FileName : string);(*vb*)
    Procedure BoundSelectedLine;(*vb*)
    Procedure BoundLineToFigures(BLine:TFigHandle; jf1,jf2: TFigHandle);(*vb*)
    Procedure BoundLinePoint(BLine:TFigHandle; seqnbr: integer; bPoint: TDoublepoint);(*vb*)
    Procedure BoundLineByText(Line:String;ptIndex:integer);
    Procedure BoundPLineByText(Line:String;ptIndex:integer);
    Procedure UnBoundLine;(*vb*)
    Procedure GetLineJoins(var lines: TstringList);
    Function MakeSelectedLinesPolyline:TFigHandle;(*vb*)
    Function WeldIntoPolyline:TFigHandle;(*vb*)
    Procedure OffSetSelection(Thick:Double);(*vb*)
    Procedure ClipSelBitmapToSelFigure;(*vb*)
    Procedure UnClipSelBitmap;(*vb*)
    function SaveToFile(LayerNbr:integer; FileName : string): Boolean;(*vb*)
    function LoadFromFile(const FileName : string): Boolean;(*vb*)
    Procedure LoadFromStream(Stream: TStream);
    Procedure SaveToStream(Stream: TStream);
    Function InsertBlockwithFileName(LayerNbr:integer; FileName: string;x,y: Double):TFigHandle;(*vb*)
    Procedure SetBlockInfo(FigHandle:Integer;Info:String);(*vb*)
    Function InsertBlockFromStream(LayerNbr:integer;Stream:TStream;x,y: Double):TFigHandle;
    Procedure ExportAsWmf(FileName: string);(*vb*)
    Function DrawingAsWmf(dpm:Double):TMetafile;overload;
    Function DrawingAsWmf:TMetafile;overload;
    Function SelectionAsWmf:TMetafile;
    Function FigureAsWmf(FigHandle:TFigHandle;isGrayed:Boolean):TMetafile;
    Function SelectionAsBitmap(dpi:Integer):TBitmap;
    Function SelectionAsMetaFile:Integer;(*vb*)
    Function DrawingAsMetaFile:Integer;(*vb*)
    Function FigureAsMetaFile(FigHandle:TFigHandle):Integer;(*vb*)
    Function SelectionAsBmpHandle(dpi:Integer):Integer;(*vb*)
    Procedure SaveAsBitmap(FileName: string);(*vb*)
    // Tolik 24/09/2019 --
    function SaveToBitmap(aPdfSave: Boolean = False): TBitmap;
    //function SaveToBitmap: TBitmap; //29.02.2012
    //
    Procedure SaveSubstrateAsBitmap(FileName: string);(*vb*)
    // Tolik 24/09/2019 --
    function SaveSubstrateToBitmap(aPdfSave: Boolean = False): TBitmap;
    //function SaveSubstrateToBitmap: TBitmap; //29.02.2012
    //
    Function CreatePreviewBitmap: TBitmap;
    Function CreatePreviewBitmapHandle:Integer;(*vb*)
    Procedure DrawToDC(dc,x,y:Integer;DScale:Double);(*vb*)
    Procedure DrawToCanvas(xCanvas:TCanvas;x,y:Integer;DScale:Double);
    Procedure DrawRectToCanvas(ARect: TDoubleRect; xCanvas:TCanvas;x,y:Integer;DScale:Double); //24.11.2011
    Procedure StretchToDC(dc,aLeft,aTop,aRight,aBottom:Integer);(*vb*)
    Procedure PrintDrawing(TitleinStatusBox: String);(*vb*)
    Procedure PrintDrawingAsWmf(TitleinStatusBox: String);(*vb*)
    Procedure PrnStartJob(TitleinStatusBox: String);(*vb*)
    Procedure PrnDoJob(NewPage:Boolean);(*vb*)
    Procedure PrnEndJob;(*vb*)
    Procedure PrnAbortJob;(*vb*)
    Procedure PrintByTiling(TitleinStatusBox: String; prWmm,prHmm: Double);(*vb*)
    procedure PrintRect(aRect: TDoubleRect);
    procedure CalcPrDims(var prWmm, prHmm: Double; var prow, pcol: Integer; AWorkW, AWorkH, AprnScale: Double); //05.12.2011 - calc print dimensions
    procedure DefinePrnDivIndent; //29.11.2011

    Procedure ImportDXF(fileName: string; Layered,IncVertex: Boolean);(*vb*)
    procedure SCSImportDXF(fileName: string; Layered,IncVertex: Boolean);
    Procedure ExportAsDxf(FileName: string);(*vb*)
    Procedure SCSExportDXF(FileName: string);

    Procedure Clear(LayerNbr : integer; UndoRecord:Boolean);overload;
    Procedure Clear(LayerNbr : integer);overload;(*vb*)
    procedure ClearFigures;
    procedure ClearNoRect(ARect: TDoubleRect);
    Function RegisterModPoint(Figure: TFigure; PType: TModPointType;DType: TPointType; Color: Tcolor; aDim,X,Y: double; seqNbr: integer;z:Double=0;fOnlyIso:Boolean=False;isBlink:Boolean=false):TModPoint;
    Procedure UnRegisterModPoint(pt: TModPoint);
    Function HitTestModPoint(x,y:Double):TModPoint;override;
    Function HitTestModPointInt(x,y:Double):Integer;override;(*vb*)
    Function HitTestModPointIntVal(x,y:Integer):TModPoint;override;
    Function HitTestModPointDetVal(x,y:Integer):TModPoint;override;
    Procedure CopyToClipBoard;(*vb*)
    Procedure CutToClipBoard;(*vb*)
    Procedure SetFieldText(FName,FValue:String);(*vb*)
    Procedure PasteFromClipBoard(LayerNbr: integer);(*vb*)
    Function GetLayerNbr(LayerName: string): integer;overload;(*vb*)
    Function GetLayerNbr(xLayer: TLayer): integer;overload;
    Function FindFigureByName(FigName:String):TFighandle;(*vb*)
    Function GetCustomPropList(BlockName: String):Tlist;
    Function Line(LayerNbr:Integer;x1,y1,x2,y2:Double;w,s,c:integer; row: integer;selected: boolean):TFigHandle;(*vb*)
    Function Vertex(LayerNbr:Integer;x,y:Double;selected: boolean):TFigHandle;(*vb*)
    Function PolyLine(LayerNbr:integer;points:TDoublePointArr; w,s,c: integer; row,brs,brc:integer;closed:boolean;selected: boolean):TFigHandle;overload;
    Function PolyLine(LayerNbr:integer;var points:TDoublePoint; pCount,w,s,c: integer; row,brs,brc:integer;closed:boolean;selected: boolean):TFigHandle;overload;(*vb*)
    Function Polygon(LayerNbr:integer; points:TDoublePointArr; w,s,c,brs,brc:integer;selected: boolean):TFigHandle;
    Function Ellipse(LayerNbr:Integer; cx,cy,lenax,lenbx,angle: Double; w,s,c,brs,brc:integer;selected: boolean):TFigHandle;(*vb*)
    Function Circle(LayerNbr: Integer; cx,cy,radius: Double;w,s,c,brs,brc:integer;selected: boolean):TFigHandle;
    Function DrawCircle(LayerNbr: Integer; cx,cy,radius: Double;w,s,c,brs,brc:integer;selected: boolean):TFigHandle;(*vb*)
    Function Arc(LayerNbr:Integer; cx,cy,radius,a1,a2:Double; w,s,c,brs,brc,ArcStyle:Integer;selected: boolean):TFigHandle;(*vb*)
    Function ElpArc(LayerNbr:Integer; cx,cy,lenax,lenbx,angle,a1,a2:Double; w,s,c,brs,brc,ArcStyle:Integer;selected: boolean):TFigHandle;(*vb*)
    Function Rectangle(LayerNbr:Integer; x1,y1,x2,y2: DOuble; w,s,c,brs,brc:integer;selected: boolean):TFigHandle;(*vb*)
    //Tolik 10/03/2016 --
    Function InsertBitmap(LayerNbr:Integer; x,y:Double; fName: string;transparent,selected: boolean; JPEGBounds: boolean = false):TFigHandle;(*vb*)
    //Function InsertBitmap(LayerNbr:Integer; x,y:Double; fName: string;transparent,selected: boolean):TFigHandle;(*vb*)
    //
    Function InsertBitmapHandle(LayerNbr:Integer; x,y:Double; xBitmap:TBitmap;transparent,selected: boolean):TFigHandle;overload;
    Function InsertBitmapHandle(LayerNbr:Integer; x,y:Double; xBitmap:HBitmap;transparent,selected: boolean):TFigHandle;overload;(*vb*)
    Function InsertWMF(LayerNbr:Integer; x,y:Double; fName: string;selected: boolean): TFigHandle;(*vb*)
    Function InsertMetafile(LayerNbr:Integer; x,y:Double; mf: TMetafile;selected: boolean): TFigHandle;
    Function ImportWMF(LayerNbr:integer; fName: string;selected: boolean): TFigHandle;(*vb*)
    Function ImportMetafile(LayerNbr:Integer; x,y:Double; mf: TMetafile;Selected: Boolean):TFigHandle;
    Function ImportDrawing(LayerNbr:Integer;x,y:Double;fName:String;Selected:Boolean):TFigHandle;(*vb*)
    Function TextOut(LayerNbr:Integer; x1,y1,angle,height,ratio: double;atext,aFontName: string;FontCharset:Byte;Color: Integer;Selected: Boolean):TFigHandle;(*vb*)
    Function AddCustomFigure(LayerNbr:integer;CustomFig: TFigure;Selected:Boolean): TFigHandle;
    Function GetFigureCustomStream(f:Integer; var size:Integer):Integer;(*vb*)
    Procedure SetFigureCustomStream(f:Integer;size:Integer;var data:Byte);(*vb*)
    Function GetCustomStream(var size:Integer):Integer;(*vb*)
    Procedure SetCustomStream(size:Integer;var data:Byte);(*vb*)
    Procedure RecordModifyUndo(xFig:Tfigure);
    Procedure PrintPreview;(*vb*)
    Procedure PrintRectPreview(ARect: TDoubleRect); //24.11.2011
    // Information of Selection
    Function GetSlcPenStyle : Integer;(*vb*)
    Function GetSlcPenWidth : Integer;(*vb*)
    Function GetSlcPenColor : Integer;(*vb*)
    Function GetSlcRowStyle : Integer;(*vb*)
    Function GetSlcBrushStyle : Integer;(*vb*)
    Function GetSlcBrushColor : Integer;(*vb*)
    Function GetSlcFont : TFont;
    Function GetSlcFontName:String;(*vb*)
    Function GetSlcFontBold:Boolean;(*vb*)
    Function GetSlcFontItalic:Boolean;(*vb*)
    Function GetSlcFontUnderline:Boolean;
    Function GetSlcFontStrike:Boolean;(*vb*)
    Function GetSlcFontSize:Double;(*vb*)
    Function GetSlcFontCharset:Integer;
    Function GetSlcFontColor:TColor;(*vb*)
    Function GetSlcPolylineClosed: Boolean;(*vb*)
    Function GetSlcImageTransparent: Boolean;(*vb*)
    Function GetSlcImageClipped: Boolean;(*vb*)
    Function GetSlcArcStyle:TArcStyle;(*vb*)
    Function GetSlcLineBounded: Boolean;(*vb*)

    Function CountBlock(BlockName:String):integer;(*vb*)
    Procedure CountBlocks(list:TStrings);
    Procedure CountBlocksByInfo(list:TStrings);
    Function GetSelectionHandles(var Handles: Array of TFigHandle): Integer;
    Procedure ExecuteTBCommand(CommandId:integer);virtual;(*vb*)
    Function GetVersion:Integer;(*vb*)
    Function GetBuildNumber: Integer;(*vb*)
    Procedure RegisterFigureClass(Fig: TFigureClass);
    Procedure PrintMessage(Mes:String);override;(*vb*)
    Procedure SetTool(aToolIndex: TPCTool;aToolInfo:String;aToolData:Integer);virtual;(*vb*)
    Procedure NewPattern(pat:TPattern);
    Function BlockAsWmf(bPath: String):TMetafile;
    Function BlockAsMetafile(bPath: String):Integer;(*vb*)
    Function BlockObjAsWmf(ABlock: TFigureGrp):TMetafile;
    Procedure View3D(const AFileStream: String='');
    function Get3DModel(const AFileStream: String=''): TObject;
    Procedure LockSelChange;(*vb*)
    Procedure UnLockSelChange;(*vb*)
    Procedure CenterPage;(*vb*)
    Procedure AlignPageDown;(*vb*)
    Procedure AlignPageUp;(*vb*)

    Procedure StartBlink;(*vb*)
    Procedure StopBlink;(*vb*)
    Procedure ResumeBlink;(*vb*)
    Function IsBlinking:Boolean;(*vb*)
    Procedure CalibrateLayerScale(p1,p2:TDoublePoint;cUnit:Byte);(*vb*)

    function GetFigureByDataID(aDataID: Integer): TFigure; //10.11.2011
    function GetForm: TForm; //03.03.2012
    function GetLineLengthM(p1, p2: TDoublePoint): Double;
    function GetLengthM(aPCLen: Double): Double;
    procedure BeginMultiDeselect; //02.04.2012
    procedure EndMultiDeselect; //02.04.2012
    procedure SelectFigures(aFigures: TList); //11.05.2012
    procedure BeginUpdate;
    procedure EndUpdate(aReFresh: Boolean=true);
    function PointToScreen(aPt: TDoublePoint): TPoint; //06.05.2013
    Procedure ResetRegions;override; //22.08.2012

    function CheckFigureInsideCabinet(aLFigures: TList; var aTraceFigure: TFigure; needCheckConn: boolean = false): byte;

    Property Selection : TList read FSelection write FSelection;
    Property PenPattern[Index:Integer]:TPattern read GetPenPattern;
    Property PenPatternCount: Integer read GetPenPatCount;
    Property BrushPatternCount:Integer read GetBrushPatCount;
    Property RealScale: Boolean read FRealScale write frealScale;(*vb*) // Used in VerbalCommand
    Property MetricMode: Integer read FMetricMode write FMEtricMode;(*vb*) // 0 = MM  1= CMM   //Used in VerbalCommand
    Property AngularMode: Integer read FAngularMode write FangularMode;(*vb*) // 0 = RAD  1= DEG   //Used in VerbalCommand
    Property WmfPrinting:Boolean read FWMFPrint write FWMFPrint;(*vb*)
  published
    { Published declarations }
    Property DefaultPenColor : TColor read fdefPenColor write setPenColor default clBlack;(*vb*)
    Property DefaultBrushColor : TColor read fdefBrsColor write setBrushColor default clBlack;(*vb*)
    Property DefaultPenWidth : integer read fdefPenWidth write setPenWidth default 1;(*vb*)
    Property DefaultPenStyle : TPenStyle read fdefPenStyle write setPenStyle default psSolid;(*vb*)
    Property DefaultBrushStyle : TBrushStyle read fdefBrsStyle write setBrushStyle default bsClear;(*vb*)
    Property DefaultRowStyle : TRowStyle read fDefRowStyle write setRowStyle default rsNone;(*vb*)
    Property DefaultTextHeight : Double read fDefTextHeight write setTextHeight;(*vb*) (* default 12 *)
    Property DefaultTextRatio : Double read fDefTextRatio write setTextRatio;(*vb*) (* default 0 *)
    Property DefaultPLineClosed: Boolean read fDefPLineClosed write SetPLineClosed default False;(*vb*)
    Property DefaultArcStyle:TArcStyle read fDefArcStyle write SetArcStyle default asOpen;(*vb*)
    Property LayerCount: integer read GetLayerCount default 1;(*vb*)
    Property FigureCount: integer read GetFigureCount default 0;(*vb*)
    Property SelectedCount: integer read GetSelCount default 0;(*vb*)
    Property MapScale: Double read FMapScale write setmapScale{ default 100};(*vb*)
    Property RescaleToMap: TMapRescale read FRescale write fRescale default rsNever;(*vb*)
    Property AutoSelect: Boolean read FAutoSelect write setAutoSelect default True;(*vb*)
    Property Font;
    Property KeyCommands: Boolean read FKeyCommands write FKeyCommands default True;(*vb*)
    Property RecordUndo:Boolean read GetRecordUndo write FRecordUndo default True;(*vb*)
    Property UndoCount: Integer read FUndoCount write FUndoCount default 24;(*vb*)
    Property DefaultPictureFolder: String read FPictureFolder write FPictureFolder;(*vb*) (* default '' *)
    Property SaveWithPreview:Boolean read FSavePrev write fSavePrev default True;(*vb*)
    Property RulerMode:TRulerMode read FRulerMode write setRulerMode default rmPage;(*vb*)
    Property ZoomRect:Boolean read FZoomRect write SetZoomRect default False;(*vb*)
    Property RangeCheck:Boolean read fRangeCheck write SetRangeCheck default False;(*vb*)
    Property AutoTilePrint:Boolean read fAutoTile write FAutoTile default True;(*vb*)
    Property FigureGuides:Boolean read FFigureGuides write SetFigureGuides default True;(*vb*)
    Property NativeFill:Boolean read FNativeFill write FNativeFill default False;(*vb*)
    Property OnSelectionChange:TNotifyEvent read FOnSelChange write FOnSelChange;(*vb*)
    Property OnObjectInserted:TInsertEvent read FOnObjectInserted write FOnObjectInserted;(*vb*)
    Property OnBeforeFigureInsert:TBeforeInsertEvent read FBeforeFigureInsert write FBeforeFigureInsert;(*vb*)
    Property OnFigureMoved:TMoveEvent read FOnFigureMoved write FOnFigureMoved;(*vb*)
    Property OnFigureModify:TFigureEvent read FFigureModify write fFigureModify;(*vb*)
    Property OnFigureSelect:TFigureEvent read FFigureSelect write FFigureSelect;(*vb*)
    Property OnBeforeDelete: TFigureDeleteEvent read FOnFigureDel write FOnFigureDel;(*vb*)
    Property OnAfterDelete: TNotifyEvent read FOnAfterFigureDel write FOnAfterFigureDel;(*vb*)
    Property OnBeforeUndo: TNotifyEvent read FOnBeforeUndo write FOnBeforeUndo;(*vb*)
    Property OnAfterUndo: TNotifyEvent read FOnAfterUndo write FOnAfterUndo;(*vb*)
    Property OnSnapToFigure: TSnapEvent read FSnapToFigure write FSnapToFigure;(*vb*)
    Property OnSurfacePaint: TNotifyEvent read SOnPaint write SOnPaint;(*vb*)
    Property OnMapScaleChanged: TNotifyEvent read FOnMapScale write FOnMapScale;(*vb*)
    Property OnUserDraw:TuserDrawEvent read FOnUserDraw write FOnUserDraw;(*vb*)
    Property OnUserHitTest:TUserHitEvent read FonUserHitTest write FonUserHitTest;(*vb*)
    Property OnBeforeClear:TNotifyEvent read FOnBeforeClear write FOnBeforeClear;(*vb*)
    Property OnCollectFaces:TOnCollectFaces read FOnCollectFaces write FOnCollectFaces;
    Property OnCollectFigureFaces:TOnCollectFigureFaces read FOnCollectFigureFaces write FOnCollectFigureFaces;
    Property OnObjectSaved:TFigureEvent read FOnObjectSaved write FOnObjectSaved;(*vb*)
    Property OnFigureEdit:TFigureEvent read FOnFigureEdit write FOnFigureEdit;(*vb*)
    Property OnCustomUndo:TOnCustomUndoEvent read FOnCustomUndo write FOnCustomUndo;(*vb*)
    Property OnBeforeModify:TFigureEvent read FOnBeforeModify write FOnBeforeModify;(*vb*)
    Property OnBeforeMove:TFigureEvent read FOnBeforeMove write FOnBeforeMove;(*vb*)
    Property OnBeforeMoveAll:TBeforeMoveAllEvent read FBeforeMoveAll write FBeforeMoveAll;(*vb*)
    Property OnAfterMoveAll:TAfterMoveAllEvent read FAfterMoveAll write FAfterMoveAll;(*vb*)
    Property OnLayerInitData:TLayerInitData read FLayerInitData write FLayerInitData;
    Property OnLayerSaveData:TLayerSaveData read FLayerSaveData write FLayerSaveData;
    Property OnLayerLoadData:TLayerLoadData read FLayerLoadData write FLayerLoadData;
    Property OnCalibrateLayer:TCalibrateLayer read FCalibrateLayer write FCalibrateLayer;(*vb*)
    Property OnCustomStreamUpdate:TNotifyEvent read FCustomStreamUpdate write FCustomStreamUpdate;(*vb*)
    Property OnCustomStreamLoaded:TNotifyEvent read FCustomStreamLoaded write FCustomStreamLoaded;(*vb*)

    Property OnGetFigureToSelect: TGetFigureEvent read FGetFigureToSelect write FGetFigureToSelect;
    property OnGetModPointToSelect: TGetModPointEvent read FGetModPointToSelect write FGetModPointToSelect;
    property OnCheckPrnWithOffset: TCheckPrnWithOffsetEvent read FCheckPrnWithOffset write FCheckPrnWithOffset;
  end;
  (*vbclassexport end*)

  TGetVerbsProc = Function:pchar;stdcall;
  TDoVerbProc = Procedure (VerbIndex: integer);stdcall;
  TInitProc = Procedure (OwnerApp:integer);stdcall;

  Function ProcessMFRecord(DC:HDC; HT:PHandleTable; rec:PEnhMetaRecord; count: integer; param: pointer): integer;stdcall;
  var
  DeltaMoveX :Double;
  DeltaMoveY :Double;
  ThickUnit  : Double = 0.25;

implementation
uses DXFEngine, DXFExport, U_DXFEngineSCS, U_Common, U_BaseCommon, Types, USCS_main, U_Constants, U_BaseConstants,
     U_ESCadClasess, fplan, U_Cad, U_SCSLists, U_ArchCommon, {U_Arch3D}U_Arch3DNew, U_SCSComponent, U_Main{Tolik 29/03/2017 -- }, U_Master_Compl
    {$ifdef 3D}
    ,Form3D {Tolik 26/10/2015}, U_HouseClasses, U_Navigator // 
    {$endif 3D}
    ;

{$R *.DCR}

var
PenRatio: Double = 1;
BufferObj: TPCDrawing;
wmfLayer: integer;
pw,pc,ps,bc,bs: integer;
MoveTOx,MOveToY,wmfwpy,wmfwpx,wmfwex,wmfwey,wmfx,wmfy: Double;
xForm:TXForm;
xFormId: Integer;
wmfVZ:TVertZero;
wmfHZ:THorzZero;
mfdpmm: extended;
Reccount : integer;
wmfMapMode: DWORD;
WmfPenBrush: Array [1..500] of TPenBrush;
SavedDC: array [1..500] of TSavedDc;
SaveCnt:Integer;
ActivePen,ActiveBrush: Integer;
wmfLogCnt : integer;
wmfpl: Tpolyline;
CF_PCAD: Word;
TextObj: TText;
FontName: String;
FontCS: Word;
FontW: Integer;
FontH: Integer;
blkvz,blkhz:Integer;
blktopx,blkTopy,blkDistX,blkDistY: Double;
blkW,blkH: Integer;

prnDivIndent: Double = 8.5; //28.11.2011
DropOFFMM: Boolean = True;


Constructor TPCDrawing.create(Aowner: TComponent);
var l: TLayer;
    pw,pc: byte;
    txColor: Integer;
    txFont: String;
    txCharset: Byte;
    txSize: Integer;
    txRatio: Double;
    txBold,txItalic,txUnderline,txStrike: Byte;
    pVector: TVector;
    BPattern: Tpattern;
    cObject: TVectorObject;
    dp: TDoublePointArr;

    i: integer; //01.11.2011
    fc: TFigureClass;
Begin
  inherited create(aowner);
  //Tolik
  TextObj := nil;
  wmfpl := nil;
  isDrawingFigures := False;
  //
  FWMFPrint := False;
  PictureFrame:= True;
  FFigureGuides := True;
  SelFeed := 0;
  DrawSurface := True;
  Layers := Tlist.create;
  //Tolik 13/12/2019 --
  //Figures := Tlist.create;
  Figures := TMyObjectList.create(False);
  //
  //ModPoints := TList.Create;
  ModPoints := TMyList.Create; // Tolik 24/12/2019 --

  FAutoTile := True;
  FMapScale := 100;
  FAutoSelect := True;
  FAnySelected := False;
  FSelection := TList.create;
  FRulerMode := rmPage;


  //MacroEngine := THalComp.Create(nil);
  //SetInterfaceHandle;
  fDefPenColor := clBlack;
  fDefBrsColor := clYellow;
  fDefPenstyle := psSolid;
  fDefPenWidth := 1;
  fDefBrsStyle := bsClear;
  fDefTextHeight := 8;
  fDefTextRatio := 0;
  fDefPLineClosed := False;
  FNativeFill := False;
  AutoRefresh := True;
  RealScale := False;
  CurrentX := 0;
  CurrentY := 0;
  CpBlockNames:= TStringlist.Create;
  cpLists:= TList.Create;
  FPenPatList := TList.Create;
  BrushList := TList.Create;
  FRescale := rsNever;
  FDetailScale := 100;

  if not (csDesigning in self.ComponentState) then begin

    if FigureClasses.IndexOf(DrawObjects.TLine) = -1 then
      FigureClasses.Add(DrawObjects.TLine);
    if FigureClasses.IndexOf(THellical) = -1 then
      FigureClasses.Add(THellical);
    if FigureClasses.IndexOf(TPolyline) = -1 then
      FigureClasses.Add(TPolyline);
    if FigureClasses.IndexOf(TFreeHand) = -1 then
      FigureClasses.Add(TFreeHand);
    if FigureClasses.IndexOf(TEllipse) = -1 then
      FigureClasses.Add(TEllipse);
    if FigureClasses.IndexOf(TArc) = -1 then
      FigureClasses.Add(TArc);
    if FigureClasses.IndexOf(TElpArc) = -1 then
      FigureClasses.Add(TElpArc);
    if FigureClasses.IndexOf(TCircle) = -1 then
      FigureClasses.Add(TCircle);
    if FigureClasses.IndexOf(DrawObjects.TRectangle) = -1 then
      FigureClasses.Add(DrawObjects.TRectangle);
    if FigureClasses.IndexOf(TVertex) = -1 then
      FigureClasses.Add(TVertex);
    if FigureClasses.IndexOf(TCircleVertex) = -1 then
      FigureClasses.Add(TCircleVertex);
    if FigureClasses.IndexOf(TBMPObject) = -1 then
      FigureClasses.Add(TBMPObject);
    if FigureClasses.IndexOf(TText) = -1 then
      FigureClasses.Add(TText);
    if FigureClasses.IndexOf(TFigureGrp) = -1 then
      FigureClasses.Add(TFigureGrp);
    if FigureClasses.IndexOf(TBlock) = -1 then
      FigureClasses.Add(TBlock);
    if FigureClasses.IndexOf(TRotate) = -1 then
      FigureClasses.Add(TRotate);
    if FigureClasses.IndexOf(TMove) = -1 then
      FigureClasses.Add(TMove);
    if FigureClasses.IndexOf(TDuplicate) = -1 then
      FigureClasses.Add(TDuplicate);
    if FigureClasses.IndexOf(TDuplicateAsBezier) = -1 then
      FigureClasses.Add(TDuplicateAsBezier);
    if FigureClasses.IndexOf(TMirror) = -1 then
      FigureClasses.Add(TMirror);
    if FigureClasses.IndexOf(TArrayPol) = -1 then
      FigureClasses.Add(TArrayPol);
    if FigureClasses.IndexOf(TArrayRect) = -1 then
      FigureClasses.Add(TArrayRect);
    if FigureClasses.IndexOf(TRichText) = -1 then
      FigureClasses.Add(TRichText);
    if FigureClasses.IndexOf(TOleObject) = -1 then
      FigureClasses.Add(TOleObject);
    if FigureClasses.IndexOf(TMathGraph) = -1 then
      FigureClasses.Add(TMathGraph);
    if FigureClasses.IndexOf(TWmfObject) = -1 then
      FigureClasses.Add(TWmfObject);
    if FigureClasses.IndexOf(THDimLine) = -1 then
      FigureClasses.Add(THDimLine);
    if FigureClasses.IndexOf(TVDimLine) = -1 then
      FigureClasses.Add(TVDimLine);
    if FigureClasses.IndexOf(TADimLine) = -1 then
      FigureClasses.Add(TADimLine);
    if FigureClasses.IndexOf(TCDimLine) = -1 then
      FigureClasses.Add(TCDimLine);
    if FigureClasses.IndexOf(TArcDimLine) = -1 then
      FigureClasses.Add(TArcDimLine);
    if FigureClasses.IndexOf(TUserRectangle) = -1 then
      FigureClasses.Add(TUserRectangle);
    if FigureClasses.IndexOf(TUserLine) = -1 then
      FigureClasses.Add(TUserLine);
    if FigureClasses.IndexOf(TUserVertex) = -1 then
      FigureClasses.Add(TUserVertex);
    if FigureClasses.IndexOf(TUserCircle) = -1 then
      FigureClasses.Add(TUserCircle);
    if FigureClasses.IndexOf(TUserArc) = -1 then
      FigureClasses.Add(TUserArc);
    if FigureClasses.IndexOf(TUserEllipse) = -1 then
      FigureClasses.Add(TUserEllipse);
    if FigureClasses.IndexOf(TUserPolyline) = -1 then
      FigureClasses.Add(TUserPolyline);
    if FigureClasses.IndexOf(TKnife) = -1 then
      FigureClasses.Add(TKnife);
    if FigureClasses.IndexOf(TTextPanel) = -1 then
      FigureClasses.Add(TTextPanel);
    if FigureClasses.IndexOf(TPointSet) = -1 then
      FigureClasses.Add(TPointSet);
    if FigureClasses.IndexOf(TAngleLine) = -1 then
      FigureClasses.Add(TAngleLine);
    if FigureClasses.IndexOf(TCalibrate) = -1 then
      FigureClasses.Add(TCalibrate);
    if FigureClasses.IndexOf(TPrintRect) = -1 then
      FigureClasses.Add(TPrintRect); //25.11.2011
    //Tolik 31/05/2017 --
    if FigureClasses.IndexOf(TPie) = -1 then  // Сектор
      FigureClasses.Add(TPie);
    if FigureClasses.IndexOf(TOverlappedEllipse) = -1 then  // Сектор
      FigureClasses.Add(TOverlappedEllipse); // эллипс с вырезанным эллипсом внутри   
    //

    //01.11.2011 - список классов в сорт виде 
    for i := 0 to FigureClasses.Count - 1 do
    begin
      fc := TFigureClass(FigureClasses[i]);
      if FigureClassesSL.IndexOf(fc.ClassName) = -1 then
        FigureClassesSL.Addobject(fc.ClassName, TObject(fc));
    end;


    l := TLayer.create('Base Layer');
    l.vertZero := ord(VerticalZero);
    l.horzZero := ord(HorizontalZero);
    l.DrawEngine := Dengine;
    Layers.add(l);
    FUndoList := TList.Create;
    FUndoIdx  := 0;
    RecordUndo := True;

    PVector:= TVector.Create(0);
    PVector.AddLineSegment(DoublePoint(2,2));
    PVector.AddLineSegment(DoublePoint(4,0));
    BPattern := Tpattern.Create(PVector,4,0);
    // Tolik 09/03/2017 --
    pVector.Free;
    //
    BPattern.PatName := pnZigZag;
    FPenPatList.Add(BPattern);

    PVector:= TVector.Create(0);
    PVector.AddBezierSegment(DoublePoint(3,0),DoublePoint(0,2),DoublePoint(3,2));
    BPattern := Tpattern.Create(PVector,3,0);
    // Tolik 09/03/2017 --
    pVector.Free;
    //
    BPattern.PatName := pnFlower;
    FPenPatList.Add(BPattern);

    PVector:= TVector.Create(0);
    PVector.AddBezierSegment(DoublePoint(3,0),DoublePoint(0,2),DoublePoint(3,2));
    PVector.AddBezierSegment(DoublePoint(6,0),DoublePoint(3,-2),DoublePoint(6,-2));
    BPattern := Tpattern.Create(PVector,6,0);
    // Tolik 09/03/2017 --
    pVector.Free;
    //
    BPattern.PatName := pnSinus;
    FPenPatList.Add(BPattern);

    PVector:= TVector.Create(0);
    cObject := TVectorObject.CreateCircleObject(DoublePoint(1.5,0),1.5);
    PVector.AddVectorObject(cObject);
    BPattern := Tpattern.Create(PVector,3,0.5);
    // Tolik 09/03/2017 --
    pVector.Free;
    //
    BPattern.PatName := pnButtons;
    FPenPatList.Add(BPattern);

    PVector:= TVector.Create(0);
    SetLength(dp,4);
    dp[0] := doublePoint(0,0);
    dp[1] := doublePoint(0,3);
    dp[2] := doublePoint(3,3);
    dp[3] := doublePoint(3,0);
    cObject := TVectorObject.CreatePolygonObject(4,dp);
    PVector.AddVectorObject(cObject);
    BPattern := Tpattern.Create(PVector,3,0.5);
    // Tolik 09/03/2017 --
    pVector.Free;
    //
    BPattern.PatName := pnSquare;
    FPenPatList.Add(BPattern);

    PVector:= TVector.Create(0);
    PVector.AddBezierSegment(DoublePoint(1.5,0),DoublePoint(0,1),DoublePoint(1.5,1));
    PVector.AddBezierSegment(DoublePoint(3,0),DoublePoint(1.5,-1),DoublePoint(3,-1));
    BPattern := Tpattern.Create(PVector,3,0);
    // Tolik 09/03/2017 --
    pVector.Free;
    //
    BPattern.PatName := pnMiniSinus;
    FPenPatList.Add(BPattern);

    FBlinkTimer:= TTimer.Create(self);
    FBlinkTimer.Enabled := False;
    FblinkTimer.Interval := 400;
    FBlinkPaused := False;
    FBlinkTimer.OnTimer := OnBlinkTimer;
  end;

  CF_PCAD := RegisterClipboardFormat('PowerCad Figure');
  FKeyCommands := True;
  evBrushStyle := EventEngine(cBrushStyle,ord(fDefBrsStyle),'',0);
  evPenStyle := EventEngine(cPenStyle,ord(fDefPenStyle),'',0);
  pw := (fDefPenWidth-1);
  evPenWidth := EventEngine(cPenWidth,pw,'',0);
  evRowStyle := EventEngine(cRowStyle,ord(fDefRowStyle),'',0);
  evPenColor := EventEngine(cPenColor,fDefPenColor,'',0);
  evBrushColor := EventEngine(cBrushColor,fDefBrsColor,'',0);

  txColor := Font.Color;
  evTextColor := EventEngine(cTextColor,txColor,'',0);

  txFont := Font.Name;
  evTextFont := EventEngine(cFontName,0,txFont,0);

  evTextSize   := EventEngine(cTextSize,8,'',0);
  evTextCharset := EventEngine(cTextCharset,0,'',0);

  txBold := 0;
  if fsBold in Font.Style then
    txBold := 1;
  evTextBold := EventEngine(cBold,txBold,'',0);

  txItalic := 0;
  if fsItalic in Font.Style then
    txItalic := 1;
  evTextItalic := EventEngine(cItalic,txItalic,'',0);

  txUnderline := 0;
  if fsUnderline in Font.Style then
    txUnderline := 1;
  evTextUnderline := EventEngine(cUnderline,txUnderline,'',0);

  txStrike := 0;
  if fsStrikeOut in Font.Style then
    txStrike := 1;
  evTextStrike := EventEngine(cStrike,txStrike,'',0);

  evToolIndex := EventEngine(cDrawTool,Integer(Self),'',0);

  pc := 0;evPLineClosed := EventEngine(cPolylineClosed,pc,'',0);
  evTransparent := EventEngine(cTransparentImage,0,'',0);

  evClipped := EventEngine(cClipImage,0,'',0);
  evArcStyle := EventEngine(cArcStyle,ord(fDefArcStyle),'',0);
  evBounded  := EventEngine(cBoundLine,0,'',0);

  evArcSel := EventEngine(cArcSel,0,'',0);
  evBmpSel := EventEngine(cBmpSel,0,'',0);
  evLineSel := EventEngine(cLineSel,0,'',0);
  evPLineSel := EventEngine(cPLineSel,0,'',0);
  evGroupSel := EventEngine(cGroupSel,0,'',0);
  evAnySel := EventEngine(cAnySel,0,'',0);
  evRulerMode := EventEngine(cRulerMode,ord(FRulerMode),'',0);
  RecordUndo := True;
  FUndoCount := 24;
  Freed:= TList.Create;
  fPictureFolder := '';
  PrevForm := TfrmPrv.Create(self);
  SlcBitmapCnt   := 0;
  SlcLineCnt     := 0;
  SlcPlineCnt    := 0;
  SlcArcCnt      := 0;
  SlcCircleCnt   := 0;
  SlcEllipseCnt  := 0;
  SlcVertexCnt   := 0;
  SlcGroupCnt    := 0;
  SlcRectangleCnt:= 0;
  SlcDimCnt      := 0;
  FSavePrev := True;
  CustomStream := nil;
  AutoRefresh := False;
  SetRulerValues(FMapScale,ord(FRulerMode));
  AutoRefresh := True;
  MetricMode := 1; //CM
  AngularMode := 1; //MM
  Faces := TList.Create;
  FSelChangeLocked := False;
  FRangeCheck := False;
  PlotHeight := 0;
  PlotCopy := 1;

  prnDivOverlay := 0; //01.12.2011
  prnScale := 1;

  FMultiDeselectCount := 0; //02.04.2012
  FUpdateCount := 0; //06.08.2012
  FUpdateCountAdd := 0;
  //Tolik
  SetLength(dp,0);
  FLastFigureID := 1000000;     // 25/10/2017
  FLastFigureIDOnLoad := 1000000; // 25/10/2017
  FBreakedOnQuota := False; // 16/11/2017 --
  //
end;

// Tolik 23/03./2017 --
Destructor TPCDrawing.Destroy;
var i, j: Integer;
    Figure: TFigure;
begin
  FOnFigureDel := nil;
  RecordUndo := False;
  AutoRefresh := False;
  //
  if not (csDesigning in self.ComponentState) then begin
    ClearUndoList;
    ExitClear;
  //  FUndoList.Clear;
    FUndoList.Free;
  end;

  try
    For i := 0 to Layers.Count - 1 do
    begin
      for j := (TLayer(Layers[i]).ModPoints.Count - 1) downto 0  do
        UnRegisterModPoint(TModPoint(TLayer(Layers[i]).ModPoints[j]));
      TLayer(Layers[i]).ModPoints.Clear;
      TLayer(Layers[i]).Free;
    end;
  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.Destroy' + E.Message);
  end;

  Layers.Free;

  For i := (ModPoints.Count - 1) downto 0 do
  begin
    UnRegisterModPoint(TModPoint(ModPoints[i]));
  end;

  ModPoints.Free;
  FreeAndNil(Figures);
  //MacroEngine.Free;
  //NilInterfaceHandle;
  CpBlockNames.Free;
//  cpLists.Clear;
  cpLists.Free;
  try
    for i := 0 to FPenPatList.Count - 1 do
    begin
      TPattern(FPenPatList[i]).Free;
    end;
    for i := 0 to BrushList.Count-1 do
    begin
      TBitmap(BrushList[i]).Free;
    end;

  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.Destroy' + E.Message);
  end;

  FSelection.Free;
  FPenPatList.Free;
  BrushList.Free;
  //Freed.Free;
  // Tolik
  If Assigned(PrevForm.Tbmp) then
    prevForm.tBmp.Free;
  //
  PrevForm.free;
  if assigned(CustomStream) then CustomStream.Free;
  //Tolik -- это выполнится на дестрое PCDrawBox, т.к. они "сидят" там
  {if TempBitMap <> nil then
    FreeAndNil(TempBitMap);
  if BaseBitMap <> nil then
    FreeAndNil(BaseBitMap);}
  ClearFaces;
  Faces.Free;

  if TextObj <> nil then
  begin
  end;
  FBlinkTimer.Free;
  //
  inherited destroy;
end;
//
 (*
Destructor TPCDrawing.Destroy;
var i: Integer;
    Figure: TFigure;
begin
  FOnFigureDel := nil;
  RecordUndo := False;
  AutoRefresh := False;
  //
  if not (csDesigning in self.ComponentState) then begin
    ClearUndoList;
    ExitClear;
  //  FUndoList.Clear;
    FUndoList.Free;
  end;

  try
    For i := 0 to Layers.Count - 1 do
    begin
      TLayer(Layers[i]).Free;
    end;
  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.Destroy' + E.Message);
  end;

  Layers.Free;
  //Figures.Free;

  //Tolik
  // ниже закомменченое не применять, т.к. все бы хорошо, но на некоторых битых проектах ModPoint не убивается,
  // получим "вылет" процедуры, КАД, соответственно, тоже не убивается, получаем "висящий" в памяти лист и авеху на
  // открытии след. проекта, если у него такое же или большее количество листов с матюком, что такой лист уже имеется
  // ВНИМАНИЕ!!! MDICHILDCOUNT основной формы уже декрементирован до прихода сюда, так что там, вроде, все - ОК, а здесь - нет!!!
 { if ModPoints.Count > 0 then
  begin
    for i := 0 to ModPoints.Count - 1 do
    begin
      if assigned(ModPoints[i]) then
        TModPoint(ModPoints[i]).Destroy;
    end;
  end;}
  ModPoints.Free;
  FreeAndNil(Figures);
  //MacroEngine.Free;
  //NilInterfaceHandle;
 // CpBlockNames.Clear;
  CpBlockNames.Free;
//  cpLists.Clear;
  cpLists.Free;

  try
    for i := 0 to FPenPatList.Count - 1 do
    begin
      TPattern(FPenPatList[i]).Free;
    end;
    for i := 0 to BrushList.Count-1 do
    begin
      TBitmap(BrushList[i]).Free;
    end;

  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.Destroy' + E.Message);
  end;

  FSelection.Free;
  FPenPatList.Free;
  BrushList.Free;
  //Freed.Free;
  // Tolik
  If Assigned(PrevForm.Tbmp) then
    prevForm.tBmp.Free;
  //
  PrevForm.free;
  if assigned(CustomStream) then CustomStream.Free;
  //Tolik -- это выполнится на дестрое PCDrawBox, т.к. они "сидят" там
  {if TempBitMap <> nil then
    FreeAndNil(TempBitMap);
  if BaseBitMap <> nil then
    FreeAndNil(BaseBitMap);}
  ClearFaces;
  Faces.Free;

  if TextObj <> nil then
  begin
  end;
  FBlinkTimer.Free;
  //
  inherited destroy;
end;  *)

Procedure TPCDrawing.Undo;
var xAction: TUndoAction;
    xType: TUndoActionType;
    xFig,aFigure : TFigure;
    xbmp: TbmpObject;
    grp: TFigureGrp;
    i,t: integer;
    p:PPoint;
    s:TMemoryStream;
    RecordRedo : Boolean;
    k,j: integer;
    oldVal, newVal: double;
    xFigH: TSCSHDimLine;
    xFigV: TSCSVDimLine;
Begin
  try
    //if (ActiveLAyer <> 1)and(Activelayer <> 7)and(not TLayer(TF_CAD(Self.Owner).PCad.GetLayer(Activelayer)).IsDxf) then
    //  Exit;  //EXIT
    {if GDropComponent <> nil then
      Exit;}
    CancelActions;

    // Tolik 18/12/2019 --
    //GShadowObject := nil;
    if GShadowObject <> nil then
      DestroyShadowObject;
    //
    try
      //Проверка фигуры на вхождение в кабинет
      if CheckAssignedPCAD(Self) then
      begin
        if TF_CAD(Self.Owner).FNeedUpdateCheckedFigures then
          TF_CAD(Self.Owner).UpdateCheckedFigures;
        for j := 0 to TF_CAD(Self.Owner).FCheckedFigures.Count - 1 do
        begin
          aFigure := TFigure(TF_CAD(Self.Owner).FCheckedFigures[j]);
          TF_CAD(Self.Owner).Pcad.CheckFigureInsideCabinet(TF_CAD(Self.Owner).FCheckedFigures, aFigure);
        end;
        TF_CAD(Self.Owner).Pcad.Refresh;
      end;
    except
    end;

    if (ActiveLAyer <> 1)and(Activelayer <> 7)and(not TLayer(TF_CAD(Self.Owner).PCad.GetLayer(Activelayer)).IsDxf) then
      Exit;  //EXIT

    if assigned(FOnCustomUndo) then begin
      FOnCustomUndo(Self,False);
      exit;
    end;
    if FUndoList.Count = 0 then
      exit;
    if FUndoIdx >= FUndoList.Count then
      exit;
    if assigned(FOnBeforeUndo) then
      FOnBeforeUndo(Self);

    xAction := TUndoAction(FUndoList[FUndoIdx]);
    xType := xAction.ActionType;
    case xType of

      uaInsert: begin
        for i := 0 to xAction.List.Count-1 do
        begin
          xFig := TFigure(xAction.List[i]);
          xfig.deselect;
          xFig.Deleted := True;
          Figures.Remove(xFig);
        end;
      end;

      uaReplace: begin
        for i := 0 to xAction.List.Count-1 do
        begin
          xFig := TFigure(xAction.List[i]);
          xfig.deselect;
          Figures.Remove(xFig);
        end;
        for i := 1 to xAction.Params.Count do
        begin
          k := xAction.Params.Count-i;
          xFig := TFigure(xAction.Params[k]);
          xFig.Deleted := False;
          t := xFig.DelIndex;
          Figures.Insert(t,xFig);
          xFig.Selected := True;
        end;
      end;

      uaRemove: begin
        for i := 1 to xAction.List.Count do
        begin
          k := xAction.List.Count-i;
          xFig := TFigure(xAction.List[k]);
          xFig.Deleted := False;
          t := xFig.DelIndex;
          Figures.Insert(t,xFig);
          xFig.Selected := True;
        end;
      end;


      uaModify: begin
        t := 0;
        RecordRedo := false;
        if xAction.RedoList.Count = 0 then RecordRedo := True;
        for i := 0 to xAction.List.Count-1 do
        begin
          xFig := TFigure(xAction.List[i]);
          if RecordRedo then begin
            s := TMemoryStream.Create;
            xFig.WriteToStream(s);
            xAction.RedoList.Add(s);
          end;
          if xFig is TFigureGrp then
          begin
            TFigureGrp(xfig).Reloading := True;
          end;
          s:= TMemoryStream(xAction.Params[i]);
          s.Position := 0;
          ReadStringFromStream(s);

          if (xFig is TSCSHDimLine) then
            oldVal := StrToFloat_My(TSCSHDimLine(xFig).DLabel);
          if (xFig is TSCSVDimLine) then
            oldVal := StrToFloat_My(TSCSVDimLine(xFig).DLabel);

          xFig.SetPropertiesFromStream(s);
          if xFig is TFigureGrp then
          begin
             TFigureGrp(xfig).Reloading := False;
          end;
          if (xFig is TSCSHDimLine) then
          begin
            xFigH := TSCSHDimLine(xFig);
            newVal := xFigH.FValue;
            xFigH.ReScaleHCAD(oldVal, newVal);
            ReScaleAllDimLines;
            newVal := MetreToUOM(newVal);
            xFigH.DLabel := FormatFloat(ffMask, newVal);
          end;
          if (xFig is TSCSVDimLine) then
          begin
            xFigV := TSCSVDimLine(xFig);
            newVal := xFigV.FValue;
            xFigV.ReScaleVCAD(oldVal, newVal);
            ReScaleAllDimLines;
            newVal := MetreToUOM(newVal);
            xFigV.DLabel := FormatFloat(ffMask, newVal);
          end;

          xFig.Modified := True;
          xFig.RefreshHatch;
        end;
      end;

      uaGroup: begin
        grp := TFigureGrp(xAction.List[0]);
        grp.UnGroup;
        figures.Remove(grp);
      end;

      uaUnGroup: begin
        for i := 0 to xAction.List.Count-1 do
        begin
          grp := TFigureGrp(xAction.List[i]);
          figures.Add(grp);
          grp.UnGrouped := false;
          for k := 0 to grp.InFigures.Count-1 do
          begin
            figures.Remove(grp.Infigures[k]);
          end;
        end;
      end;

      uaOrder: begin
        for i := 0 to xAction.List.Count-1 do
        begin
          if xAction.FIndex = 1 then
            j := xAction.List.Count-1-i
          else
            j := i;
          xFig := TFigure(xAction.List[j]);
          k := Integer(xAction.Params[j]);
          t := Figures.IndexOf(xFig);
          Figures.Move(t,k);
        end;
      end;

      uaClip: begin
        xBmp := TBmpObject(xAction.List[0]);
        xFig := TFigure(xAction.Params[0]);
        Figures.Add(xfig);
        xFig.Select;
        xBmp.ClipFigure := nil;
      end;

      uaUnClip: begin
        xBmp := TBmpObject(xAction.List[0]);
        xFig := TFigure(xAction.Params[0]);
        Figures.Remove(xfig);
        xBmp.ClipFigure :=xFig;
      end;

      uaDimLine: begin
        t := 0;
        RecordRedo := false;
        if xAction.RedoList.Count = 0 then RecordRedo := True;
        for i := 0 to xAction.List.Count-1 do
        begin
          xFig := TFigure(xAction.List[i]);
          if RecordRedo then begin
            s := TMemoryStream.Create;
            xFig.WriteToStream(s);
            xAction.RedoList.Add(s);
          end;
          if xFig is TFigureGrp then
          begin
            TFigureGrp(xfig).Reloading := True;
          end;
          s:= TMemoryStream(xAction.Params[i]);
          s.Position := 0;
          ReadStringFromStream(s);
          xFig.SetPropertiesFromStream(s);
          if xFig is TFigureGrp then
          begin
             TFigureGrp(xfig).Reloading := False;
          end;
          xFig.Modified := True;

          // Tolik 15/10/2020 -- применить масштаб
          if xFig is TSCSHDimLine then
            TSCSHDimLine(xFig).ReScaleHCAD(0,TSCSHDimLine(xFig).FValue)
          else
            if xFig is TSCSVDimLine then
              TSCSVDimLine(xFig).ReScaleVCAD(0,TSCSVDimLine(xFig).FValue);
          //
          xFig.RefreshHatch;
        end;
      end;
      // Tolik 03/06/2021 --
      uaList:
        TF_Cad(Owner).SCSUndoElScheme;
      //Tolik 23/06/2021 --
      uaDesignList:
        TF_Cad(Owner).SCSUndoDesignList;
      // Tolik 25/06/2021 --
      uaProjectPlan:
        TF_Cad(Owner).SCSUndoProjectPlan;

    end;
    FUndoIdx := FUndoIdx +1;
    if xAction.Tag = 1 then Undo;
    if assigned(FOnAfterUndo) then FOnAfterUndo(Self);
    Refresh;
  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.Undo' + E.Message);
  end;
End;

Procedure TPCDrawing.Redo;
var xAction: TUndoAction;
    xType: TUndoActionType;
    xFig,aFigure : TFigure;
    xBmp: TBmpObject;
    i,k,t,j: integer;
    s:TmemoryStream;
    grp: TFigureGrp;
    oldVal, newVal: double;
    xFigH: TSCSHDimLine;
    xFigV: TSCSVDimLine;
Begin
  try
    //if (ActiveLAyer <> 1)and(Activelayer <> 7)and(not TLayer(TF_CAD(Self.Owner).PCad.GetLayer(Activelayer)).IsDxf) then
    //  Exit;  //EXIT
    CancelActions;
    // Tolik 18/12/2019 --
    if GShadowObject <> nil then
      DestroyShadowObject;
    //GShadowObject := nil;
    //
    try
      //Проверка фигуры на вхождение в кабинет
      if CheckAssignedPCAD(Self) then
      begin
        if TF_CAD(Self.Owner).FNeedUpdateCheckedFigures then
          TF_CAD(Self.Owner).UpdateCheckedFigures;
        for j := 0 to TF_CAD(Self.Owner).FCheckedFigures.Count - 1 do
        begin
          aFigure := TFigure(TF_CAD(Self.Owner).FCheckedFigures[j]);
          TF_CAD(Self.Owner).Pcad.CheckFigureInsideCabinet(TF_CAD(Self.Owner).FCheckedFigures, aFigure);
        end;
        TF_CAD(Self.Owner).Pcad.Refresh;
      end;
    except
    end;

    if (ActiveLAyer <> 1)and(Activelayer <> 7)and(not TLayer(TF_CAD(Self.Owner).PCad.GetLayer(Activelayer)).IsDxf) then
      Exit;  //EXIT

    if assigned(FOnCustomUndo) then begin
      FOnCustomUndo(Self,True);
      exit;
    end;

    if FUndoList.Count = 0 then
      exit;
    if FUndoIdx = 0 then
      exit;
    FUndoIdx := FUndoIdx -1;

    xAction := TUndoAction(FUndoList[FUndoIdx]);
    xType := xAction.ActionType;
    case xType of

      uaInsert: begin
        for i := 0 to xAction.List.Count-1 do
        begin
          xFig := TFigure(xAction.List[i]);
          Figures.Add(xFig);
          xFig.Selected := True;
          xFig.Deleted := False;
        end;
      end;

      uaReplace: begin
        for i := 0 to xAction.List.Count-1 do
        begin
          xFig := TFigure(xAction.List[i]);
          Figures.Add(xFig);
          xFig.Selected := True;
          xFig.Deleted := False;
        end;
        for i := 0 to xAction.Params.Count-1 do
        begin
          xFig := TFigure(xAction.Params[i]);
          xFig.Deleted := True;
          xFig.DelIndex := Figures.IndexOf(xFig);
          xfig.deselect;
          Figures.Remove(xFig);
        end;
      end;

      uaRemove: begin
        for i := 0 to xAction.List.Count-1 do
        begin
          xFig := TFigure(xAction.List[i]);
          xFig.Deleted := True;
          xFig.DelIndex := Figures.IndexOf(xFig);
          xfig.deselect;
          Figures.Remove(xFig);
        end;
      end;

      uaModify: begin
        for i := 0 to xAction.RedoList.Count-1 do
        begin
          xFig := TFigure(xAction.List[i]);
          s:= TMemoryStream(xAction.RedoList[i]);
          s.Position := 0;
          if xFig is TFigureGrp then
          begin
             TFigureGrp(xfig).Reloading := True;
             TFigureGrp(xfig).LoadIdx := 0;
          end;
          ReadStringFromStream(s);

          if (xFig is TSCSHDimLine) then
            oldVal := StrToFloat_My(TSCSHDimLine(xFig).DLabel);
          if (xFig is TSCSVDimLine) then
            oldVal := StrToFloat_My(TSCSVDimLine(xFig).DLabel);

          xFig.SetPropertiesFromStream(s);
          if xFig is TFigureGrp then
          begin
             TFigureGrp(xfig).Reloading := False;
             TFigureGrp(xfig).LoadIdx := 0;
          end;

          if (xFig is TSCSHDimLine) then
          begin
            xFigH := TSCSHDimLine(xFig);
            newVal := xFigH.FValue;
            xFigH.ReScaleHCAD(oldVal, newVal);
            ReScaleAllDimLines;
            newVal := MetreToUOM(newVal);
            xFigH.DLabel := FormatFloat(ffMask, newVal);
          end;
          if (xFig is TSCSVDimLine) then
          begin
            xFigV := TSCSVDimLine(xFig);
            newVal := xFigV.FValue;
            xFigV.ReScaleVCAD(oldVal, newVal);
            ReScaleAllDimLines;
            newVal := MetreToUOM(newVal);
            xFigV.DLabel := FormatFloat(ffMask, newVal);
          end;
          
          xFig.Modified := True;
        end;
      end;

      uaGroup: begin
        grp := TFigureGrp(xAction.List[0]);
        for i := 0 to grp.InFigures.Count -1 do
        begin
          figures.Remove(grp.InFigures[i]);
        end;
        figures.Add(grp);
        grp.UnGrouped := false;
      end;

      uaUnGroup: begin
        for i := 0 to xAction.List.Count-1 do
        begin
          grp := TFigureGrp(xAction.List[i]);
          figures.Remove(grp);
          for k := 0 to grp.InFigures.Count-1 do
          begin
            figures.Add(grp.Infigures[k]);
          end;
          grp.UnGrouped := true;
        end;
      end;

      uaOrder: begin
        for i := 0 to xAction.List.Count-1 do
        begin
          xFig := TFigure(xAction.List[i]);
          k := Integer(xAction.RedoList[i]);
          t := Figures.IndexOf(xFig);
          Figures.Move(t,k);
        end;
      end;

      uaClip: begin
        xBmp := TBmpObject(xAction.List[0]);
        xFig := TFigure(xAction.Params[0]);
        Figures.Remove(xfig);
        xBmp.ClipFigure := xfig;
      end;

      uaUnClip: begin
        xBmp := TBmpObject(xAction.List[0]);
        xFig := TFigure(xAction.Params[0]);
        Figures.Add(xfig);
        xFig.Select;
        xBmp.ClipFigure := nil;
      end;
      uaList:
        TF_Cad(Owner).SCSRedoNormalList;
      uaDesignList, uaProjectPlan:
        //TF_Cad(Owner).SCSRedoDesignList;
        TF_Cad(Owner).SCSRedoNormalList;
    end;
    if xAction.Tag = 2 then Redo;
    Refresh;
  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.Undo' + E.Message);
  end;
End;

Procedure TPCDrawing.KillUndoAction(xAction:TUndoAction);
var k,j: integer;
    xFig: TFigure;
    s: TMemoryStream;
    grp: TFigureGrp;
begin
  try
    // Tolik -- 08/12/2016 -- вот это все нах, правильная очистка фигур у нас раньше произойдет
    (*
    if (xAction.ActionType = uaRemove) or
       (xAction.ActionType = uaInsert) then
    begin
      for k := 0 to xAction.List.Count-1 do
      begin
        xFig := TFigure(xAction.List[k]);
        if (xAction.ActionType = uaRemove) or (Figures.IndexOf(xFig) = -1) then
        begin
          xFig.urc := xFig.urc-1;
          if (xFig.urc = 0) and (xFig.Deleted) and (Freed.IndexOf(xFig) = -1) then
          begin
            Freed.Add(xFig);
            if xFig is TFigureGrp then
            begin
              grp := xFig as TFigureGrp;
              for j := 0 to grp.Infigures.Count-1 do
              begin
                if Freed.IndexOf(grp.Infigures[j]) = -1 then
                begin
                  Freed.Add(grp.Infigures[j]);
                  TFigure(grp.Infigures[j]).Free;
                end;
              end;
              grp.ClearFigureList;
            end;
            xFig.Free;
          end;
        end;
      end;
    end
    else if (xAction.ActionType = uaReplace) then
    begin
      for k := 0 to xAction.List.Count-1 do
      begin
        xFig := TFigure(xAction.List[k]);
        xFig.urc := xFig.urc-1;
        if (xFig.urc = 0) and (xFig.Deleted) and (Freed.IndexOf(xFig) = -1) then
        begin
          Freed.Add(xFig);
          if xFig is TFigureGrp then
          begin
            grp := xFig as TFigureGrp;
            for j := 0 to grp.Infigures.Count-1 do
            begin
              if Freed.IndexOf(grp.Infigures[j]) = -1 then
              begin
                Freed.Add(grp.Infigures[j]);
                TFigure(grp.Infigures[j]).Free;
              end;
            end;
          end;
          xFig.Free;
        end;
      end;

      for k := 0 to xAction.Params.Count-1 do
      begin
        xFig := TFigure(xAction.Params[k]);
        xFig.urc := xFig.urc-1;
        if (xFig.urc = 0) and (xFig.Deleted) and (Freed.IndexOf(xFig) = -1) then
        begin
          Freed.Add(xFig);
          if xFig is TFigureGrp then
          begin
            grp := xFig as TFigureGrp;
            for j := 0 to grp.Infigures.Count-1 do
            begin
              if Freed.IndexOf(grp.Infigures[j]) = -1 then
              begin
                Freed.Add(grp.Infigures[j]);
                TFigure(grp.Infigures[j]).Free;
              end;
            end;
          end;
          xFig.Free;
        end;
      end;
    end
    else if (xAction.ActionType = uaModify) then
    begin
      for k := 0 to xAction.Params.Count-1 do
      begin
        s := TMemoryStream(xAction.Params[k]);
        s.free;
        if xAction.RedoList.Count > k then begin
          s := TMemoryStream(xAction.RedoList[k]);
          s.free;
        end;
      end;
    end else if (xAction.ActionType = uaGroup) or
                (xAction.ActionType = uaUnGroup) then
    begin
      for k := 0 to xAction.List.Count-1 do
      begin
        grp := TFigureGrp(xAction.List[k]);
        if (grp.UnGrouped) and (Freed.IndexOf(grp) = -1) then
        begin
          Freed.Add(grp);
          grp.DestroyGrp;
        end;
      end;
    end;
   *)
  finally
//    ShowMessage(CPowerCadMessage + 'TPCDrawing.KillUndoAction');
    xAction.List.Clear;
    xAction.Free;
  end;

end;

Procedure TPCDrawing.ClearUndoList;
var
  xAction: TUndoAction;
  i: integer;
begin
  try
    for i := 0 to FUndoList.Count-1 do
    begin
      xAction := TUndoAction(FUndoList[i]);
      KillUndoAction(xAction);
    end;
    FUndoList.Clear;
    Freed.Clear;
    FUndoIdx := 0;
  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.ClearUndoList' + E.Message);
  end;
end;

Procedure TPCDrawing.Draw;
// Tolik -- 22/12/2016--
var CAdRefreshFlagChanged : Boolean;
begin
  // Tolik -- 22/12/2016 --
  if not GCanRefreshCad then
    exit;
  try
//    TempBitmap.PixelFormat := pf4bit;
//    TempBitmap.HandleType := bmDIB;
//    BaseBitmap.PixelFormat := pf4bit;
//    BaseBitmap.HandleType := bmDIB;
  except
  end;

  GCanRefreshCad := False;
  //
  try
    SetBufferEngine;
    DrawFigures(FRangeCheck);
    SetBufferDetailEngine;
    ClipToDetailRegion(TempBitmap.Canvas);
    DrawDetail;
    UnClip(TempBitmap.Canvas);
  except
    on E: Exception do;
  end;
  // Tolik
  GCanRefreshCad := True;
  
  //
  //SetBufferEngine; //22.08.2012
end;

Procedure GetCorrectlyPOints(aCabinet: TFigure; var aParr:TDoublepointArr);
var
   i: integer;
begin
  try
    if Length(aParr) <> 0 then
      SetLength(aParr,0);
    SetLength(aParr,aCabinet.PointCount);
    for i := 0 to aCabinet.PointCount - 1  do
    begin
      aParr[i] := aCabinet.ActualPoints[i+1];
    end;
  except
  end;
end;

Function CheckByIntersectionInCabinetExt(ACabinet, aTracefigure: TFigure): boolean;
var i: integer;
    p: TDoublePoint;
begin
  try
    result := false;
    for i := 0 to ACAbinet.PointCount - 1 do
    begin
      if (i+1) <> ACAbinet.PointCount then
      begin
        if GetIntersectionPoint(aTraceFigure.ActualPoints[1], aTraceFigure.ActualPoints[2], aCabinet.ActualPoints[i+1], aCabinet.ActualPoints[i+2], p,false) then
        begin
          result := true;
          break;
        end;
      end
      else
      begin
        if GetIntersectionPoint(aTraceFigure.ActualPoints[1], aTraceFigure.ActualPoints[2], aCabinet.ActualPoints[i+1], aCabinet.ActualPoints[1], p,false) then
        begin
          result := true;
          break;
        end;
      end;
    end;
  except
  end;
end;

Function CheckOrtholineCablesOnProperty(SCSCatalog: TSCSCatalog): boolean;
var i,j: integer;
  SCSCompon: TSCSComponent;
  ExistSpec_Cable: boolean;
begin
  result := true;
  if SCSCatalog <> nil then
  begin
    if SCSCatalog.ComponentReferences.Count > 0 then
    begin
      for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do
      begin
        ExistSpec_Cable := false;
        SCSCompon := SCSCatalog.ComponentReferences[i];
        if CheckSysNameIsCable(SCSCompon.ComponentType.SysName) then
        begin
          for j := 0 to SCSCompon.Properties.Count - 1 do
            if PProperty(SCSCompon.Properties[j]).SysName = 'SPEC_CABLE' then
            begin
              ExistSpec_Cable := true;
              if PProperty(SCSCompon.Properties[j]).Value = '1' then
              begin
                Result := false;
              end
              else
              begin
                Result := True;
                break;
              end;
            end;

          if not ExistSpec_Cable then
            result := True;
          if result then
            break;
        end;
      end;
    end
    else
      result := false;
  end;
end;

//Проверка фигуры внутри кабинета//////////////////////////////////////////////////
function TPCDrawing.CheckFigureInsideCabinet(aLFigures: TList; var aTraceFigure: TFigure; needCheckConn: boolean = false): byte;
var i: Integer;
    aFigure: TFigure;
    Cabinet: TCabinet;
    CabinetExt: TCabinetExt;
    p: TDoublepoint;
    Parr: TDoublePointArr;
    z:double;
    SCSCatalog: TSCSCatalog;
    JoinedLen: integer; // Tolik 13/02/2020 --
begin
  result := 0;
  try
    if Owner.ClassName = 'TF_CAD' then
    begin
      aTraceFigure.InsideCabinet := False;                                         //По умолчанию, фигура не внутри кабинета
      if CheckFigureByClassName(aTraceFigure, 'TConnectorObject') then             //Если это...
      begin
        // Tolik 12/02/2020 -- это чтобы не выбило ошибку на подъезде дома
        if TConnectorObject(aTraceFigure).FisApproach then
          exit;
        // Коннекторы, установенные на углах дома -- тоже нафиг
        if TConnectorObject(aTraceFigure).HouseIndex <> -1 then
          exit;
        //
        NeedCheckConn := True; // Tolik 13/02/2020 --
        if TConnectorObject(aTraceFigure).ConnectorType = ct_Clear then //  Tolik 27/08/2019 -- это чтобы не "проскочил" Точечный объект,
                                                                        // если его вдруг нет в ПМ (битый проект)
        // если это коннектор прицепленный к ТО - то такого коннектора и не должно быть в ПМке
        begin
        // Tolik 13/02/2020 --
          JoinedLen := length(TConnectorObject(aTraceFigure).FJoinedConnectorsIndexes);
          //if length(TConnectorObject(aTraceFigure).FJoinedConnectorsIndexes) > 0 then
          if JoinedLen > 0 then
            NeedCheckConn := false;
        end;
        if NeedCheckConn then
          SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(aTraceFigure.ID);
        if NeedCheckConn and (SCSCatalog = nil) then
        begin
          if TConnectorObject(aTraceFigure).ConnectorType = ct_Clear then
            result := 1
          else
            result := 2;
        end
        else
        begin
          for i:= 0 to aLFigures.Count - 1 do                                         //Проходим по всем фигурам
          begin
            aFigure := TFigure(aLFigures[i]);
            if CheckFigureByClassName(aFigure, 'TCabinet') then                     //находим кабинет
            begin
              Cabinet := TCabinet(aFigure);
              if Cabinet.CabinetConfig.aUnroutableArea then
              begin
                if (Cabinet.FIndex <> -1)and(GCadForm.FRemFigures.IndexOf(Cabinet) = - 1) then //У которого индекс не -1 и он не в удаленных кабинетах
                begin
                  p := aTraceFigure.ActualPoints[1];
      //            GetCorrectlyPOints(Figure, Parr);
                  if (Cabinet.isPointInMod(p.x, p.y))and(Cabinet.CabinetConfig.aUnroutableArea)and(Cabinet.FIndex <> -1) then
                  begin
                    aTraceFigure.InsideCabinet := true;                                //Если фигура входит в кабинет, ставим флажок
                    break;
                  end
                  else
                    aTraceFigure.InsideCabinet := False;
                end;
              end;
            end
            else
            if CheckFigureByClassName(aFigure, 'TCabinetExt') then                  //С Ext кабинетами то же самое
            begin
              Cabinetext := TCabinetExt(aFigure);
              if Cabinet.CabinetConfig.aUnroutableArea then
              begin
                if (Cabinetext.FIndex <> - 1)and(GCadForm.FRemFigures.IndexOf(CabinetExt) = - 1) then
                begin
                  p := aTraceFigure.ActualPoints[1];
      //            GetCorrectlyPOints(Figure, Parr);
                  if (Cabinetext.isPointInMod(p.x,p.y))and(Cabinetext.CabinetConfig.aUnroutableArea)and(Cabinetext.FIndex <> -1) then
                  begin
                    aTraceFigure.InsideCabinet := true;
                    break;
                  end
                  else
                    aTraceFigure.InsideCabinet := False;
                end;
              end;
            end;  
          end;
        end;
      end
      else
      if CheckFigureByClassName(aTraceFigure, 'TOrthoLine') then
      begin
        SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(aTraceFigure.ID); //Для проверки свойств кабеля
        if SCSCatalog = nil then
        begin
          result := 4;
        end
        else
        begin
          for i:= 0 to aLFigures.Count - 1 do                                         //Проходим по всем фигурам
          begin
            aFigure := TFigure(aLFigures[i]);
            if CheckFigureByClassName(aFigure, 'TCabinet') then
            begin
              Cabinet := TCabinet(aFigure);
              if Cabinet.CabinetConfig.aUnroutableArea or Cabinet.CabinetConfig.aPlenumArea then
              begin
                if (Cabinet.FIndex <> -1)and(GCadForm.FRemFigures.IndexOf(Cabinet) = - 1) then
                begin

                  if (Cabinet.isPointInMod(aTraceFigure.ActualPoints[1].x, aTraceFigure.ActualPoints[1].y))and
                  ((Cabinet.CabinetConfig.aPlenumArea)or(Cabinet.CabinetConfig.aUnroutableArea)) then
                  begin
                    aTraceFigure.InsideCabinet := true;
                    if (aTraceFigure.InsideCabinet)and(not Cabinet.CabinetConfig.aUnroutableArea) then
                    begin
                      aTraceFigure.InsideCabinet := CheckOrtholineCablesOnProperty(SCSCatalog);
                    end;
                    if aTraceFigure.InsideCabinet then             //Если фигура внутри кабинета, только тогда выходить из цикла
                      break;
                  end
                  else
                  if (Cabinet.isPointInMod(aTraceFigure.ActualPoints[2].x, aTraceFigure.ActualPoints[2].y))and
                  ((Cabinet.CabinetConfig.aPlenumArea)or(Cabinet.CabinetConfig.aUnroutableArea)) then
                  begin
                    aTraceFigure.InsideCabinet := true;
                    if (aTraceFigure.InsideCabinet)and(not Cabinet.CabinetConfig.aUnroutableArea) then
                    begin
                      aTraceFigure.InsideCabinet := CheckOrtholineCablesOnProperty(SCSCatalog);
                    end;
                    if aTraceFigure.InsideCabinet then
                      break;
                  end
                  else
                  if ((GetIntersectionPoint(aTraceFigure.ActualPoints[1], aTraceFigure.ActualPoints[2], Cabinet.ap1,Cabinet.AP2, p,false))or
                     (GetIntersectionPoint(aTraceFigure.ActualPoints[1], aTraceFigure.ActualPoints[2], Cabinet.ap2,Cabinet.AP3, p,false))or
                     (GetIntersectionPoint(aTraceFigure.ActualPoints[1], aTraceFigure.ActualPoints[2], Cabinet.ap3,Cabinet.AP4, p,false))or
                     (GetIntersectionPoint(aTraceFigure.ActualPoints[1], aTraceFigure.ActualPoints[2], Cabinet.ap4,Cabinet.AP1, p,false)))and
                     ((Cabinet.CabinetConfig.aPlenumArea)or(Cabinet.CabinetConfig.aUnroutableArea)) then
                  begin
                    aTraceFigure.InsideCabinet := true;
                    if (aTraceFigure.InsideCabinet)and(not Cabinet.CabinetConfig.aUnroutableArea) then
                    begin
                      aTraceFigure.InsideCabinet := CheckOrtholineCablesOnProperty(SCSCatalog);
                    end;
                    if aTraceFigure.InsideCabinet then
                      break;
                  end
                  else
                    aTraceFigure.InsideCabinet := False;
                end;
              end;  
            end
            else
            if CheckFigureByClassName(aFigure, 'TCabinetExt') then
            begin
              CabinetExt := TCabinetext(aFigure);
              if Cabinet.CabinetConfig.aUnroutableArea or Cabinet.CabinetConfig.aPlenumArea then
              begin
                if (Cabinetext.FIndex <> -1)and(GCadForm.FRemFigures.IndexOf(CabinetExt) = - 1) then
                begin

                  if (CabinetExt.isPointInMod(aTraceFigure.ActualPoints[1].x, aTraceFigure.ActualPoints[1].y))and
                  ((CabinetExt.CabinetConfig.aPlenumArea)or(CabinetExt.CabinetConfig.aUnroutableArea)) then
                  begin
                    aTraceFigure.InsideCabinet := true;
                    if (aTraceFigure.InsideCabinet)and(not CabinetExt.CabinetConfig.aUnroutableArea) then
                    begin
                      aTraceFigure.InsideCabinet := CheckOrtholineCablesOnProperty(SCSCatalog);
                    end;
                    if aTraceFigure.InsideCabinet then
                      break;
                  end
                  else
                  if (CabinetExt.isPointInMod(aTraceFigure.ActualPoints[2].x, aTraceFigure.ActualPoints[2].y))and
                  ((CabinetExt.CabinetConfig.aPlenumArea)or(CabinetExt.CabinetConfig.aUnroutableArea)) then
                  begin
                    aTraceFigure.InsideCabinet := true;
                    if (aTraceFigure.InsideCabinet)and(not CabinetExt.CabinetConfig.aUnroutableArea) then
                    begin
                      aTraceFigure.InsideCabinet := CheckOrtholineCablesOnProperty(SCSCatalog);
                    end;
                    if aTraceFigure.InsideCabinet then
                      break;
                  end
                  else
                  //Так как это кабинет Ext,то у него может быть куча граней, потому внутри этого метода
                  //проверяются все грани)))))
                  if (CheckByIntersectionInCabinetExt(aFigure, aTraceFigure))and
                  ((CabinetExt.CabinetConfig.aPlenumArea)or(CabinetExt.CabinetConfig.aUnroutableArea)) then
                  begin
                    aTraceFigure.InsideCabinet := true;
                    if (aTraceFigure.InsideCabinet)and(not CabinetExt.CabinetConfig.aUnroutableArea) then
                    begin
                      aTraceFigure.InsideCabinet := CheckOrtholineCablesOnProperty(SCSCatalog);
                    end;
                    if aTraceFigure.InsideCabinet then
                      break;
                  end
                  else
                    aTraceFigure.InsideCabinet := False;
                end;
              end;
            end;
          end;  
        end;
      end;
    end;
  except
  end
end;

Procedure TPCDrawing.DrawFigures(OnlyVisibles:Boolean);
var a, i: integer;
    Figure : TFigure;
    Layer : TLayer;
    isDraw,isFlue: Boolean;
    unreg: string;
    xFont: TFont;
    nh,nl:Integer;
    vRect: TDoubleRect;
    frect: TDoubleRect;
    cReg:HRGN;
    // Tolik 28/08/2019 --  эти переменные юзаются для GetTickCount, но она возвращает число типа Dword, которое
    //                      не помещается в cardinal, поэтому возникает математическое переполнение ...
    //OldTick, CurrTick: Cardinal;
    OldTick, CurrTick: DWord;
    //
    SLayers: TRapList;
    TmpRect: TRect;

    pmc: PPROCESS_MEMORY_COUNTERS;
    cb: Integer;
    // Tolik -- 14/09/2017 --
    FigMinX, FigMinY, FigMaxX, FigMaxY: double;
    // если есть автосозданные фигуры в фигуре отрисовки - не выставлять флажок, чтобы
  // границы такого объекта пересчитывались постоянно

  function CheckisAutoFigureIn(aFigure: TFigureGrp): Boolean;
  var i: Integer;
  begin
    Result := False;
    for i := 0 to aFigure.Infigures.Count - 1 do
    begin
      if not TFigure(aFigure.InFigures[i]).deleted then
      begin
        if not TFigure(aFigure.InFigures[i]).deleted then
        begin
          if TFigure(aFigure.InFigures[i]) is TFigureGrp then
            Result := CheckisAutoFigureIn(TFigureGrp(aFigure.InFigures[i]))
          else
            if (TFigure(aFigure.InFigures[i]).isAutoCreatedFigure = bitrue) then
              Result := True;
        end;
      end;
      if Result then exit;
    end;
  end;

    //

begin
  isDrawingFigures := True;
  try
    Figures.Pack; //Tolik 04/01/2022

    if FUpdateCount = 0 then
    begin
      //GProcCnt := 0;
      OldTick := GetTickCount;

      //SLayers := TRapList.Create;
      //for a := 0 to Layers.Count - 1 do
      //  InsertValueToSortetRapList(TLayer(Layers[a]), SLayers);

      Dengine.CachePen := true; //01.11.2011
      Dengine.ClearPens; //01.11.2011
      Dengine.DefinePrinting; //01.11.2011

      vRect := GetVisibleRect;
      a := 0;
      while a < Figures.count do
      begin
        //Tolik
        try
        //
          try
            Figure := TFigure(Figures[a]);
            //Tolik
            //if Figure.ID <> -1 then
            if (Figure.ID <> -1) and (not Figure.Deleted) then // 31/10/2015
            begin
            //
              isDraw := Figure.Visible and (not Figure.InClip);
              isFlue := False;
              if (Figure.LayerHandle > 0) and Figure.Visible and (not Figure.InClip)  then begin
                Layer := TLayer(Figure.LayerHandle);
                {//31.10.2011} if Layers.IndexOf(Layer) > -1 then
                //if GetValueIndexFromSortedRapList(Layer, SLayers) > -1 then
                begin
                  isDraw := (Layer.visible <> lost);
                  isFlue := (Layer.visible = grayed);
                end;
              end;

              if isDraw then
              begin
                if Figure is TfigureGrpMod then
                begin
                  //if CheckisAutoFigureIn(TFigureGrp(Figure)) then
                  if TFigureGrpMod(Figure).HasAutocreatedFigures then
                  begin
                    TFigureGrp(fiGure).GetBoundsWithAutoCreatedFigures(FigMaxX, FigMaxY, FigMinX, FigMinY);
                    frect := DoubleRect(FigMinX, FigMinY, FigMaxX, FigMaxY);
                  end
                  else
                  begin
                    if Figure.FIsLoadedBounds then
                      frect := Figure.FBoundRect
                    else
                    begin
                      fRect := fiGure.GetBoundRect;
                      Figure.FBoundRect := fRect;
                      Figure.FIsLoadedBounds := true;
                    end;
                  end
                end
                else
                begin
                  if Figure.FIsLoadedBounds then
                    frect := Figure.FBoundRect
                  else
                  begin
                    fRect := fiGure.GetBoundRect;
                    Figure.FBoundRect := fRect;
                    Figure.FIsLoadedBounds := true;
                  end;
                end;

                //31.10.2011 }isDraw := isDraw and ((not onlyVisibles) or (OnlyVisibles and RectOverlaps(vRect,fRect)));
                isDraw := isDraw and ((not onlyVisibles) or (OnlyVisibles and OverlapDoubleRects(vRect,fRect) ));

                // test - OverlapDoubleRects
                //if a = 0 then
                //begin
                //  OldTick := GetTickCount;
                //  for i := 0 to 1000000 do
                //    RectOverlaps(vRect,fRect);
                //  CurrTick := GetTickCount - OldTick;
                //  CurrTick := GetTickCount - OldTick;
                //  OldTick := GetTickCount;
                //  for i := 0 to 1000000 do
                //    OverlapDoubleRects(vRect,fRect);
                //  CurrTick := GetTickCount - OldTick;
                //  CurrTick := GetTickCount - OldTick;
                //end;
              end;
              if (isDraw)(* or (Figure is TFigureGrp))*)  then
              begin
                Figure.Draw(Dengine,isflue);
                Figure.DrawDimLines(DEngine,isFlue);
              end;
            end;
          finally
            inc(a);
          end;
        //Tolik
        except
          on E: Exception do
          begin

            AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.DrawFigures ' + E.Message);
            // Tolik -- 19/07/2017 --
            cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
            GetMem(pmc, cb);
            pmc^.cb := cb;
            if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then
            begin
              AddExceptionToLog('WORK MEM : ' + IntToStr(pmc^.WorkingSetSize) + ' KBytes');
              AddExceptionToLog('VIRT MEM : ' + IntToStr(pmc^.PageFileUsage) + ' KBytes');
             // Label1.Caption := IntToStr(pmc^.WorkingSetSize) + ' Bytes'
            end;
            //else
             // Label1.Caption := 'Unable to retrieve memory usage structure';
            FreeMem(pmc);
            //
          end;
        end;
        //
      end;
      Dengine.CachePen := false;
      Dengine.ClearPens;


      {$ifdef unregistered}
      Unreg := '';
      For a:= 1 to 30 do
      begin
        UnReg := Unreg + chr(regChars[a]);
      end;
      DEngine.Canvas.Font.Name := 'Arial';
      DEngine.Canvas.Font.Color := clBlack;
      DEngine.Canvas.Font.Size := 16;
      Dengine.Canvas.Brush.Style := bsClear;
      DEngine.Canvas.TextOut(30,30,Unreg);
      {$endif unregistered}

      //SLayers.Free;

      CurrTick := GetTickCount - OldTick;
      CurrTick := GetTickCount - OldTick;
    end;
  except
    on E: Exception do AddExceptionToLog('TPCDrawing.DrawFigures' + E.Message);
  end;
  isDrawingFigures := False;
end;

procedure TPCDrawing.TestListFigures(aCheckOverlap: Boolean);
var a, i: integer;
    Figure : TFigure;
    Layer : TLayer;
    isDraw,isFlue: Boolean;
    unreg: string;
    xFont: TFont;
    nh,nl:Integer;
    vRect: TDoubleRect;
    frect: TDoubleRect;
    cReg:HRGN;
    // Tolik 28/08/2019 --
    //OldTick, CurrTick: Cardinal;
    OldTick, CurrTick: DWord;
    //
    SLayers: TRapList;
    TmpRect: TRect;
    OnlyVisibles: Boolean;
begin
  if FUpdateCount = 0 then
  begin
    //GProcCnt := 0;
    OnlyVisibles := true;
    OldTick := GetTickCount;

    Dengine.CachePen := true; //01.11.2011
    Dengine.ClearPens; //01.11.2011
    Dengine.DefinePrinting; //01.11.2011

    vRect := GetVisibleRect;
    a := 0;
    while a < Figures.count do
    begin
      try
        Figure := TFigure(Figures[a]);
        isDraw := Figure.Visible and (not Figure.InClip);
        isFlue := False;
        if (Figure.LayerHandle > 0) and Figure.Visible and (not Figure.InClip)  then begin
          Layer := TLayer(Figure.LayerHandle);
          {//31.10.2011} if Layers.IndexOf(Layer) > -1 then
          begin
            isDraw := (Layer.visible <> lost);
            isFlue := (Layer.visible = grayed);
          end;
        end;

        if isDraw then begin
          if Figure.FIsLoadedBounds then
            frect := Figure.FBoundRect
          else
          begin
            fRect := fiGure.GetBoundRect;
            Figure.FBoundRect := fRect;
            Figure.FIsLoadedBounds := true;
          end;
          if aCheckOverlap then
            isDraw := isDraw and ((not onlyVisibles) or (OnlyVisibles and OverlapDoubleRects(vRect,fRect) ));
        end;
      finally
        inc(a);
      end;
    end;
    Dengine.CachePen := false;
    Dengine.ClearPens;


    {$ifdef unregistered}
    Unreg := '';
    For a:= 1 to 30 do
    begin
      UnReg := Unreg + chr(regChars[a]);
    end;
    DEngine.Canvas.Font.Name := 'Arial';
    DEngine.Canvas.Font.Color := clBlack;
    DEngine.Canvas.Font.Size := 16;
    Dengine.Canvas.Brush.Style := bsClear;
    DEngine.Canvas.TextOut(30,30,Unreg);
    {$endif unregistered}

    //SLayers.Free;

    CurrTick := GetTickCount - OldTick;
    CurrTick := GetTickCount - OldTick;
  end;
end;

Procedure TPCDrawing.DrawSubstrateFigures(OnlyVisibles:Boolean);
var a: integer;
    Figure : TFigure;
    Layer : TLayer;
    isDraw,isFlue: Boolean;
    unreg: string;
    xFont: TFont;
    nh,nl:Integer;
    vRect: TDoubleRect;
    frect: TDoubleRect;
    cReg:HRGN;
begin
  vRect := GetVisibleRect;
  a := 0;
  while a < Figures.count do
  begin
    try
      Figure := TFigure(Figures[a]);
      isDraw := Figure.Visible and (not Figure.InClip);
      isFlue := False;
      if (Figure.LayerHandle > 0) and Figure.Visible and (not Figure.InClip) then
      begin
        Layer := TLayer(Figure.LayerHandle);
        if (Layers.IndexOf(Layer) = 1) or (Layers.IndexOf(Layer) = 8) or (Layer.IsDxf) then
        begin
          isDraw := (Layer.visible <> lost);
          isFlue := (Layer.visible = grayed);
        end
        else
          isDraw := False;  
      end;

      if isDraw then
      begin
        fRect := fiGure.GetBoundRect;
        isDraw := isDraw and ((not onlyVisibles) or (OnlyVisibles and RectOverlaps(vRect,fRect)));
      end;
      if (isDraw)(* or (Figure is TFigureGrp))*)  then
      begin
        Figure.Draw(Dengine,isflue);
        Figure.DrawDimLines(DEngine,isFlue);
      end;
    finally
      inc(a);
    end;
  end;
end;


Procedure TPCDrawing.ClearFaces;
var
  i: Integer;
  face: TfaceRecord;
begin
  try
    for i := 0 to Faces.Count-1 do
    begin
      Face := TFaceRecord(faces[i]);
      Face.Free;
    end;
    Faces.Clear;
  except
    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.ClearFaces' + E.Message);
  end;
end;

Procedure TPCDrawing.CollectFaces;
var
  {//04.01.2012 - Перенос в CollectFacesFromFigures
  isDraw,isFlue:Boolean;
  i,k: Integer;
  Layer: TLayer;
  Figure: TFigure;
  face: TfaceRecord;
  pCnt: Integer;
  p: T3dPoint;
  xRoom: T3DRoom;
  NeedAdd: boolean;}
// 22.07.2011
  xNets, xScsObjects: TList;

  procedure CollectFacesFromFigures(AFigures: TList);
  var
    isDraw,isFlue:Boolean;
    i,k: Integer;
    Layer: TLayer;
    Figure: TFigure;
    face: TfaceRecord;
    pCnt: Integer;
    p: T3dPoint;
    xRoom: T3DRoom;
    NeedAdd: boolean;
  begin
    For i := 0 to AFigures.count - 1 do
    begin
      try
        Figure := TFigure(AFigures[i]);
        isDraw := True;
        isFlue := False;
        if Figure.LayerHandle > 0 then
        begin
          Layer := TLayer(Figure.LayerHandle);
          isDraw := (Layer.visible <> lost);
          isFlue := (Layer.visible = grayed);
        end;
        if (isDraw or (Figure is TFigureGrp))  then
        begin
          if Figure is TNet then
          begin
            // Tolik 15/06/2018 --
            NeedAdd := True;
            {NeedAdd := False;
            if TNet(Figure).FComponID <> 0 then
              NeedAdd := True;}
            //
            {$if Not Defined(ES_GRAPH_SC)}
             //Tolik -- 15/06/2018 --
             { if NeedAdd then
                if GetArchObjByCADObj(TNet(Figure)).IsLine = ctArhRoofSeg then
                  NeedAdd := False;}
            {$ifend}
            if NeedAdd and (TNet(Figure).Paths.Count > 0) then
            begin
              xNets.Add(Figure);
              //xRoom := T3DRoom.Create(Faces, TNet(Figure), xModel);
              //xModel.FRooms.Add(xRoom);
            end;
          end
          else if Figure is TFigureGrp then
          begin
            CollectFacesFromFigures(TFigureGrp(Figure).InFigures); //04.01.2012
          end
          else
          begin
  // 22.07.2011
            //Figure.CollectFaces(Faces);
            if Figure.Name = 'Anchor' then
              Figure.CollectFaces(Faces)
            else
            begin
              //xScsObjects.Add(Figure);
              //Figure.CollectFaces(Faces); //04.01.2012 xScsObjects.Add(Figure);

              //04.01.2012 - test
              if (Figure.ClassName = 'TConnectorObject') then
              begin
                //if (TConnectorObject(Figure).ConnectorType <> ct_Clear) then
                //if TConnectorObject(Figure).FTrunkName = '' then
                  xScsObjects.Add(Figure);
              end
              else if Figure.ClassName = TOrthoLine.ClassName then
              begin
                xScsObjects.Add(Figure);
              end;
            end;
          end;
          if assigned(FOnCollectFigureFaces) then
            FOnCollectFigureFaces(Self,Figure,Faces);
        end;
      except
      end;
    end;
  end;

begin
  xNets := TList.create;
  xScsObjects := TList.create;
  ClearFaces;

  CollectFacesFromFigures(Figures);

  (*
  For i := 0 to Figures.count - 1 do
  begin
    try
      Figure := TFigure(Figures[i]);
      isDraw := True;
      isFlue := False;
      if Figure.LayerHandle > 0 then
      begin
        Layer := TLayer(Figure.LayerHandle);
        isDraw := (Layer.visible <> lost);
        isFlue := (Layer.visible = grayed);
      end;
      if (isDraw or (Figure is TFigureGrp))  then
      begin
        if Figure is TNet then
        begin
          NeedAdd := False;
          if TNet(Figure).FComponID <> 0 then
            NeedAdd := True;
          {$if Defined(FINAL_SCS)}
            if NeedAdd then
              if GetArchObjByCADObj(TNet(Figure)).IsLine = ctArhRoofSeg then
                NeedAdd := False;
          {$ifend}
          if NeedAdd and (TNet(Figure).Paths.Count > 0) then
          begin
            xNets.Add(Figure);
            //xRoom := T3DRoom.Create(Faces, TNet(Figure), xModel);
            //xModel.FRooms.Add(xRoom);
          end;
        end
        else
        begin
// 22.07.2011
          //Figure.CollectFaces(Faces);
          if Figure.Name = 'Anchor' then
            Figure.CollectFaces(Faces)
          else
          begin
            xScsObjects.Add(Figure);
          end;
        end;
        if assigned(FOnCollectFigureFaces) then
          FOnCollectFigureFaces(Self,Figure,Faces);
      end;
    except
    end;
  end;*)
// 22.07.2011
  {$ifdef 3D}
    frm3D.F3DModel.CollectModel(Faces, xNets);
    frm3D.F3DModel.CollectScsModel(Faces, xScsObjects);
  {$endif 3D}
// 22.07.2011
  if assigned(FOnCollectFaces) then
    FOnCollectFaces(Self,Faces);
  // Tolik -- 23/03/2017 --
  xNets.Free;
  xScsObjects.Free;

  //
end;

function TPCDrawing.GetFacadeArea(AResInM: Boolean): Double; // AResInM - результат в метрах
var
  isDraw,isFlue:Boolean;
  i,j,k,l: Integer;
  Layer: TLayer;
  Figure: TFigure;
  face: TfaceRecord;
  pCnt: Integer;
  p: T3dPoint;
  xModel: T3DModel;
  xRoom: T3DRoom;
  xWall: T3DWall;
  xSide: T3DSide;
  DoublePointArr: TDoublePointArr;
  PointCnt: Integer;
  FaceNames: TStringList;

  function Normalize3DFace(var APoints: T3DPointArray): T3DPointArray;
  //var
    //a1, a2:
  begin

  end;
  

begin
  Result := 0;
  GCurrentRoom3DView := nil;
  ClearFaces;

  FaceNames := TStringList.Create;

  xModel := T3DModel.Create;
  For i := 0 to Figures.count - 1 do
  begin
    try
      Figure := TFigure(Figures[i]);
      if Figure is TNet then
      begin
        if TNet(Figure).Paths.Count > 0 then
        begin
          xRoom := T3DRoom.Create(Faces, TNet(Figure), xModel);
          xModel.FRooms.Add(xRoom);
        end;
      end;
    except
    end;
  end;
  for i := 0 to xModel.FRooms.Count - 1 do
  begin
    xRoom := T3DRoom(xModel.FRooms[i]);
    for j := 0 to xRoom.FWalls.Count - 1 do
    begin
      xWall := T3DWall(xRoom.FWalls[j]);
      for k := 0 to xWall.FSides.Count - 1 do
      begin
        xSide := T3DSide(xWall.FSides[k]);
        if (xSide.FFaceType = ftNetPath) and 
          (xSide.FWallType = fwtOuter) and
          (xSide.FSideType in [wstLeft, wstRight]) then
        begin
          PointCnt := Length(xSide.FPoints);
          //if PointCnt > 0 then
//          begin
//            SetLength(DoublePointArr, PointCnt+1);
//            for l := 0 to PointCnt do
//            begin
//              DoublePointArr[l].x := xSide.FPoints[l].x;
//              // Поскольку грани вертикальные, то координата Y для всех точек одинакова
//              DoublePointArr[l].y := xSide.FPoints[l].z;
//            end;
//            DoublePointArr[PointCnt] := DoublePointArr[0];
//            Result := Result + GetAreaFromPolygon(DoublePointArr);
//            SetLength(DoublePointArr, 0);            
//          end;
          if PointCnt = 4 then
          begin
            Result := Result + GetTriangleArea3D(xSide.FPoints[0], xSide.FPoints[1], xSide.FPoints[2])+
                               GetTriangleArea3D(xSide.FPoints[2], xSide.FPoints[3], xSide.FPoints[0]);
            FaceNames.Add(xWall.FName +'.'+ xSide.FName);
          end;
        end;
      end;
    end;
  end;
  FreeAndNil(xModel);

  if AResInM then
    Result := Result * sqr(MapScale / 1000);

  FaceNames.Free;
end;

Procedure TPCDrawing.DrawFaces;
var i,k:Integer;
  face: TfaceRecord;
  pArr:TdoublePointArr;
  rgn: HRGN;
  unreg:String;
begin
  for i := 0 to Faces.Count-1 do
  begin
    Face := TFaceRecord(faces[i]);
    SetLength(pArr,Length(Face.Points));
    for k := 0 to Length(pArr)-1 do
      pArr[k] := Convert3DPoint(Face.Points[k]);
    //LocateIsometricArray(pArr);
    rgn := 1;
    DEngine.drawpolygon(pArr,clBlack,1,ord(psSolid),Face.color,ord(bsSolid),rgn);
  end;

  {$ifdef unregistered}
  Unreg := '';
  For i:= 1 to 30 do
  begin
    UnReg := Unreg + chr(regChars[i]);
  end;
  DEngine.Canvas.Font.Name := 'Arial';
  DEngine.Canvas.Font.Color := clBlack;
  DEngine.Canvas.Font.Size := 16;
  Dengine.Canvas.Brush.Style := bsClear;
  DEngine.Canvas.TextOut(30,30,Unreg);
  {$endif unregistered}
end;


Procedure TPCDrawing.DrawSelectedFigures;
var a: integer;
    Figure : TFigure;
    Layer : TLayer;
    isDraw,isFlue: Boolean;
    unreg: string;
    xFont: TFont;
    nh,nl: Integer;
begin
  For a := 0 to Figures.count-1 do
  begin
    Figure := TFigure(Figures[a]);
    isDraw := True;
    isFlue := False;
    if Figure.LayerHandle > 0 then begin
      Layer  := TLayer(Figure.LayerHandle);
      isDraw := (Layer.visible <> lost);
      isFlue := (Layer.visible = grayed);
    end;
    if ((isDraw or (Figure is TFigureGrp)) and (Figure.Selected)) and (not Figure.InClip) then
    begin
      Figure.ResetRegion;
      Figure.draw(Dengine,isflue);
      Figure.DrawDimLines(Dengine,isFlue);
      Figure.ResetRegion;
    end;
  end;
  {$ifdef unregistered}
  Unreg := '';
  For a:= 1 to 30 do
  begin
    UnReg := Unreg + chr(regChars[a]);
  end;
  DEngine.Canvas.Font.Name := 'Arial';
  DEngine.Canvas.Font.Color := clBlack;
  DEngine.Canvas.Font.Size := 16;
  DEngine.Canvas.TextOut(30,30,Unreg);
  {$endif unregistered}
end;

Procedure TPCDrawing.DrawSelectionPoints;
var a: integer;
    Figure : TFigure;
    Layer : TLayer;
    LInfo: TLayerInfo;
    isDraw,isFlue: Boolean;
begin
  if FDetail then begin
    SetBufferDetailEngine;
    ClipToDetailRegion(TempBitmap.Canvas);
    For a := 0 to Figures.count - 1 do
    begin
      Figure := TFigure(Figures[a]);
      // Tolik   26/10/2015
      if not Figure.Deleted then
      begin
      //
        isDraw := True;
        isFlue := False;
        if Figure.LayerHandle > 0 then begin
          Layer := TLayer(Figure.LayerHandle);
          isDraw := (Layer.visible <> Lost);
          isFlue := (Layer.visible = grayed);
        end;
        if (isDraw and Figure.Selected) then begin
          Figure.IsDrawingDetail := True;
          Figure.drawselectionpoints(Dengine,isFlue);
          Figure.IsDrawingDetail := False;
        end;
      end;
    end;
    UnClip(TempBitmap.Canvas);
  end;

  SetBufferEngine;
  ClipToActiveRegion(TempBitmap.Canvas);
  For a := 0 to Figures.count - 1 do
  begin
    Figure := TFigure(Figures[a]);
    // Tolik   26/10/2015
    if not Figure.Deleted then
    begin
    //
      isDraw := True;
      isFlue := False;
      if Figure.LayerHandle > 0 then
      begin
        try
          Layer := TLayer(Figure.LayerHandle);
        except
          on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.DrawSelectionPoints' + E.Message);
        end;
        isDraw := (Layer.visible <> Lost);
        isFlue := (Layer.visible = grayed);
      end;
      if (isDraw and Figure.Selected) then Figure.drawselectionpoints(Dengine,isFlue);
    end;
  end;
  UnClip(TempBitmap.Canvas);
end;

Procedure TPCDrawing.DrawFigureGuides;
var a: integer;
    Figure : TFigure;
    Layer : TLayer;
    LInfo: TLayerInfo;
    isDraw,isFlue: Boolean;
begin
  if not FFigureGuides then exit;
  if FDetail then begin
    ClipToDetailRegion(TempBitmap.Canvas);
    SetEngine(TempBitmap.Canvas,DetConvertXY,DetDeConvertXY,DetConvertDim,DetDeConvertDim,false,nil);
    For a := 0 to Figures.count-1 do
    begin
      Figure := TFigure(Figures[a]);
      isDraw := True;
      isFlue := False;
      if Figure.LayerHandle > 0 then
      begin
        Layer := TLayer(Figure.LayerHandle);
        isDraw := (Layer.visible <> lost);
        isFlue := (Layer.visible = grayed);
      end;
      if isDraw and (Figure.inClip = False) then
        Figure.DrawFigureGuidesInDetail(Dengine,DetailStyle);
    end;
    UnClip(TempBitmap.Canvas);
  end;

  SetEngine(TempBitmap.Canvas,ConvertXY,DeConvertXY,ConvertDim,DeConvertDim,false,nil);
  ClipToActiveRegion(TempBitmap.Canvas);
  try
    For a := 0 to Figures.count-1 do
    begin
      Figure := TFigure(Figures[a]);
      isDraw := True;isFlue := False;
      if Figure.LayerHandle > 0 then
      begin
        Layer := TLayer(Figure.LayerHandle);
        isDraw := (Layer.visible <> lost);
        isFlue := (Layer.visible = grayed);
      end;
      if isDraw then
        Figure.DrawFigureGuides(Dengine);
    end;
  {Mityai} //D0000006303
  //Проверка при перемещении объектов, чтоб не пропадала топовая направляющая////
  //if Assigned(GCadForm) then                                                   //
    if GuidesVisible then                                        //
      DrawGuidesTop(DEngine.Canvas);                                           //
  except
  end;
  UnClip(TempBitmap.Canvas);
end;


Procedure TPCDrawing.ManualRefresh;
Begin
  DoSurfacePaint(surface);
End;

Function TPCDrawing.GetSurfaceBitmap:Tbitmap;
begin
  result := TempBitmap;
end;

Function TPCDrawing.GetSurfaceBitmapHandle:Integer;
Begin
  result := TempBitmap.Handle;
End;

Procedure TPCDrawing.Refresh;
var
  xCanvas: TCanvas;
begin
  GisCadRefresh := True;
  try
    // Tolik 18/02/2018 --
    if not GCanRefreshCad then exit;
    //
    if AutoRefresh then
    begin
      //GCadForm.GWallTracePointList.Clear; // Tolik 17/01/2021 - -
      DoSurfacePaint(surface);
      DoSelChange;
      //Tolik 17/01/2022
     {
     if Assigned(TraceFigure) then
     begin
       if traceFigure is TwallPath then
       begin
        TWallPath(TraceFigure).ShadowTrace(TWallPath(TraceFigure).PointCount, GCurrMousePos.x, GCurrMousePos.y);
       end;
     end;
     }
    end;
  except
    // TODO - на 2.3.0 было закоменчено, пока оставим тоже закоменченным
	// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.Refresh' + E.Message);
  end;
  //Tolik 26/08/2021 --   сбросить описание выбранной фигуры в статус баре (если, например, удалили все или еще чего)
  if Selection.Count = 0 then
  begin
    if Assigned(Owner) then
    begin
      if Owner is TF_CAD then
      begin
        if Assigned(TF_Cad(Owner).sbView) then
          TF_Cad(Owner).sbView.Panels[2].Text := '';
        TF_Cad(Owner).ShowHideButtons; // Tolik 27/01/2022 - -
      end;
    end;
  end;
  //
  GisCadRefresh := False;
end;

Procedure TPCDrawing.RefreshSelection;
var a,i: integer;
    Layer : TLayer;
    istyle: Integer;
    bStyle: Byte;
    color: TColor;
    aFont:TFont;
    txFont: String;
    pc,txCharset: Byte;
    txSize: Double;
    txRatio: Double;
    txBold,txItalic,txUnderline,txStrike: Byte;
    hasBool: Boolean;
begin
 //Tolik
  try
    FSelection.Clear;
    SetEngine(TempBitmap.Canvas,ConvertXY,DeConvertXY,ConvertDim,DeConvertDim,false,nil);
    Reselect;
    drawselectionpoints;
    collectSelectedFigures(FSelection);

    istyle := GetSlcBrushStyle;
    if iStyle = -1 then
      bstyle := ord(fdefBrsStyle) else bStyle := istyle;
    if bStyle in [bsExHatch,bsExGrad,bsExTexture] then
      bStyle := 8;
    evBrushStyle.RaiseEvent(bStyle,'',0);

    istyle := GetSlcPenStyle;
    if iStyle = -1 then
      bstyle := ord(fdefPenStyle)
    else
      bStyle := istyle;
    evPenStyle.RaiseEvent(bStyle,'',0);

    istyle := GetSlcPenWidth-1;
    if iStyle < 0 then
      bstyle := fdefPenWidth-1
    else
      bStyle := istyle;
    evPenWidth.RaiseEvent(bStyle,'',0);

    istyle := GetSlcRowStyle;
    if iStyle = -1 then
      bstyle := ord(fdefRowStyle)
    else
      bStyle := istyle;
    evRowStyle.RaiseEvent(bStyle,'',0);

    color := GetSlcPenColor;
    if color = -1 then color := fdefPenColor;
    evPenColor.RaiseEvent(Color,'',0);

    color := GetSlcBrushColor;
    if color = -1 then color := fdefBrsColor;
    evBrushColor.RaiseEvent(Color,'',0);

    aFont := nil;
    aFont := GetSlcFont;
    if not assigned(aFont) then aFont := Font;

    color := aFont.Color;evTextColor.RaiseEvent(Color,'',0);
    txFont := aFont.Name;evTextFont.RaiseEvent(0,txFont,0);
    txSize := GetSlcFontSize;
    if txSize <= 0 then txSize := 80;
    evTextSize.RaiseEvent(txSize);
    txCharSet := 0;
    for i := 0 to 17 do
      if aFont.Charset = csArray[i] then txCharSet := i;
    evTextCharSet.RaiseEvent(txCharSet);

    txBold := 0; if fsBold in aFont.Style then txBold := 1;
    evTextBold.RaiseEvent(txBold,'',0);
    txItalic := 0; if fsItalic in aFont.Style then txItalic := 1;
    evTextItalic.RaiseEvent(txItalic,'',0);
    txUnderline := 0; if fsUnderline in aFont.Style then txUnderline := 1;
    evTextUnderline.RaiseEvent(txUnderline,'',0);
    txStrike := 0; if fsStrikeOut in aFont.Style then txStrike := 1;
    evTextStrike.RaiseEvent(txStrike,'',0);

    pc := 0; if GetSlcPolyLineClosed = True then pc := 1;
    evPLineClosed.RaiseEvent(pc);

    if SlcBitmapCnt = 0 then
    begin
      evTransparent.EnableEvent(false);
      evClipped.EnableEvent(false);
      evBmpSel.EnableEvent(false);
    end
    else
    begin
      pc := 0; if GetSlcImageTransparent = True then pc := 1;
      evTransparent.RaiseEvent(pc);
      pc := 0; if GetSlcImageClipped = True then pc := 1;
      evClipped.RaiseEvent(pc);
      evBmpSel.EnableEvent(true);
    end;


    if (SlcLineCnt = 0) and (slcPlineCnt = 0) then
    begin
      evBounded.EnableEvent(false);
    end
    else
    begin
      pc := 0; if GetSlcLineBounded = True then pc := 1;
      evBounded.RaiseEvent(pc);
    end;

    pc := ord(GetSlcArcStyle);evArcStyle.RaiseEvent(pc);
    if slcArcCnt = 0 then
    begin
      evArcSel.EnableEvent(False);
    end
    else
    begin
      evArcSel.EnableEvent(True);
    end;

    if (SlcLineCnt = 0) then
    begin
      evLineSel.EnableEvent(false);
    end else begin
      evLineSel.EnableEvent(true);
    end;

    if (SlcPLineCnt = 0) then
    begin
      evPLineSel.EnableEvent(false);
    end else begin
      evPLineSel.EnableEvent(true);
    end;

    if (SlcGroupCnt = 0) then
    begin
      evGroupSel.EnableEvent(false);
    end else begin
      evGroupSel.EnableEvent(true);
    end;
    if (FSelection.Count = 0) then
    begin
      evAnySel.EnableEvent(false);
    end else begin
      evAnySel.EnableEvent(true);
    end;
  except
    on E: Exception do AddExceptionToLog('TPCDrawing.RefreshSelection!!!  ' + E.Message);
  end;

end;

//Tolik 26/11/2021 -- старая закомменчена - см ниже, здесь - немножко оптимизирвано
Procedure TPCDrawing.CollectSelectionOrder(var Selecteds:TList);
var a:integer;
    f, fs: Tfigure;
    ord, i: Integer;
    inserted: Boolean;
begin
  if not assigned(selecteds) then exit;
  Selecteds.Clear;

  for a := 0 to figures.count - 1 do
  begin
    if TFigure(figures[a]).Selected then
    begin
      //f := figures[a];
      f := TFigure(figures[a]);
      ord := f.SelOrder;
      if Selecteds.Count = 0 then
        Selecteds.Add(f)
      else
      begin
        i := 0;
        inserted := false;

        repeat
          fs := TFigure(Selecteds[i]);
          if ord < fs.SelOrder then
          begin
            Selecteds.Insert(i,f);
            inserted := true;
            i := Selecteds.Count;
          end
          else
            inc(i);
        until i = Selecteds.Count;

        if not inserted then Selecteds.Add(f);
      end;
    end;
  end;
end;
(*
Procedure TPCDrawing.CollectSelectionOrder(var Selecteds:TList);
var a:integer;
    f, fs: Tfigure;
    ord, i: Integer;
    inserted, done: Boolean;
begin
  if not assigned(selecteds) then exit;
  Selecteds.Clear;

  for a := 0 to figures.count - 1 do
  begin
    if TFigure(figures[a]).Selected then
    begin
      //f := figures[a];
      f := TFigure(figures[a]);
      ord := f.SelOrder;
      if Selecteds.Count = 0 then
        Selecteds.Add(f)
      else
      begin
        i := 0;
        done := false;
        inserted := false;
        repeat
          fs := Selecteds[i];
          if ord < fs.SelOrder then
          begin
            Selecteds.Insert(i,f);
            done := True;
            inserted := true;
          end;
          i := i+1;
          if i = selecteds.Count then
            done := true;
        until done;
        if not inserted then Selecteds.Add(f);
      end;
    end;
  end;
end;
*)
Procedure TPCDrawing.collectSelectedFigures(var Selecteds:TList);
var a:integer;
    f: Tfigure;
begin
  if not assigned(selecteds) then exit;
  SlcBitmapCnt   := 0;
  SlcLineCnt     := 0;
  SlcPlineCnt    := 0;
  SlcArcCnt      := 0;
  SlcCircleCnt   := 0;
  SlcEllipseCnt  := 0;
  SlcVertexCnt   := 0;
  SlcGroupCnt    := 0;
  SlcRectangleCnt:= 0;
  SlcDimCnt      := 0;

  for a := 0 to figures.count - 1 do
  // Tolik 25/10/2015 --- ибо нех удаленные фигуры снова выбирать
    // if TFigure(figures[a]).Selected then
    if TFigure(figures[a]).Selected and (not TFigure(figures[a]).Deleted) then
  //
    begin
      //f := figures[a];
      f := TFigure(figures[a]);
      Selecteds.add(figures[a]);
      //Tolik 26/11/2021 -- чуть ускорить и здесь ...
      {
      if f is TbmpObject then inc(SlcBitmapCnt);
      if f is DrawObjects.TLine then inc(SlcLineCnt);
      if f is TPolyline then inc(SlcPlineCnt);
      if f is TArc then inc(SlcArcCnt);
      if f is TCircle then inc(SlcCircleCnt);
      if f is TEllipse then inc(SlcEllipseCnt);
      if f is DrawObjects.TRectangle then inc(SlcRectangleCnt);
      if f is TVertex then inc(SlcVertexCnt);
      if f is TFigureGrp then inc(SlcGroupCnt);
      if f is TDimLine then inc(SlcDimCnt);
      }
      if f is TbmpObject then
        inc(SlcBitmapCnt)
      else
      //Tolik 17/02/2022 --
      //if f is DrawObjects.TLine then
      if f.ClassName = 'TLine' then
      //
        inc(SlcLineCnt)
      else
      if f is TPolyline then
        inc(SlcPlineCnt)
      else
      if f is TArc then
        inc(SlcArcCnt)
      else
      if f is TCircle then
        inc(SlcCircleCnt)
      else
      if f is TEllipse then
        inc(SlcEllipseCnt)
      else
      if f is DrawObjects.TRectangle then
        inc(SlcRectangleCnt)
      else
      if f is TVertex then
        inc(SlcVertexCnt)
      else
      if f is TFigureGrp then
        inc(SlcGroupCnt)
      else
      if f is TDimLine then
        inc(SlcDimCnt);
    end;

end;


procedure TPCDrawing.reselect;
var a,k: integer;
    Figure : TFigure;
begin
  //Tolik 26/11/2021 -- это вытащил с условий ниже, т.к. по нему все равно ничего не происходит,
  //чтобы впустую не колотило и работало быстрее ...
 if (TraceFigure <> nil) and (GCadForm.PCad.ModPoint <> nil) then
    exit;
  //
  {//02.04.2012
  for a := 0 to figures.count-1 do
  begin
    Figure := TFigure(Figures[a]);
    if Figure.selected then
    begin
      Figure.Reselect;
    end;
  end;}

  //02.04.2012
  if figures.count > 0 then
  begin
    BeginMultiDeselect; //02.04.2012
    try
      for a := 0 to figures.count-1 do
      begin
        Figure := TFigure(Figures[a]);
        // Tolik
        if (Assigned(Figure) and (not Figure.Deleted)) then
        begin
        //
          if Figure.selected then
          begin
            // commented by Tolik 26/11/2021 --
            //if (TraceFigure <> nil) and (GCadForm.PCad.ModPoint <> nil) then // IGOR D0000006157
            //else
            //
            Figure.ReSelectUnsel;
          end;
        end;
      end;
    finally
      EndMultiDeselect; //02.04.2012
    end;
    for a := 0 to figures.count-1 do
    begin
      Figure := TFigure(Figures[a]);
      // Tolik 26/10/2015 --- ибо нех удаленные фигуры выбирать
      // if Figure.selected then
      if (Figure.selected and (not Figure.Deleted)) then
      //
      begin
        // commented by Tolik 26/11/2021 --
        //if (TraceFigure <> nil) and (GCadForm.PCad.ModPoint <> nil) then // IGOR D0000006157
        //else
        //
        Figure.ReSelectSel;
      end;
    end;
  end;
end;



Procedure TPCDrawing.ReDrawSelection;
begin
  if not (csDesigning in self.ComponentState)  then begin
    DrawGuideTrace(-25000,-25000);
    TempBitmap.Assign(BaseBitmap);
    RefreshSelection;
    DrawFigureGuides;
    if assigned(self.parent) then Surface.Canvas.Draw(0,0,TempBitmap);
    if assigned(CustomSurface) then CustomSurface.Draw(0,0,TempBitmap);
  end;
end;

Procedure TPCDrawing.DoSurfacePaint(sender: Tobject);
var
  xCanvas: Tcanvas;
  ExeDir: string;
begin
  if FUpdateCount = 0 then //04.04.2013
  begin
    try
      if Assigned(GCadForm) then
        if GCanRefreshCad then
          DrawShadowCrossPoints; // Tolik 17/01/2022
      inherited;
      if locked then
        exit;

      if Self.Owner.ClassName = 'TF_CAD' then
        if (GCadForm = nil) then
          GCadForm := TF_CAD(self.Owner);

      if not (csDesigning in self.ComponentState) then
      begin
        draw;
      end;
      DrawRulersToCanvas(TempBitmap.Canvas);
      DrawScrollsToCanvas(TempBitmap.Canvas, False, False, False);
//      DrawGuides(TempBitmap.Canvas);
//      if assigned(BaseBitmap) then
//        DrawGuides(BaseBitmap.Canvas);
//      DrawGuidesTop(DEngine.Canvas);
//      DrawGuidesTop(TempBitmap.Canvas);
      if not (csDesigning in self.ComponentState) then
      begin
        if assigned(BaseBitmap) then
        begin
          Basebitmap.Free;
          Basebitmap := TBitmap.Create;
        end;
        BaseBitmap.Assign(TempBitmap);
        RefreshSelection;
        DrawFigureGuides;

        ExeDir := ExtractFileDir(Application.ExeName);
        if copy(ExeDir,length(ExeDir), 1) <> '\' then
          ExeDir := ExeDir + '\';
        if Not FileExists(ExeDir + 'NoTopGuides.ini') then
        begin
          SetEngine(TempBitmap.Canvas,ConvertXY,DeConvertXY,ConvertDim,DeConvertDim,false,nil);
          ClipToActiveRegion(TempBitmap.Canvas);
          {Mityai} //D0000006303
          //if Assigned(GCadForm) then
            if GuidesVisible then
              DrawGuidesTop(DEngine.Canvas);
          DrawCenterGuide(DEngine.Canvas);
          UnClip(TempBitmap.Canvas);
        end;
      end;

      if DrawSurface then
      begin
        if assigned(CustomSurface) then
        begin
          CustomSurface.Draw(0, 0, TempBitmap);
        end
        else
        if assigned(self.parent) then
        begin
          Surface.Canvas.Draw(0, 0, TempBitmap);
        end;
      end;
      Surface.Canvas.Pen.Mode := pmCopy;
      If assigned(SOnPaint) then
        SOnPaint(self);
    except
      on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.DoSurfacePaint' + E.Message);
    end;
  end
  else
  begin
    RefreshSelection; //06.08.2013 - чтобы выполнялись все зарегистрированные события в TF_CAD.PCadGUIEvent
  end;
end;

Function TPCDrawing.NewLayer(Layername: string):integer;
var Layer: Tlayer;
Begin
  Layer := TLayer.create(layerName);
  Layer.DrawEngine := DEngine;
  Layer.vertZero := ord(VerticalZero);
  Layer.horzZero := ord(HorizontalZero);
  Layers.add(Layer);
  Result := Layers.count-1;
  Updated := True;
  if assigned(FLayerInitData) then FLayerInitData(Self,Layer);
  SyncEnv;
end;

Procedure TPCDrawing.SetCursor(cr:TCursor);
begin
  inherited;
  //if assigned(cbCursorChange) then cbCursorChange(LongInt(Self),LongInt(OleCursor(cr)),False);
end;

Function TPCDrawing.GetLayerCount: integer;
Begin
  result := Layers.count;
end;

Function TPCDrawing.GetFigureCount:integer;
Begin
  result := Figures.count;
end;

Function TPCDrawing.GetSelCount:integer;
Begin
  result := Selection.count;
end;

Function TPCDrawing.GetLayerNbr(LayerName: string): integer;
var a: integer;
    s: string[255]; // Tolik 10/12/2021
Begin
  result := -1;
  s := Copy(LayerName, 1, 255);
  for a := 0 to Layers.Count -1 do
  begin
    //if TLayer(layers[a]).Name = LayerName then
    if TLayer(layers[a]).Name = s then // Tolik 10/12/2021
    begin
      result := a;
      exit;
    end;
  end;
End;

Procedure TPCDrawing.DeleteAllUserLayers;
var c,a: integer;
Begin
  c := layerCount;

  For a := c - 1 downto 1 do
  begin
    DeleteLayerWithNbr(a);
  end;
end;

Function TPCDrawing.DeleteLayer(LayerName: string): boolean;
var LayerNbr : integer;
begin
  LayerNbr := GetLayerNbr(LayerName);
  if LayerNbr <> -1 then
  begin
    result := DeleteLayerWithNbr(LayerNbr);
    SyncEnv;
    Updated := True;
    ClearUndoList;
  end
  else
    result := false;
end;


Function TPCDrawing.DeleteLayerWithNbr(LayerNbr: integer): boolean;
var a,b,cnt: Integer;
    f: Tfigure;
    CanDelete:Boolean;
begin

  if (LayerNbr = 0) or (LayerNbr > LayerCount-1)
  then
    result := false
  else
  begin
    if (LayerNbr = ActiveLayer) then  ActiveLayer := 0;

    cnt := figures.count;
    for a:= 0 to cnt-1 do
    begin
      b := cnt-1-a;
      f := TFigure(figures[b]);

      if f.LayerHandle = LongInt(Layers[LayerNbr]) then
      begin
        //if assigned(FOnFigureDel) then FOnFigureDel(Self,f,CanDelete);
        f.Destroy;
        figures.Delete(b);
        if assigned(FOnAfterFigureDel) then FOnAfterFigureDel(Self);
      end;
    end;
    TLayer(Layers[LayerNbr]).destroy;
    Layers.Delete(LayerNbr);
    result := true;
    refresh;
    SyncEnv;
    Updated := True;
  end;
end;

Procedure TPCDrawing.ShowLayer(LayerNbr:integer);
begin
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then exit;
  TLayer(Layers[LayerNbr]).visible := seen;
  refresh;
  SyncEnv;
  Updated := True;
end;

Procedure TPCDrawing.ShowAllLayers;
var a: integer;
begin
  For a:= 0 to LayerCount-1 do
    TLayer(Layers[a]).visible := seen;
  refresh;
  SyncEnv;
  Updated := True;
end;


Procedure TPCDrawing.HideLayer(LayerNbr:integer);
begin
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then exit;
  DeselectAll(LayerNbr);
  TLayer(Layers[LayerNbr]).visible := lost;
  refresh;
  SyncEnv;
  Updated := True;
end;

Procedure TPCDrawing.HideAllLayers;
var a: integer;
begin
  DeselectAll(0);
  For a:= 0 to LayerCount-1 do
    TLayer(Layers[a]).visible := lost;
  refresh;
  SyncEnv;
  Updated := True;
end;

Procedure TPCDrawing.GrayLayer(LayerNbr:integer);
begin
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then exit;
  If TLayer(Layers[LayerNbr]).visible = lost then exit;

  TLayer(Layers[LayerNbr]).visible := Grayed;
  refresh;
  SyncEnv;
  Updated := True;
end;


Procedure TPCDrawing.ExGrayLayer(LayerNbr:integer);
var a: integer;
    Layer : Tlayer;
begin
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then exit;

  For a := 0 to Layers.Count - 1 do
  begin
    Layer := Tlayer(Layers[a]);
    If Layer.visible = seen then Layer.visible := Grayed;
  end;
  TLayer(Layers[LayerNbr]).visible := seen;
  refresh;
  SyncEnv;
  Updated := True;
end;

Procedure TPCDrawing.ExHideLayer(LayerNbr:integer);
var a: integer;
    Layer : Tlayer;
begin
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then exit;

  For a := 0 to Layers.Count - 1 do
  begin
    Layer := Tlayer(Layers[a]);
    //If Layer.visible = seen then
    Layer.visible := lost;
  end;
  TLayer(Layers[LayerNbr]).visible := seen;
  refresh;
  SyncEnv;
  Updated := True;
end;

Procedure TPCDrawing.MergeAllLayers;
var
BaseLayer,Layer : TLayer;
a,b,len : integer;
Begin

  BaseLayer := TLayer(Layers[0]);

  For a := 0 to Figures.count - 1 do
  begin
    TFigure(Figures[a]).LayerHandle := LongInt(BaseLayer);
  end;

  len := Layers.Count-1;
  For a := 1 to len do
  Begin
    b := (len - a)+1;
    Layer := TLayer(Layers[b]);
    Layer.Free;
    Layers.Delete(b);
  End;
  refresh;
  SyncEnv;
  Updated := True;
End;

Procedure TPCDrawing.MergeVisibleLayers;
var
BaseLayer,Layer : TLayer;
a,b,len,x : integer;
found : Boolean;
Saved : TList;
f: TFigure;
Begin

  found := false;
  a:= 0;
  repeat
    if TLayer(Layers[a]).visible <> lost then
    begin
      x := a;
      found := true;
    end;
    inc(a);
  until (found) or (a = Layers.Count);

  If not found then exit;

  BaseLayer := TLayer(Layers[x]);


  For b := 0 to Figures.count - 1 do
  begin
     f := TFigure(Figures[b]);
     Layer := TLayer(f.LayerHandle);
     if (Layer.Visible <> lost) and (Layer <> BaseLayer) then
       f.LayerHandle := LongInt(BaseLayer);
  end;


  Saved := TList.create;
  len := Layers.Count-1;
  For a := 0 to len do
  Begin
    Layer := TLayer(Layers[a]);
    if (a = x) or (Layer.Visible = lost)
    then
      Saved.Add(Layer)
    else
    begin
      Layer.Free;
    end;
  End;

  Layers.Clear;
  For a := 0 to Saved.count -1 do
   Layers.Add(Saved[a]);

  saved.free;
  refresh;
  SyncEnv;
  Updated := True;
End;

Procedure TPCDrawing.Clear(LayerNbr : integer; UndoRecord:Boolean);
var a,cnt,b: integer;
    f: TFigure;
    xAction: TUndoAction;
    CanDelete:Boolean;
begin
  //Tolik
  xAction := nil;
  //
  if assigned(FOnBeforeClear) then
    FOnBeforeClear(Self);
  if RecordUndo and UndoRecord then
    xAction := TUndoAction.Create(uaRemove);
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then
    exit;
  if not (RecordUndo and UndoRecord) then
    ClearUndoList;
   cnt := figures.count;
   //cnt := figures.count - 1;
  for a:= 0 to cnt-1 do
  begin
    b := cnt-1-a;
    f := TFigure(figures[b]);
    if (LayerNbr=0) or (f.LayerHandle = LongInt(Layers[LayerNbr])) then
    begin
      CanDelete := True;
      if CanDelete then begin
        TFigure(figures[b]).deselect;
        TFigure(figures[b]).Deleted := True;
        if not (RecordUndo and UndoRecord) then
          TFigure(figures[b]).Free;
        if RecordUndo and UndoRecord then
        begin
          xAction.List.Add(figures[b]);
          TFigure(figures[b]).Urc := TFigure(figures[b]).Urc+1;
          TFigure(figures[b]).DelIndex := b;
        end;
        figures.Delete(b);
        if assigned(FOnAfterFigureDel) then FOnAfterFigureDel(Self);
      end;
    end;
  end;
  {for a := cnt Downto 0 do
  begin
    f := TFigure(figures[a]);
    if (LayerNbr=0) or (f.LayerHandle = LongInt(Layers[LayerNbr])) then
    begin
      CanDelete := True;
      if CanDelete then begin
        TFigure(figures[a]).deselect;
        TFigure(figures[a]).Deleted := True;
        if not (RecordUndo and UndoRecord) then
          //FreeAndNil(TFigure(figures[a]));
          FreeAndNil(f);
        if RecordUndo and UndoRecord then
        begin
          if xAction <> nil then
          begin
            xAction.List.Add(figures[a]);
            TFigure(figures[a]).Urc := TFigure(figures[a]).Urc+1;
            TFigure(figures[a]).DelIndex := a;
          end
          else
            FreeAndNil(f);
        end;
        figures.Delete(a);
        if assigned(FOnAfterFigureDel) then FOnAfterFigureDel(Self);
      end;
    end;
  end; }

  if RecordUndo and UndoRecord then
  //begin
  //  if xAction <> nil then
      InsertUndoAction(xAction);
 // end;

  ClearGuides;
  refresh;
  Updated := True;
End;

Function TPCDrawing.GetLayerInfo(LayerNbr: integer): TLayerInfo;
Var
Info : TLayerInfo;
Layer : Tlayer;
Begin
  if (LayerNbr > LayerCount - 1) then
  begin
    Info.Name := '';
  end
  else
  begin
    Layer := TLayer(Layers[LayerNbr]);
    Info.Name := Layer.Name;
    Info.Visible := (Layer.visible = seen) or (Layer.visible = Grayed);
    Info.Grayed := (Layer.visible = Grayed);
  end;
  result := Info;
end;

Function TPCDrawing.GetLayerName(LayerNbr: integer): String;
var Layer : Tlayer;
begin
  Result := '';
  if (LayerNbr < LayerCount) then
  begin
    Result := TLayer(Layers[LayerNbr]).Name;
  end;
end;

Function TPCDrawing.GetLayerHandle(LayerNbr: integer): Integer;
begin
  Result := 0;
  if (LayerNbr < LayerCount) then
  begin
    Result := Integer(Layers[LayerNbr]);
  end;
end;

Function TPCDrawing.GetLayerVisible(LayerNbr: integer): Boolean;
var Layer : Tlayer;
begin
  Result := False;
  if (LayerNbr < LayerCount) then
  begin
    Result := (Layer.visible = seen) or (Layer.visible = Grayed);
  end;
end;

Function TPCDrawing.GetLayerGrayed(LayerNbr: integer): Boolean;
var Layer : Tlayer;
begin
  Result := False;
  if (LayerNbr < LayerCount) then
  begin
    Result := (Layer.visible = Grayed);
  end;
end;

Procedure TPCDrawing.setMapscale(value: double);
var px: Double;
begin
  if value = 0 then value := 1;
  px := FMapScale/Value;
  FMapScale := value;
  SetRulerValues(FMapScale,ord(FRulerMode));
  if assigned(FOnMapScale) then FOnMapScale(Self);
  if (Figures.Count > 0) and ((FRescale = rsAlways) or
     ((FReScale = rsAskUser) and
     (MessageDlg(ReScaleMessage,mtConfirmation,[mbYes,mbNo],0) = mrYes)
     ))
  then ScaleDrawing(px,px);

  Refresh;
  SyncEnv;
  Updated := True;
end;

Function TPCDrawing.selectbypoint(LayerNbr:Integer;x,y:Double;shiftpressed: boolean): Boolean;
var a: integer;
    Res : TFigure;
    found : boolean;
begin
  result := false;
  res := nil;
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then exit;

  res := checkbypoint(LayerNbr,x,y);
  if Assigned(FGetFigureToSelect) then //#From Oleg# //04.10.2010
    FGetFigureToSelect(Self, res, x, y);

  if (res <> nil) and (res.LockSelect = False) then
  begin
    result := SelectByFigure(LayerNbr,res.Handle,ShiftPressed);
  end
  else
  begin
    If (not shiftpressed) and (FAnySelected) then
    begin
      ClearTreeSelection; // Tolik 30/11/2021 --
      deselectall(0);
      DoSelChange;
    end;
  end;
end;


Function TPCDrawing.RegisterModPoint(Figure: TFigure;
             PType: TModPointType; DType : TPointType; Color: TColor;
             aDim,X,Y: Double; SeqNbr: integer; z:DOuble=0;fOnlyIso:Boolean=False;isBlink:Boolean=False): TModPoint;
var MP : TModPoint;
Begin
  MP := TModPoint.Create(Figure,PType,DType,color,aDim,X,Y,SeqNbr,z);
  mp.OnlyIso := fOnlyIso;
  mp.isBlink := isBlink;
  ModPoints.Add(MP);
  result := MP;
End;

Procedure TPCDrawing.UnRegisterModPoint(pt: TModPoint);
var
  idx: Integer;
  i, j: Integer;
Begin
  //02.04.2012 ModPoints.Remove(pt);
  //02.04.2012
  if FMultiDeselectCount = 0 then
    ModPoints.Remove(pt)
  else
  begin
    for i := FModPointsStartIdx to ModPoints.Count - 1 do
      if ModPoints.List^[i] = pt then
      begin
        idx := i;
        ModPoints[idx] := nil;
        // если точку нашли в начале списка, то увелисиваем позицию поиска на 1
        if i = FModPointsStartIdx then
          Inc(FModPointsStartIdx)
        else
          ModPoints.Delete(idx);
        //else
        // иначе определяем от FModPointsStartIdx до i сколько пустых значений, смещая FModPointsStartIdx
        //for j := FModPointsStartIdx+1 to i do
        //begin
        //  if ModPoints.List^[j] = nil then
        //    FModPointsStartIdx := j;
        //end;
        Break; //// BREAK ////
      end;
  end;

  if assigned(pt) then
  begin
    //Tolik 02/01/2019 --
    if Assigned(GCadForm) then
      if Assigned(GCadForm.PCad) then
        if GCadForm.PCad.ModPoint = pt then
          GCadForm.PCad.ModPoint := nil;
    //
    pt.free;
    pt := nil;
  end;
End;

Function TPCDrawing.HitTestModPointInt(x,y: Double):Integer;
begin
  result := Integer(HitTestModPoint(x,y));
end;

Function TPCDrawing.HitTestModPoint(x,y: Double):TModPoint;
var a: integer;
    pdim : Double;
Begin
  result := nil;
  //DeConvertDim(pdim);
  for a := 0 to ModPoints.count-1 do
  begin
    pdim := pointdim;
    if TModPoint(ModPoints[a]).Figure <> nil then
    begin
      try
        if (TModPoint(ModPoints[a]).Figure is TOrthoLine) or (TModPoint(ModPoints[a]).Figure is TConnectorObject) then
          pdim := pdim + dimp_add;
      except
        //НЕЛБЗЯ анрег делать - непонятно пока почему - но падает потом все если анрег сделать! 
        //if Figures.IndexOf(TModPoint(ModPoints[a]).Figure) = -1 then
        //begin
        //  try
        //    UnRegisterModPoint(TModPoint(ModPoints[a]));
        //  except
        //  end;
        //  break;
        //end;
        pdim := pdim;
      end;
    end;
    DeConvertDim(pdim);
    if TModPoint(ModPoints[a]).IsPointIn(x,y,pdim) then
    begin
      result := ModPoints[a];
      exit;
    end;
  end;
End;

//Tolik 30/11/2021 --
Function TPCDrawing.selectwithinArea(LayerNbr: integer;area:TDoubleRect;shiftpressed: boolean):Boolean;
var
  a: integer;
  f: TFigure;
  invis:Boolean;
  RefreshFlag: boolean;
begin
  RefreshFlag := GCanRefreshCad;
  GCanRefreshCad := False;
  try
    FSCS_Main.TimerRefresh.Enabled := False;
    result := false;
    //Tolik 29/11/2021 - -
    //if not shiftpressed then
    ClearTreeSelection;
    //

    If (not shiftpressed) and (FAnySelected) then
    begin
      deselectall(LayerNbr);
      RedrawSelection;
      SyncEnv;
      DoSelChange;
    end;

    If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then
      exit;
    result := false;

    for a := 0 to figures.count-1 do
    begin
      f := TFigure(figures[a]);
      invis := false;
      if (f.LayerHandle <> 0) then
        invis :=  (TLayer(f.LayerHandle).Visible = lost);

      if (not invis) and (not f.LockSelect) and ((LayerNbr = 0) or (f.LayerHandle = LongInt(Layers[LayerNbr]))) and
      (f.checkifInArea(area)) then
      begin
        f.rMode := false;
        if f is Tnet then
        begin
          TNet(f).SelType := stStruct;
          TNet(f).SelIndex := 0;
        end;
        f.select;
        if assigned(FFigureSelect) then
          FFigureSelect(Self,f);
        f.drawSelectionPoints(DEngine,false);
        If not FAnySelected then
          f.FirstSelected := True;
        FAnySelected := True;
        result := true;
      end;
      // подложка, ДХФ слои
      if (not invis) and (not f.LockSelect) and ((LayerNbr = 1) and TLayer(f.LayerHandle).IsDxf {CheckFigureInDXFLayer(f)}) and
      (f.checkifInArea(area)) then
      begin
        f.rMode := false;
        f.select;
        if assigned(FFigureSelect) then
          FFigureSelect(Self,f);
        f.drawSelectionPoints(DEngine,false);
        If not FAnySelected then
          f.FirstSelected := True;
        FAnySelected := True;
        result := true;
      end;
    end;

    if result = true then
    begin
      SyncEnv;
      RedrawSelection;
      DoSelChange;
    end;
  Except
    on E: Exception do AddExceptionToLog('TPCDrawing.SelectArea' + E.Message);
  end;
  GCanRefreshCad := RefreshFlag;

end;
//
(*
Function TPCDrawing.selectwithinArea(LayerNbr: integer;area:TDoubleRect;shiftpressed: boolean):Boolean;
var
  a: integer;
  f: TFigure;
  invis:Boolean;
begin

  result := false;
  //Tolik 29/11/2021 - -
  //if not shiftpressed then
  ClearTreeSelection;
  //

  If (not shiftpressed) and (FAnySelected) then
  begin
    deselectall(LayerNbr);
    RedrawSelection;
    SyncEnv;
    DoSelChange;
  end;

  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then
    exit;
  result := false;

  for a := 0 to figures.count-1 do
  begin
    f := TFigure(figures[a]);
    invis := false;
    if (f.LayerHandle <> 0) then
      invis :=  (TLayer(f.LayerHandle).Visible = lost);

    if (not invis) and (not f.LockSelect) and ((LayerNbr = 0) or (f.LayerHandle = LongInt(Layers[LayerNbr]))) and
    (f.checkifInArea(area)) then
    begin
      f.rMode := false;
      if f is Tnet then
      begin
        TNet(f).SelType := stStruct;
        TNet(f).SelIndex := 0;
      end;
      f.select;
      if assigned(FFigureSelect) then
        FFigureSelect(Self,f);
      f.drawSelectionPoints(DEngine,false);
      If not FAnySelected then
        f.FirstSelected := True;
      FAnySelected := True;
      result := true;
    end;
    // подложка, ДХФ слои
    if (not invis) and (not f.LockSelect) and ((LayerNbr = 1) and TLayer(f.LayerHandle).IsDxf {CheckFigureInDXFLayer(f)}) and
    (f.checkifInArea(area)) then
    begin
      f.rMode := false;
      f.select;
      if assigned(FFigureSelect) then
        FFigureSelect(Self,f);
      f.drawSelectionPoints(DEngine,false);
      If not FAnySelected then
        f.FirstSelected := True;
      FAnySelected := True;
      result := true;
    end;
  end;

  if result = true then
  begin
    SyncEnv;
    RedrawSelection;
    DoSelChange;
  end;
end;
*)

Procedure TPCDrawing.SelectFigure(FHandle: Integer);
begin
  if Figures.IndexOf(Pointer(FHandle)) <> -1 then
  begin
    if TFigure(FHandle).LockSelect then exit;
    TFigure(FHandle).Select;
    FAnySelected := True;
    SyncEnv;
    RedrawSelection;
    DoSelChange;
  end;
end;

Procedure TPCDrawing.DeSelectFigure(FHandle: Integer);
begin
  if Figures.IndexOf(Pointer(FHandle)) <> -1 then
  begin
    TFigure(FHandle).DeSelect;
    SyncEnv;
    RedrawSelection;

  end;
end;


Function TPCDrawing.checkbypoint(LayerNbr:Integer;x,y:Double): TFigure;
var
  a, i, k: integer;
  f, fc: Tfigure;
  invis: boolean;
begin
  result := nil;
  for i := 0 to figures.count - 1 do
  begin
    a := figures.count - 1 - i;
    f := TFigure(figures[a]);
    invis := false;
    if (f.LayerHandle <> 0) then
      invis :=  (TLayer(f.LayerHandle).Visible = lost);
    if (not invis) and ((LayerNbr = 0) or (f.LayerHandle = LongInt(Layers[LayerNbr]))) then
    begin
      if (f.isPointIn(x, y)) then
      begin
        Result := f;
        exit;
      end;
    end;
    // подложка, ДХФ слои
    if (not invis) and ((LayerNbr = 1) and TLayer(f.LayerHandle).IsDxf {CheckFigureInDXFLayer(f)})  then
    begin
      if (f.isPointIn(x, y)) then
      begin
        Result := f;
        exit;
      end;
    end;
  end;
end;
{
Procedure TPCDrawing.moveselection(deltax,deltay:Double);
var
  a: integer;
  MovedList: TList;
  curFigure: TFigure;
begin
  if RecordUndo then
    RecordModifyUndo(nil);
  for a := 0 to figures.count - 1 do
  begin
    if (TFigure(figures[a]).selected) and not (TFigure(figures[a]).LockMove) and (TFigure(figures[a]) is DrawObjects.TLine) then
    begin
      DrawObjects.TLine(figures[a]).InMoveList := True;
    end;
  end;

  MovedList := TList.create;
  for a := 0 to figures.count - 1 do
  begin
    if (TFigure(figures[a]).selected) and not (TFigure(figures[a]).LockMove) then
    begin
      MovedList.Add(TFigure(figures[a]));
    end
  end;
  for a := 0 to MovedList.Count - 1 do
  begin
    curFigure := TFigure(MovedList[a]);
    if not curFigure.Deleted then
    begin
      curFigure.move(deltax,deltay);
      if assigned(FOnFigureMoved) then
        FOnFigureMoved(Self, curFigure ,deltax, deltay);
    end;
  end;
  FreeAndNil(MovedList);
  Updated := True;
end; }

Procedure TPCDrawing.moveselection(deltax,deltay:Double);
var
  a, i: integer;
  MovedList: TList;
  curFigure: TFigure;
  // Tolik
  LineCount: Integer;
  CanMakeMove: Boolean;
  LineList, RaiseList: TList;
  isVerticalLine, isHorizontalLine: Boolean;
  CanRefreshFlag: Boolean;

  Procedure AddConnectorToMoveList(AConnector: TConnectorObject);
  var MovedConnector: TConnectorObject;
      CanMove: Boolean;
  begin
    MovedConnector := TConnectorObject(AConnector);

    if TConnectorObject(AConnector).JoinedConnectorsList.Count > 0 then
      MovedConnector := TConnectorObject(AConnector).JoinedConnectorsList[0];
    if TConnectorObject(AConnector).FConnRaiseType <> crt_None then
      if TConnectorObject(AConnector).FObjectFromRaise <> nil then
        MovedConnector := TConnectorObject(AConnector).FObjectFromRaise;
    // *******************************************************************
    CanMove := True;
    if (MovedConnector.FIsApproach) and (not MovedConnector.fHouse.Selected) then
      CanMove := MovedConnector.IsApproachInHouse(deltax, deltay);

    if CanMove then
    begin
      if (not MovedConnector.Selected) and (not GDisableMove) then
        if not ((MovedConnector.FIsHouseJoined) and (MovedConnector.fHouse <> nil) and (MovedConnector.fHouse.Selected)) then
          if MovedList.IndexOF(MovedConnector) = -1 then
            MovedList.Add(MovedConnector);
    end;
  end;
  //
  // Tolik -- 28/03/2016 --
  Function CheckCanMove(aLineList: TList): Boolean;
  var i: Integer;
      LeftRigthLine, UpDownLine: Boolean;
      currLine: TOrthoLine;
      isVerticalLine, isHorizontalLine: Boolean;
      tmpConn, Conn1, Conn2: TConnectorObject;
      NBConn: TConnectorObject;
  begin
    Result := True;
    if LineList.Count = 1 then
    begin
      isVerticalLine := False;
      isHorizontalLine := False;
      //Result := False;
      currLine := TOrthoLine(aLineList[0]);
      Conn1 := TConnectorObject(currLine.JoinConnector1);
      Conn2 := TConnectorObject(currLine.JoinConnector2);
      if CompareValue(conn1.ap1.x, conn2.ap1.x) = 0 then
        isVerticalLine := True
      else
        if CompareValue(conn1.ap1.y, Conn2.ap1.y) = 0 then
          isHorizontalLine := True;
      {if (isVerticalLine and (deltay = 0) ) then
        Result := True
      else
        if (isHorizontalLine and (deltax = 0)) then
          Result := True;
      if not Result then
      begin
        if ((not isHorizontalLine) and (not isVerticalLine)) then
          Result := True;
      end }
      if isVerticalLine  then
        deltay := 0
      else
        if isHorizontalLine  then
          deltax := 0;
    end;
  end;

  Function CanMoveConn(aConn: TConnectorObject): Boolean;
  var i,j: Integer;
      RaiseLine: TOrthoLine;
  begin
    Result := True;
    RaiseLine := Nil;
    if aConn.ConnectorType = ct_Nb then
    begin
      for i := 0 to aConn.JoinedConnectorsList.Count - 1 do
      begin
        for j := 0 to TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do
        begin
          if TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown then
          begin
            RaiseLine := TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]);
            break;
          end;
        end;
        if RaiseLine <> nil then
          break;
      end;
    end
    else
    if AConn.ConnectorType = ct_Clear then
    begin
      for i := 0 to AConn.JoinedOrtholinesList.Count - 1 do
      begin
        if TOrthoLine(AConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
        begin
          RaiseLine := TOrthoLine(AConn.JoinedOrtholinesList[i]);
          break;
        end;
      end;
    end;
    if RaiseLine <> nil then
      if RaiseList.IndexOf(RaiseLine) <> -1 then
        Result := False;
  end;
begin
  if RecordUndo then
    RecordModifyUndo(nil);
  // Tolik -- 29/03/2016 --
  LineCount := 0;
  CanMakeMove := False;
  LineList := TList.Create;
  MovedList := TList.Create;
  RaiseList := TList.Create; // список райзов, чтобы двигать райзы отдельно, т.к. если их двигать через коннекторы,
                             // райз двигается только горизонтально 
  // Tolik 24/01/2017 --
  CanRefreshFlag := GCanRefreshCad;
  GCanRefreshCad := False;
  try
    //
    //
    // Tolik -- 16/11/2015
    // во-первых, есть Selection на CADе, так что нех все фигуры перебирать -- здесь немножко ускорим процесс
    // во-вторых, здесь можно вкинуть коннекторы ортолинии в Move-лист и избавиться от проблемы
    // повторного сдвига общего коннектора для нескольких линий, когда выбраны только сами линии
    // (через Shift)
    { for a := 0 to figures.count - 1 do
    begin
      if (TFigure(figures[a]).selected) and not (TFigure(figures[a]).LockMove) and (TFigure(figures[a]) is DrawObjects.TLine) then
      begin
        DrawObjects.TLine(figures[a]).InMoveList := True;
      end;
    end;

    MovedList := TList.create;
    for a := 0 to figures.count - 1 do
    begin
      if (TFigure(figures[a]).selected) and not (TFigure(figures[a]).LockMove) then
      begin
        MovedList.Add(TFigure(figures[a]));
      end
    end;}

    // Tolik 16/11/2015 -- линии совать тоже не будем -- подвинем только коннектора
    for a := 0 to Selection.Count - 1 do
    begin
      if (TFigure(Selection[a]).selected) and not (TFigure(Selection[a]).LockMove) and (TFigure(Selection[a]) is DrawObjects.TLine) then
        if not TFigure(Selection[a]).Deleted then
        begin
          DrawObjects.TLine(Selection[a]).InMoveList := True;
          //Tolik --
          if CheckFigureByClassName(TFigure(Selection[a]), cTOrthoLine) then
          begin
            // 07/08/2018 --
            if TOrthoLine(Selection[a]).FisRaiseUpDown then
            begin
              if RaiseList.IndexOf(TOrthoLine(Selection[a])) = -1 then
                RaiseList.Add(TOrthoLine(Selection[a]));
            end
            else
            //
            begin
              Inc(LineCount);
              LineList.Add(TOrthoLine(Selection[a]));
            end;
          end;
          //
        end;
    end;

    for a := 0 to Selection.Count - 1 do
    begin
      curFigure := TFigure(Selection[a]);
      if ((not curFigure.Deleted) and (not Curfigure.LockMove)) then
      begin
        // ортолинии двинуть по коннекторам
        if CheckFigureByClassName(curFigure, cTOrthoLine) then
        begin
          if not TOrthoLine(curFigure).FisRaiseUpDown then
          begin
            if TConnectorObject(TOrthoLine(curFigure).JoinConnector1) <> nil then
              if not TConnectorObject(TOrthoLine(curFigure).JoinConnector1).Selected then
                if MovedList.IndexOF(TConnectorObject(TOrthoLine(curFigure).JoinConnector1)) = -1 then
                  AddConnectorToMoveList(TConnectorObject(TOrthoLine(curFigure).JoinConnector1));
            //Toilk -- 13/06/2017 --
            //для вертикали -- двинуть только один коннектор
            if not TOrthoLine(curFigure).FisVertical then
            //
            if TConnectorObject(TOrthoLine(curFigure).JoinConnector2) <> nil then
              if not TConnectorObject(TOrthoLine(curFigure).JoinConnector2).Selected then
                if MovedList.IndexOF(TConnectorObject(TOrthoLine(curFigure).JoinConnector2)) = -1 then
                  AddConnectorToMoveList(TConnectorObject(TOrthoLine(curFigure).JoinConnector2));
          end;
        end
        else
          // точечные двинуть как есть
          if MovedList.IndexOf(curFigure) = -1 then
            MovedList.Add(curFigure);
      end
    end;
    if LineCount > 1 then
      CanMakeMove := True
    else
      CanMakeMove := CheckCanMove(LineList);

    for i := 0 to RaiseList.Count - 1 do
    begin
      curFigure := Tfigure(RaiseList[i]);
      curFigure.move(deltax, deltay);
      if assigned(FOnFigureMoved) then
        FOnFigureMoved(Self, curFigure, deltax, deltay);
    end;

    if CanMakeMove then
    begin
      // ---------------- M O V E --------------------------
      // Tolik -- 07/06/2016 --
      // -- исправлен прое, когда точечный расположден на коннекторе, нужно сначала двинуть точечные,
      // а потом пустые коннекторы трасс, иначе неправильно пересчитается длина трасс

      // двинуть точечные
      for a := 0 to MovedList.Count - 1 do
      begin
        curFigure := TFigure(MovedList[a]);
        if CheckFigureByClassName(curFigure, cTConnectorObject) then
        begin
          if TConnectorObject(curFigure).ConnectorType = ct_NB then
          begin
            if CanMoveConn(TConnectorObject(curFigure)) then
            begin
              curFigure.move(deltax, deltay);
              if assigned(FOnFigureMoved) then
                FOnFigureMoved(Self, curFigure, deltax, deltay);
            end;
          end;
        end
        else
        begin
          curFigure.move(deltax, deltay);
          if assigned(FOnFigureMoved) then
            FOnFigureMoved(Self, curFigure, deltax, deltay);
        end;
      end;
      // двинуть пустые коннектора трасс
      for a := 0 to MovedList.Count - 1 do
      begin
        curFigure := TFigure(MovedList[a]);
        if CheckFigureByClassName(curFigure, cTConnectorObject) and (TConnectorObject(curFigure).ConnectorType = ct_Clear) then
        begin
          if CanMoveConn(TConnectorObject(curFigure)) then
          begin
              curFigure.move(deltax, deltay);
            if assigned(FOnFigureMoved) then
              FOnFigureMoved(Self, curFigure, deltax, deltay);
          end;
        end;
      end;

      {for a := 0 to MovedList.Count - 1 do
      begin
        curFigure := TFigure(MovedList[a]);
        curFigure.move(deltax, deltay);
        if assigned(FOnFigureMoved) then
          FOnFigureMoved(Self, curFigure, deltax, deltay);
      end;}
      //
      Updated := True;
    end;
  except
    on E: exception do AddExceptionToLog('TPCDrawing.moveselection' + E.Message);
  end;
  FreeAndNil(MovedList);
  FreeAndNil(LineList);
  RaiseList.Free;
  GCanRefreshCad := CanRefreshFlag;
end;

Procedure TPCDrawing.CopyToClipBoard;
var a: integer;
    Selecteds : TList;
    fStream,mStream:TMemoryStream;
    fCount: integer;
    xSize: Integer;
    Figure :TFigure;
    mf: TMetafile;
    Data: THandle;
    Format: Word;
    Palette: HPALETTE;
    Clp :TClipBoard;
    xBmp:TBitmap;
Begin
  Selecteds := TList.create;
  collectSelectedFigures(Selecteds);
  // Tolik -- 07/02/2017 -- утечка памяти !!!
  // If Selecteds.count = 0 then exit;
  If Selecteds.count = 0 then
  begin
    FreeAndNil(Selecteds);
    exit;
  end;
  //

  mStream := TMemoryStream.Create;
  fCount := Selecteds.count;
  mStream.Write(fCount,4);

  For a := 0 to fCount-1 do
  begin
    Figure := TFigure(Selecteds[a]);
    fStream := TMemoryStream.Create;
    Figure.WriteToStream(fStream);
    xSize := fStream.Size;
    fStream.Seek(0,soFromBeginning);
    mStream.Write(xSize,4);
    StreamToStream(fStream,mStream,xSize);
    fStream.Free;
  end;
  mStream.Seek(0,soFromBeginning);
  StreamToClipBoard(mStream,CF_PCAD);
  mStream.Free;

  mf := SelectionAsWmf;
  OpenClipBoard(0);
  mf.SaveToClipboardFormat(Format, Data, Palette);
  SetClipboardData(Format, Data);
  if Palette <> 0 then SetClipboardData(CF_PALETTE, Palette);
  CloseClipBoard;

  DoSurfacePaint(Surface);
  xBmp := SelectionAsBitmap(80);
  OpenClipBoard(0);
  xBmp.SaveToClipboardFormat(Format,Data,Palette);
  SetClipboardData(Format, Data);
  if Palette <> 0 then SetClipboardData(CF_PALETTE, Palette);
  CloseClipBoard;

End;

Procedure TPCDrawing.CutToClipBoard;
Begin
  copytoclipboard;
  RemoveSelection;
  Updated := True;
End;

Procedure TPCDrawing.PasteFromClipBoard(LayerNbr: integer);
var
  a: integer;
  clp : TClipBoard;
  fig,inFig: Tfigure;
  xAction : TUndoAction;
  mStream:TmemoryStream;
  fCount: integer;
  Figure : TFigure;
  xSize: Integer;
  fStream:TMemoryStream;
  mf: TMetafile;
  LayerHandle: Integer;
  Cont: TFigure;
Begin
  Cont := nil;
  // Tolik -- 20/11/2015
  // о целесообразности использования данной технологии история умалчивает, НО
  // если юзать, то приводит к интересному БАГУ: в случае, если выбрана не та фигура, которая
  // вставляется из буфера, то ВСТАВЛЕННАЯ ФИГУРА БУДЕТ ОТРИСОВЫВАТЬСЯ ТОЛЬКО В ГРАНИЦАХ ФИГУРЫ,
  // ВЫБРАННОЙ В ДАННЫЙ МОМЕНТ --- поэтому закомментил 

  // if Selection.Count = 1 then
  //   Cont := TFigure(Selection[0]);
  //

  
  // Tolik 27/10/2015
  // if assigned(Cont) and (Cont.RegHandle = 0) then
    if assigned(Cont) and (Cont.RegHandle = 0) and ((Cont.RegObject = nil) or ((Cont.RegObject <> nil) and (Cont.RegObject.RegObjData = nil))) then
    Cont := nil;

  if RecordUndo then
    xAction := TUndoAction.Create(uaInsert);
  if IsClipboardFormatAvailable(CF_PCAD) then
  begin
    Layerhandle := 0;
    if (LayerNbr >-1) and (LayerNbr < Layers.Count) then
      LayerHandle := Integer(layers[LayerNbr]);
    mStream := TMemoryStream.Create;
    ClipBoardToStream(mStream,CF_PCAD);
    if mStream.Size = 0 then
      exit;
    mStream.Read(fCount,4);
    DeselectAll(LayerNbr);
    For a := 1 to fCount do
    begin
      mStream.Read(xSize,4);
      fStream := TMemoryStream.Create;
      StreamToStream(mStream,fStream,xSize);
      fStream.Seek(0,soFromBeginning);
      Figure :=  nil;
      Figure := TFigure.CreateFromStream(fStream,0,mydsNormal,self);
      fStream.Free;
      if Figure <> nil then
      begin
        if layerHandle <> 0 then
          Figure.LayerHandle := LayerHandle;
        if FindFigureByName(figure.name) <> 0 then
          Figure.Rename;
        if assigned(Cont) then
        begin
          Figure.Deselect;
          Cont.ClipFigures.Add(Figure);
          Figure.inClip := True;
          Figures.Add(Figure);
        end
        else
        begin
          Figure.Selected := True;
          Figure.inClip := False;
          Figures.Add(Figure);
        end;
        if RecordUndo then
          xAction.List.Add(figure);
        if assigned(FOnObjectInserted) then
          FOnObjectInserted(self,irPaste);
        // сдвинуть новый объект
        Figure.Move(1, 1);  
      end;
    end;
    // ===
    mStream.Free;
  end
  else
  if IsClipboardFormatAvailable(CF_METAFILEPICT) then
  begin
    mf := TMetafile.Create;
    mf.Assign(ClipBoard);
    insertMetafile(0,0,0,mf,True);
    mf.Free;
  end;

  FAnySelected := true;
  if RecordUndo then
  begin
    if xAction.List.Count > 0 then
    begin
      InsertUndoAction(xAction);
    end
    else
    begin
      xAction.Free;
    end;
  end;
  refresh;
  Updated := True;
End;

Function CanAlign(ActiveLayer: Integer; Figure: TFigure): Boolean;
begin
  REsult := false;
  if  ActiveLayer = 2 then
  begin
    if not CheckFigureByClassName(Figure, 'TOrthoLine') then
    begin
      if (CheckFigureByClassName(Figure, 'TConnectorObject'))and
         (TConnectorObject(Figure).JoinedOrtholinesList.count = 0) then
        Result := true
      else
        Result := false;
    end
    else
      Result := false;
  end
  else
    Result := true;
end;
// Tolik 06/02/2017 -- старая закомменчена - смотри ниже
// здесь дописано выравнивание для архитектурного проектирования
Procedure TPCDrawing.alignSelection(HorzAlign: THorzAligns; VertAlign: TVertAligns);
var a,b,ocx,ocy,RefBlockIdx : integer;
    Selecteds : TList;
    RefFigure  : TFigure;
    CustFigure  : TFigure;
    MaxFig : TFigure;
    MinFig : Tfigure;
    CurrentFig : TFigure;
    MaxY,MinY : Double;
    RefRect : TDoubleRect;
    CustRect : TDoubleRect;
    HelpRect : TDoubleRect;
    Found : Boolean;
    Dist : Double;
    PartDist : real;
    centers : array [0..1000] of Double;
    occupied : array [0..1000] of Boolean;
    Center, MinDist, FirstCenter:  Double;
    figMaxX,figMaxY,figMinX,figMinY: Double;
    // Tolik -- 06/02/2017 --
    NetList: TList;
    currNet: TNet;
    currPath: TNetPath;
    PointToMove: PDoublePoint;
    i: Integer;
    RefreshFlag: Boolean;
    pathMoveAllPoints: Boolean;
    p: PDoublePoint;


    function GetMovePointByMode: PDoublePoint;
    var currNet, NetForRemove: TNet;
        NetPoint: PDoublePoint;
        i, j: Integer;
    begin
      NetForRemove := TNet(NetList[0]);
      Result := PDoublePoint(NetForRemove.Points[0]);

      for i := 0 to NetList.Count - 1 do
      begin
        currNet := TNet(NetList[i]);
        for j := 0 to currNet.Points.Count - 1 do
        begin
          // по левому краю
          if (HorzAlign = haNoChange) and (VertAlign = vaLeft) then
          begin
            if CompareValue(Result^.x, TDoublePoint(currNet.Points[j]^).x) = 1 then
            begin
              NetForRemove := currNet;
              Result := PDoublePoint(currNet.Points[j]);
            end;
          end;
          // по правому краюд
          if (HorzAlign = haNoChange) and (VertAlign = vaRight) then
          begin
            if CompareValue(Result^.x, TDoublePoint(currNet.Points[j]^).x) = -1 then
            begin
              NetForRemove := currNet;
              Result := PDoublePoint(currNet.Points[j]);
            end;
          end;
          // по верхнему краю
          if (HorzAlign = haTop) and (VertAlign = vaNoChange) then
          begin
            if CompareValue(Result^.y, TDoublePoint(currNet.Points[j]^).y) = 1 then
            begin
              NetForRemove := currNet;
              Result := PDoublePoint(currNet.Points[j]);
            end;
          end;
          // по нижнему краю
          if (HorzAlign = haBottom) and (VertAlign = vaNoChange) then
          begin
            if CompareValue(Result^.y, TDoublePoint(currNet.Points[j]^).y) = -1 then
            begin
              NetForRemove := currNet;
              Result := PDoublePoint(currNet.Points[j]);
            end;
          end;
        end;
      end;
      NetList.Remove(NetForRemove);
    end;

    function GetNetPointByMode(aNet: TNet) : PDoublePoint;
    var i: Integer;
    begin
      Result := PDoublePoint(aNet.Points[0]);
      // по левому краю
      if (HorzAlign = haNoChange) and (VertAlign = vaLeft) then
      begin
        if aNet.Points.Count > 1 then
        begin
          for i := 1 to aNet.Points.Count - 1 do
          begin
            if CompareValue(Result^.x, TDoublePoint(aNet.Points[i]^).x) = 1 then
              Result := PDoublePoint(aNet.Points[i]);
          end;
        end;
      end;
      // по правому краю
      if (HorzAlign = haNoChange) and (VertAlign = vaRight) then
      begin
        if aNet.Points.Count > 1 then
        begin
          for i := 1 to aNet.Points.Count - 1 do
          begin
            if CompareValue(Result^.x, TDoublePoint(aNet.Points[i]^).x) = -1 then
              Result := PDoublePoint(aNet.Points[i]);
          end;
        end;
      end;
      // по верхнему краю
      if (HorzAlign = haTop) and (VertAlign = vaNoChange) then
      begin
        if aNet.Points.Count > 1 then
        begin
          for i := 1 to aNet.Points.Count - 1 do
          begin
            if CompareValue(Result^.y, TDoublePoint(aNet.Points[i]^).y) = 1 then
              Result := PDoublePoint(aNet.Points[i]);
          end;
        end;
      end;

      // по нижнему краю
      if (HorzAlign = haBottom) and (VertAlign = vaNoChange) then
      begin
        if aNet.Points.Count > 1 then
        begin
          for i := 1 to aNet.Points.Count - 1 do
          begin
            if CompareValue(Result^.y, TDoublePoint(aNet.Points[i]^).y) = -1 then
              Result := PDoublePoint(aNet.Points[i]);
          end;
        end;
      end;
    end;

    procedure MoveNets(ANetList: TList);
    var i, j: Integer;
        MovingNet: TNet;
        DeltaX, DeltaY: Double;

        Procedure GetDeltaForMove;
        var currNetPoint: PDoublePoint;
        begin
          DeltaX := 0;
          DeltaY := 0;
          currNetPoint := GetNetPointByMode(MovingNet);
          // по левому или по правому краю
          if (HorzAlign = haNoChange) and ((VertAlign = vaLeft)or(VertAlign = vaRight)) then
            DeltaX :=  PointToMove^.x - currNetPoint^.x;

          //по верхнему краю или по нижнему краю
          if ((HorzAlign = haBottom) or (HorzAlign = haTop)) and (VertAlign = vaNoChange) then
            DeltaY :=  PointToMove^.y - currNetPoint^.y;
        end;
    begin
      for i := 0 to ANetList.Count - 1 do
      begin
        MovingNet := TNet(ANetList[i]);
        GetDeltaForMove;
        j:= 0 ;

        for j := 0 to MovingNet.Points.Count -  1 do
        begin
          p := PDoublePoint(MovingNet.Points[j]);
          p.x := p.x + DeltaX;
          p.y := P.y + DeltaY;
        end;
        MovingNet.SetModified;
      end;
    end;
    //

begin
  //RefreshFlag := False;
  RefreshFlag := GCanRefreshCad;
  GCanRefreshCad := False;
  {if GCanRefreshCad then
  begin
    GCanRefreshCad := False;
    RefreshFlag := True;
  end; }

  try
    if (GCadForm.PCad.ActiveLayer = 2) then
      GCadForm.SaveForUndo(uat_None, True, False);

    if GCadForm.PCad.ActiveLayer = 8 then
    begin
      NetList := TList.Create;
      for i := 0 to Selection.Count - 1 do
      begin
        if TFigure(Selection[i]).ClassName = 'TNetPath' then
        begin
          currPath := TNetPath(Selection[i]);
          if Assigned(currPath.Net) and (NetList.IndexOf(currPath.Net) = -1) then
            NetList.Add(currPath.Net);
        end
        else
          if (TFigure(Selection[i]).ClassName = 'TNet') and (NetList.IndexOf(TNet(Selection[i])) = -1) then
            NetList.Add(TNet(Selection[i]));
      end;
      // хотя бы две фигуры (не сегмента, а именно ТНЕТ фигуры)
      if NetList.Count > 1 then
      begin
        // УНДО
        GCadForm.SaveForUndo(uat_None, True, False);
        // выравнивание (от параметра)
        PointToMove := GetMovePointByMode;
        MoveNets(NetList);
      end;
      FreeAndNil(NetList);
    end
    else
    begin
      Selecteds := TList.Create;
      collectSelectedFigures(Selecteds);
      If Selecteds.Count < 2 then
      begin
        GCanRefreshCad := RefreshFlag;
        FreeAndNil(Selecteds);
        exit;
      end;

      RefBlockIdx := 0;

      a := 0;
      Found := false;

      while (a < selecteds.Count) and (not found) do
      begin
        If TFigure(Selecteds[a]).firstselected then
        begin
          RefBlockIdx := a;
          found := true;
        end;
        inc(a);
      end;

      if RecordUndo then RecordModifyUndo(nil);

      RefFigure := TFigure(Selecteds[RefBlockIdx]);
      RefRect := RefFigure.GetBoundRect;

      a := 0;
      while (a < selecteds.Count) do
      begin
        if CanAlign(GCadform.PCad.ActiveLayer, TFigure(Selecteds[a])) then
        begin
          if ssCtrl in GGlobalShiftState then
            RefRect := TFigure(Selecteds[a]).GetBoundRect
          else
          begin
            if GCadForm.PCad.ActiveLayer = 2 then
              RefRect := TFigure(Selecteds[a]).GetBoundRect(false)
            else
              RefRect := TFigure(Selecteds[a]).GetBoundRect;
          end;
          break;
        end;
        Inc(a);
      end;
      a := 0;

      while (a < selecteds.Count) do
      begin
        if CanAlign(GCadform.PCad.ActiveLayer, TFigure(Selecteds[a])) then
        begin
          if ssCtrl in GGlobalShiftState then
            HelpRect := TFigure(Selecteds[a]).GetBoundRect
          else
          begin
            if GCadForm.PCad.ActiveLayer = 2 then
              HelpRect := TFigure(Selecteds[a]).GetBoundRect(false)
            else
              HelpRect := TFigure(Selecteds[a]).GetBoundRect;
          end;
          if RefRect.left > HelpRect.left then RefRect.left := HelpRect.left;
          if RefRect.Right < HelpRect.right then RefRect.Right := HelpRect.Right;
          if RefRect.top > HelpRect.Top then RefRect.Top := HelpRect.Top;
          if RefRect.Bottom < HelpRect.Bottom then RefRect.Bottom := HelpRect.Bottom;
        end;
        inc(a);
      end;

      if (VertAlign = vaDistVert) and (selecteds.count > 2)  then
      begin
        MaxY := TFigure(Selecteds[0]).GetBoundRect.Top;
        MaxFig := TFigure(Selecteds[0]);
        MinY := TFigure(Selecteds[0]).GetBoundRect.Top;
        MinFig := TFigure(Selecteds[0]);
        for a := 1 to Selecteds.Count - 1 do
        begin
          if TFigure(Selecteds[a]).GetBoundRect.Top > MaxY then
          begin
            MaxY := TFigure(Selecteds[a]).GetBoundRect.Top;
            MaxFig := TFigure(Selecteds[a]);
          end;
          if TFigure(Selecteds[a]).GetBoundRect.Top < MinY then
          begin
            MinY := TFigure(Selecteds[a]).GetBoundRect.Top;
            MinFig := TFigure(Selecteds[a]);
          end;
        end;

        Dist := (((MaxFig.GetBoundRect.Top - MaxFig.GetBoundRect.Bottom)/2)
                +
                MaxFig.GetBoundRect.Bottom) -
                (((MinFig.GetBoundRect.Top - MinFig.GetBoundRect.Bottom)/2)
                +
                MinFig.GetBoundRect.Bottom);

        PartDist := Dist / (selecteds.count - 1);

        FirstCenter := (((MinFig.GetBoundRect.Top - MinFig.GetBoundRect.Bottom)/2)
                       +
                       MinFig.GetBoundRect.Bottom);

        for a := 0 to Selecteds.count -1  do
        begin
          centers[a] := FirstCenter + round(a*PartDist);
          occupied[a] := false;
        end;

        for a := 0 to Selecteds.count - 1 do
        begin

          CurrentFig := TFigure(Selecteds[a]);
          if (CurrentFig <> MinFig) and
             (CurrentFig <> MaxFig) then
          begin
            Center := (((CurrentFig.GetBoundRect.Top - CurrentFig.GetBoundRect.Bottom)/2)
                       +
                      CurrentFig.GetBoundRect.Bottom);

            MinDist := abs(Centers[1] - center); ocx := 1;

            for b := 2 to Selecteds.count -2 do
              if (abs(Centers[b] - center) < MinDist) and (not occupied[b]) then
              begin
                MinDist := abs(Centers[b] - center);
                ocx := b;
              end;

            occupied[ocx] := true;

            MinDist :=  Centers[ocx] - center;

            CurrentFig.Move(0,MinDist);
          end;
        end;

      end;

      if (HorzAlign = haDistHorz) and (selecteds.count > 2) then
      begin
        MaxY := TFigure(Selecteds[0]).GetBoundRect.Right;
        MaxFig := TFigure(Selecteds[0]);
        MinY := TFigure(Selecteds[0]).GetBoundRect.Right;
        MinFig := TFigure(Selecteds[0]);
        for a := 1 to Selecteds.Count - 1 do
        begin
          if TFigure(Selecteds[a]).GetBoundRect.Right > MaxY then
          begin
            MaxY := TFigure(Selecteds[a]).GetBoundRect.Right;
            MaxFig := TFigure(Selecteds[a]);
          end;
          if TFigure(Selecteds[a]).GetBoundRect.Right < MinY then
          begin
            MinY := TFigure(Selecteds[a]).GetBoundRect.Right;
            MinFig := TFigure(Selecteds[a]);
          end;
        end;

        Dist := (((MaxFig.GetBoundRect.Right - MaxFig.GetBoundRect.Left)/2)
                +
                MaxFig.GetBoundRect.Left) -
                (((MinFig.GetBoundRect.Right - MinFig.GetBoundRect.Left)/2)
                +
                MinFig.GetBoundRect.Left);

        PartDist := Dist / (selecteds.count - 1);

        FirstCenter := (((MinFig.GetBoundRect.Right - MinFig.GetBoundRect.Left)/2)
                       +
                       MinFig.GetBoundRect.Left);

        for a := 0 to Selecteds.count -1  do
        begin
          centers[a] := FirstCenter + (a*PartDist);
          occupied[a] := false;
        end;

        for a := 0 to Selecteds.count - 1 do
        begin
          CurrentFig := TFigure(Selecteds[a]);
          if (CurrentFig <> MinFig) and
             (CurrentFig <> MaxFig) then
          begin
            Center := (((CurrentFig.GetBoundRect.Right - CurrentFig.GetBoundRect.Left)/2)
                       +
                       CurrentFig.GetBoundRect.Left);

            for b := 1 to Selecteds.count -2 do
            begin
              if (not occupied[b]) then
              begin
                MinDist := abs(Centers[b] - center);
                ocx := b;
                ocy := b;
              end;
            end;

            for b := ocy+1 to Selecteds.count-2 do
              if (abs(Centers[b] - center) < MinDist) and (not occupied[b]) then
              begin
                MinDist := abs(Centers[b] - center);
                ocx := b;
              end;

            occupied[ocx] := true;

            MinDist :=  Centers[ocx] - center;

            CurrentFig.Move(MinDist,0);
          end;
        end;
      end;

      for a := 0 to Selecteds.Count - 1 do
      begin
    //    if a <> RefBlockIdx then
        begin
          CustFigure := TFigure(Selecteds[a]);
          if ssCtrl in GGlobalShiftState then
            CustRect := CustFigure.GetBoundRect
          else
          begin
            if GCadForm.PCad.ActiveLayer = 2 then
              CustRect := CustFigure.GetBoundRect(false)
            else
              CustRect := CustFigure.GetBoundRect;
          end;
          if CanAlign(GCadform.PCad.ActiveLayer, CustFigure) then
          begin
            case HorzAlign of
             haNoChange :   begin end;
             haTop:         begin
                              if VerticalZero = vzTop then
                                CustFigure.Move(0,(RefRect.top - CustRect.top))
                              else
                                CustFigure.Move(0,(RefRect.Bottom - CustRect.Bottom));
                            end;
             haBottom:      begin
                              if VerticalZero = vzTop then
                                CustFigure.Move(0,(RefRect.Bottom - CustRect.Bottom))
                              else
                                CustFigure.Move(0,(RefRect.top - CustRect.top));
                            end;
             haCenter:      begin
                              CustFigure.Move(0,(RefRect.Bottom +
                                                 ((RefRect.Top-RefRect.Bottom)/2)) -
                                                (CustRect.Bottom +
                                                ((CustRect.Top-CustRect.Bottom)/2)));
                            end;
            end;

            case VertAlign of
             vaNoChange:   begin end;
             vaLeft:       begin
                             if HorizontalZero = vzLeft then
                               CustFigure.Move((RefRect.left - CustRect.left),0)
                             else
                               CustFigure.Move((RefRect.right - CustRect.right),0);
                           end;
             vaRight:      begin
                             if HorizontalZero = vzLeft then
                              CustFigure.Move((RefRect.right - CustRect.right),0)
                             else
                              CustFigure.Move((RefRect.left - CustRect.left),0);
                           end;
             vaCenter:     begin
                              CustFigure.Move((RefRect.Left +
                                               ((RefRect.Right-RefRect.Left)/2)) -
                                               (CustRect.Left +
                                               ((CustRect.Right-CustRect.Left)/2))
                                               ,0);
                           end;
            end;
          end;
        end;
      end;
      Selecteds.Free;
    end;
  except
    on E: exception do
    begin
      AddExceptionToLog('TPCDrawing.alignSelection' + E.Message);
    end;
  end;
  GCanRefreshCad := RefreshFlag;
  Updated := True;
  refresh;
end;
(*
Procedure TPCDrawing.alignSelection(HorzAlign: THorzAligns; VertAlign: TVertAligns);
var a,b,ocx,ocy,RefBlockIdx : integer;
    Selecteds : TList;
    RefFigure  : TFigure;
    CustFigure  : TFigure;
    MaxFig : TFigure;
    MinFig : Tfigure;
    CurrentFig : TFigure;
    MaxY,MinY : Double;
    RefRect : TDoubleRect;
    CustRect : TDoubleRect;
    HelpRect : TDoubleRect;
    Found : Boolean;
    Dist : Double;
    PartDist : real;
    centers : array [0..1000] of Double;
    occupied : array [0..1000] of Boolean;
    Center, MinDist, FirstCenter:  Double;
    figMaxX,figMaxY,figMinX,figMinY: Double;
begin
  if (GCadForm.PCad.ActiveLayer = 2) then
    GCadForm.SaveForUndo(uat_None, True, False);

  Selecteds := TList.Create;
  collectSelectedFigures(Selecteds);

  If Selecteds.Count < 2 then exit;
  RefBlockIdx := 0;

  a := 0;
  Found := false;

  while (a < selecteds.Count) and (not found) do
  begin
    If TFigure(Selecteds[a]).firstselected then
    begin
      RefBlockIdx := a;
      found := true;
    end;
    inc(a);
  end;

  if RecordUndo then RecordModifyUndo(nil);

  RefFigure := TFigure(Selecteds[RefBlockIdx]);
  RefRect := RefFigure.GetBoundRect;

  a := 0;                                     
  while (a < selecteds.Count) do
  begin
    if CanAlign(GCadform.PCad.ActiveLayer, TFigure(Selecteds[a])) then
    begin
      if ssCtrl in GGlobalShiftState then
        RefRect := TFigure(Selecteds[a]).GetBoundRect
      else
      begin
        if GCadForm.PCad.ActiveLayer = 2 then
          RefRect := TFigure(Selecteds[a]).GetBoundRect(false)
        else
          RefRect := TFigure(Selecteds[a]).GetBoundRect;
      end;
      break;
    end;
    Inc(a);
  end;
  a := 0;

  while (a < selecteds.Count) do
  begin
    if CanAlign(GCadform.PCad.ActiveLayer, TFigure(Selecteds[a])) then
    begin
      if ssCtrl in GGlobalShiftState then
        HelpRect := TFigure(Selecteds[a]).GetBoundRect
      else
      begin
        if GCadForm.PCad.ActiveLayer = 2 then
          HelpRect := TFigure(Selecteds[a]).GetBoundRect(false)
        else
          HelpRect := TFigure(Selecteds[a]).GetBoundRect;
      end;
      if RefRect.left > HelpRect.left then RefRect.left := HelpRect.left;
      if RefRect.Right < HelpRect.right then RefRect.Right := HelpRect.Right;
      if RefRect.top > HelpRect.Top then RefRect.Top := HelpRect.Top;
      if RefRect.Bottom < HelpRect.Bottom then RefRect.Bottom := HelpRect.Bottom;
    end;
    inc(a);
  end;

  if (VertAlign = vaDistVert) and (selecteds.count > 2)  then
  begin
    MaxY := TFigure(Selecteds[0]).GetBoundRect.Top;
    MaxFig := TFigure(Selecteds[0]);
    MinY := TFigure(Selecteds[0]).GetBoundRect.Top;
    MinFig := TFigure(Selecteds[0]);
    for a := 1 to Selecteds.Count - 1 do
    begin
      if TFigure(Selecteds[a]).GetBoundRect.Top > MaxY then
      begin
        MaxY := TFigure(Selecteds[a]).GetBoundRect.Top;
        MaxFig := TFigure(Selecteds[a]);
      end;
      if TFigure(Selecteds[a]).GetBoundRect.Top < MinY then
      begin
        MinY := TFigure(Selecteds[a]).GetBoundRect.Top;
        MinFig := TFigure(Selecteds[a]);
      end;
    end;

    Dist := (((MaxFig.GetBoundRect.Top - MaxFig.GetBoundRect.Bottom)/2)
            +
            MaxFig.GetBoundRect.Bottom) -
            (((MinFig.GetBoundRect.Top - MinFig.GetBoundRect.Bottom)/2)
            +
            MinFig.GetBoundRect.Bottom);

    PartDist := Dist / (selecteds.count - 1);

    FirstCenter := (((MinFig.GetBoundRect.Top - MinFig.GetBoundRect.Bottom)/2)
                   +
                   MinFig.GetBoundRect.Bottom);

    for a := 0 to Selecteds.count -1  do
    begin
      centers[a] := FirstCenter + round(a*PartDist);
      occupied[a] := false;
    end;

    for a := 0 to Selecteds.count - 1 do
    begin

      CurrentFig := TFigure(Selecteds[a]);
      if (CurrentFig <> MinFig) and
         (CurrentFig <> MaxFig) then
      begin
        Center := (((CurrentFig.GetBoundRect.Top - CurrentFig.GetBoundRect.Bottom)/2)
                   +
                  CurrentFig.GetBoundRect.Bottom);

        MinDist := abs(Centers[1] - center); ocx := 1;

        for b := 2 to Selecteds.count -2 do
          if (abs(Centers[b] - center) < MinDist) and (not occupied[b]) then
          begin
            MinDist := abs(Centers[b] - center);
            ocx := b;
          end;

        occupied[ocx] := true;

        MinDist :=  Centers[ocx] - center;

        CurrentFig.Move(0,MinDist);
      end;
    end;

  end;

  if (HorzAlign = haDistHorz) and (selecteds.count > 2) then
  begin
    MaxY := TFigure(Selecteds[0]).GetBoundRect.Right;
    MaxFig := TFigure(Selecteds[0]);
    MinY := TFigure(Selecteds[0]).GetBoundRect.Right;
    MinFig := TFigure(Selecteds[0]);
    for a := 1 to Selecteds.Count - 1 do
    begin
      if TFigure(Selecteds[a]).GetBoundRect.Right > MaxY then
      begin
        MaxY := TFigure(Selecteds[a]).GetBoundRect.Right;
        MaxFig := TFigure(Selecteds[a]);
      end;
      if TFigure(Selecteds[a]).GetBoundRect.Right < MinY then
      begin
        MinY := TFigure(Selecteds[a]).GetBoundRect.Right;
        MinFig := TFigure(Selecteds[a]);
      end;
    end;

    Dist := (((MaxFig.GetBoundRect.Right - MaxFig.GetBoundRect.Left)/2)
            +
            MaxFig.GetBoundRect.Left) -
            (((MinFig.GetBoundRect.Right - MinFig.GetBoundRect.Left)/2)
            +
            MinFig.GetBoundRect.Left);

    PartDist := Dist / (selecteds.count - 1);

    FirstCenter := (((MinFig.GetBoundRect.Right - MinFig.GetBoundRect.Left)/2)
                   +
                   MinFig.GetBoundRect.Left);

    for a := 0 to Selecteds.count -1  do
    begin
      centers[a] := FirstCenter + (a*PartDist);
      occupied[a] := false;
    end;

    for a := 0 to Selecteds.count - 1 do
    begin
      CurrentFig := TFigure(Selecteds[a]);
      if (CurrentFig <> MinFig) and
         (CurrentFig <> MaxFig) then
      begin
        Center := (((CurrentFig.GetBoundRect.Right - CurrentFig.GetBoundRect.Left)/2)
                   +
                   CurrentFig.GetBoundRect.Left);

        for b := 1 to Selecteds.count -2 do
        begin
          if (not occupied[b]) then
          begin
            MinDist := abs(Centers[b] - center);
            ocx := b;
            ocy := b;
          end;
        end;

        for b := ocy+1 to Selecteds.count-2 do
          if (abs(Centers[b] - center) < MinDist) and (not occupied[b]) then
          begin
            MinDist := abs(Centers[b] - center);
            ocx := b;
          end;

        occupied[ocx] := true;

        MinDist :=  Centers[ocx] - center;

        CurrentFig.Move(MinDist,0);
      end;
    end;
  end;

  for a := 0 to Selecteds.Count - 1 do
  begin
//    if a <> RefBlockIdx then
    begin
      CustFigure := TFigure(Selecteds[a]);
      if ssCtrl in GGlobalShiftState then
        CustRect := CustFigure.GetBoundRect
      else
      begin
        if GCadForm.PCad.ActiveLayer = 2 then
          CustRect := CustFigure.GetBoundRect(false)
        else
          CustRect := CustFigure.GetBoundRect;
      end;
      if CanAlign(GCadform.PCad.ActiveLayer, CustFigure) then
      begin
        case HorzAlign of
         haNoChange :   begin end;
         haTop:         begin
                          if VerticalZero = vzTop then
                            CustFigure.Move(0,(RefRect.top - CustRect.top))
                          else
                            CustFigure.Move(0,(RefRect.Bottom - CustRect.Bottom));
                        end;
         haBottom:      begin
                          if VerticalZero = vzTop then
                            CustFigure.Move(0,(RefRect.Bottom - CustRect.Bottom))
                          else
                            CustFigure.Move(0,(RefRect.top - CustRect.top));
                        end;
         haCenter:      begin
                          CustFigure.Move(0,(RefRect.Bottom +
                                             ((RefRect.Top-RefRect.Bottom)/2)) -
                                            (CustRect.Bottom +
                                            ((CustRect.Top-CustRect.Bottom)/2)));
                        end;
        end;

        case VertAlign of
         vaNoChange:   begin end;
         vaLeft:       begin
                         if HorizontalZero = vzLeft then
                           CustFigure.Move((RefRect.left - CustRect.left),0)
                         else
                           CustFigure.Move((RefRect.right - CustRect.right),0);
                       end;
         vaRight:      begin
                         if HorizontalZero = vzLeft then
                          CustFigure.Move((RefRect.right - CustRect.right),0)
                         else
                          CustFigure.Move((RefRect.left - CustRect.left),0);
                       end;
         vaCenter:     begin
                          CustFigure.Move((RefRect.Left +
                                           ((RefRect.Right-RefRect.Left)/2)) -
                                           (CustRect.Left +
                                           ((CustRect.Right-CustRect.Left)/2))
                                           ,0);
                       end;
        end;
      end;
    end;
  end;
  Selecteds.Free;
  Updated := True;
  refresh;
end;
*)

Procedure TPCDrawing.selectall(LayerNbr : integer);
var
  i, a: integer;
  f: TFigure;
  invis: Boolean;
  layer: TLayer;
  RefreshFlag: Boolean;//Tolik 30/11/2021 --
begin
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then
    exit;

  //Tolik 30/11/2021 - -
  RefreshFlag := GCanRefreshCad;
  GCanRefreshCad := False;
  Try
  //
    for a := 0 to figures.count - 1 do
    begin
      f := TFigure(figures[a]);
      invis := false;
      if (f.LayerHandle <> 0) then
        invis :=  (TLayer(f.LayerHandle).Visible = lost);
      if (not invis) and (not f.InClip) and (not f.Selected) and
         ((LayerNbr = 0) or (f.LayerHandle = LongInt(Layers[LayerNbr])))
      then
      begin
        if not f.LockSelect then
        begin
          if f is Tnet then
          begin
            TNet(f).SelType := stStruct;
            TNet(f).SelIndex := 0;
          end;
          f.Select;
          FAnySelected := true;
        end;
      end;
      // если на подложке, а фигура на ДХФ слое
      if (not invis) and (not f.InClip) and (not f.Selected) and
         ((LayerNbr = 1) and TLayer(f.LayerHandle).IsDxf {CheckFigureInDXFLayer(f)})
      then
      begin
        if not f.LockSelect then
        begin
          f.Select;
          FAnySelected := true;
        end;
      end;
    end;
    ReDrawSelection;
    SyncEnv;
  Except
    On e: Exception do AddExceptionToLog('TPCDrawing.SelectAll' + E.Message);
  End;
  GCanRefreshCad := RefreshFlag;//Tolik 30/11/2021-
end;


//Tolik 30/11/2021 -- старая закомменчена - см. ниже. Здесь выполнена попытка ускорить процесс
Procedure TPCDrawing.deselectall(LayerNbr : integer);
var
  a: integer;
  f: TFigure;
  stillSelected: Boolean;
  RefreshFlag: Boolean;
begin
  SelFeed := 0;
  if not FAnySelected then
    exit;
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then
    exit;
  FAnySelected := false;

  RefreshFlag := GCanRefreshCad;
  GCanRefreshCad := False;

  BeginMultiDeselect; //02.04.2012
  try
    if LayerNbr = 0 then
    begin
      for a := 0 to figures.count - 1 do
      begin
        f := TFigure(figures[a]);
        if f.Selected then
        begin
          f.Deselect;
        end
      end;
    end
    else
    // если на подложке, а фигура на ДХФ слое
    if LayerNbr = 1 then
    begin
      for a := 0 to figures.count - 1 do
      begin
        f := TFigure(figures[a]);
        if (TLayer(f.LayerHandle).IsDxf and (f.Selected)) then
        begin
          if not f.LockSelect then
          begin
            f.Deselect;
          end;
        end
        else
        if f.Selected then
        begin
          FAnySelected := True;
        end;
      end;
    end
    else
    begin
      for a := 0 to figures.count - 1 do
      begin
        f := TFigure(figures[a]);
        if ((f.LayerHandle = LongInt(Layers[LayerNbr])) and (f.Selected)) then
        begin
          f.Deselect;
        end
        else
        if f.Selected then
        begin
          FAnySelected := True;
        end;
      end;
    end;
  finally
    EndMultiDeselect; //02.04.2012
  end;

  GCanRefreshCad := RefreshFlag;

  RedrawSelection;
  SyncEnv;
end;


(*
Procedure TPCDrawing.deselectall(LayerNbr : integer);
var
  a: integer;
  f: TFigure;
  stillSelected: Boolean;
begin
  SelFeed := 0;
  if not FAnySelected then
    exit;
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then
    exit;
  FAnySelected := false;

  BeginMultiDeselect; //02.04.2012
  try
    for a := 0 to figures.count - 1 do
    begin
      f := TFigure(figures[a]);
      if ((LayerNbr = 0) or (f.LayerHandle = LongInt(Layers[LayerNbr]))) and (f.Selected) then
      begin
        f.Deselect;
      end
      else
      if f.Selected then
      begin
        FAnySelected := True;
      end;
      // если на подложке, а фигура на ДХФ слое
      if ((LayerNbr = 1) and TLayer(f.LayerHandle).IsDxf {CheckFigureInDXFLayer(f)}) and (f.Selected) then
      begin
        if not f.LockSelect then
        begin
          f.Deselect;
        end;
      end
      else
      if f.Selected then
      begin
        FAnySelected := True;
      end;
    end;
  finally
    EndMultiDeselect; //02.04.2012
  end;
  RedrawSelection;
  SyncEnv;
end;
*)

Procedure TPCDrawing.InvertSelection;
var a: integer;
    f: TFigure;
begin
  if not FAnySelected then exit;
  for a := 0 to figures.count-1 do
  begin
    f := TFigure(figures[a]);
    if (f.Selected) then
    begin
      f.Deselect;
    end else
    begin
      f.Select;
    end;
  end;
  Refresh;
  SyncEnv;
end;


Function TPCDrawing.groupselection: TFigHandle;
var
  grpId: integer;
  a: integer;
  Fig: Tfigure;
  grp: TFigureGrp;
  sel: TList;
  cnt: integer;
  LHandle: LongInt;
  xAction: TUndoAction;
  zOrder: Integer;
  RefFig: Pointer;
  isLast: Boolean;
begin
  result := 0;
  sel := TList.Create;
  collectselectedFigures(sel);
  cnt := sel.count;
  sel.Clear;
  //Tolik -- 07/02/2017 --
  if cnt = 0 then
  begin
    FreeAndNil(Sel); // --шлепать нужно, раз создали!!!
    exit;
  end;

  if RecordUndo then
  begin
    xAction := TUndoAction.Create(uaGroup);
  end;

  grp := TfigureGrp.create(LongInt(Layers[0]), self);
  if RecordUndo then
    xAction.List.Add(grp);
  LHandle := 0;
  zOrder := 0;
  RefFig := nil;
  isLast := False;
  try
    BeginMultiDeselect; //02.04.2012
    try
      for a := figures.count - 1 downto 0 do
      begin
        Fig := Tfigure(figures[a]);
        if fig.Selected then
        begin
          if not(Fig.ClassName = 'TCabinet') and not(Fig.ClassName = 'TCabinetNumber') then
          begin
            if (RefFig = nil) and (not isLast) then
            begin
              if a = figures.count - 1 then
                isLast := True
              else
                RefFig := Figures[a + 1];
            end;
            //02.04.2012 fig.Deselect;
            //02.04.2012 sel.Add(fig);
            //02.04.2012 figures.Remove(fig);
            //02.04.2012 LHandle := fig.LayerHandle;

            //02.04.2012 - для выделения запоминаем в списке
            sel.Add(fig);
            LHandle := fig.LayerHandle;
          end;
        end;
      end;
      //02.04.2012 - снимаем выделение в нормельном порядке, а не обратном (обратный от первого цыкла, который обратный for a := figures.count - 1),
      //02.04.2012 чтобы на UnRegisterModPoint при поиске индекса точки в ModPoints ее индекс был вначале (меньше перебора)
      for a := sel.Count - 1 downto 0 do
        TFigure(sel[a]).Deselect;
      //02.04.2012 Удаляем из списка figures в том порядке в котором был первый цыкл (чтобы удаление шло с конца списка figures - так быстрее)
      for a := 0 to sel.Count - 1 do
        figures.Remove(sel[a]);

    finally
      EndMultiDeselect; //02.04.2012
    end;
  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.groupselection' + E.Message);
  end;
  for a := sel.count - 1 downto 0 do
  begin
    grp.AddFigure(sel[a], false);
  end;
  grp.ResetRegion;
  sel.free;

  grp.LayerHandle := LHandle;
  grp.select;
  if (isLast) or (RefFig = nil) then
    figures.Add(grp)
  else
  begin
    Zorder := Figures.indexOf(RefFig);
    if zOrder = -1 then
      figures.Add(grp)
    else
      figures.Insert(zOrder,grp);
  end;
  result := grp.Handle;
  if RecordUndo then
  begin
   InsertUndoAction(xAction);
  end;
  grp.CreateMetaFile;
  refresh;
  Updated := True;
end;

// Tolik -- 30/11/2021 --
procedure TPCDrawing.ungroupselection;
var
  a: integer;
  fig: TFigure;
  xAction: TUndoAction;
  RefreshFlag :Boolean;

begin
  RefreshFlag := GCanRefreshCad;
  GCanRefreshCad := False;
  try
    // Tolik -- 12/12/2016 --
    if GCadForm.FNotSCSDeletedFiguresList = nil then
      GCadForm.FNotSCSDeletedFiguresList := TList.Create;
    //
    if RecordUndo then
      xAction := TUndoAction.Create(uaUnGroup);
    for a := figures.count - 1 downto 0 do
    begin
      fig := TFigure(figures[a]);
      if (TFigure(fig) is TFigureGrp) and (TFigure(fig).selected) then
      begin
        if not TFigureGrp(fig).AlwaysTogether then
        begin
          TFigureGrp(fig).UnGroup;
          if RecordUndo then
            xAction.List.Add(fig);
          // Tolik
          //Fig.deleted := True;
          if GCadForm.FNotSCSDeletedFiguresList.IndexOf(fig) = -1 then
            GCadForm.FNotSCSDeletedFiguresList.Add(fig);
          //
          figures.Delete(a);
          //13.03.2012 - не удаляем, так как объект может запоминатся для отката - xAction.List.Add(fig)
          //13.03.2012 TFigureGrp(fig).InFigures.Clear; //30.05.2011
          //13.03.2012 fig.Free; //30.05.2011
        end;
      end;
    end;
    if RecordUndo then
    begin
      if xAction.List.Count > 0 then
      begin
        InsertUndoAction(xAction);
      end else
      begin
        xAction.Free;
      end;
    end;
    //refresh;
    //Updated := True;
  except
    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.ungroupselection' + E.Message);
  end;

  GCanRefreshCad := RefreshFlag;
  refresh;
  Updated := True;
end;
(*
// Tolik -- 07/12/2016 --
// тут немножко переписано, чтобы удалить групповую фигуру, а то как-то непонятно, куда она делась
procedure TPCDrawing.ungroupselection;
var
  a: integer;
  fig: TFigure;
  xAction: TUndoAction;

begin
  try
  // Tolik -- 12/12/2016 --
  if GCadForm.FNotSCSDeletedFiguresList = nil then
    GCadForm.FNotSCSDeletedFiguresList := TList.Create;
  //
    if RecordUndo then
      xAction := TUndoAction.Create(uaUnGroup);
    for a := figures.count - 1 downto 0 do
    begin
      fig := TFigure(figures[a]);
      if (TFigure(fig) is TFigureGrp) and (TFigure(fig).selected) then
      begin
        if not TFigureGrp(fig).AlwaysTogether then
        begin
          TFigureGrp(fig).UnGroup;
          if RecordUndo then
            xAction.List.Add(fig);
          // Tolik
          //Fig.deleted := True;
          if GCadForm.FNotSCSDeletedFiguresList.IndexOf(fig) = -1 then
            GCadForm.FNotSCSDeletedFiguresList.Add(fig);
          //
          figures.Delete(a);
          //13.03.2012 - не удаляем, так как объект может запоминатся для отката - xAction.List.Add(fig)
          //13.03.2012 TFigureGrp(fig).InFigures.Clear; //30.05.2011
          //13.03.2012 fig.Free; //30.05.2011
        end;
      end;
    end;
    if RecordUndo then
    begin
      if xAction.List.Count > 0 then
      begin
        InsertUndoAction(xAction);
      end else
      begin
        xAction.Free;
      end;
    end;
    refresh;
    Updated := True;
  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.ungroupselection' + E.Message);
  end;
end;
*)

(*
procedure TPCDrawing.ungroupselection;
var
  a: integer;
  fig: TFigure;
  xAction: TUndoAction;
begin
  try
    if RecordUndo then
      xAction := TUndoAction.Create(uaUnGroup);
    for a := figures.count - 1 downto 0 do
    begin
      fig := TFigure(figures[a]);
      if (TFigure(fig) is TFigureGrp) and (TFigure(fig).selected) then
      begin
        if not TFigureGrp(fig).AlwaysTogether then
        begin
          TFigureGrp(fig).UnGroup;
          if RecordUndo then
            xAction.List.Add(fig);
          figures.Delete(a);
          //13.03.2012 - не удаляем, так как объект может запоминатся для отката - xAction.List.Add(fig)
          //13.03.2012 TFigureGrp(fig).InFigures.Clear; //30.05.2011
          //13.03.2012 fig.Free; //30.05.2011
        end;
      end;
    end;
    if RecordUndo then
    begin
      if xAction.List.Count > 0 then
      begin
        InsertUndoAction(xAction);
      end else
      begin
        xAction.Free;
      end;
    end;
    refresh;
    Updated := True;
  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.ungroupselection' + E.Message);
  end;
end;
*)

Procedure TPCDrawing.BoundSelectedLine;
var BLine: Tfigure;
    a: integer;
begin
  For a := 0 to Selection.Count-1 do
  begin
    BLine := TFigure(Selection[a]);
    if (BLine is DrawObjects.TLine) or (BLine is TPolyLine) then begin
      BoundLinePoint(TfigHandle(BLine),1,BLine.ActualPoints[1]);
      BoundLinePoint(TFigHandle(BLine),BLine.PointCount,BLine.ActualPoints[Bline.PointCount])
    end;
  end;
  refresh;
  Updated := True;
end;


Procedure TPCDrawing.BoundLineToFigures(BLine:TFigHandle; jf1,jf2: TFigHandle);
var b,j1,j2: TFigure;
begin
  b := TFigure(BLine);
  j1 := TFigure(jf1);
  j2 := TFigure(jf2);
  if B is DrawObjects.TLine then begin
    DrawObjects.TLine(B).SetJFigure1(j1);
    DrawObjects.TLine(B).SetJFigure2(j2);
  end else if B is TPolyLine then begin
    TPolyLine(B).SetJFigure1(j1);
    TPolyLine(B).SetJFigure2(j2);
  end;
  refresh;
  Updated := True;
end;


Procedure TPCDrawing.BoundLinePoint(BLine:TFigHandle; seqnbr: integer; bPoint: TDoublepoint);

var a,i,x: integer;
    Layer: TLayer;
    Fig: Tfigure;
    b: TFigure;
begin
  b := TFigure(BLine);
  for a := figures.count - 1 downto 0 do
    begin
      Fig := Tfigure(figures[a]);
      if (fig <> B) and (fig.isPointIn(bPoint.x,bPoint.y)) then
      begin
           if B is DrawObjects.TLine then begin
             if seqnbr = 1 then DrawObjects.TLine(B).SetJFigure1(fig)
             else if seqnbr = 2 then DrawObjects.TLine(B).SetJFigure2(fig);
           end else if B is TPolyLine then begin
             if seqnbr = 1 then TPolyLine(B).SetJFigure1(fig)
             else if seqnbr = B.PointCount then TpolyLine(B).SetJFigure2(fig);
           end;
      end;
  end;
  refresh;
  Updated := True;
end;

Procedure TPCDrawing.UnBoundLine;
var a: integer;
begin
  for a := 0 to figures.count - 1 do
  begin
    if TFigure(figures[a]).selected then
    begin
      if (TFigure(figures[a]) is DrawObjects.TLine) then DrawObjects.TLine(figures[a]).UnBound
      else if (TFigure(figures[a]) is TPolyLine) then TPolyLine(figures[a]).UnBound;
    end;
  end;
  refresh;
  Updated := True;
end;


procedure TPCDrawing.GetLineJoins(var lines: TstringList);
var a: integer;
    jf: Tfigure;
begin
  For a:= 0 to Figures.Count-1 do
  begin
    if (TFigure(Figures[a]) is DrawObjects.TLine) then begin
      jf :=DrawObjects. TLine(Figures[a]).JoinFigure1;
      if jf <> nil then
        Lines.Add('    JoinLE1 = '+ DrawObjects.TLine(Figures[a]).Name+','+ TFigure(jf).Name);
      jf := DrawObjects.TLine(Figures[a]).JoinFigure2;
      if jf <> nil then
        Lines.Add('    JoinLE2 = '+ DrawObjects.TLine(Figures[a]).Name+','+TFigure(jf).Name);
    end;
    if (TFigure(Figures[a]) is TPolyLine) then begin
      jf := TPolyLine(Figures[a]).JoinFigure1;
      if jf <> nil then
        Lines.Add('    JoinPE1 = '+ TPolyLine(Figures[a]).Name+','+TFigure(jf).Name);
      jf := TPolyLine(Figures[a]).JoinFigure2;
      if jf <> nil then
        Lines.Add('    JoinPE2 = '+ TPolyLine(Figures[a]).Name+','+TFigure(jf).Name);
    end;
  end;

end;


procedure TPCDrawing.OrderSelection(Dest: TOrderStyle);
var
  a, x, fronted, backed: integer;
  Figure: TFigure;
  xAction: TUndoAction;
  i: integer;
  BackList: TList;
  UnselectList: TList;
  LHBack: integer;
  LHSCSCommon: integer;
  NeedReOrderSubstr: boolean;
begin
  try
    NeedReOrderSubstr := False;
    if not FAnySelected then
      exit;
    BackList := TList.Create;
    UnselectList := TList.Create;
    LHBack := GetLayerHandle(lnSubstrate);
    LHSCSCommon := GetLayerHandle(lnSCSCommon);
    if RecordUndo then
      xAction := TUndoAction.Create(uaOrder);
    for a := 0 to figures.count - 1 do
    begin
      Figure := TFigure(figures[a]);
      if Figure.LayerHandle = LHBack then
        BackList.Add(Figure);
      if Figure.Selected then
      begin
        if (Dest = osBack) and (Figure.LayerHandle = LHSCSCommon) then
          NeedReOrderSubstr := True;
        if CheckFigureByClassName(Figure, cTConnectorObject) then
        begin
          if TConnectorObject(Figure).ConnectorType <> ct_Clear then
          begin
            if TConnectorObject(Figure).DrawFigure <> nil then
            begin
              if Not TConnectorObject(Figure).DrawFigure.Selected then
                UnselectList.Add(TConnectorObject(Figure).DrawFigure);
              TConnectorObject(Figure).DrawFigure.Selected := True;
              // в принципе можно без этого
              //for i := 0 to TConnectorObject(Figure).DrawFigure.InFigures.Count - 1 do
              //begin
              //  if Not TFigure(TConnectorObject(Figure).DrawFigure.InFigures[i]).Selected then
              //    UnselectList.Add(TConnectorObject(Figure).DrawFigure.InFigures[i]);
              //  TFigure(TConnectorObject(Figure).DrawFigure.InFigures[i]).Selected := true;
              //end;
            end;
          end;
        end;
        if CheckFigureByClassName(Figure, cTOrthoLine) then
        begin
          if TOrthoLine(Figure).DrawFigure <> nil then
          begin
            if Not TOrthoLine(Figure).DrawFigure.Selected then
              UnselectList.Add(TOrthoLine(Figure).DrawFigure);
            TOrthoLine(Figure).DrawFigure.Selected := True;
          end;
        end;
      end;
    end;

    if (Dest = osFront) or (Dest = osBWard) then
    begin
      fronted := 0;
      for a := 0 to figures.count-1 do
      begin
        Figure := TFigure(figures[a-fronted]);
        if Figure.Selected then
        Begin
          if RecordUndo then xAction.List.Add(Figure);
          if RecordUndo then xAction.Params.Add(Pointer(a));
          if Dest = osFront then
          begin
            figures.Move(a-fronted,figures.count-1);
            if RecordUndo then xAction.RedoList.Add(Pointer(figures.count-1));
            inc(fronted);
            if RecordUndo then xAction.FIndex := 0;
          end
          else if Dest = osBWard then
          begin
            if a > 0 then figures.Exchange(a,a-1);
            if RecordUndo then xAction.FIndex := 1;
            if RecordUndo then xAction.RedoList.Add(Pointer(a-1));
          end;
        end;
      end;
    end
    else
    begin
      Backed := 0;
      for a := 0 to figures.count-1 do
      begin
        x := figures.count-1-a;
        Figure := TFigure(figures[x+backed]);
        if Figure.Selected then
        Begin
          if RecordUndo then xAction.List.Add(Figure);
          if RecordUndo then xAction.Params.Add(Pointer(x));
          if Dest = osBack then
          begin
            figures.move(x+backed,0);
            inc(Backed);
            if RecordUndo then xAction.FIndex := 0;
            if RecordUndo then xAction.RedoList.Add(Pointer(0));
          end
          else if dest = osFWard then
          begin
            if x < figures.count -1 then figures.exchange(x,x+1);
            if RecordUndo then xAction.FIndex := 1;
            if RecordUndo then xAction.RedoList.Add(Pointer(x+1));
          end;
        end;
      end;
    end;
    for a := 0 to UnselectList.count-1 do
    begin
      Figure := TFigure(UnselectList[a]);
      Figure.Selected := False;
    end;
    UnselectList.Clear;
    FreeAndNil(UnselectList);
    if NeedReOrderSubstr then
    begin
      Backed := 0;
      for a := 0 to figures.count-1 do
      begin
        x := figures.count-1-a;
        Figure := TFigure(figures[x+backed]);
        if BackList.IndexOf(Figure) <> -1 then
        Begin
          if RecordUndo then xAction.List.Add(Figure);
          if RecordUndo then xAction.Params.Add(Pointer(x));
          figures.move(x+backed,0);
          inc(Backed);
          if RecordUndo then xAction.FIndex := 0;
          if RecordUndo then xAction.RedoList.Add(Pointer(0));
        end;
      end;
    end;
    BackList.Clear;
    FreeAndNil(BackList);

    if RecordUndo then
    begin
      if xAction.List.Count > 0 then
      begin
        InsertUndoAction(xAction);
      end else
        xAction.Free;
    end;

    refresh;
    Updated := True;
  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.OrderSelection' + E.Message);
  end;
End;

procedure TPCDrawing.OrderFigureToFront(aFigure: TFigure);
var
  Index: Integer;
begin
  try
    Index := Figures.IndexOf(aFigure);
    // Tolik 13/06/2017 --
    if Index <> -1 then
    //
    begin
      figures.Move(Index, figures.count - 1);
      refresh;
      Updated := True;
    end;
  except
    on E: Exception do AddExceptionToLog('TPCDrawing.OrderFigureToFront' + E.Message);
  end;
end;

procedure TPCDrawing.OrderFigureToBack(aFigure: TFigure);
var
  Index: Integer;
begin
  try
    Index := Figures.IndexOf(aFigure);
    figures.move(Index, 0);
    refresh;
    Updated := True;
  except
    on E: Exception do AddExceptionToLog('TPCDrawing.OrderFigureToBack' + E.Message);
  end;
end;

(*
procedure TPCDrawing.RemoveSelection;
var a,max,k: integer;
    xAction: TUndoAction;
    CanDelete:Boolean;
    fig: TFigure;
begin
  try
    if not FAnySelected then exit;
    a := 0;
    max := figures.count - 1;
    ResetRemoveSelection := False;
    if RecordUndo then xAction := TUndoAction.Create(uaRemove);
    while a <= max do
    begin
      if TFigure(figures[a]).selected then
      begin
        CanDelete := True;
        if assigned(FOnFigureDel) then FOnFigureDel(Self,figures[a],CanDelete);
        if CanDelete then begin
          {TFigure(figures[a]).deselect;
          TFigure(figures[a]).Deleted := True;}
          if not RecordUndo then
          begin
            // Tolik
            // TFigure(figures[a]).ClipFigures.Clear -- выполнится на деструкторе фигуры

            {for k := 0 to TFigure(figures[a]).ClipFigures.Count - 1 do
            begin
              figures.Remove(TFigure(figures[a]).ClipFigures[k]);
            end;}

            //Tolik 26/10/2015
            //TFigure(figures[a]).destroy;
           // TFigure(Figures[a]).free;
            {
            if CheckFigureByClassName(TFigure(figures[a]), cTOrthoLine) then
              TOrthoLine(figures[a]).delete
            else
            if  CheckFigureByClassName(TFigure(figures[a]), cTConnectorObject) then
              TConnectorObject(figures[a]).Delete(true)
            else
            if CheckFigureByClassName(TFigure(figures[a]), cTCabinet) then
              TCabinet(figures[a]).Delete
            else
            if CheckFigureByClassName(TFigure(figures[a]), cTCabinetExt) then
              TCabinetExt(figures[a]).Delete
            else
            if CheckFigureByClassName(TFigure(figures[a]), cTPlanObject) then
              TPlanObject(figures[a]).Delete
            else
            if CheckFigureByClassName(TFigure(figures[a]), cTPlanConnector) then
              TPlanConnector(figures[a]).Delete
            else
            if CheckFigureByClassName(TFigure(figures[a]), cTPlanTrace) then
              TPlanTrace(figures[a]).Delete
            else
            if CheckFigureByClassName(TFigure(figures[a]), cTSCSFigureGrp) then
              TSCSFigureGrp(figures[a]).Delete
            else
            if CheckFigureByClassName(TFigure(figures[a]), cTHouse) then
              THouse(figures[a]).Delete;
            }
            //
          end;
          if RecordUndo then begin
            xAction.List.Add(figures[a]);
            TFigure(figures[a]).Urc := TFigure(figures[a]).Urc+1;
            TFigure(figures[a]).DelIndex := a;
          end;
          fig := TFigure(figures[a]);
          if recordundo then begin
            for k := 0 to fig.ClipFigures.Count-1 do
            begin
              TFigure(fig.ClipFigures[k]).inClip := False;
            end;
          end;
          figures.Remove(fig);
          max := max -1;
          a   := a - 1;
          if assigned(FOnAfterFigureDel) then FOnAfterFigureDel(Self);
        end
        else
        begin
          if ResetRemoveSelection then
          begin
            a := -1;
            max := figures.count - 1;
            ResetRemoveSelection := False;
          end;
        end;
      end;
      inc (a);
    end;
    if RecordUndo then
    begin
      InsertUndoAction(xAction);
    end;
    refresh;
    Updated := True;
  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.RemoveSelection' + E.Message);
  end;
end;
*)

procedure TPCDrawing.RemoveSelection;
var a,max,k, i: integer;
    xAction: TUndoAction;
    CanDelete:Boolean;
    fig: TFigure;
    DeletedNotSCSFigureIndex: Integer;
    FlagChecked: Boolean;
    //Tolik 21/04/2017 --
    CanDeleteFigure: boolean;
    DelFiguresIDList: TIntList;
    FigureToDel : TFigure;
    CurrFigureIndex: Integer;
    GroupUpdateFlag: Boolean;
    CanRefreshFlag: Boolean;

    function GetFiguresToDelList: TIntList;
    var i: Integer;
    begin
      Result := TIntList.Create;
      (*
      for i := 0 to Figures.Count - 1 do
      begin
        if TFigure(Figures[i]).Selected and (not TFigure(Figures[i]).deleted)  and
           (Result.IndexOf(TFigure(Figures[i]).ID) = -1) then
          Result.Add(TFigure(Figures[i]).ID);
      end;
      *)
      for i := 0 to Figures.Count - 1 do
      begin
        TFigure(Figures[i]).id_for_dellist := -1;
        if TFigure(Figures[i]).Selected and (not TFigure(Figures[i]).deleted)  and
           (Result.IndexOf(i) = -1) then
        begin
          TFigure(Figures[i]).id_for_dellist := i;
          Result.Add(i);
        end;
      end;
    end;
    //
    function GetFigureToDelByID(FigureId: Integer): TFigure;
    var i: Integer;
    begin
      Result := nil;
      CurrFigureIndex := -1;
      (*
      for i := 0 to Figures.Count - 1 do
      begin
        if TFigure(Figures[i]).Id = FigureID then
        begin
          FigureToDel.id_for_dellist := -1;
          Result := TFigure(Figures[i]);
          CurrFigureIndex := i;
          Break; //// BREAK ////;
        end;
      end;
      *)
      for i := 0 to Figures.Count - 1 do
      begin
        if TFigure(Figures[i]).id_for_dellist = FigureID then
        begin
          Result := TFigure(Figures[i]);
          Result.id_for_dellist := -1;
          CurrFigureIndex := i;
          Break; //// BREAK ////;
        end;
      end;
    end;

begin
  try
  // Tolik -- 12/12/2016 --
  FlagChecked := True;
  CanRefreshFlag := GCanRefreshCad;
  GCanRefreshCad := False;
  if GCadForm.FNotSCSDeletedFiguresList = nil then
    GCadForm.FNotSCSDeletedFiguresList := TList.Create;
  //
    if not FAnySelected then
    begin
      GCanRefreshCad := CanRefreshFlag;
      exit;
    end;
    a := 0;
    max := figures.count - 1;
    ResetRemoveSelection := False;
    if RecordUndo then xAction := TUndoAction.Create(uaRemove);
    // Tolik -- 21/04/2017 --
    DelFiguresIDList := GetFiguresToDelList;
    //Tolik 26/06/2017 --
    //Selection.clear;   //Tolik 22/11/2019 -- если будет отмена удаления, фигуры останутся выбранными а список будет пустой(нехоросо)
    //
    try
      //Tolik 22/04/2017 --
      BeginProgress;
      GroupUpDateFlag := GisGroupUpdate;
      GisGroupUpdate := True;
      //
      for i := 0 to DelFiguresIDList.Count - 1 do
      begin
        FigureToDel := GetFigureToDelByID(DelFiguresIDList[i]);
        if FigureToDel <> nil then
        begin
          CanDelete := True;
          if assigned(FOnFigureDel) then
              FOnFigureDel(Self,FigureToDel,CanDelete);

          if CanDelete then
          begin
            FigureToDel.deselect;
            if not RecordUndo then
            begin
              for k := 0 to FigureToDel.ClipFigures.Count - 1 do
              begin
                figures.Remove(FigureToDel.ClipFigures[k]);
              end;
              Figures.Remove(FigureToDel);
              if Assigned(Self.Owner) then
                TF_CAD(Self.Owner).FRemFigures.Remove(FigureToDel);
              FigureToDel.destroy;
            end
            else
              if RecordUndo then
              begin
                xAction.List.Add(FigureToDel);
                FigureToDel.Urc := FigureToDel.Urc + 1;
                FigureToDel.DelIndex := CurrFigureIndex;

                fig := FigureToDel;

                for k := 0 to fig.ClipFigures.Count - 1 do
                begin
                  TFigure(fig.ClipFigures[k]).inClip := False;
                end;

                figures.Remove(fig);
                // здесь ловим удаленные НЕ СКС фигуры
                if not Fig.deleted then
                begin
                  fig.Deleted := True;
                  //Tolik 26/11/2021 --
                  //DeletedNotSCSFigureIndex := GCadForm.FNotSCSDeletedFiguresList.IndexOf(Fig);
                  //if DeletedNotSCSFigureIndex = -1 then
                  if GCadForm.FNotSCSDeletedFiguresList.IndexOf(Fig) = -1 then
                  //
                    GCadForm.FNotSCSDeletedFiguresList.Add(fig);
                end;
              end;
            if assigned(FOnAfterFigureDel) then FOnAfterFigureDel(Self);
          end;
        end;
      end;
      GisGroupUpdate := GroupUpDateFlag;
      EndProgress;
    // Tolik 22/04/2017 --
    except
      on E: exception do
      begin
        GisGroupUpdate := GroupUpDateFlag;
        EndProgress;
        AddExceptionToLog('TPCDrawing.RemoveSelection' + E.Message);
      end;
    //  
    end;
    //

    //Tolik --17/11/2015
    // while a <= max do
    (*
    while a <= (figures.count - 1) do
    begin
      if TFigure(figures[a]).selected then
      for a := 0 to Figures.Count - 1 do
      begin
        if TFigure(figures[a]).selected then
        begin

          if assigned(FOnFigureDel) then
            FOnFigureDel(Self,figures[a],CanDelete);

          if CanDelete then
          begin
            TFigure(figures[a]).deselect;
            // TFigure(figures[a]).Deleted := True;
            if not RecordUndo then
            begin
              for k := 0 to TFigure(figures[a]).ClipFigures.Count - 1 do
              begin
                figures.Remove(TFigure(figures[a]).ClipFigures[k]);
              end;
              TFigure(figures[a]).destroy;
            end;
            if RecordUndo then
            begin
              xAction.List.Add(figures[a]);
              TFigure(figures[a]).Urc := TFigure(figures[a]).Urc + 1;
              TFigure(figures[a]).DelIndex := a;
            end;
            fig := TFigure(figures[a]);
            if recordundo then
            begin
              for k := 0 to fig.ClipFigures.Count - 1 do
              begin
                TFigure(fig.ClipFigures[k]).inClip := False;
              end;
            end;
            figures.Remove(fig);
            // здесь ловим удаленные НЕ СКС фигуры
            if not Fig.deleted then
            begin
              fig.Deleted := True;
              DeletedNotSCSFigureIndex := GCadForm.FNotSCSDeletedFiguresList.IndexOf(Fig);
              if DeletedNotSCSFigureIndex = -1 then
                GCadForm.FNotSCSDeletedFiguresList.Add(fig);
            end;
            //
            //max := max - 1;
            //a := a - 1;

            if assigned(FOnAfterFigureDel) then FOnAfterFigureDel(Self);
          end
          else
          begin
            if ResetRemoveSelection then
            begin
              a := -1;
              max := figures.count - 1;
              ResetRemoveSelection := False;
            end;
          end;
        end;

        // Tolik -- 17/11/2105
        if  max = (figures.count - 1) then
          inc(a)
        else
        begin
          a := a - (max - figures.count);
          if a < 0 then a := 0;
        end;
        max := figures.count - 1;
        //
      end;
    end;
    *)
    if RecordUndo then
    begin
      InsertUndoAction(xAction);
    end;
    {BeginProgress;
    EndProgress;}
    //FlagChecked := False;
    //GCanRefreshCad := True;

    refresh;
    Updated := True;
  except
    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.RemoveSelection' + E.Message);
  end;

  DelFiguresIDList.Free;
  //GCanRefreshCad := True;
  // оно конечно  GCanRefreshCad := True; вроде и хорошо бы сделать именно здесь
  // но есть вероятность что вызов RemoveSelection делается где-то по коду а не только юзером поэтому пока что просто
  // восстановим флажок
  GCanRefreshCad := CanRefreshFlag;
  Refresh;
  Self.SetFocus;
end;


Procedure TPCDrawing.ModifySelection(mm : TModifyMode; value: integer);
var a: Integer;
Begin
  if not FAnySelected then
    exit;
  if RecordUndo then RecordModifyUndo(nil);
  for a := 0 to figures.count - 1 do
  begin
    if TFigure(figures[a]).selected then
    begin
      TFigure(figures[a]).modifySelection(mm,value);
      if assigned(FFigureModify) then FFigureModify(Self,TFigure(figures[a]));
    end;
  end;
  refresh;
  Updated := True;
end;

Procedure TPCDrawing.ModifyFontName(value:String);
begin
  ModifyTextAndFont(mmFontName,0,value,[],True);
end;

Procedure TPCDrawing.ModifyFontBold(value:Boolean);
begin
  ModifyTextandFont(mmFontBold,0,'',[],Value);
end;

Procedure TPCDrawing.ModifyFontItalic(value:Boolean);
begin
  ModifyTextandFont(mmFontItalic,0,'',[],Value);
end;

Procedure TPCDrawing.ModifyFontUnderline(value:Boolean);
begin
  ModifyTextandFont(mmFontUnderline,0,'',[],Value);
end;

Procedure TPCDrawing.ModifyFontStrike(value:Boolean);
begin
  ModifyTextandFont(mmFontStrike,0,'',[],Value);
end;

Procedure TPCDrawing.ModifyFontSize(value:Double);
begin
  DefaultTextHeight := Value;
end;

Procedure TPCDrawing.ModifyFontCharset(value:Integer);
begin
  ModifyTextandFont(mmFontCs,csArray[value],'',[],True);
end;

Procedure TPCDrawing.ModifyFontColor(value:TColor);
begin
  ModifyTextandFont(mmFontColor,value,'',[],True);
end;

Procedure TPCDrawing.ModifyPenColor(value:TColor);
begin
  DefaultPenColor := Value;
end;

Procedure TPCDrawing.ModifyBrushColor(value:TColor);
begin
  DefaultBrushColor := Value;
end;

Procedure TPCDrawing.ModifyPenStyle(value:TPenStyle);
begin
  DefaultPenStyle := Value;
end;

Procedure TPCDrawing.ModifyBrushStyle(value:TBrushStyle);
begin
  DefaultBrushStyle := Value;
end;

Procedure TPCDrawing.ModifyRowStyle(value:TRowStyle);
begin
  DefaultRowStyle := Value;
end;

Procedure TPCDrawing.ModifyPenWidth(value:Integer);
begin
  DefaultPenWidth := Value;
end;

Procedure TPCDrawing.ModifyTextandFont(mm: TModifyMode; valueI: Double;
                     valueS: string; valueSt: TFontStyles;ValueB:Boolean);
var a: Integer;
    res: Boolean;
Begin

  res := false;
  if RecordUndo then
    if Selection.Count > 0 then RecordModifyUndo(nil);
  for a := 0 to Selection.count - 1 do
  begin
    if TFigure(Selection[a]).selected then
    begin
      if TFigure(Selection[a]).modifyTextandFont(mm,valueI,valueS,valueSt,ValueB) then res := true;
      if assigned(FFigureModify) then FFigureModify(Self,TFigure(figures[a]));
    end;
  end;

  if res then
  begin
    refresh;
    SyncEnv;
  end else begin
    if mm = mmFontName then Font.Name := valueS
    else if mm = mmFontCs then Font.Charset := Round(valueI)
    else if mm = mmFontColor then Font.Color := Round(valueI)
    else if mm = mmFontStyle then Font.Style := valueSt
    else if mm = mmFontBold then begin
         if ValueB then Font.Style := Font.Style + [fsBold]
                   else Font.Style := Font.Style - [fsBold];end
    else if mm = mmFontItalic then begin
         if ValueB then Font.Style := Font.Style + [fsItalic]
                   else Font.Style := Font.Style - [fsItalic];end
    else if mm = mmFontUnderline then begin
         if ValueB then Font.Style := Font.Style + [fsUnderline]
                   else Font.Style := Font.Style - [fsUnderline];end
    else if mm = mmFontStrike then begin
         if ValueB then Font.Style := Font.Style + [fsStrikeOut]
                   else Font.Style := Font.Style - [fsStrikeOut];end;
    refresh;
    SyncEnv;
    Updated := True;
  end;

end;

Function TPCDrawing.IsTextSelected:Boolean;
var a: Integer;
Begin
  if not FAnySelected then exit;
  for a := 0 to Selection.count - 1 do
  begin
    if TFigure(Selection[a]) is TText then
    begin
      result := True;
      exit;
    end;
  end;
end;

Procedure TPCDrawing.InvertArcsOfSelection;
var a: Integer;
    xAction:TUndoAction;
    s:TMemoryStream;
Begin
  if not FAnySelected then exit;
  if RecordUndo then
    xAction:= TundoAction.Create(uaModify);
  for a := 0 to Selection.Count-1 do begin
    if (Tfigure(Selection[a]) is TArc) then
    begin
      if RecordUndo then AddFigureToModifyUndo(xAction,Selection[a]);
      TArc(Selection[a]).Invert;
      Updated := True;
    end;
  end;
  if RecordUndo then
  begin
    if xAction.List.Count >0 then
    begin
      InsertUndoAction(xAction);
    end
    else
      xAction.free;
  end;
  refresh;
end;

Procedure TPCDrawing.ArrangeArcStyleOfSelection(value: TarcStyle);
var a: Integer;
    xAction:TUndoAction;
    s:TMemoryStream;
    found:Boolean;
Begin
  found := false;
  if RecordUndo then xAction:= TundoAction.Create(uaModify);
  for a := 0 to Selection.Count-1 do begin
    if (Tfigure(Selection[a]) is TArc) or
       (Tfigure(Selection[a]) is TElpArc) then
    begin
      if RecordUndo then
        AddFigureToModifyUndo(xAction,Selection[a]);
      if (Tfigure(Selection[a]) is TArc) then
        TArc(Selection[a]).ArrangeStyle(value)
      else if (Tfigure(Selection[a]) is TElpArc) then
        TElpArc(Selection[a]).ArrangeStyle(value);
      Updated := True;
      Found:= True;
    end;
  end;
  if not found then fDefArcStyle := value;
  if RecordUndo then
  begin
    if xAction.List.Count > 0 then
    begin
      InsertUndoAction(xAction);
    end
    else
      xAction.free;
  end;
  refresh;
end;

Procedure TPCDrawing.CloseSelectedPolyline;
var a: integer;
    xAction: TUndoAction;
    Found:Boolean;
begin
  Found := False;
  if RecordUndo then xAction := TUndoAction.Create(uaModify);
  for a := 0 to Selection.Count-1 do begin
   if TFigure(Selection[a]) is TpolyLine then
   begin
     if RecordUndo then AddFigureToModifyUndo(xAction,Selection[a]);
     TpolyLine(Selection[a]).Closed := True;
     Updated := True;
     Found := True;
   end;
  end;
  if not found then fDefPLineClosed := True;
  if RecordUndo then
  begin
    if xAction.List.Count > 0 then
    begin
      InsertUndoAction(xAction);
    end else
    begin
      xAction.Free;
    end;
  end;
  refresh;
end;

Procedure TPCDrawing.OpenSelectedPolyline;
var a: integer;
    xAction: TUndoAction;
    found: Boolean;
begin
  Found := False;
  if RecordUndo then
    xAction := TUndoAction.Create(uaModify);
  for a := 0 to Selection.Count-1 do begin
   if TFigure(Selection[a]) is TpolyLine then
   begin
     if RecordUndo then
       AddFigureToModifyUndo(xAction,Selection[a]);
     TpolyLine(Selection[a]).Closed := False;
     Updated := True;
     Found:= True;
   end;
  end;
  if not found then fDefPLineClosed := False;

  if RecordUndo then
  begin
    if xAction.List.Count > 0 then
    begin
      InsertUndoAction(xAction);
    end else
    begin
      xAction.Free;
    end;
  end;

  refresh;
end;


Procedure TPCDrawing.ConvertPLToBezier;
var a: integer;
    xAction: TUndoAction;
begin
  if RecordUndo then
    xAction := TUndoAction.Create(uaModify);
  for a := 0 to Selection.Count-1 do begin
   if TFigure(Selection[a]) is TpolyLine then
   begin
     if RecordUndo then AddFigureToModifyUndo(xAction,Selection[a]);
     TpolyLine(Selection[a]).ConvertToBezier;
     Updated := True;
   end;
  end;
  if RecordUndo then
  begin
    if xAction.List.Count > 0 then
    begin
      InsertUndoAction(xAction);
    end else
    begin
      xAction.Free;
    end;
  end;
  refresh;
end;

Procedure TPCDrawing.ConvertPlToPolyline;
var a: integer;
    xAction: TUndoAction;
begin
  if RecordUndo then
    xAction := TUndoAction.Create(uaModify);
  for a := 0 to Selection.Count-1 do begin
   if TFigure(Selection[a]) is TpolyLine then
   begin
     if RecordUndo then AddFigureToModifyUndo(xAction,Selection[a]);
     TpolyLine(Selection[a]).ConvertToPolyLine;
     Updated := True;
   end;
  end;
  if RecordUndo then
  begin
    if xAction.List.Count > 0 then
    begin
      InsertUndoAction(xAction);
    end else
    begin
      xAction.Free;
    end;
  end;
  refresh;
end;


Procedure TPCDrawing.FlipImagesOfSelection(FlipMode: TFlipMode);
var a: Integer;
    xAction:TUndoAction;
Begin
  if not FAnySelected then exit;
  if RecordUndo then xAction := TUndoAction.Create(uaModify);
  for a := 0 to Selection.count-1 do
    If (Tfigure(Selection[a]) is TBMPObject) then
    begin
      if RecordUndo then AddFigureToModifyUndo(xAction,Selection[a]);
      If flipMode = fmHorz then
        TBMPObject(Selection[a]).FlipHorz
      else
        TBMPObject(Selection[a]).FlipVert;
      Updated := True;
    end;
  if RecordUndo then
  begin
    if xAction.List.Count > 0 then
    begin
      InsertUndoAction(xAction);
    end else
    begin
      xAction.Free;
    end;
  end;
  refresh;
end;

Procedure TPCDrawing.OffSetSelection(Thick:Double);
var selecteds : TList;
    a,x : integer;
    fig : TFigure;
    newFig : TFigure;
    xAction : TUndoAction;
begin
  if VerticalZero = vzBottom then Thick := -Thick;
  selecteds := TList.create;
  CollectSelectedFigures(Selecteds);
  // Tolik 07/02/2017 -- утечка памяти!!!
  //if selecteds.count = 0 then exit;
  if selecteds.count = 0 then
  begin
    FreeAndNil(Selecteds);
    exit;
  end;
  //
  deselectall(0);
  if RecordUndo then
    xAction := TUndoAction.Create(uaInsert);
  for x := 0 to selecteds.count - 1 do
  begin
    fig := TFigure(selecteds[x]);
    newFig := fig.Offset(Thick);
    if assigned(newfig) then
    begin
      newFig.Selected := True;
      Figures.Add(newFig);
      if RecordUndo then xAction.List.Add(newFig);
      if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
    end;
  end;
  FAnySelected := true;
  Selecteds.Free;
  if RecordUndo then
  begin
    InsertUndoAction(xAction);
  end;
  refresh;
  Updated := True;
end;

Function TPCDrawing.WeldIntoPolyline:TFigHandle;
var
  f,f1,f2 : TFigure;
  fline: TFigure;
  cnt,a,i,k: integer;
  points: TDoublePointArr;
  nbrPoint,w,s,c: integer;
  Row:integer;
  lHandle: LongInt;
  first: Boolean;
  sList,fList: Tlist;

  done:Boolean;
  firstP,p1,p2,p,px1,px2:TdoublePoint;
  pLine: TPolyLine;
  PIndex : Integer;
  Closed: Boolean;
  pCnt: Integer;
  Segment: TPlSegment;
  orders: array of Integer;
  Order,SIndex,SCount,wi,lp: Integer;
  found: Boolean;
  firstFig: Integer;
  undo: TUndoaction;
  Converts: TList;
  fb: Tfigure;

  label ex;
begin
  result := 0;
  done := false;
  FList := TList.Create;
  SList := TList.Create;
  Converts := TList.Create;
  nbrPoint := 0;

  CollectSelectionOrder(Slist);
  cnt := Slist.Count;

  for a := cnt-1 downto 0  do
  begin
    f  := TFigure(Slist[a]);
    if not ((f is DrawObjects.TLine) or (f is TPolyLine) or (f is TArc) or (f is TElpArc) ) then begin
      SList.Remove(f);
    end;
    if (f is TElpArc) then begin
      fb := f.DuplicateAsBezier;
      SList.Insert(a,fb);
      SList.Remove(f);
      Converts.Add(fb);
    end;
  end;
  if Slist.Count < 1 then goto ex;

  i := 0;

  //find first figure
  firstfig := 0;
  while (i < SList.Count) and not done do
  begin
    f1 := TFigure(SList[i]);
    found := false;
    k := 0;
    wi := 0;
    while (k < SList.Count) and not done do
    begin
      if (i <> k) then begin
        f2 := TFigure(SList[k]);
        wi := wi+f1.IsWelded(f2);
      end;
      k := k +1;
    end;
    if wi < 3 then
    begin
      firstFig := i;
      done := true;
    end;
    i := i+1;
  end;

  if wi = 0 then goto ex;
  fList.Add(SList[firstFig]);
  SList.Remove(SList[firstFig]);
  
  done := false;
  f1 := Tfigure(fList[0]);
  repeat
    found := false;
    k := 0;
    repeat
      f2 := TFigure(sList[k]);
      wi := f1.IsWelded(f2);
      if wi > 0 then begin
        found := true;
        fList.Add(f2);
        SList.Remove(f2);
        f1 := f2;
      end;
      k := k+1;
    until found or (k >= SList.Count);
    if not found then begin
      done := true;
      if fList.Count = 0 then goto ex;
    end;
    if SList.Count = 0 then begin
      done := true;
    end;
  until done;


  SetLength(orders,FList.Count);

  Closed := False;

  // Find Chain Start

  f1 := Tfigure(Flist[0]);
  p1 := f1.GetStartPoint;
  p2 := f1.GetEndPoint;
  f2 := Tfigure(Flist[1]);
  px1 := f2.GetStartPoint;
  px2 := f2.GetEndPoint;


  if EQDP(p1,px1) then begin
    Orders[0] := 2;
    Orders[1] := 1;
    Pindex := 2;
    FirstP := p2;
  end else if EQDP(p1,px2) then begin
    Orders[0] := 2;
    Orders[1] := 2;
    Pindex := 1;
    FirstP := p2;
  end else if EQDP(p2,px1) then begin
    Orders[0] := 1;
    Orders[1] := 1;
    Pindex := 2;
    FirstP := p1;
  end else if EQDP(p2,px2) then begin
    Orders[0] := 1;
    Orders[1] := 2;
    Pindex := 1;
    FirstP := p1;
  end else goto ex;

  for i := 1 to FList.Count-1 do
  begin
    f1 := Tfigure(Flist[i]);
    p1 := f1.GetStartPoint;
    p2 := f1.GetEndPoint;
    if pIndex = 1 then p := p1 else p := p2;

    if i < Flist.Count-1 then
    begin
      f2 := Tfigure(Flist[i+1]);
      px1 := f2.GetStartPoint;
      px2 := f2.GetEndPoint;
      if EQDP(p,px1) then begin
        Pindex := 2;
        Orders[i+1] := 1;
      end else if EQDP(p,px2) then begin
        Pindex := 1;
        Orders[i+1] := 2;
      end else begin
        goto ex;
      end;
    end else begin
      if EQDP(p,firstP) then Closed := True;
    end;
  end;

  //add first point
  pcnt := 1;
  SetLength(points,pCnt);
  Points[0] := firstP;

  for i := 0 to fList.Count-1 do
  begin
    f := TFigure(fList[i]);
    Order := Orders[i];
    if i = 0 then begin
      LHandle := f.LayerHandle;
    end;
    if f is TPolyLine then begin
      a := pcnt;
      pCnt := pcnt+f.PointCount-1;
      lp := 0;
      if ((i = fList.Count-1) and closed) then lp := 1;
      pCnt := pCnt-lp;
      SetLength(Points,pCnt);
      if Order = 1 then begin
        for k := 2 to f.PointCount-lp do begin
          Points[a] := f.FigurePoints[k];
          a := a+1;
        end;
      end else begin
        for k := f.PointCount-1 downto 1+lp do begin
          Points[a] := f.FigurePoints[k];
          a := a+1;
        end;
      end;
    end else if f is TArc then begin
      if not ((i = fList.Count-1) and closed) then
      begin
        pCnt := pCnt+1;
        SetLength(Points,pCnt);
        if Order = 1 then begin
          Points[pCnt-1] := f.ap3;
        end else begin
          Points[pCnt-1] := f.ap2;
        end;
      end;
    end else if f is DrawObjects.TLine then begin
      if not ((i = fList.Count-1) and closed) then
      begin
        pCnt := pCnt+1;
        SetLength(Points,pCnt);
        if Order = 1 then begin
          Points[pCnt-1] := f.ap2;
        end else begin
          Points[pCnt-1] := f.ap1;
        end;
      end;
    end;
  end;

  pLine := TPolyLine.create(points,DefaultPenWidth,ord(DefaultPenStyle),
                            DefaultPenColor,ord(DefaultBrushStyle),
                            DefaultBrushColor,ord(DefaultRowStyle),Closed,
                            LHandle,mydsNormal,Self);

  SIndex := 0;
  for i := 0 to fList.Count -1 do
  begin
    f := TFigure(fList[i]);
    Order := Orders[i];
    if f is TPolyLine then begin
      sCount:= Tpolyline(f).Segments.Count-1; // last closing segment is ignored
      if order = 1 then begin
        for k := 0 to  SCount-1 do
        begin
          Segment := TPLSegment(Tpolyline(f).Segments[k]);
          pLine.ArrangeSegment(sIndex+1,segment.SType);
          TPlSegment(pLine.Segments[sIndex]).cpoint1 := segment.CPoint1;
          TPlSegment(pLine.Segments[sIndex]).cpoint2 := segment.CPoint2;
          TPlSegment(pLine.Segments[sIndex]).Inverted := segment.Inverted;
          TPlSegment(pLine.Segments[sIndex]).TangentKnot := segment.TangentKnot;
          SIndex :=  sIndex+1;
        end;
      end else begin
        for k := SCount-1 downto 0 do
        begin
          Segment := TPLSegment(Tpolyline(f).Segments[k]);
          pLine.ArrangeSegment(sIndex+1,segment.SType);
          TPlSegment(pLine.Segments[sIndex]).cpoint1 := segment.CPoint2;
          TPlSegment(pLine.Segments[sIndex]).cpoint2 := segment.CPoint1;
          TPlSegment(pLine.Segments[sIndex]).Inverted := segment.Inverted;
          TPlSegment(pLine.Segments[sIndex]).TangentKnot := segment.TangentKnot;
          SIndex :=  sIndex+1;
        end;
      end;
    end else if f is TArc then begin
      pLine.ArrangeSegment(SIndex+1,sArc);
      if orders[i] = 2 then TPlSegment(pLine.Segments[SIndex]).Inverted := True;
      TPlSegment(pLine.Segments[SIndex]).cpoint1 := f.ap1;
      TPlSegment(pLine.Segments[SIndex]).cpoint2 := f.ap1;
      Sindex := sIndex +1;
    end else if f is DrawObjects.TLine then begin
      SIndex := sIndex+1;
    end;

  end;

  RemoveSelection;
  if RecordUndo then TundoAction(FUndoList[0]).Tag:= 2;

  figures.add(pLine);

  pLine.Select;
  result := pLine.Handle;
  if RecordUndo then RecordInsertUndo(pLine,1);

  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  FAnySelected := true;
  Updated := True;
  Refresh;

  ex:
  FList.Free;
  Slist.Free;
  for i := 0 to Converts.Count -1 do
  begin
    TFigure(Converts[i]).Free;
  end;
  Converts.Free;

end;


Function TPCDrawing.MakeSelectedLinesPolyline:TFigHandle;
var
f : TFigure;
fline: TFigure;
cnt,a: integer;
points: TDoublePointArr;
nbrPoint,w,s,c: integer;
Row:integer;
lHandle: LongInt;
first: Boolean;
begin
  result := 0;
  cnt := Selection.Count;
  nbrPoint := 0;
  first := true;
  for a := 0 to cnt-1 do
  begin
    fline := TFigure(Selection[a]);
    if (fline is DrawObjects.TLine) and (fline.selected)  then
    begin
      if first then begin
        inc(nbrPoint);
        SetLength(Points,nbrPoint);
        points[nbrPoint-1] := fline.FigurePoints[1];
        inc(nbrPoint);
        SetLength(Points,nbrPoint);
        points[nbrPoint-1] := fline.FigurePoints[2];
        lHandle := fline.LayerHandle;
        w := fLine.width;
        s := fLine.Style;
        c := fline.Color;
        row := fLine.RowStyle;
        first := false;
      end else begin
        if (fline.FigurePoints[1].x <> points[nbrPoint-1].x) and
           (fline.FigurePoints[1].y <> points[nbrPoint-1].y)
        then begin
          inc(nbrPoint);
          SetLength(Points,nbrPoint);
          points[nbrPoint-1] := fline.FigurePoints[1];
        end;
        inc(nbrPoint);
        SetLength(Points,nbrPoint);
        points[nbrPoint-1] := fline.FigurePoints[2];
      end;
    end;
  end;

  if nbrPoint > 1 then begin
    for a := 0 to cnt-1 do
    begin
      fline := TFigure(Selection[a]);
      if (fline is DrawObjects.TLine) and (fline.selected)  then begin
        figures.remove(fLine);
        fLine.destroy;
      end;
    end;
    f := TPolyLine.create(points,w,s,c,ord(fDefBrsStyle),fDefbrsColor,row,false,LHandle,mydsNormal,self);
    figures.add(f);
    f.Select;
    result := f.Handle;
    if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
    FAnySelected := true;
    Updated := True;
    Refresh;
  end;
end;

Procedure TPCDrawing.UnClipSelBitmap;
var a: Integer;
    xBmp: TBmpObject;
    xFig: TFigure;
    xAction : TUndoAction;
Begin
  if RecordUndo then
    xAction := TUndoAction.Create(uaUnClip);
  for a := 0 to Selection.count-1 do
  begin
    If (Tfigure(Selection[a]) is TBMPObject) then
    begin
      xBmp := TBMpObject(Selection[a]);
      if assigned(xBmp.ClipFigure) then
      begin
        xFig := xBmp.ClipFigure;
        if RecordUndo then
        begin
          xAction.List.Add(xbmp);
          xAction.Params.Add(xfig);
        end;
        Figures.Add(xfig);
        xFig.SelecT;
        xBmp.ClipFigure := nil;
        Updated := True;
      end;
    end;
  end;
  if RecordUndo then
  begin
    if xAction.List.Count > 0 then
    begin
      InsertUndoAction(xAction);
    end else
      xAction.Free;
  end;

  refresh;
end;


Procedure TPCDrawing.ClipSelBitmapToSelFigure;
var a: Integer;
    xBmp: TBmpObject;
    xFig: TFigure;
    xAction: TUndoAction;
Begin
  if Selection.Count <> 2 then begin
    MessageDlg( emClipErr,mtError,[mbOk],0);
    exit;
  end;

  for a := 0 to Selection.count-1 do
  begin
    If (Tfigure(Selection[a]) is TBMPObject) then
    begin
      xBmp := TBMpObject(Selection[a]);
    end else begin
      xFig := TFigure(Selection[a]);
    end;
  end;

  if not assigned(xbmp) or (xFig.RegHandle = 0) then
  begin
    MessageDlg( emClipErr,mtError,[mbOk],0);
    exit;
  end;

  if RecordUndo then
  begin
    xAction := TUndoAction.Create(uaClip);
    xAction.List.Add(xbmp);
    xAction.Params.Add(xfig);
    InsertUndoAction(xAction);
  end;

  xBmp.ClipFigure := xFig;
  Figures.Remove(xFig);
  refresh;
  Updated := True;
end;



Procedure TPCDrawing.SetTransparentOfSelection(Transparent:Boolean);
var a: Integer;
    xAction:TUndoAction;
Begin
  if not FAnySelected then exit;
  if RecordUndo then
    xAction := TUndoAction.Create(uaModify);
  for a := 0 to Selection.count-1 do
    If (Tfigure(Selection[a]) is TBMPObject) then
    begin
      if RecordUndo then AddFigureToModifyUndo(xAction,Selection[a]);
      TBMPObject(Selection[a]).Transparent := Transparent ;
      Updated := True;
    end;
  if RecordUndo then
  begin
    if xAction.List.Count > 0 then
    begin
      InsertUndoAction(xAction);
    end else
    begin
      xAction.Free;
    end;
  end;
  refresh;
end;

function TPCDrawing.GetSelectionBlock: TBlock;
var a,x,sx: integer;
    FilelInes : TStringList;
    fStream: TFileStream;
    block:TBlock;
    fig:TFigure;
    figGrp:TfigureGrp;
    cnt: integer;
    bName: string;
begin
  sx := 0;

  if Selection.count>1 then begin
    GroupSelection;
  end;

  if (Selection.count=0) then exit;
  fig := TFigure(Selection[0]);
  Block := TBlock.create(0,Self);
  if ((fig is TFigureGrp) or (fig is TBlock)) then
  begin
    figGrp := TFigureGrp(fig);
    cnt := figGrp.InFigures.Count;
    for a := 0 to cnt-1 do
    begin
      Block.AddToGrp(figGrp.InFigures[a]); //28.04.2011 Block.InFigures.Add(figGrp.InFigures[a]);
    end;
    Block.Combined := figGrp.Combined;
  end else begin
    Block.AddToGrp(fig); //28.04.2011 Block.InFigures.Add(fig);
  end;
  //bName := ExtractFileName(FileName);
  //bName := Copy(bName,1,Length(bName)-4);
  //Block.Blockname := bName;
  Result := Block;
end;

function TPCDrawing.GetSelectionBlockDuplicate: TBlock;
var
  Block: TBlock;
begin
 Block := GetSelectionBlock;
 Result := TBlock(Block.duplicate);
 Block.InFigures.Clear;
 Block.Free;
end;

Procedure TPCDrawing.MakeSelectionBlock(FileName : string);
var a,x,sx: integer;
    FilelInes : TStringList;
    //fStream: TFileStream;
    block:TBlock;
    fig:TFigure;
    figGrp:TfigureGrp;
    cnt: integer;
    bName: string;
begin
  sx := 0;

  if Selection.count>1 then begin
    GroupSelection;
  end;

  if (Selection.count=0) then exit;
  fig := TFigure(Selection[0]);
  Block := TBlock.create(0,Self);
  if ((fig is TFigureGrp) or (fig is TBlock)) then
  begin
    figGrp := TFigureGrp(fig);
    cnt := figGrp.InFigures.Count;
    for a := 0 to cnt-1 do
    begin
      Block.AddToGrp(figGrp.InFigures[a]); //28.04.2011 Block.InFigures.Add(figGrp.InFigures[a]);
    end;
    Block.Combined := figGrp.Combined;
  end else begin
    Block.AddToGrp(fig); //28.04.2011 Block.InFigures.Add(fig);
  end;
  bName := ExtractFileName(FileName);
  bName := Copy(bName,1,Length(bName)-4);
  Block.Blockname := bName;

  //fStream := TFileStream.Create(FileName,fmCreate);
  //Block.WriteToStream(fStream);
  //fStream.free;
  Block.SaveToFile(FileName);

  //27.08.2010 FileLines := TStringList.Create;
  Block.InFigures.Clear;
  Block.Free;
end;

Procedure TPCDrawing.SetBlockInfo(FigHandle:Integer;Info: String);
begin
  TBlock(FigHandle).Info := Info;
end;

Function TPCDrawing.InsertBlockWithFileName(LayerNbr:integer;FileName: string;
                                           x,y: Double):TFigHandle;
var
  xStream: Tstream;
  xByte: Byte;
  sign: string;
  a: integer;
Begin
  sign := ''; // Tolik 05/04/2019 --
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then LayerNbr := 0;
  DeselectAll(0);
  xStream := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);

  for a := 1 to 6 do
  begin
    xStream.Read(xByte,1);
    //Tolik 05/04/2019 --
    //sign := sign + chr(xByte);
    sign := sign + Ansichar(xByte);
    //
  end;

  if Sign = 'TBlock' then
  begin
    xStream.Position := 0;
    result := InsertBlockFromStream(LayerNbr,xStream,x,y);
  end;
  xStream.free;
  Updated := True;
  Refresh;
End;

Function TPCDrawing.InsertBlockFromStream(LayerNbr: integer; Stream: TStream; x, y: Double): TFigHandle;
var
  Block: TBlock;
  i: Integer;
  mx, my, ax, ay, lx, ly: Double;
  lHandle, xhandle: LongInt;
  fig: Tfigure;
  DistedLayer: Boolean;
  Center: Boolean;
  scMult: Double;
begin
  DeselectAll(0);
  Result := 0;
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then
    LayerNbr := 0;
  lHandle := LongInt(Layers[LayerNbr]);
  Block := TBlock(TFigure.CreateFromStream(Stream, lHandle, mydsNormal, Self));
  if (x = -1) and (y = -1) then
  begin
    x := WorkWidth / 2;
    y := Workheight / 2;
  end;
  if assigned(Block) then
  begin
    Block.VerifyZeroPoints(Block.orgVz,Block.OrgHz);
    // Tolik 22/06/2021 --
    mx := 0;
    my := 0;
    ax := 0;
    ay := 0;
    //
    Block.getbounds(mx,my,ax,ay);
    lx := (mx+ax) / 2;
    ly := (my+ay) / 2;
    Block.move(x-lx,y-ly);
    Figures.Add(Block);
    Block.Name := Block.BlockName + inttostr(Block.Handle);
    Block.Select;
    Block.DiagonalScale := true;
    FAnySelected := True;
    xhandle := 0;
    Distedlayer := false;
    for i := 0 to Block.Infigures.Count-1 do
    begin
      fig := Tfigure(Block.Infigures[i]);
      if i = 0 then
        xhandle := fig.LayerHandle
      else begin
        if xHandle <> fig.LayerHandle then
          DistedLayer := true;
      end;
    end;

    if not distedlayer then
    begin
      for i := 0 to Block.Infigures.Count-1 do
      begin
        fig := Tfigure(Block.Infigures[i]);
        fig.LayerHandle := lHandle;
      end;
    end;
    if (Block.MapScale <> MapScale) and ((FRescale = rsAlways) or
     ((FReScale = rsAskUser) and
     (MessageDlg(ReScaleBlockMessage,mtConfirmation,[mbYes,mbNo],0) = mrYes)
     )) then begin
      scMult := Block.MapScale / MapScale;
      BLock.scale(scMult,scMult,Block.ap1);
    end;
    result := TFigHandle(Block);
    if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
    RecordInsertUndo(Block);
    Updated := True;
  end;
end;


function TPCDrawing.LoadFromFile(const FileName : string): Boolean;
Var a : integer;
    Lines : TStringList;
    DocLines : TStringList;
    xStream:TFileStream;
    i: integer;
Begin
  Result := false;
  Clear(0);
//  xStream := TFileStream.Create(FileName, fmOpenRead or fmShareExclusive);
  xStream := SafeOpenFileStream(FileName, fmOpenRead or fmShareExclusive, 'TPCDrawing.LoadFromFile', cSCSComponent_Msg22_10+' '+FileName+'. '+cCauseFailFileAccess);
  if xStream <> nil then
  begin
    LoadFromStream(xStream);
    xStream.Free;
    Updated := False;
    Refresh;
    Result := true;
    if GReadOnlyMode then
    begin
      for i := 0 to Figures.Count - 1 do
      begin
        TFigure(Figures[i]).LockModify := True;
        TFigure(Figures[i]).LockMove := True;
        TFigure(Figures[i]).LockSelect := True;
      end;
    end;
  end;
End;

function TPCDrawing.SaveToFile(LayerNbr:integer; FileName:string): Boolean;
var
  Lines : TStringlist;
  xStream: TFileStream;
begin
  Result := false;
  //08.09.2011 try
    ClearUndoList;
//    xStream := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
    xStream := SafeOpenFileStream(FileName, fmCreate or fmShareExclusive, 'TPCDrawing.SaveFromFile', cSCSComponent_Msg22_11+' '+FileName+'. '+cCauseFailFileAccess);
    if xStream <> nil then
    begin
      try
        SaveToStream(xStream);
      except
        on E: Exception do AddExceptionToLog('TPCDrawing.SaveToFile' + E.Message);
      end;
      Updated := False;
      xStream.Free;
      Result := true;
    end;
  //08.09.2011 finally
  //08.09.2011   xStream.Free;
  //08.09.2011 end;
end;


Procedure TPCDrawing.LoadFromStream(Stream: TStream);
var
  sBytes: array [1..8] of Byte;
  a,i: integer;
  Version: Word;
  SecCount: Byte;
  xSize: integer;
  SecStr: TMemoryStream;
  SecName: String;
  aFigure: TFigure;
  SCSCatalog: TSCSCatalog;
begin
  DisableAlign; //02.11.2011
  try //02.11.2011

    for a := 1 to 8 do
      Stream.Read(sBytes[a],1);

    for a := 1 to 8 do
      if sBytes[a] <> signBytes[a] then
      begin
        AddExceptionToLog('TPCDrawing.LoadFromStream');
  //      ShowMessage(emInvalidStream);
        Exit;
      end;
    try
      For a := 0 to Layers.Count - 1 do
      begin
        TLayer(Layers[a]).destroy;
      end;
      Layers.Clear;
    except
  //    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.LoadFromStream' + E.Message);
    end;

    Stream.Read(Version,2);
    Stream.Read(SecCount,1);

    for a := 1 to SecCount do
    begin
      Stream.Read(xSize,4);
      SecName := ReadStringFromStream(Stream);
      SecStr:= TMemoryStream.Create;
      StreamToStream(Stream,SecStr,xSize);
      SecStr.Seek(0,soFromBeginning);
      if SecName = 'Document' then
        SetDocumentProperties(SecStr)
      else
      if SecName = 'Layers' then
        SetLayerData(SecStr)
      else
      if SecName = 'Figures' then
        SetFiguresData(SecStr)
      else
      if SecName = 'Joins' then
        SetJoinsData(SecStr)
      else
      if SecName = 'Guides' then
        SetGuidesData(SecStr)

      else if SecName = 'Custom Stream' then
      begin
        if assigned(CustomStream) then
          CustomStream.free;
        CustomStream := TMemoryStream.Create;
        StreamToStream(SecStr,CustomStream,xSize);
        CustomStream.Position := 0;
        if assigned(FCustomStreamLoaded) then
          FCustomStreamLoaded(Self);
        CustomStream.Free;
      end;
      SecStr.Free;
    end;
    Updated := False;
  finally
    //Tolik -- 25/10/2017 --
    Self.FLastFigureID := 1000000;
    if Self.FLastFigureIDOnLoad > 1000000 then
      Self.FLastFigureID := Self.FLastFigureIDOnLoad;
    //
    try
      if CheckAssignedPCAD(Self) then
      begin
        TF_Cad(self.Owner).UpdateCheckedFigures(False);
        NotExistInCatalog := 0;
        for i := 0 to TF_Cad(self.Owner).FCheckedFigures.Count - 1 do
        begin
          aFigure := TFigure(TF_Cad(self.Owner).FCheckedFigures[i]);
          NotExistInCatalog := NotExistInCatalog or CheckFigureInsideCabinet(TF_Cad(self.Owner).FCheckedFigures, aFigure, true);
        end;
      end;
    except
    end;
    EnableAlign; //02.11.2011
    if GReadOnlyMode then
    begin
      for i := 0 to Figures.Count - 1 do
      begin
        TFigure(Figures[i]).LockModify := True;
        TFigure(Figures[i]).LockMove := True;
        TFigure(Figures[i]).LockSelect := True;
      end;
    end;

  end;
end;

Procedure TPCDrawing.SaveToStream(Stream: TStream);
var a: integer;
    Version: Word;
    SecCount: Byte;
    xSize: Integer;
    SecStr: TMemoryStream;
    xBmp: Tbitmap;
    //Tolik -- 25/07/2017 --
    RefreshFlag: boolean;
    //
begin
   RefreshFlag := GCanRefreshCad;
   GCanRefreshCad := True;
  try
    refresh;
  except
    on E: Exception do
    begin
      AddExceptionToLog('TPCDrawing.SaveToStream.RefreshCAD' + E.Message);
      //GCanRefreshCad := RefreshFlag;
    end;
  end;
  GCanRefreshCad := RefreshFlag;
  try
    xSize := 0;
    for a := 1 to 8 do
      Stream.Write(SignBytes[a],1);
    Version := GetVersion;
    SecCount := 5;

    if fSavePrev then
      SecCount := SecCount+1;
    if assigned(CustomStream) then
      SecCount := SecCount+1;


    Stream.Write(Version,2);
    Stream.Write(SecCount,1);

    if fSavePrev then begin
      // Section 0: Preview Image
      SecStr:= TMemoryStream.Create;
      xBmp := CreatePreviewBitmap;
      xBmp.SaveToStream(SecStr);
      xSize := SecStr.Size;
      SecStr.Seek(0,soFromBeginning);
      Stream.Write(xSize,4);
      WriteString(Stream,'Preview');
      StreamToStream(SecStr,Stream,xSize);
      SecStr.free;
      xbmp.free;
    end;


    // Section 1: Document Properties
    SecStr:= TMemoryStream.Create;
    GetDocumentProperties(SecStr);
    xSize := SecStr.Size;
    SecStr.Seek(0,soFromBeginning	);
    Stream.Write(xSize,4);
    WriteString(Stream,'Document');
    StreamToStream(SecStr,Stream,xSize);
    SecStr.free;

    // Section 2: Layer Data
    SecStr:= TMemoryStream.Create;
    GetLayerData(SecStr);
    xSize := SecStr.Size;
    SecStr.Seek(0,soFromBeginning	);
    Stream.Write(xSize,4);
    WriteString(Stream,'Layers');
    StreamToStream(SecStr,Stream,xSize);
    SecStr.free;

    // Section 3: Figures
    SecStr:= TMemoryStream.Create;
    GetFiguresData(SecStr);
    xSize := SecStr.Size;
    SecStr.Seek(0,soFromBeginning	);
    Stream.Write(xSize,4);
    WriteString(Stream,'Figures');
    StreamToStream(SecStr,Stream,xSize);
    SecStr.free;

    // Section 4: Line Joins
    SecStr:= TMemoryStream.Create;
    GetJoinsData(SecStr);
    xSize := SecStr.Size;
    SecStr.Seek(0,soFromBeginning	);
    Stream.Write(xSize,4);
    WriteString(Stream,'Joins');
    StreamToStream(SecStr,Stream,xSize);
    SecStr.free;

    // Section 5: Custom Stream
    if assigned(CustomStream) then
      CustomStream.Position := 0;
    if assigned(FCustomStreamUpdate) then
      FCustomStreamUpdate(Self);
    if assigned(CustomStream) then
    begin
      xSize := CustomStream.Size;
      CustomStream.Seek(0,soFromBeginning);
      Stream.Write(xSize,4);
      WriteString(Stream,'Custom Stream');
      StreamToStream(CustomStream,Stream,xSize);
    end;

    // Section 6: Guides Data
    SecStr := TMemoryStream.Create;
    GetGuidesData(SecStr);
    xSize := SecStr.Size;
    SecStr.Seek(0, soFromBeginning);
    Stream.Write(xSize, 4);
    WriteString(Stream, 'Guides');
    StreamToStream(SecStr, Stream, xSize);
    SecStr.free;

    Updated := False;
  except
    on E: Exception do AddExceptionToLog('TPCDrawing.SaveToStream' + E.Message);
  end;
end;

Procedure TPCDrawing.GetDocumentProperties(Stream:TStream);
var xInt: Integer;
    xByte: Byte;
    xWord: Word;
    xSize: integer;
    pGuides: pByte;
    a: integer;
    xDbl: Double;
begin
  xInt:= BackGround;
  WriteField(21,Stream,xInt,4);
  xInt:= GridColor;
  WriteField(22,Stream,xInt,4);
  xDbl:= GridStep;
  WriteField(220,Stream,xDbl,8);
  xInt:= GuideColor;
  WriteField(24,Stream,xInt,4);

  xDbl:= WorkWidth;
  WriteField(221,Stream,xDbl,8);
  xDbl:= WorkHeight;
  WriteField(222,Stream,xDbl,8);

  xInt:= ZoomScale;
  WriteField(27,Stream,xInt,4);
  xInt := Round(MapScale);
  WriteField(28,Stream,xInt,4);
  xInt:= PageColor;
  WriteField(29,Stream,xInt,4);

  xByte:= ord(PageLayout);
  WriteField(90,Stream,xByte,1);
  xByte:= ord(PageOrient);
  WriteField(91,Stream,xByte,1);
  xByte:= ord(VerticalZero);
  WriteField(92,Stream,xByte,1);
  xByte:= ord(HorizontalZero);
  WriteField(93,Stream,xByte,1);
  xByte:= ord(RulerSystem);
  WriteField(94,Stream,xByte,1);

  xDbl:= MapScale;
  WriteField(239, Stream, xDbl, sizeof(xDbl));

  if Guides.count > 0 then
  begin
    xSize := Guides.count * 9;
    GetMem(pGuides,xSize);
    for a := 0 to Guides.count -1 do
    begin
      pByte(pAnsiChar(pGuides) + a*9 )^ := ord(TGuideLine(Guides[a]).gType);
      pDouble(pAnsiChar(pGuides) + a*9 + 1)^ := TGuideLine(Guides[a]).coord;
    end;
    WriteBinField(151,Stream,pGuides,xSize); // the old format was 150
    FreeMem(pGuides, xSize); // Tolik 03/05/2019 - -
  end;
end;

Procedure TPCDrawing.SetDocumentProperties(Stream:TStream);
var xSize,bSize: Integer;
    xCode: Byte;
    intVal: integer;
    byteVal: Byte;
    strVal: string;
    dblval: Double;
    bytes: pByte;
begin
  xSize:= Stream.Size;
  Repeat
    Stream.Read(xCode,1);
    if (xCode >= 20) and (xCode < 90) then
    begin
      Stream.Read(intVal,4);
      SetDocumentPropertyInt(xCode,intVal);
    end
    else if (xCode >= 90) and (xCode < 120) then
    begin
      Stream.Read(byteVal,1);
      SetDocumentPropertyInt(xCode,byteVal);
    end
    else if (xCode >= 150) and (xCode < 180) then
    begin
      Stream.Read(bSize,4);
      GetMem(Bytes,bSize);
      Stream.Read(Bytes^,bSize);
      SetDocumentPropertyBin(xCode,bytes,bSize);
      FreeMem(Bytes, bSize); // Tolik 03/05/2109 --
    end
    else if (xCode >= 180) and (xCode < 220) then
    begin
      strval := ReadStringFromStream(Stream);
      SetDocumentPropertyStr(xCode,strval);
    end
    else if (xCode >= 220) and (xCode < 240) then
    begin
      Stream.Read(dblVal,8);
      if CompareValue(dblVal, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
        dblVal := 0;
      SetDocumentPropertyDbl(xCode,dblVal);
    end;
  until Stream.Position = xSize;
end;


Procedure TPCDrawing.SetDocumentPropertyInt(xCode:Byte; Value:Integer);
begin

  case  XCode of
    21: BackGround := Value;
    22: GridColor := Value;
    23: GridStep := Value/10;
    24: GuideColor := Value;
    25: WorkWidth := Value/10;
    26: WorkHeight := Value/10;
    27: ZoomScale := Value;
    28: MapScale := Value;
    29: PageColor := Value;
    90: PageLayout := TPageLayout(Value);
    91: PageOrient := TPageOrient(Value);
    92: VerticalZero := TVertZero(Value);
    93: HorizontalZero := THorzZero(Value);
    94: RulerSystem := TRulerSystem(Value);
  end;

end;

Procedure TPCDrawing.SetDocumentPropertyStr(xCode:Byte; Value:String);
begin
end;

Procedure TPCDrawing.SetDocumentPropertyDbl(xCode:Byte; Value:Double);
begin
  case  XCode of
    220: GridStep := Value;
    221: WorkWidth := Value;
    222: WorkHeight := Value;
    239: MapScale := Value;
  end;
end;

Procedure TPCDrawing.SetDocumentPropertyBin(xCode:Byte;Value:pByte; xSize:integer);
var xStream: TMemoryStream;
    gType: byte;
    gCoord: integer;
    gCoordD: Double;
    Guide: TGuideLine;
begin

  case xCode of
  150: begin
         xStream := TMemoryStream.Create;
         xStream.Write(Value^,xSize);
         xStream.Position := 0;
         repeat
           xStream.Read(gType,1);
           xStream.Read(gCoord,4);
           Guide := TGuideLine.create(TGuideType(gType),gCoord/10);
           Guides.Add(Guide);
         until xStream.Position = xStream.Size;
         // ===
         xStream.Free;
       end;
  151: begin
         xStream := TMemoryStream.Create;
         xStream.Write(Value^,xSize);
         xStream.Position := 0;
         repeat
           xStream.Read(gType,1);
           xStream.Read(gCoord,8);
           if CompareValue(gCoord, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
             gCoord := 0;
           Guide := TGuideLine.create(TGuideType(gType),gCoord);
           Guides.Add(Guide);
         until xStream.Position = xStream.Size;
         // ===
         xStream.Free;
       end;
  end;
end;


Procedure TPCDrawing.SetLayerData(Stream:TStream);
var xSize : Integer;
    a,lCount: integer;
    Layer : Tlayer;
    lyStream:TMemoryStream;
begin
  Stream.Read(lCount,4);

  for a := 1 to lCount do
  begin
    Stream.Read(xSize,4);
    lyStream := TMemoryStream.Create;
    StreamToStream(Stream,lyStream,xSize);
    lyStream.Seek(0,soFromBeginning);
    Layer := Tlayer.CreateFromStream(lyStream,DEngine,Self);
    lyStream.free;
    if layer <> nil then begin
      Layer.vertZero := ord(VerticalZero);
      Layer.horzZero := ord(HorizontalZero);
      Layers.Add(Layer);
    end;
  end;
end;

Procedure TPCDrawing.GetLayerData(Stream:TStream);
var a,lCount: integer;
    Layer : Tlayer;
    xSize: Integer;
    lyStream:TMemoryStream;
begin
  lCount := Layers.Count;
  Stream.Write(lCount,4);
  For a := 0 to lCount-1 do
  begin
    Layer := TLayer(Layers[a]);
    lyStream := TMemoryStream.Create;
    Layer.WriteToStream(lyStream,Self);
    xSize := lyStream.Size;
    lyStream.Seek(0,soFromBeginning);
    Stream.Write(xSize,4);
    StreamToStream(lyStream,Stream,xSize);
    lyStream.Free;
  end;
end;

// считать со Stream - создать на КАД
Procedure TPCDrawing.SetGuidesData(Stream: TStream);
var
  xSize: Integer;
  a, LCount: integer;
  Guide: TGuideLine;
  gStream: TMemoryStream;
begin
  try
    For a := 0 to Guides.Count - 1 do
    begin
      TGuideLine(Guides[a]).Destroy;
    end;
    Guides.Clear;
  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.SetGuidesData' + E.Message);
  end;

  Stream.Read(LCount, 4);

  for a := 1 to LCount do
  begin
    Stream.Read(xSize, 4);
    gStream := TMemoryStream.Create;
    StreamToStream(Stream, gStream, xSize);
    gStream.Seek(0, soFromBeginning);
    Guide := TGuideLine.CreateFromStream(gStream);
    gStream.Free;
    if Guide <> nil then
    begin
      Guides.Add(Guide);
    end;
  end;
end;

// записать в Stream - считать с КАД
Procedure TPCDrawing.GetGuidesData(Stream: TStream);
var
  a, LCount: integer;
  Guide: TGuideLine;
  xSize: Integer;
  gStream: TMemoryStream;
begin
  LCount := Guides.Count;
  Stream.Write(LCount, 4);
  For a := 0 to LCount - 1 do
  begin
    Guide := TGuideLine(Guides[a]);
    gStream := TMemoryStream.Create;
    Guide.WriteToStream(gStream);
    xSize := gStream.Size;
    gStream.Seek(0, soFromBeginning);
    Stream.Write(xSize, 4);
    StreamToStream(gStream, Stream, xSize);
    gStream.Free;
  end;
end;

// Tolik -- 21/02/2017 -- Старая закомменчена -- смотри ниже
Procedure TPCDrawing.SetFiguresData(Stream:TStream);
var a,fCount: integer;
    Figure : TFigure;
    xSize: Integer;
    figStream:TMemoryStream;
    CheckCounter, CurrentUserQuota, UserObjectsQuota: integer;
    UserQuotaReached: string;
    ee: Integer;
begin
   ee := 0;
   //времено для посмотреть
   if ee = 1 then
   begin
     Self.FBreakedOnQuota := True;
     //ShowMessage(UserQuotaReached);
     Exit;
   end;
   //
  UserQuotaReached := '';
  UserQuotaReached := GetQuotaMessage(CheckUserObjQuotaReached(1), cMess_Quota_OpenProj);


  if UserQuotaReached <> '' then
  begin
    //ShowMessage(UserQuotaReached);
    exit;
  end;
  CheckCounter := 0;
  Stream.Read(fCount,4);

  For a := 1 to fCount do
  begin
    if CheckCounter = 200 then
    begin
      CheckCounter := 0;
      UserQuotaReached := GetQuotaMessage(CheckUserObjQuotaReached(1), cMess_Quota_OpenProj);

      if UserQuotaReached <> '' then
      begin
        Self.FBreakedOnQuota := True;
        //ShowMessage(UserQuotaReached);
        Exit;
      end;
    end
    else
      Inc(CheckCounter);

    Stream.Read(xSize,4);
    figStream := TMemoryStream.Create;
    StreamToStream(Stream,figStream,xSize);
    figStream.Seek(0,soFromBeginning);
    Figure :=  nil;
    Figure := TFigure.CreateFromStream(figStream,0,mydsNormal,self);
    //Tolik 25/01/2021 --
    if Figure is TBMPObject then
      TBMPObject(Figure).ImageEdited := True;
    //
    if Figure.LayerHandle = 0 then
      Figure.LayerHandle := LongInt(Layers[1]);

    figStream.Free;
    if Figure <> nil then begin
      Figures.Add(Figure);
      if assigned(FOnObjectInserted) then
        FOnObjectInserted(Self,irLoad);
    end;
  end;
end;
{
Procedure TPCDrawing.SetFiguresData(Stream:TStream);
var a,fCount: integer;
    Figure : TFigure;
    xSize: Integer;
    figStream:TMemoryStream;

begin
  UserObjectsQuota := GetUserObjectsQuota;

  Stream.Read(fCount,4);
  For a := 1 to fCount do
  begin
    Stream.Read(xSize,4);
    figStream := TMemoryStream.Create;
    StreamToStream(Stream,figStream,xSize);
    figStream.Seek(0,soFromBeginning);
    Figure :=  nil;
    Figure := TFigure.CreateFromStream(figStream,0,mydsNormal,self);

    if Figure.LayerHandle = 0 then
      Figure.LayerHandle := LongInt(Layers[1]);

    figStream.Free;
    if Figure <> nil then begin
      Figures.Add(Figure);
      if assigned(FOnObjectInserted) then
        FOnObjectInserted(Self,irLoad);
    end;
  end;
end;
}
Procedure TPCDrawing.GetJoinsData(Stream:TStream);
var a: integer;
    jf: Tfigure;
    jStr: string;
begin
  For a:= 0 to Figures.Count-1 do
  begin
    if (TFigure(Figures[a]) is DrawObjects.TLine) then begin
      jf := DrawObjects.TLine(Figures[a]).JoinFigure1;
      if jf <> nil then
      begin
        jStr := DrawObjects.TLine(Figures[a]).Name+','+ TFigure(jf).Name;
        WriteStrField(180,Stream,jStr);
      end;
      jf := DrawObjects.TLine(Figures[a]).JoinFigure2;
      if jf <> nil then
      begin
        jStr := DrawObjects.TLine(Figures[a]).Name+','+ TFigure(jf).Name;
        WriteStrField(181,Stream,jStr);
      end;
    end;
    if (TFigure(Figures[a]) is TPolyLine) then begin
      jf := TPolyLine(Figures[a]).JoinFigure1;
      if jf <> nil then
      begin
        jStr := TPolyLine(Figures[a]).Name+','+ TFigure(jf).Name;
        WriteStrField(182,Stream,jStr);
      end;
      jf := TPolyLine(Figures[a]).JoinFigure2;
      if jf <> nil then
      begin
        jStr := TPolyLine(Figures[a]).Name+','+ TFigure(jf).Name;
        WriteStrField(183,Stream,jStr);
      end;
    end;
  end;

end;

Procedure TPCDrawing.SetJoinsData(Stream:TStream);
var xCode:Byte;
    strVal:string;
begin
  repeat
    Stream.read(xCode,1);
    StrVal := ReadStringFromStream(Stream);
    case xCode of
      180: BoundLineByText(StrVal,1);
      181: BoundLineByText(StrVal,2);
      182: BoundPLineByText(StrVal,1);
      183: BoundPLineByText(StrVal,2);
    end;
  until Stream.Position = Stream.Size;
end;


Procedure TPCDrawing.GetFiguresData(Stream:TStream);
var
  a, fCount: integer;
  Figure : TFigure;
  xSize: Integer;
  figStream:TMemoryStream;
  isExistShadow: boolean;
begin
  try
    Figure := nil; //#From Oleg# //20.09.2010

    if GCadForm <> nil then
      GCadForm.FCreateObjectOnClick := False;
    RestoreCadGridStatus; // Tolik 04/03/2021 --

    if GShadowObject <> nil then
    begin
      if Figures.IndexOf(GShadowObject) >= 0 then
      begin
        DestroyShadowObject;
      end;
    end;

    isExistShadow := True;
    while isExistShadow do
    begin
      isExistShadow := False;
      For a := 0 to Figures.Count - 1 do
      begin
        if TFigure(Figures[a]) is TFigureGrpNotMod then
          if TFigureGrpNotMod(Figures[a]).InFigures.Count = 1 then
            begin
              Figure := TFigureGrpNotMod(Figures[a]).InFigures[0];
              if Figure.ClassName = 'TLine' then
              begin
                isExistShadow := True;
                GIsDrawShadow := False;
                RemoveInFigureGrp(TFigureGrpNotMod(Figures[a]));
                Figures.Remove(Figures[a]);
                break;
              end;
            end;
      end;
    end;

    Figure := nil; //#From Oleg# //20.09.2010
    fCount := Figures.Count;
    Stream.Write(fCount, 4);
    For a := 0 to fCount - 1 do
    begin
      Figure := TFigure(Figures[a]);
      figStream := TMemoryStream.Create;
      Figure.WriteToStream(figStream);
      xSize := figStream.Size;
      figStream.Seek(0,soFromBeginning);
      Stream.Write(xSize,4);
      StreamToStream(figStream,Stream,xSize);
      if assigned(FOnObjectSaved) then
        FOnObjectSaved(Self,Figure);
      figStream.Free;
    end;
  except
    on E: Exception do
    begin
      AddExceptionToLogExt(ClassName, 'GetFiguresData', E.Message);
      //if Figure <> nil then
      //  ShowMessage('GetFiguresData ' + IntToStr(a) + ' name=' + Figure.Name + ' Classname=' + Figure.ClassName)
      //else
      //  ShowMessage('GetFiguresData ' + IntToStr(a));
      if Figure <> nil then
        AddExceptionToLogExt(ClassName, 'GetFiguresData ' + IntToStr(a) + ' name=' + Figure.Name + ' Classname=' + Figure.ClassName, '')
      else
        AddExceptionToLogExt(ClassName, 'GetFiguresData ' + IntToStr(a), '');
    end;
  end;
end;


Procedure TPCDrawing.BoundLineByText(Line:String;ptIndex:integer);
var fName1,fName2: string;
    s: TStringArray;
    myLine: DrawObjects.TLine;
    myFigure: Tfigure;
Begin
  myLine:= nil;
  myFigure := nil;
  if SplitStr(Line,s) = 2 then
  begin
    fName1 := s[0];fName2 := s[1];
    MyLine := DrawObjects.TLine(FindFigureByName(fname1));
    MyFigure := Tfigure(FindFigureByName(fName2));
    if (MyLine <> nil) and (MyFigure <> nil) then
    begin
     if ptIndex = 1 then MyLine.SetJFigure1(MyFigure);
     if ptIndex = 2 then MyLine.SetJFigure2(MyFigure);
    end;
  end;
End;

Procedure TPCDrawing.BoundPLineByText(Line:String;ptIndex:integer);
var fName1,fName2: string;
    s: TStringArray;
    myLine: TPolyLine;
    myFigure: Tfigure;
Begin
  myLine:= nil;
  myFigure := nil;

  if SplitStr(Line,s) = 2 then
  begin
    fName1 := s[0];fName2 := s[1];
    MyLine := TPolyLine(FindFigureByName(fname1));
    MyFigure := Tfigure(FindFigureByName(fName2));
    if (MyLine <> nil) and (MyFigure <> nil) then
     begin
       if ptIndex = 1 then MyLine.SetJFigure1(MyFigure);
       if ptIndex = 2 then MyLine.SetJFigure2(MyFigure);
    end;
  end;
End;

Function TPCDrawing.FindFigureByName(figName:String):TFigHandle;
var a,b: integer;
Layer: TLayer;
begin
  result := 0;
  For a := 0 to Figures.count-1 do
  begin
    if TFigure(Figures[a]).Name = figName then begin
      result := LongInt(TFigure(figures[a]));
      exit;
    end;
  end;
end;

Procedure TPCDrawing.ExportAsWmf(FileName: string);
var
  mf : TMetafile;
  mc : TMetafileCanvas;
  a : integer;
  Layer: TLayer;
Begin
  mf := DrawingAsWmf;
  mf.SaveToFile(FileName);
  mf.Free;

  exit;

  { что бы не сбивало с толку - вверху екзит стоит!
  mf := TMetafile.Create;
  prDpm := DotsPerMilOrig;
  mf.Width := Round(WorkWidth * prDpm);
  mf.Height := round(WorkHeight * prDpm);
  mc := TMetafileCanvas.Create(mf,0);
  SetEngine(mc,prConvertXY,prDeConvertXY,prConvertDim,prDeConvertDim,false,nil);
  DrawFigures;
  mc.Free;
  mf.SaveToFile(FileName);
  mf.Free;
  }
end;

Function TPCDrawing.SelectionAsMetaFile:Integer;
var xwmf:TMetafile;
begin
  xWmf := nil;
  xWmf := SelectionAsWmf;
  if assigned(xWmf) then result := xWmf.Handle else result := 0;
end;

Function TPCDrawing.SelectionAsWmf:TMetafile;
var mf : TMetafile;
    mc : TMetafileCanvas;
    r: TDoubleRect;
    w,h: Double;
    dx,dy: Double;
Begin
  mf := TMetafile.Create;
  dcDpm := DotsPerMilOrig;
  r := GetSelectionRect;
  w := abs(r.right-r.Left);
  h := abs(r.top-r.bottom);
  mf.Width := Round(w * dcDpm)+1;
  mf.Height := round(h * dcDpm)+1;
  mc := TMetafileCanvas.Create(mf,0);

  if VerticalZero = vzBottom then
    dy := workheight-r.bottom
  else
    dy := r.top;

  if HorizontalZero = vzLeft then
    dx := r.left
  else
    dx := workwidth-r.right;

  dcConvertDim(dx);
  dcConvertDim(dy);
  dcCoordX := Round(-1*dx);
  dcCoordy := Round(-1*dy);
  SetEngine(mc,dcConvertXY,prDeConvertXY,dcConvertDim,prDeConvertDim,false,nil);
  DrawSelectedFigures;
  mc.Free;
  result := mf;
end;

Function TPCDrawing.CreatePreviewBitmap: TBitmap;
var Bitmap: TBitmap;
    sc,scx,scy,w,h: Double;
Begin
  Bitmap := TBitmap.Create;
  w := WorkWidth;
  h := WorkHeight;
  scx := 85/w; scy := 100/h;
  if scx > scy then sc := scy else sc := scx;
  prDpm := sc;
  Bitmap.Width := Round((WorkWidth) * prDpm);
  Bitmap.Height := round((WorkHeight) * prDpm);
  SetEngine(Bitmap.canvas,prConvertXY,prDeConvertXY,prConvertDim,prDeConvertDim,false,nil);
  DrawFigures;
  result := Bitmap;
End;

Procedure TPCDrawing.SaveAsBitmap(Filename:string);
var
  Bitmap: TBitmap;
  OldH: integer;
Begin
  {//29.02.2012
  prDpm := DotsPerMilOrig;
  Bitmap := TBitmap.Create;
  Bitmap.Width := Round((WorkWidth) * prDpm);
  Bitmap.Height := round((WorkHeight) * prDpm);
  SetEngine(Bitmap.canvas,prConvertXY,prDeConvertXY,prConvertDim,prDeConvertDim,false,nil);}

  try
    Bitmap := PrepareBitmap; //29.02.2012

    Bitmap.Canvas.Brush.Color := PageColor;
    Bitmap.Canvas.Brush.Style := bsSolid;
    Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
    //SetEngine(Bitmap.Canvas,prConvertXY,prDeConvertXY,prConvertDim,prDeConvertDim,false,nil);
    DrawFigures;
    Bitmap.SaveToFile(filename);

    Bitmap.Free;
  except
  end;
End;

//function TPCDrawing.SaveToBitmap: TBitmap;
function TPCDrawing.SaveToBitmap(aPdfSave: Boolean = False): TBitmap;
begin
  Result := PrepareBitmap(aPdfSave);
  Result.Canvas.Brush.Color := PageColor;
  Result.Canvas.Brush.Style := bsSolid;
  Result.Canvas.FillRect(Rect(0, 0, Result.Width, Result.Height));
  DrawFigures;
end;

Procedure TPCDrawing.SaveSubstrateAsBitmap(FileName: string);(*vb*)
var
  Bitmap: TBitmap;
Begin
  {//29.02.2012
  prDpm := DotsPerMilOrig;
  Bitmap := TBitmap.Create;
  Bitmap.Width := Round((WorkWidth) * prDpm);
  Bitmap.Height := round((WorkHeight) * prDpm);
  SetEngine(Bitmap.canvas,prConvertXY,prDeConvertXY,prConvertDim,prDeConvertDim,false,nil);}
  Bitmap := PrepareBitmap; //29.02.2012
  DrawSubstrateFigures(False);
  Bitmap.SaveToFile(filename);
  Bitmap.Free;
End;

// Tolik 24/09/2019 --
function TPCDrawing.SaveSubstrateToBitmap(aPdfSave: Boolean = False): TBitmap;
//function TPCDrawing.SaveSubstrateToBitmap: TBitmap;
begin
  Result := PrepareBitmap(aPdfSave);
  DrawSubstrateFigures(False);
end;

Procedure TPCDrawing.DrawToCanvas(xCanvas:TCanvas;x,y:Integer;DScale:Double);
begin
  dcDpm := DotsPerMilOrig * (dScale);
  dcCoordx := x;
  dcCoordy := y;
  SetEngine(xCanvas,dcConvertXY,prDeConvertXY,dcConvertDim,dcDeConvertDim,false,nil);
  DrawFigures;
end;

Procedure TPCDrawing.DrawRectToCanvas(ARect: TDoubleRect; xCanvas:TCanvas;x,y:Integer;DScale:Double);
var
  PrinterBmp: TBitmap;
  OldTileX, OldTileY: Double;
begin
  OldTileX := TileX;
  OldTileY := TileY;

  PrinterBmp := TBitmap.Create;

  dcDpm := DotsPerMilOrig * (dScale);
  dcCoordx := x;
  dcCoordy := y;
  tileX := Min(ARect.Left, ARect.Right);
  tileY := Min(ARect.Top, ARect.Bottom);
  SetEngine(xCanvas,dcConvertXYTile,prDeConvertXY,dcConvertDim,dcDeConvertDim,false,nil);
  //SetEngine(xCanvas,prConvertXY,prDeConvertXY,prConvertDim,prDeConvertDim, true, PrinterBmp);
  DrawFigures;
  ClearNoRect(ARect);

  PrinterBmp.Free;

  TileX := OldTileX;
  TileY := OldTileY;
end;

Procedure TPCDrawing.DrawToDC(dc,x,y:integer;DScale:Double);
var xCanvas:TCanvas;
begin
  dcDpm := DotsPerMilOrig * (dScale);
  xCanvas:= TCanvas.Create;
  xCanvas.Handle := dc;
  dcCoordx := x;
  dcCoordy := y;
  SetEngine(xCanvas,dcConvertXY,prDeConvertXY,dcConvertDim,prDeConvertDim,false,nil);
  DrawFigures;
  xCanvas.Handle := 0;
  xCanvas.Free;
end;

Procedure TPCDrawing.StretchToDC(dc,aLeft,aTop,aRight,aBottom:Integer);
var xCanvas:TCanvas;
    Bitmap: TBitmap;
Begin
  prDpm := DotsPerMilOrig;
  Bitmap := TBitmap.Create;
  Bitmap.Width := Round((WorkWidth / 10) * prDpm);
  Bitmap.Height := round((WorkHeight / 10) * prDpm);
  SetEngine(Bitmap.canvas,prConvertXY,prDeConvertXY,prConvertDim,prDeConvertDim,false,nil);
  DrawFigures;
  xCanvas:= TCanvas.Create;
  xCanvas.Handle := dc;
  xCanvas.StretchDraw(Rect(aLeft,aTop,aRight,aBottom),Bitmap);
  Bitmap.Free;
  xCanvas.Handle := 0;
  xCanvas.Free;
end;

Procedure TPCDrawing.prDeConvertXY(var X,Y,Z:Double);
Begin
  x := x;
End;

Procedure TPCDrawing.prDeConvertDim(var Dim: Double);
Begin
  Dim := Dim / (prDpm * ConvertRatio * prnScale);
End;


Procedure TPCDrawing.prConvertXY(var X,Y,Z: Double);
Begin
  if VerticalZero = vzBottom then
    y := WorkHeight - y;
  if HorizontalZero = vzRight then
    x := WorkWidth - x;
  x := x - OFFMMX;
  y := y - OFFMMY;
  x := x - TileX;
  y := y - TileY;
  prConvertDim(x);
  prConvertDim(y);
  x := x + ConvertDx;
  y := y + ConvertDy;
  y := y - MCopyDelta;
End;

Procedure TPCDrawing.prConvertDim(var Dim: Double);
Begin
  Dim := Dim * (prDpm * ConvertRatio * prnScale);
End;

Procedure TPCDrawing.blkConvertXY(var X,Y,Z: Double);
begin
 if blkVZ = ord(vzBottom) then y := blkTopy - y else y := y-blkDistY;
 if blkHZ = ord(vzRight) then x := blkTopx - x else x := x-blkDistx;
 blkConvertDim(x);
 blkConvertDim(y);
 x := x+ConvertDx;
 y := y+ConvertDy;
 
end;

Procedure TPCDrawing.blkConvertDim(var Dim: Double);
begin
  Dim := Dim * (dcDpm*ConvertRatio);
end;


Procedure TPCDrawing.dcConvertXY(var X,Y,Z:Double);
Begin
  if VerticalZero = vzBottom then
    y := WorkHeight - y;
  if HorizontalZero = vzRight then
    x := WorkWidth - x;
  dcConvertDim(x);
  dcConvertDim(y);
  x := x + dcCoordx;
  y := y + dcCoordy;
  x := x+ConvertDx;
  y := y+ConvertDy;
End;

Procedure TPCDrawing.dcConvertXYTile(var X,Y,Z: Double);
begin
  if VerticalZero = vzBottom then
    y := WorkHeight - y;
  if HorizontalZero = vzRight then
    x := WorkWidth - x;
  x := x - TileX;
  y := y - TileY;
  dcConvertDim(x);
  dcConvertDim(y);
  x := x + dcCoordx;
  y := y + dcCoordy;
  x := x+ConvertDx;
  y := y+ConvertDy;
end;

Procedure TPCDrawing.dcConvertDim(var Dim: Double);
begin
 Dim := Dim * (dcDpm*ConvertRatio);
end;

Procedure TPCDrawing.prTileConvertXY(var X,Y,Z: Double);
Begin
 if VerticalZero = vzBottom then y := WorkHeight - y;
 if HorizontalZero = vzRight then x := WorkWidth - x;
 x := x-TileX;
 y := y-TileY;
 prConvertDim(x);
 prConvertDim(y);
 x := x+ConvertDx;
 y := y+ConvertDy;
 y := y-MCopyDelta;

End;

Procedure TPCDrawing.bmpConvertXY(var X,Y,Z: Double);
var minx,miny,maxx,maxy: Double;
    wHeight,wWidth: Double;
Begin

 if prBmpRect.Left > prBmpRect.Right then begin
   minX := prBmpRect.Right;
   maxX := prBmpRect.Left;
 end
 else begin
   maxX := prBmpRect.Right;
   minX := prBmpRect.Left;
 end;

 if prBmpRect.Top > prBmpRect.bottom then begin
   minY := prBmpRect.Bottom;
   maxY := prBmpRect.Top;
 end
 else begin
   maxY := prBmpRect.Bottom;
   minY := prBmpRect.Top;
 end;

 y := y-minY;
 x := x-minX;

 wWidth := abs(prBmpRect.Right-prBmpRect.Left);
 wHeight := abs(prBmpRect.Top-prBmpRect.Bottom);

 if VerticalZero = vzBottom then y := wHeight - y;
 if HorizontalZero = vzRight then x := wWidth - x;
 bmpConvertDim(x);
 bmpConvertDim(y);
 x := x+ConvertDx;
 y := y+ConvertDy;

End;

Procedure TPCDrawing.bmpConvertDim(var Dim: Double);
Begin
 Dim := Dim * (bmpDpm*ConvertRatio);
End;

Procedure TPCDrawing.PrnStartJob(TitleinStatusBox: String);
begin
  Printer.BeginDoc;
  Printer.Title := TitleinStatusBox;
end;

Procedure TPCDrawing.PrnDoJob(NewPage: Boolean);
begin
  if NewPage then Printer.NewPage;
  if FWmfPrint then PrintPageAsWmf else PrintPage;
end;

Procedure TPCDrawing.PrnAbortJob;
begin
  Printer.Abort;
end;

Procedure TPCDrawing.PrnEndJob;
begin
  Printer.EndDoc;
end;


Procedure TPCDrawing.PrintDrawing(TitleinStatusBox: String);
var
  prW, prH: Double;
  resW, resH, mW, mH: Integer;
begin
  tileY := 0;
  tileX := 0;
  MCopyDelta := 0;

  OFFMMX := 0; //29.11.2011
  OFFMMY := 0; //29.11.2011

  if FAutoTile and (not FWmfPrint) then
  begin
    prW := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
    prH := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
    resW := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
    resH := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
    mW := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
    mH := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);

    {//29.11.2011
    OFFX := mW;
    if OFFX > 0 then
    begin
      OFFX := OFFX + 12.7;
    end;
    OFFY := mH;
    if OFFY > 0 then
    begin
      if PageOrient = PCTypesUtils.poLandscape then
        OFFY := OFFY + 25.4;
      if PageOrient = PCTypesUtils.poPortrait then
        OFFY := OFFY - 25.4;
    end;

    DPIX := resW;
    DPIY := resH;

    OFFMMX := (OFFX / DPIX) * 25.4;
    OFFMMY := (OFFY / DPIY) * 25.4;
    OFFMMX := 0; //28.11.2011 OFFMMX := (OFFX / DPIX) * 25.4;
    OFFMMY := 0; //28.11.2011 OFFMMY := (OFFY / DPIY) * 25.4;}
    mw := round((mw / resw) * 25.4 * 2) + 6;
    mh := round((mh / resh) * 25.4 * 2) + 6;
    prW := round((prW / resw) * 25.4);
    prH := round((prH / resw) * 25.4);
    if (((prW + prnReservTiling) < (WorkWidth*prnScale)) or ((prh + prnReservTiling) < (WorkHeight*prnScale))) then
    begin
      PrintByTiling(TitleinStatusBox, prW, prH);
      exit;
    end;
  end;

  {//28.11.2011 - непечатываемые поля принтера в мм
  DPIX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
  DPIY := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
  OFFX := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
  OFFY := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
  OFFMMX := (OFFX / DPIX) * 25.4;
  OFFMMY := (OFFY / DPIY) * 25.4;}
  if (Abs(prnScale-1) < 0.1) and Assigned(FCheckPrnWithOffset) and FCheckPrnWithOffset(Self) then
  begin
    prW := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
    prH := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
    resW := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
    resH := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
    mW := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
    mH := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);

    OFFX := mW;
    if OFFX > 0 then
    begin
      //OFFX := OFFX + 12.7;
    end;
    OFFY := mH;
    {if OFFY > 0 then
    begin
      if PageOrient = PCTypesUtils.poLandscape then
        OFFY := OFFY + 25.4;
      if PageOrient = PCTypesUtils.poPortrait then
        OFFY := OFFY - 25.4;
    end;}
    DPIX := resW;
    DPIY := resH;
    OFFMMX := (OFFX / DPIX) * 25.4;
    OFFMMY := (OFFY / DPIY) * 25.4;
    //02.12.2011 - смещения
    OFFMMX := OFFMMX + 0.5;
    if PageOrient = PCTypesUtils.poLandscape then
    begin
      OFFMMY := OFFMMY + 0.5;
    end
    else
    if PageOrient = PCTypesUtils.poPortrait then
    begin
      OFFMMY := OFFMMY - 0.5;
      if OFFMMY < 0 then
        OFFMMY := 0;
    end;
  end;

  Printer.BeginDoc;
  Printer.Title := TitleinStatusBox;

  if FWmfPrint then
  begin
    PrintPageAsWmf;
  end
  else
  begin
    PrintPage;
  end;
  Printer.EndDoc;
end;

Procedure TPCDrawing.PrintPage;
var
  a,b: integer;
  Layer: TLayer;
  PrinterBmp, tBmp: TBitmap;
  Figure, xFigure: TFigure;
  isDraw, isFlue: boolean;
  bH, bW: double;
  xFigures: TList;
  // Test
  X, Y, Z, Dim: Double;
  Rect: TRect;
begin
{$ifndef betatest}
  ResetRegions;
  xFigures := TList.Create;
  // сформировать лист всех фигур
  For a := 0 to Figures.count - 1 do
  begin
    Figure := TFigure(Figures[a]);
    if (figure is TFigureGrp) then
    begin
      if TFigureGrp(figure).Visible then
        TFigureGrp(figure).GetFigures(xFigures);
    end
    else
    begin
      xFigures.Add(Figure);
    end;
  end;
  prDpm := (GetDeviceCaps(Printer.Handle, LOGPIXELSX) / 25.4);
  prDpm := (GetDeviceCaps(Printer.Handle, LOGPIXELSY) / 25.4);

  // перебор всех фигур
  For a := 0 to xFigures.count - 1 do
  begin
    Figure := TFigure(xFigures[a]);

    isDraw := True;
    if Figure.LayerHandle > 0 then
    begin
      Layer := TLayer(Figure.LayerHandle);
      isDraw := (Layer.visible <> lost);
      isFlue := (Layer.visible = Grayed);
    end;
    // MY
    if not Figure.Visible then
      isDraw := False;
    //
    // для BMP фигур
    if (isDraw and (Figure is TBmpObject) and (TBMPObject(Figure).Transparent)) then
    begin
      tBmp := TBitmap.Create;
      prBmpRect := Figure.getboundRect;
      bW := abs(prBmpRect.Left - prBmpRect.Right);
      bH := abs(prBmpRect.Top - prBmpRect.Bottom);
      tBmp.Width := 5;
      tBmp.Height := 5;
      SetEngine(tBmp.Canvas, prConvertXY, prDeConvertXY, prConvertDim, prDeConvertDim, true, tBmp);
      Dengine.DefinePrinting; //24.11.2011
      Figure.draw(Dengine, isFlue);
      Figure.DrawDimLines(Dengine, isFlue);
      PrinterBmp := TBitmap.Create;
      if Figure.ap1.y = Figure.ap2.y then
      begin
        PrinterBmp.Width := TBMPObject(Figure).Picture.Width;
        PrinterBmp.Height := TBMPObject(Figure).Picture.Height;
      end
      else
      begin  // rotated
        PrinterBmp.Width := TBMPObject(Figure).Image.Width;
        PrinterBmp.Height := TBMPObject(Figure).Image.Height;
      end;
      bmpDpm := PrinterBmp.Width / bw;
      SetEngine(PrinterBmp.Canvas, bmpConvertXY, prDeConvertXY, bmpConvertDim, prDeConvertDim, false, nil);
      Dengine.DefinePrinting; //24.11.2011
      For b := 0 to a - 1 do
      begin
        xFigure := TFigure(xFigures[b]);
        isDraw := True;
        isFlue := False;
        if Figure.LayerHandle > 0 then
        begin
          Layer := TLayer(Figure.LayerHandle);
          isDraw := (Layer.visible <> lost);
          isFlue := (Layer.visible = Grayed);
        end;
        if (isDraw or (Figure is TFigureGrp)) then
        begin
          xFigure.draw(Dengine, isflue);
          xFigure.DrawDimLines(Dengine, isFlue);
        end;
      end;
      SetEngine(Printer.Canvas, prConvertXY, prDeConvertXY, prConvertDim, prDeConvertDim, true, PrinterBmp);
      Dengine.DefinePrinting; //24.11.2011
      Figure.draw(Dengine, isFlue);
      Figure.DrawDimLines(Dengine, isFlue);
      PrinterBmp.free;
      tBmp.free;
    end
    else
    // для не BMP
    if isDraw then
    begin
      PrinterBmp := TBitmap.Create;

//      Rect := Printer.Canvas.ClipRect;
//      Rect.Left := Rect.Left + 35;
//      Rect.Right := Rect.Right + 35;
//      Rect.Top := Rect.Top + 35;
//      Rect.Bottom := Rect.Bottom + 35;
//      Printer.Canvas.DrawFocusRect(Rect);

      SetEngine(Printer.Canvas, prConvertXY, prDeConvertXY, prConvertDim, prDeConvertDim, true, PrinterBmp);
      Dengine.DefinePrinting; //24.11.2011
      if IsDraw then
      begin
//        Printer.Canvas.MoveTo(-6, -6);
//        Printer.Canvas.LineTo(100, 100);
        Figure.draw(Dengine, isFlue);
        Figure.DrawDimLines(Dengine, isFlue);
      end;
    end;
  end;
//  if assigned(PrinterBmp) then
//    PrinterBmp.SaveToFile('c:\11111111111.bmp');
  xFigures.Free;
  ResetRegions;
{$endif betatest}
end;


Procedure TPCDrawing.PrintByTiling(TitleinStatusBox: String; prWmm,prHmm: Double);
var
  pi,pk : integer;
  prow, pcol : integer;
  r: trect;
  bm: Tbitmap;

  OldTileX, OldTileY: Double;
Begin
  OldTileX := TileX;
  OldTileY := TileY;

  DefinePrnDivIndent; //29.11.2011

  prDpm := (GetDeviceCaps(Printer.Handle,LOGPIXELSX)/25.4);
  {//05.12.2011
  if prHmm >= WorkHeight then
    prow := 1
  else
  begin
    prHmm := prHmm - prnDivIndentX;
    prow := Trunc((WorkHeight+(prHmm)-1) / prHmm);
  end;
  if prWmm >= WorkWidth then
    pcol := 1
  else
  begin
    prWmm := prWmm - prnDivIndentY;
    pcol := Trunc((WorkWidth+(prWmm)-1) / (prWmm));
  end;}
  CalcPrDims(prWmm, prHmm, prow, pcol, WorkWidth, WorkHeight, prnScale);

  Printer.Title := TitleinStatusBox;
  Printer.BeginDoc;

  //04.01.2012 bm := GCadForm.PCad.CreatePreviewBitmap;
  //04.01.2012 bm.SaveToFile('111.bmp');
  
//  GCadForm.PCad.DrawToCanvas(Printer.Canvas, 0, 0, 2.95 / 1.41);

  for pi := 1 to prow do
  begin
    tileY := (pi-1) * prHmm / prnScale;
    for pk := 1 to pcol do
    begin
      tileX := (pk-1) * prWmm / prnScale;
      if FWmfPrint then
        PrintPageAsWmf
      else
        PrintPage;
      if not ((pi = prow) and (pk = pcol)) then
        Printer.NewPage;
    end;
  end;
  Printer.EndDoc;

  TileX := OldTileX;
  TileY := OldTileY;
end;

procedure TPCDrawing.PrintRect(aRect: TDoubleRect);
var
  pRect: TDoubleRect;
  rWidth, rHeight: Double;
  prW, prH: Double;
  resW, resH, mW, mH: Integer;

  Procedure PrintRectByTiling(prWmm,prHmm: Double);
  var
    pi,pk : integer;
    prow, pcol : integer;
    r: trect;
    bm: Tbitmap;
  Begin
    DefinePrnDivIndent; //29.11.2011

    prDpm := (GetDeviceCaps(Printer.Handle,LOGPIXELSX)/25.4);
    {if prHmm >= rHeight then
      prow := 1
    else
    begin
      prHmm := prHmm - prnDivIndentX;
      prow := Trunc((rHeight+(prHmm)-1) / prHmm);
    end;
    if prWmm >= rWidth then
      pcol := 1
    else
    begin
      prWmm := prWmm - prnDivIndentY;
      pcol := Trunc((rWidth+(prWmm)-1) / (prWmm));
    end;}
    CalcPrDims(prWmm, prHmm, prow, pcol, rWidth, rHeight, prnScale);

    Printer.BeginDoc;
    For pi := 1 to prow do
    begin
      tileY := pRect.Top + (pi-1) * prHmm / prnScale;
      for pk := 1 to pcol do
      begin
        tileX := pRect.Left + (pk-1) * prWmm / prnScale;
        if FWmfPrint then
          PrintPageAsWmf
        else
          PrintPage;
        ClearNoRect(pRect);
        
        if not ((pi = prow) and (pk = pcol)) then
          Printer.NewPage;
      end;
    end;
    Printer.EndDoc;
  end;

Begin
  Printer.Title := 'Drawing rect';
  tileY := 0;
  tileX := 0;
  //02.10.2013
  pRect.Left := Min(aRect.Left, aRect.Right);
  pRect.Top := Min(aRect.Top, aRect.Bottom);
  pRect.Right := Max(aRect.Left, aRect.Right);
  pRect.Bottom := Max(aRect.Top, aRect.Bottom);

  rWidth := pRect.Right - pRect.Left;
  rHeight := pRect.Bottom - pRect.Top;

  MCopyDelta := 0;

  prW := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
  prH := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
  resW := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
  resH := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
  mW := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
  mH := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);

  OFFMMX := 0; //3;
  OFFMMY := 0; //3;

  mw := round((mw / resw) * 25.4 * 2) + 6;
  mh := round((mh / resh) * 25.4 * 2) + 6;
  prw := round((prW / resw) * 25.4);
  prH := round((prH / resw) * 25.4);
  if (((prW + prnReservTiling) < (rWidth*prnScale)) or ((prh + prnReservTiling) < (rHeight*prnScale))) then
  begin
    PrintRectByTiling(prW, prH);
    exit;
  end;

  Printer.BeginDoc;
  try
    tileX := pRect.Left;
    tileY := pRect.Top;

    PrintPage;

    ClearNoRect(aRect);
  finally
    Printer.EndDoc;
  end;
  tileY := 0;
  tileX := 0;
end;

procedure TPCDrawing.CalcPrDims(var prWmm, prHmm: Double; var prow, pcol: Integer; AWorkW, AWorkH, AprnScale: Double);
begin
  AWorkW := AWorkW * AprnScale;
  AWorkH := AWorkH * AprnScale;

  prDpm := (GetDeviceCaps(Printer.Handle,LOGPIXELSX)/25.4);
  if prHmm >= AWorkH then
    prow := 1
  else
  begin
    prHmm := prHmm - prnDivIndentX;
    prow := {RoundUp(AWorkH / prHmm); //28.11.2011} Trunc((AWorkH+(prHmm)-1) / prHmm);
  end;

  if prWmm >= AWorkW then
    pcol := 1
  else
  begin
    prWmm := prWmm - prnDivIndentY;
    pcol := {RoundUp(AWorkW / prWmm); //28.11.2011} Trunc((AWorkW+(prWmm)-1) / (prWmm));
  end;
end;

procedure TPCDrawing.DefinePrnDivIndent; //29.11.2011
var
  DPIX, DPIY: double;
  OFFX, OFFY: double;
begin
  PrnDivIndentX := PrnDivIndent;
  PrnDivIndentY := PrnDivIndent;

  DPIX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
  DPIY := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
  OFFX := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
  OFFY := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
  PrnDivIndentX := (OFFX / DPIX) * 25.4;
  if PrnDivIndentX < PrnDivIndent then
    PrnDivIndentX := PrnDivIndent;
  PrnDivIndentX := PrnDivIndentX + prnDivOverlay;

  PrnDivIndentY := (OFFY / DPIY) * 25.4;
  if PrnDivIndentY < PrnDivIndent then
    PrnDivIndentY := PrnDivIndent;
  PrnDivIndentY := PrnDivIndentY + prnDivOverlay;
end;

procedure TPCDrawing.MirrorSelection(Point1,Point2: TDoublePoint; dupl: boolean);
var a: integer;
begin
  if RecordUndo then
    if not dupl then RecordModifyUndo(nil);
  if dupl then duplicateselection(0,0);
  for a := 0 to Figures.count - 1 do
  begin
    if TFigure(Figures[a]).selected then
    begin
      TFigure(Figures[a]).mirror(Point1,Point2);
    end;
  end;
  refresh;
  Updated := True;
end;

Procedure TPCDrawing.InterBreakSelection;
var i,bCnt,k: Integer;
    Selecteds: TList;
    breaker: TFigure;
    bp1,bp2: TDoublePoint;
    fig: TFigure;
    bList: TList;
    bArr,bPoints: TDoublePointArr;
    fList: TList;
    rList: TList;
    NewFigures: TList;
    TrashFigures: TList;
    found,done: boolean;
    Nonbreaks: TList;
    xAction: TUndoAction;
begin
  Selecteds := TList.Create;
  // Tolik -- 07/02/2017 -- это -- после проверки -- а вдруг вывалится нах, зачем лишнее создавать/удалять?
  {bList := TList.Create;
  rList := TList.Create;
  fList := TList.Create;
  NewFigures := TList.Create;
  TrashFigures := TList.Create;
  NonBreaks := TList.Create;}
  done := false;
  found := false;
  CollectSelectedFigures(Selecteds);
  // Tolik -- 07/02/2017 -- утечка памяти !!!
  //if selecteds.count  = 0 then exit;
  if selecteds.count  = 0 then
  begin
    FreeAndNil(Selecteds);
    exit;
  end;
  bList := TList.Create;
  rList := TList.Create;
  fList := TList.Create;
  NewFigures := TList.Create;
  TrashFigures := TList.Create;
  NonBreaks := TList.Create;
  //
  if RecordUndo then
    xAction := TUndoAction.Create(uaReplace);

  repeat
    i := 0;
    found := false;
    repeat
      breaker := TFigure(Selecteds[i]);
      if (breaker is DrawObjects.TLine) and
         not (breaker is TPolyline) and
         (nonbreaks.IndexOf(breaker) = -1) then found := true;
      i := i + 1;
    until found or (i = Selecteds.Count);
    if not found then begin
      done := true;
    end else begin
      bp1 := breaker.ap1;
      bp2 := breaker.ap2;
      SetLength(bPoints,0);
      bCnt := 0;
      for i := 0 to Selecteds.Count - 1 do
      begin
        fig := TFigure(Selecteds[i]);
        bList.Clear;
        if (fig <> breaker) and fig.Knife(bp1,bp2,bList) then begin
          for k := 0  to bList.Count - 1 do fList.Add(bList[k]);
          rList.Add(fig);
          SetLength(bArr,0);
          if fig.GetLinearInterSections(bp1,bp2,bArr) then begin
            bCnt := bCnt+Length(bArr);
            SetLength(bPoints,bCnt);
            for k := 0 to Length(bArr)- 1 do bPoints[bcnt - k - 1] := bArr[k];
          end;
        end;
      end;
      if bCnt > 0 then begin
        bList.Clear;
        if breaker.BreakbyPoints(bPoints,bList) then
        begin
          rList.Add(breaker);
          for k := 0  to bList.Count - 1 do fList.Add(bList[k]);
          for k := 0  to bList.Count - 1 do NonBreaks.Add(bList[k]);
        end;
      end;
      NonBreaks.Add(breaker);
      for k := 0 to rList.Count - 1 do
      begin
        Selecteds.Remove(rList[k]);
        TrashFigures.Add(rList[k]);
      end;
      rList.Clear;
      for k := 0 to fList.Count - 1 do
      begin
        fig := TFigure(fList[k]);
        Selecteds.Add(fig);
        NewFigures.Add(fig);
      end;
      fList.Clear;
    end;
  until done;

  for i := TrashFigures.Count - 1 downto 0 do
  begin
    fig := TFigure(TrashFigures[i]);
    fig.Deselect;
    fig.Deleted := True;
    fig.delIndex := Figures.IndexOf(fig);
    if (RecordUndo) and (fig.delIndex > -1) then begin
      xAction.Params.Add(fig);
      fig.Urc := fig.Urc + 1;
    end else begin
      fig.destroy;
    end;
    Figures.Remove(fig);
    Newfigures.Remove(fig);
  end;

  for i := 0 to NewFigures.Count - 1 do
  begin
    fig := TFigure(NewFigures[i]);
    Figures.Add(fig);
    fig.select;
    if RecordUndo then
      xAction.List.Add(fig);
  end;
  if RecordUndo then begin
    if xAction.List.Count > 0 then
      InsertUndoAction(xAction)
    else
      xAction.Free;
  end;
  Selecteds.free;
  bList.free;
  rList.free;
  fList.free;
  NewFigures.free;
  TrashFigures.Free;
  NonBreaks.Free;
  refresh;
  Updated := True;
end;

Procedure TPCDrawing.KnifeSelection(Point1,Point2: TDoublePoint);
var a,i: integer;
    xList,yList: TList;
    bfig,fig :Tfigure;
    xAction : TUndoAction;
begin
  xList := TList.Create;
  yList := TList.Create;

  if RecordUndo then
    xAction := TUndoAction.Create(uaReplace);

  a := Figures.count;
  repeat
    a := a - 1;
    bFig := TFigure(Figures[a]);
    if bfig.selected then
    begin
      if bFig.Knife(Point1,Point2,yList) then
      begin
        for i := 0 to yList.Count - 1 do
          xList.Add(yList[i]);
        bFig.Deselect;
        bFig.Deleted := True;
        if RecordUndo then
        begin
          xAction.Params.Add(bfig);
          bFig.Urc := bfig.Urc + 1;
          bFig.delIndex := Figures.IndexOf(bFig);
        end
        else
        begin
          bFig.destroy;
        end;
        Figures.Delete(a);
      end;
    end;
    yList.Clear;
  until a = 0;

  for a := 0 to xList.Count - 1 do
  begin
    fig := TFigure(xList[a]);
    fig.Select;
    Figures.Add(fig);
    if RecordUndo then xAction.List.Add(fig);
  end;

  if RecordUndo then begin
    if xAction.list.Count > 0 then
      InsertUndoAction(xAction)
    else xAction.Free;
  end;

  refresh;
  Updated := True;
  xList.free;
  yList.Free;
end;

Procedure TPCDrawing.LockSelectionToMove(Locked:Boolean);
var a: integer;
begin
  for a := 0 to Figures.count - 1 do
  begin
    if TFigure(Figures[a]).selected then
    begin
      TFigure(Figures[a]).LockMove:= Locked;
    end;
  end;
end;

Procedure TPCDrawing.LockSelectionToModify(Locked:Boolean);
var a: integer;
begin
  for a := 0 to Figures.count - 1 do
  begin
    if TFigure(Figures[a]).selected then
    begin
      TFigure(Figures[a]).LockModify:= Locked;
    end;
  end;
end;


procedure TPCDrawing.RotateSelection(Angle:Double;rPoint: TDoublePoint);
var a: integer;
begin
  if RecordUndo then
    RecordModifyUndo(nil);
  for a := 0 to Figures.count - 1 do
  begin
    if TFigure(Figures[a]).selected then
    begin
      TFigure(Figures[a]).Rotate(angle,rPoint);
    end;
  end;
  refresh;
  Updated := True;
end;


Procedure TPCDrawing.ScaleDrawing(percentx,percenty:Double);
var a: integer;
    rPoint:TDoublePoint;
    dRect: TDoubleRect;
begin
  dRect := GetDrawingRect;
  //rPoint :=  DoublePoint((drect.left+drect.right)/2,(drect.top+drect.bottom)/2);
  rPoint :=  DoublePoint(drect.left,drect.bottom);
  for a := 0 to Figures.count-1 do
      Tfigure(Figures[a]).scale(percentx,percenty,rPoint);
  refresh;
  Updated := True;
end;

procedure TPCDrawing.scaleSelection(percentx,percenty:Double;rPoint: TDoublePoint);
var a: integer;
begin
  for a := 0 to Selection.count-1 do
    if TFigure(Selection[a]).selected then
      Tfigure(Selection[a]).scale(percentx,percenty,rPoint);
  refresh;
  Updated := True;
end;

Function TPCDrawing.GetDrawingRect: TDoubleRect;
Var
  Resrect : TDoublerect;
  a: Integer;
  MaxX, MaxY, MinX, MinY : Double;
  figMaxX, figMaxY, figMinX, figMinY: Double;
  // Tolik 22/8/2019 --
  function CheckCorrectBounds: Boolean;
  begin
    Result := True;
    //abs(figMinY) > 10e+11
    //abs(figMinY) < 10e-11
    //if Pos('E', FloatTostr(figMinX)) > 0 then
    //if ((abs(figMinX) > 10e+11) or (abs(figMinX) < 10e-11)) then
    if (abs(figMinX) > 10e+11) then //or ((abs(figMinX) < 10e-11) and (abs(figMinX) > 0.0000001 )) then
    begin
      Result := False;
      exit;
    end
    else
    if (abs(figMinX) < 10e-11) then
      figMinX := 0;
    //if Pos('E', FloatTostr(figMaxX)) > 0 then
    //if ((abs(figMaxX) > 10e+11) or (abs(figMaxX) < 10e-11)) then
    if (abs(figMaxX) > 10e+11) then //or (figMaxX < -10e-11)) then
    begin
      Result := False;
      exit;
    end
    else
    if (abs(figMaxX) < 10e-11) then
      figMaxX := 0;
    //if Pos('E', FloatTostr(figMaxY)) > 0 then
    //if ((abs(figMaxY) > 10e+11) or (abs(figMaxY) < 10e-11)) then
    if (abs(figMaxY) > 10e+11) then//or (figMaxY < -10e-11)) then
    begin
      Result := False;
      exit;
    end
    else
    if (abs(figMaxY) < 10e-11) then
      figMaxY := 0;
    //if Pos('E', FloatTostr(figMinY)) > 0 then
    //if ((abs(figMinY) > 10e+11) or (abs(figMinY) < 10e-11)) then
    if (abs(figMinY) > 10e+11) then//or (figMinY < -10e-11)) then
    begin
      Result := False;
      exit;
    end
    else
    if (abs(figMinY) < 10e-11) then
      figMinY := 0;
  end;
  //
begin
  if Figures.count = 0 then
  begin
    Result := DoubleRect(0, 0, 0, 0);
    exit;
  end;
  figMaxX := 0;
  figMaxY := 0;
  figMinX := 0;
  figMinY := 0;
  TFigure(Figures[0]).GetBounds(figMaxX, figMaxY, figMinX, figMinY);
  // Tolik 22/08/2019 --
  //MaxX := figMaxX;
  //MinX := figMinX;
  //MaxY := figMaxY;
  //MinY := figMinY;
  MaxX := 0;
  MinX := 0;
  MaxY := 0;
  MinY := 0;

  if CheckCorrectBounds then
  begin
    MaxX := figMaxX;
    MinX := figMinX;
    MaxY := figMaxY;
    MinY := figMinY;
  end;
  //

  for a := 1 to Figures.Count - 1 do
  begin
    TFigure(Figures[a]).GetBounds(figMaxX, figMaxY, figMinX, figMinY);
    // Tolik 22/08/2019
    if CheckCorrectBounds then
    begin
    //
      if figMaxX > MaxX then
        MaxX := figMaxX;
      if figMaxY > MaxY then
        MaxY := figMaxY;

      if figMinX < MinX then
        if minX > 0 then
          MinX := figMinX;
      if figMinY < MinY then
        if MinY > 0 then
          MinY := figMinY;
    end;
  end;

  ResRect.left := MinX;
  ResRect.right := MaxX;
  ResRect.Top  := MinY;
  ResRect.Bottom := MaxY;

  Result := ResRect;
end;

function TPCDrawing.GetFigureListRect(AFigures: TList): TDoubleRect;
Var
  a: Integer;
  MaxX,MaxY,MinX,MinY : Double;
  figMaxX,figMaxY,figMinX,figMinY: Double;
begin
  if AFigures.count = 0 then
  begin
    Result := DoubleRect(0,0,0,0);
    exit;
  end;
  TFigure(AFigures[0]).GetSelBounds(figMaxX,figMaxY,figMinX,figMinY);
  MaxX := figMaxX;
  MinX := figMinX;
  MaxY := figMaxY;
  MinY := figMinY;
  for a := 1 to AFigures.Count - 1 do
  begin
    TFigure(AFigures[a]).GetSelBounds(figMaxX,figMaxY,figMinX,figMinY);
    if figMaxX > MaxX then MaxX := figMaxX;
    if figMinX < MinX then MinX := figMinX;
    if figMaxY > MaxY then MaxY := figMaxY;
    if figMinY < MinY then MinY := figMinY;
  end;
  Result.left := MinX;
  Result.right := MaxX;
  Result.Top  := MinY;
  Result.Bottom := MaxY;
end;

Procedure TPCDrawing.GetDrawingBounds(var MaxX,MaxY,MinX,MinY: Double);
Var
  a:Integer;
  figMaxX,figMaxY,figMinX,figMinY: Double;
begin
  MaxX := 0; MaxY := 0;
  MinX := 0; MinY := 0;
  if Figures.count = 0 then exit;
  TFigure(Figures[0]).GetBounds(figMaxX,figMaxY,figMinX,figMinY);
  MaxX := figMaxX;
  MinX := figMinX;
  MaxY := figMaxY;
  MinY := figMinY;

  for a := 1 to Figures.Count - 1 do
  begin
    TFigure(Figures[a]).GetBounds(figMaxX,figMaxY,figMinX,figMinY);
    if figMaxX > MaxX then MaxX := figMaxX;
    if figMinX < MinX then MinX := figMinX;
    if figMaxY > MaxY then MaxY := figMaxY;
    if figMinY < MinY then MinY := figMinY;
  end;
end;

Function TPCDrawing.getSelectionRect: TDoubleRect;
Var
  Resrect : TDoublerect;
  a: Integer;
  MaxX,MaxY,MinX,MinY : Double;
  figMaxX,figMaxY,figMinX,figMinY: Double;
begin
  if Selection.count = 0 then
  begin
    Result := DoubleRect(0,0,0,0);
    exit;
  end;
  TFigure(Selection[0]).GetSelBounds(figMaxX,figMaxY,figMinX,figMinY);
  MaxX := figMaxX;
  MinX := figMinX;
  MaxY := figMaxY;
  MinY := figMinY;

  for a := 1 to Selection.Count - 1 do
  begin
    TFigure(Selection[a]).GetSelBounds(figMaxX,figMaxY,figMinX,figMinY);
    if figMaxX > MaxX then MaxX := figMaxX;
    if figMinX < MinX then MinX := figMinX;
    if figMaxY > MaxY then MaxY := figMaxY;
    if figMinY < MinY then MinY := figMinY;
  end;



  ResRect.left := MinX; ResRect.right := MaxX;
  ResRect.Top  := MinY; ResRect.Bottom := MaxY;
  Result := ResRect;
end;


Procedure TPCDrawing.GetSelectionBoundS(var MaxX,MaxY,MinX,MinY: Double);
Var
  Selecteds : TList;
  Resrect : TDoublerect;
  a: integer;
  figMaxX,figMaxY,figMinX,figMinY: Double;
begin

  Selecteds := TList.Create;
  CollectSelectedFigures(Selecteds);

  if selecteds.count = 0 then
  begin
    figMaxX := 0;figMaxY := 0;figMinX := 0;figMinY := 0;
    // Tolik -- 07/02/2017 -- утечка памяти!!!
    FreeAndNil(Selecteds);
    //
    exit;
  end;

  TFigure(Selecteds[0]).GetBounds(figMaxX,figMaxY,figMinX,figMinY);
  MaxX := figMaxX;
  MinX := figMinX;
  MaxY := figMaxY;
  MinY := figMinY;

  for a := 1 to Selecteds.Count - 1 do
  begin
    TFigure(Selecteds[a]).GetBounds(figMaxX,figMaxY,figMinX,figMinY);
    if figMaxX > MaxX then MaxX := figMaxX;
    if figMinX < MinX then MinX := figMinX;
    if figMaxY > MaxY then MaxY := figMaxY;
    if figMinY < MinY then MinY := figMinY;

  end;
  Selecteds.Free;

end;


Procedure TPCDrawing.ArrayRectSelection(distanceX,distanceY: Double;col,row: integer);
var selecteds : TList;
    a,b,x : integer;
    newFig,Fig : TFigure;
    xAction: TUndoAction;
begin
  selecteds := TList.create;
  CollectSelectedFigures(selecteds);
  if RecordUndo then xAction := TUndoAction.Create(uaInsert);
  for a := 0 to row-1 do
  begin
    for b := 0 to col-1 do
    begin
      if not((a = 0) and (b = 0)) then
      begin
        for x := 0 to selecteds.count - 1 do
        begin
          fig := TFigure(selecteds[x]);
          newFig := fig.duplicate;
          newFig.move(distanceX*b,distanceY*a);
          Figures.Add(newFig);
          if RecordUndo then xAction.List.Add(newFig);
        end;
      end;
    end;
  end;
  Selecteds.Free;
  if RecordUndo then
  begin
    InsertUndoAction(xAction);
  end;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  refresh;
  Updated := True;
end;

Procedure TPCDrawing.ArrayPolarSelection(cpoint: TDoublePoint; angle: Double);
var selecteds : TList;
    a,b,x : integer;
    fig : TFigure;
    newFig : TFigure;
    bounds : TRect;
    MaxY,MinY, MaxX, MinX, distanceX,distanceY: Double;
    nbrofDups: Integer;
    centerSelecteds, NewPoint : TDoublePoint;
    xAction:TUndoAction;
    xAngle: Double;
    neg : Integer;
begin

  selecteds := TList.create;
  CollectSelectedFigures(selecteds);
  neg := 1;
  if angle < 0 then neg := -1;
  //angle := angle*neg;

  nbrOfDups := Round((2*pi) / abs(angle)) -1;
  GetselectionBounds(MaxX,MaxY, MinX, MinY);
  centerSelecteds.x := MinX+ (MaxX-MinX)/2;
  centerSelecteds.y := MinY+ (MaxY-MinY)/2;
  if RecordUndo then xAction := TUndoAction.Create(uaInsert);
  for a := 1 to nbrOfDups do
  begin
    //xAngle := (abs(angle))*a;
    //xAngle := xAngle * neg;
    xAngle := angle*a;
    for x := 0 to selecteds.count - 1 do
    begin

      NewPoint := RotatePoint(cPoint,CenterSelecteds, xAngle);
      distanceX := NewPoint.x - centerSelecteds.x;
      distanceY := NewPoint.y - centerSelecteds.y;
      fig := TFigure(selecteds[x]);
      newFig := fig.duplicate;
      //newFig.Move(distanceX,distanceY);
      //newfig.Rotate(xAngle , NewPoint);
      newfig.Rotate(xAngle , cPoint);
      Figures.Add(newFig);
      if RecordUndo then xAction.List.Add(newFig);
    end;
  end;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  Selecteds.Free;
  if RecordUndo then
  begin
    InsertUndoAction(xAction);
  end;
  refresh;
  Updated := True;
End;

Procedure TPCDrawing.DuplicateSelectionAsBezier(deltax,deltay: Double);
var selecteds : TList;
    a,x,i : integer;
    fig : TFigure;
    newFig : TFigure;
    xAction : TUndoAction;
begin
  selecteds := TList.create;
  CollectSelectedFigures(Selecteds);
  // Tolik -- 07/02/2017 -- утечка памяти!!!
  //if selecteds.count = 0 then exit;
  if selecteds.count = 0 then
  begin
    freeAndNil(Selecteds);
    exit;
  end;
  //
  deselectall(0);
  if RecordUndo then
    xAction := TUndoAction.Create(uaInsert);
  for x := 0 to selecteds.count - 1 do
  begin
    fig := TFigure(selecteds[x]);
    newFig := fig.duplicateAsBezier;
    if assigned(newfig) then
    begin

      newFig.move(deltaX,deltaY);
      if (fig is TTExt) and (newFig is TFigureGrp) then
      begin
        for i :=0 to TFigureGrp(newFig).InFigures.Count-1 do
        begin
          TFigure(TFigureGrp(newFig).InFigures[i]).Select;
          Figures.Add(TFigureGrp(newFig).InFigures[i]);
          if RecordUndo then xAction.List.Add(TFigureGrp(newFig).InFigures[i]);
          if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
        end;
        newfig.Destroy;
      end else begin
        newFig.Selected := True;
        Figures.Add(newFig);
        if RecordUndo then xAction.List.Add(newFig);
        if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
      end;
    end;
  end;
  FAnySelected := true;
  Selecteds.Free;
  if RecordUndo then
  begin
    if xAction.List.Count > 0 then
      InsertUndoAction(xAction)
    else begin
      xAction.Free;
    end;
  end;
  refresh;
  Updated := True;
end;

Procedure TPCDrawing.ConvertSelectionToBezier;
var selecteds : TList;
    a,x,i : integer;
    fig : TFigure;
    newFig : TFigure;
    xAction : TUndoAction;
begin
  selecteds := TList.create;
  CollectSelectedFigures(Selecteds);
  // Tolik -- 07/02/2017 -- утечка памяти!!!
  //if selecteds.count = 0 then exit;
  if selecteds.count = 0 then
  begin
    freeAndNil(Selecteds);
    exit;
  end;
  //
  if RecordUndo then
    xAction := TUndoAction.Create(uaReplace);
  for x := 0 to selecteds.count - 1 do
  begin
    fig := TFigure(selecteds[x]);
    newFig := fig.duplicateAsBezier;
    //newFig := fig.duplicateAsStroke;
    if assigned(newfig) then
    begin
      fig.Deselect;
      fig.Deleted := True;

      if (not (fig is TFigureGrp)) and (newFig is TFigureGrp) then
      begin
        for i :=0 to TFigureGrp(newFig).InFigures.Count-1 do
        begin
          TFigure(TFigureGrp(newFig).InFigures[i]).Select;
          Figures.Add(TFigureGrp(newFig).InFigures[i]);
          if RecordUndo then xAction.List.Add(TFigureGrp(newFig).InFigures[i]);
        end;
        TFigureGrp(newFig).Infigures.Clear;
        newfig.Destroy;
      end else begin
        newFig.Select;
        Figures.Add(newFig);
        if RecordUndo then xAction.List.Add(newFig);
      end;
      if RecordUndo then begin
        xAction.Params.Add(fig);
        fig.Urc := fig.Urc+1;
        fig.delIndex := Figures.IndexOf(fig);
      end else begin
        fig.destroy;
      end;
      Figures.Remove(fig);
    end;
  end;
  FAnySelected := true;
  Selecteds.Free;
  if RecordUndo then
  begin
    if xAction.List.Count > 0 then begin
      InsertUndoAction(xAction);
    end else
      xAction.Free;
  end;
  refresh;
  Updated := True;
end;


Procedure TPCDrawing.DuplicateSelection(deltaX,deltaY:Double);
var selecteds : TList;
    a,x : integer;
    fig : TFigure;
    newFig : TFigure;
    xAction : TUndoAction;
begin
  selecteds := TList.create;
  CollectSelectedFigures(Selecteds);
  // Tolik -- 07/02/2017 -- утечка памяти!!!
  //if selecteds.count = 0 then exit;
  if selecteds.count = 0 then
  begin
    freeAndNil(Selecteds);
    exit;
  end;
  //
  deselectall(0);
  if RecordUndo then
    xAction := TUndoAction.Create(uaInsert);
  for x := 0 to selecteds.count - 1 do
  begin
    fig := TFigure(selecteds[x]);
    newFig := fig.duplicate;
    if assigned(newfig) then
    begin
      newFig.move(deltaX,deltaY);
      newFig.Selected := True;
      Figures.Add(newFig);
      if RecordUndo then xAction.List.Add(newFig);
      if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
    end;
  end;
  FAnySelected := true;
  Selecteds.Free;
  if RecordUndo then
  begin
    InsertUndoAction(xAction);
  end;
  refresh;
  Updated := True;
end;


Function TPCDrawing.CountBlock(BlockName:String):integer;
var f:TFigure;
    a,cnt,i: integer;
    fg: TFigureGrp;
begin
  cnt := 0;
  for a := 0 to Figures.Count-1 do
  begin
    f := TFigure(Figures[a]);
    if f is TBlock then
    begin
      if TBlock(f).BlockName = BlockName then cnt := cnt +1;
    end
    else if f is TFigureGrp then begin
      fg := TFigureGrp(f);
      cnt := cnt + fg.CountBlock(BlockName);
    end;
  end;
  result := cnt;
end;

Procedure TPCDrawing.CountBlocks(list:TStrings);
var f:TFigure;
    a: integer;
    counts: array of Integer;
    fg: TFigureGrp;
    bName: String;
    idx: Integer;
begin
  if not assigned(list) then exit;
  list.Clear;
  for a := 0 to Figures.Count-1 do
  begin
    f := TFigure(Figures[a]);
    if f is TBlock then
    begin
      bName := TBlock(f).BlockName;
      idx := list.IndexOf(bName);
      if idx = -1 then
      begin
        list.Add(bName);
        SetLength(Counts,list.Count);
        Counts[List.Count-1] := 1;
      end else begin
        Counts[idx] := Counts[idx]+1;
      end;
    end;
  end;
  For a := 0 to list.Count-1 do
  begin
    list[a] := List[a] +'  '+ inttostr(Counts[a]);
  end;
end;

Procedure TPCDrawing.CountBlocksByInfo(list:TStrings);
var f:TFigure;
    a: integer;
    counts: array of Integer;
    fg: TFigureGrp;
    bName: String;
    idx: Integer;
begin
  if not assigned(list) then exit;
  list.Clear;
  for a := 0 to Figures.Count-1 do
  begin
    f := TFigure(Figures[a]);
    if (f is TBlock) and (TBlock(f).Info <> '') then
    begin
      bName := TBlock(f).Info;
      idx := list.IndexOf(bName);
      if idx = -1 then
      begin
        list.Add(bName);
        SetLength(Counts,list.Count);
        Counts[List.Count-1] := 1;
      end else begin
        Counts[idx] := Counts[idx]+1;
      end;
    end;
  end;
  For a := 0 to list.Count-1 do
  begin
    list[a] := List[a] +'  '+ inttostr(Counts[a]);
  end;
end;


////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////

/// Figure Commands

Function TPCDrawing.AddCustomFigure(LayerNbr:integer;CustomFig: TFigure;Selected:Boolean): TFigHandle;
var
  i: Integer;
  vLayer: TLayer;
  figLayerNbr: Integer;
begin
  if (layerNbr < 0) or (layerNbr > layers.count) then
    layerNbr := 0;
  CustomFig.LayerHandle := Integer(Layers[LayerNbr]);
  CustomFig.Owner := self;
  if CustomFig is TfigureGrp then
  begin
    for i := 0 to TFigureGrp(CustomFig).InFigures.Count - 1 do
    begin
      vLayer := Tlayer(TFigure(TFigureGrp(CustomFig).InFigures[i]).LayerHandle);
      if (vLayer = nil) or (not vLayer.IsDxf) then
        TFigure(TFigureGrp(CustomFig).InFigures[i]).LayerHandle := Integer(Layers[LayerNbr]);
      if vLayer = nil then
        AddExceptionToLogEx('TPCDrawing.AddCustomFigure', 'Not defined Layer for Object');
      TFigure(TFigureGrp(CustomFig).InFigures[i]).Owner := Self;
    end;
  end;

  figures.add(Customfig);
  if selected then CustomFig.Select;
  result := Customfig.Handle;
  if selected then FAnySelected := true;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  Updated := True;
  if CheckAssignedPCAD(Self) then
  begin
    if (LayerNbr = 2)or(LayerNbr = 9) then
    begin
      TF_CAD(Self.Owner).FNeedUpdateCheckedFigures := True;
      //GCadForm.FNeedUpdateCheckedFigures := True;
    end;
  end;  
end;

Function TPCDrawing.GetCustomStream(var size:Integer):Integer;
var buf:pByte;
begin
  result := 0;
  size := 0;
  if assigned(CustomStream) then
  begin
    size := CustomStream.Size;
    GetMem(buf,size);
    CustomStream.Position := 0;
    CustomStream.Read(buf^,size);
    result := Integer(buf);
  end;
end;

Procedure TPCDrawing.SetCustomStream(size:Integer;var data:Byte);
begin
  if assigned(CustomStream) then
    CustomStream.Free;
  if (size > 0) then
  begin
    CustomStream := TMemoryStream.Create;
    CustomStream.Write(data,size);
    CustomStream.Position := 0;
    // WARNING
    CustomStream.Free;
  end;
end;


Function TPCDrawing.GetFigureCustomStream(f:Integer; var size:Integer):Integer;
var figure:TFigure;
    buf:pByte;
begin
  figure := TFigure(f);
  result := 0;
  size := 0;
  if assigned(figure.CustomStream) then
  begin
    size := figure.CustomStream.Size;
    GetMem(buf,size);
    figure.CustomStream.Position := 0;
    figure.CustomStream.Read(buf^,size);
    result := Integer(buf);
  end;
end;

Procedure TPCDrawing.SetFigureCustomStream(f:Integer;size:Integer;var data:Byte);
var
  figure: TFigure;
begin
  figure := TFigure(f);
  if assigned(figure.CustomStream) then
    figure.CustomStream.Free;
  if (size > 0) then
  begin
    figure.CustomStream := TMemoryStream.Create;
    figure.CustomStream.Write(data,size);
    figure.CustomStream.Position := 0;
    // WARNING
    figure.CustomStream.Free;
  end;
end;


Function TPCDrawing.line(LayerNbr:Integer;x1,y1,x2,y2:Double;w,s,c:integer; row:integer; Selected: Boolean):TFigHandle;
var
f : TFigure;
begin
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  f := DrawObjects.TLine.create(x1,y1,x2,y2,w,s,c,row,LongInt(Layers[LayerNbr]),mydsNormal,self);
  figures.add(f);
  if selected then f.select;
  result := f.Handle;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  if selected then FAnySelected := true;
  if RecordUndo then RecordInsertUndo(f);
  Updated := True;
end;

Function TPCDrawing.Vertex(LayerNbr:INteger;x,y:Double;Selected: Boolean):TFigHandle;
var
f : TFigure;
Begin
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  f := TVertex.create(x,y,LongInt(Layers[LayerNbr]),mydsNormal,self);
  figures.add(f);
  if selected then f.Select;
  result := f.Handle;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  if selected then FAnySelected := true;
  Updated := True;
End;

Function TPCDrawing.PolyLine(LayerNbr:integer;var points: TDoublePoint;
                             pCount,w,s,c: integer;
                             Row:integer;
                             brs,brc: integer;
                             Closed,Selected: Boolean):TFigHandle;
var p:TDoublePointArr;
a: Integer;
x,y: Double;
begin
  SetLength(p,pCount);
  for a := 0 to pCount-1 do
  begin
    x := pDouble(pAnsiChar(@points)+(a)*16+0)^;
    y := pDouble(pAnsiChar(@points)+(a)*16+8)^;
    //x := pDouble(pChar(@points)+(a)*16+0)^;
    //y := pDouble(pChar(@points)+(a)*16+8)^;
    p[a] := DoublePoint(x,y);
  end;

  result := PolyLine(LayerNbr,p,w,s,c,Row,brs,brc,Closed,Selected);
end;

Function TPCDrawing.PolyLine(LayerNbr: integer; points: TDoublePointArr;
                             w, s, c: integer; Row: integer; brs, brc: integer;
                             Closed, Selected: Boolean): TFigHandle;
var
  f : TFigure;
begin
  if Length(points) < 2 then
  begin
    result := -1;
    exit;
  end;
  if (layerNbr<0) or (layerNbr>layers.count) then
    LayerNbr := 0;
  f := TPolyLine.create(points, w, s, c, brs, brc, row, Closed, LongInt(Layers[LayerNbr]), mydsNormal, self);
  figures.add(f);
  if selected then
    f.Select;
  result := f.Handle;
  if assigned(FOnObjectInserted) then
    FOnObjectInserted(self,irCreate);
  if selected then
    FAnySelected := true;
  Updated := True;
end;



//** For backwards compatibilty
Function TPCDrawing.Polygon(LayerNbr:integer; points:TDoublePointArr;w,s,c,brs,brc:integer;Selected: Boolean):TFigHandle;
begin
  result := PolyLine(LayerNbr,points,w,s,c,0,brs,brc,true,selected);
end;

Function TPCDrawing.Ellipse(LayerNbr:Integer;cx,cy,lenax,lenbx,angle:Double;w,s,c,brs,brc:integer;Selected: Boolean):TFigHandle;
var
f: TFigure;
begin
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  f := TEllipse.create(cx,cy,lenax,lenbx,angle,w,s,c,brs,brc,LongInt(Layers[LayerNbr]),mydsNormal,self);
  figures.add(f);
  if selected then f.Select;
  result := f.Handle;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  if selected then FAnySelected := true;
  Updated := True;
end;

Function TPCDrawing.Circle(LayerNbr:Integer;cx,cy,radius:Double;w,s,c,brs,brc:integer;Selected: Boolean):TFigHandle;
var
f: TFigure;
begin
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  f := TCircle.create(cx,cy,radius,w,s,c,brs,brc,LongInt(Layers[LayerNbr]),mydsNormal,self);
  figures.add(f);
  if selected then f.Select;
  result := f.Handle;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  if selected then FAnySelected := true;
  Updated := True;
end;

Function TPCDrawing.DrawCircle(LayerNbr:Integer;cx,cy,radius:Double;w,s,c,brs,brc:integer;Selected: Boolean):TFigHandle;
begin
  // Used for VBExport ... Circle is already reserved in VB
  result := Circle(LayerNbr,cx,cy,radius,w,s,c,brs,brc,Selected);
end;


Function TPCDrawing.Arc(LayerNbr:Integer;cx,cy,radius,a1,a2: Double; w,s,c,brs,brc,ArcStyle:Integer;Selected: Boolean):TFigHandle;
var
f: TFigure;
begin
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  f := TArc.create(cx,cy,radius,a1,a2,w,s,c,brs,brc,arcStyle,LongInt(Layers[LayerNbr]),mydsNormal,self);
  figures.add(f);
  if selected then f.Select;
  result := f.Handle;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  if selected then FAnySelected := true;
  Updated := True;
end;

Function TPCDrawing.ElpArc(LayerNbr:Integer; cx,cy,lenax,lenbx,angle,a1,a2:Double; w,s,c,brs,brc,ArcStyle:Integer;selected: boolean):TFigHandle;
var
f: TFigure;
begin
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  f := TElpArc.create(cx,cy,lenax,lenbx,a1,a2,angle,w,s,c,brs,brc,arcStyle,LongInt(Layers[LayerNbr]),mydsNormal,self);
  figures.add(f);
  if selected then f.Select;
  result := f.Handle;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  if selected then FAnySelected := true;
  Updated := True;
end;

Function TPCDrawing.Rectangle(LayerNbr:Integer;x1,y1,x2,y2:Double;w,s,c,brs,brc:integer;Selected: Boolean):TFigHandle;
var
f: TFigure;
begin
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  f := DrawObjects.TRectangle.create(x1, y1, x2,y2,w,s,c,brs,brc,LongInt(Layers[LayerNbr]),mydsNormal,self);
  figures.add(f);
  if selected then f.Select;
  result := f.Handle;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  if selected then FAnySelected := true;
  Updated := True;
end;

Function TPCDrawing.InsertBitmap(LayerNbr:Integer;x,y:Double; fName: string;
Transparent,Selected: Boolean; JPEGBounds: Boolean = False):TFigHandle;
var
f: TBMPObject;
begin
  GImageScale := 0;// Tolik 30/01/2020
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  f := TBMPObject.create(x,y,fName,LongInt(Layers[LayerNbr]),mydsNormal,self, JPEGBounds);

  // Tolik 09/08/2019 -- если вдруг пустой файл
  if ((f.Picture.Width = 0) or (f.Picture.Height = 0)) then
  begin
    f.Free;
    Result := -1;
    exit;
  end;
  f.Transparent := TransParent;
  figures.add(f);
  if selected then f.Select;
  result := f.Handle;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  if selected then FAnySelected := true;
  try
    if GImageScale <> 0 then
    begin
      f.Scale(GImageScale, GImageScale, f.ap1);
      GImageScale := 0;
    end;
  Except
    on E: Exception do
      GImageScale := 0;
  end;
  refresh;
  Updated := True;
end;

Function TPCDrawing.InsertBitmapHandle(LayerNbr:Integer; x,y:Double; xBitmap:TBitmap;transparent,selected: boolean):TFigHandle;
var
f: TBMPObject;
begin
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  f := TBMPObject.createEx(x,y,xBitmap,LongInt(Layers[LayerNbr]),mydsNormal,self);
  f.Transparent := TransParent;
  figures.add(f);
  if selected then f.Select;
  result := f.Handle;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  if selected then FAnySelected := true;
  refresh;
  Updated := True;
end;

Function TPCDrawing.TextOut(LayerNbr:Integer; x1,y1,angle,height,ratio: double;
                            atext,aFontName: string;FontCharset:Byte;Color: Integer;
                            Selected: Boolean):TFigHandle;
var
TextFig: TText;
begin
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  TextFig := TText.create(x1, y1,Height, ratio, atext,aFontName,FontCharset,Color,
                          LongInt(Layers[LayerNbr]),mydsNormal,self);
  TextFig.angle := Angle;
  figures.add(TextFig);
  if selected then TextFig.Select;
  result := TextFig.Handle;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  if selected then FAnySelected := true;
  Updated := True;
end;


Procedure TPCDrawing.SyncEnv;
Begin
  inherited;
End;

(*
Procedure TPCDrawing.RunMacroByFileName(MacroName:String);
var macro: TStringList;
Begin
   SetInterfaceHandle;
   macro := TStringlist.Create;
   if fileexists(MacroName) then
   begin
     Macro.LoadFromFile(Macroname);
     MacroEngine.script := Macro;
     MacroEngine.Compile('Self',MacroEngine);
     MacroEngine.Run;
     Updated := True;
   end;
End;

Procedure TPCDrawing.RunMacro(Macro:TStringlist);
Begin
   SetInterfaceHandle;
   MacroEngine.script := Macro;
   MacroEngine.Compile('Self',MacroEngine);
   MacroEngine.Run;
   Updated := True;
End;

Procedure TPCDrawing.RunMacroText(Macro:String);
var list:Tstringlist;
begin
   SetInterfaceHandle;
   list := TStringList.Create;
   list.text := Macro;
   MacroEngine.script := list;
   MacroEngine.Compile('Self',MacroEngine);
   MacroEngine.Run;
   Updated := True;
   List.Free;
end;

Procedure TPCDrawing.AddPSCLConstant(ConstName:String;Value:Variant);
begin
  AddConst(ConstName,Value);
end;

Procedure TPCDrawing.AddPSCLProcedure(ProcName:String;ProcAddr:TProcType;const Params:array of byte);
begin
  AddProc(ProcName,ProcAddr,params);
end;

Procedure TPCDrawing.AddPSCLFunction(ProcName:String;ProcAddr:TProcType;const Params:array of byte);
begin
  AddFun(ProcName,ProcAddr,params);
end;
*)


Function TPCDrawing.InsertWMF(LayerNbr:Integer;x,y: Double; fName: string;Selected: Boolean):TFigHandle;
var
f: TWMFObject;
begin
  result := 0;
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  f := TWMFObject.create(x,y,fName,LongInt(Layers[LayerNbr]),mydsNormal,self);
  figures.add(f);
  if selected then f.Select;
  result := f.Handle;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  if selected then FAnySelected := true;
  if autorefresh then refresh;
  Updated := True;
end;

Function TPCDrawing.InsertMetafile(LayerNbr:Integer; x,y:Double; mf: TMetafile;selected: boolean): TFigHandle;
var
f: TWMFObject;
begin
  result := 0;
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  f := TWMFObject.createEx(x,y,mf,LongInt(Layers[LayerNbr]),mydsNormal,self);
  figures.add(f);
  if selected then f.Select;
  result := f.Handle;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
  if selected then FAnySelected := true;
  if autorefresh then refresh;
  Updated := True;
end;

Function TPCDrawing.ImportWMF(LayerNbr: integer; fName: string;Selected: Boolean):TFigHandle;
var
mf: TMetafile;
x,y: Double;
begin
  result := 0;
  if (layerNbr<0) or (layerNbr>layers.count) then LayerNbr := 0;
  mf := TMetafile.create;
  mf.LoadFromFile(fName);
  x := -1;y := -1;
  result := ImportMetafile(LayerNbr,x,y,mf,Selected);
  mf.Free;
  Updated := True;
  if Result = -1 then
    GisUserDimLine := false;
end;

var WmfPoints: TDOublePointArr;
    wmfPoCount: Integer;

Function TPCDrawing.ImportMetafile(LayerNbr:Integer;x,y:Double; mf: TMetafile;Selected: Boolean):TFigHandle;
var
ptr: Pointer;
mfwidthmm,mfwidth: extended;
EnhMetaHeader: PEnhMetaHeader;
mmRect,mfRect : TRect;
selrect: TDoubleRect;
res: integer;
begin
  BufferObj := Self;
  WmfLayer := LayerNbr;
  pw := 1; pc := clBlack; ps := ord(psClear); bs:= ord(bsClear); bc := clWhite;
  GetMem(EnhMetaHeader,100);
  mfdpmm := mf.Inch;
  GetEnhMetaFileHeader(mf.handle,100,EnhMetaHeader);
  mfRect  := EnhMetaHeader.rclBounds;
  mmRect  := EnhMetaHeader.rclFrame;
  mfwidthmm := (abs(mmRect.left/100 - mmRect.right/100));
  mfwidth   := (abs(mfRect.left - mfRect.right));
  mfdpmm := mfwidth/mfwidthmm;
  wmfx := WorkWidth;
  wmfy := WorkHeight;
  wmfVz := VerticalZero;
  wmfHz := HorizontalZero;
  wmfMapMode:= MM_TEXT;
  wmfwpx := 1;
  wmfwex := 1;
  wmfwpy := 1;
  wmfwey := 1;
  DeselectAll(0);
  RecCount := 0;
  wmfLogCnt := 0;
  SaveCnt := 0;
  xForm.eM11 := 1;
  xForm.eM22 := 1;
  xForm.eM12 := 0;
  xForm.eM21 := 0;
  xForm.eDx := 0;
  xForm.eDy := 0;
  SetLength(wmfPoints,0);
  wmfPoCount := 0;
  EnumEnhMetafile(0,mf.handle,@ProcessMFRecord,ptr,Rect(0,0,0,0));
  result := GroupSelection;
  FreeMem(EnhMetaHeader,100); // Tolik 03/05/2019 --
  if result = 0 then exit;
  TFigure(result).DiagonalScale := True;
  SelRect := TFigure(result).GetBoundrect;
  wmfx := (SelRect.left+SelRect.right) / 2;
  wmfy := (SelRect.top+SelRect.bottom) / 2;
  if (x = -1) and (y = -1) then //center
  begin
    wmfx := ((SelRect.left+SelRect.Right)/ 2);
    wmfx := (WorkWidth /2) - wmfx;
    wmfy := ((SelRect.Top+SelRect.Bottom)/ 2);
    wmfy := (WorkHeight /2) - wmfy;
  end else begin
    wmfx :=  x - SelRect.left;
    wmfy :=  y - SelRect.Top;
  end;
  MoveSelection(wmfx,wmfy);
  FAnySelected := true;
  refresh;
  Updated := True;
  if assigned(FOnObjectInserted) then FOnObjectInserted(self,irCreate);
end;

Function TPCDrawing.SnapToFigures(var x,y: double):Boolean;
var Figure:TFigure;
    i,dx,dy : integer;
    R: TDoubleRect;
begin
  result := false;
  For i := 0 to Figures.Count-1 do
  begin
    Figure := Tfigure(Figures[i]);
    if figure.isVisible then begin
      R := Figure.GetBoundRect;
      r := DoubleRect(r.left - 10,r.top-10,r.right+10,r.Bottom+10);
      if (PointInRect(DoublePoint(x,y),r)) and (not result) then begin
        result := Figure.SnapPoints(x,y,DotsPerMil);
        if (not result) and assigned (FSnapToFigure) then
        begin
          result := FSnapToFigure(Self,Figure,x,y);
          if result then exit;
        end;
      end;
    end;  
  end;
end;


Procedure TPCDrawing.setPenColor(value: TColor);
Begin
  if Selection.Count > 0 then
    Modifyselection(mmPenColor,value)
  else begin
    fDefPenColor := value;
    if assigned(evPenColor) and not (csDesigning in  ComponentState)
    and not (csReading   in  ComponentState)then
    begin
      evPenColor.RaiseEvent(fDefPenColor,'',0);
    end;
  end;
  Updated := True;
  SyncEnv;
end;

Procedure TPCDrawing.setBrushColor(value: TColor);
Begin
  if Selection.Count > 0 then
     Modifyselection(mmBrushColor,value)
  else begin
    fDefBrsColor := value;
    if assigned(evBrushColor) and not (csDesigning in  ComponentState)
    and not (csReading   in  ComponentState)then
    begin
      evBrushColor.RaiseEvent(fDefBrsColor,'',0);
    end;
  end;
  Updated := True;
  SyncEnv;
end;

Procedure TPCDrawing.setPenWidth(value: integer);
var pw: Byte;
Begin
  if Selection.Count > 0 then
    Modifyselection(mmPenWidth,value)
  else begin
    fDefPenWidth := value;
    if assigned(evPenWidth) and not (csDesigning in  ComponentState)
    and not (csReading   in  ComponentState)
    then
    begin
      pw := value -1;
      evPenWidth.RaiseEvent(pw,'',0);
    end;
  end;
  Updated := True;
  SyncEnv;
end;

Procedure TPCDrawing.setPenStyle(value: TPenStyle);
Begin
  if Selection.Count > 0 then
    Modifyselection(mmPenStyle,ord(value))
  else begin
    fDefPenStyle := value;
    if assigned(evPenStyle) and not (csDesigning in  ComponentState)
    and not (csReading   in  ComponentState)then
      evPenStyle.RaiseEvent(ord(fDefPenStyle),'',0);
  end;
  Updated := True;
  SyncEnv;
end;

Procedure TPCDrawing.setBrushStyle(value: TBrushStyle);
Begin
  if Selection.Count > 0 then
    Modifyselection(mmBrushStyle,ord(value))
  else begin
    fDefBrsStyle := value;
    if assigned(evBrushStyle) and not (csDesigning in  ComponentState)
    and not (csReading   in  ComponentState)then
      evBrushStyle.RaiseEvent(ord(fDefBrsStyle),'',0);
  end;
  Updated := True;
  SyncEnv;
end;

Procedure TPCDrawing.setRowStyle(value: TRowStyle);
Begin
  if Selection.Count > 0 then
    Modifyselection(mmRowStyle,ord(value))
  else begin
    fDefRowStyle := value;
    if assigned(evPenStyle) and not (csDesigning in  ComponentState)
    and not (csReading   in  ComponentState)then
      evRowStyle.RaiseEvent(ord(fDefRowStyle),'',0);
  end;
  Updated := True;
  SyncEnv;
end;

Procedure TPCDrawing.setTextHeight(value: Double);
begin
  if Selection.Count > 0 then
  begin
    ModifyTextandFont(mmFontSize,Value,'',[],False);
    fDefTextheight := value;
  end else begin
    fDefTextheight := value;
  end;
  Updated := True;
end;

Procedure TPCDrawing.setTextRatio(value: Double);
begin
  fDefTextratio := value;
  Updated := True;
end;

Procedure TPCDrawing.SetPLineClosed(value:Boolean);
begin
  if value then
    CloseSelectedPolyLine
  else
    OpenSelectedPolyLine;
end;

Procedure TPCDrawing.SetArcStyle(value:TArcStyle);
begin
  ArrangeArcStyleOfSelection(value);
end;


Function TPCDrawing.GetSlcPenStyle : Integer;
var a: integer;
    MultiStyle,Based : Boolean;
Begin
  result := ord(FDefPenStyle);
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    if TFigure(Selection[a]).Style <> -1 then
    begin
      if not Based then
      begin
        result := TFigure(Selection[a]).Style;
        Based := True;
      end
      else
      begin
        if TFigure(Selection[a]).Style <> result then MultiStyle := true;
      end;
    end;
  end;
  if MultiStyle then result := ord(FDefPenStyle);
End;

Function TPCDrawing.GetSlcPenWidth : Integer;
var a: integer;
    MultiStyle,Based : Boolean;
Begin
  result := FDefPenWidth;
  MultiStyle := False;
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    if TFigure(Selection[a]).Width <> -1 then
    begin
      if not Based then
      begin
        result := TFigure(Selection[a]).Width;
        Based := True;
      end
      else
      begin
        if TFigure(Selection[a]).Width <> result then MultiStyle := true;
      end;
    end;
  end;
  if MultiStyle then result := FDefPenWidth;
End;

Function TPCDrawing.GetSlcPenColor : Integer;
var a: integer;
    MultiStyle,Based : Boolean;
Begin
  result := FDefPenColor;
  MultiStyle := False;
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    if TFigure(Selection[a]).Color <> -1 then
    begin
      if not Based then
      begin
        result := TFigure(Selection[a]).Color;
        Based := True;
      end
      else
      begin
        if TFigure(Selection[a]).Color <> result then MultiStyle := true;
      end;
    end;
  end;
  if MultiStyle then result := FDefPenColor;
End;

Function TPCDrawing.GetSlcRowStyle : Integer;
var a: integer;
    MultiStyle,Based : Boolean;
Begin
  result := ord(FDefRowStyle);
  MultiStyle := False;
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    if TFigure(Selection[a]).RowStyle <> -1 then
    begin
      if not Based then
      begin
        result := TFigure(Selection[a]).RowStyle;
        Based := True;
      end
      else
      begin
        if TFigure(Selection[a]).RowStyle <> result then MultiStyle := true;
      end;
    end;
  end;
  if MultiStyle then result := ord(FDefRowStyle);
End;

Function TPCDrawing.GetSlcBrushStyle : Integer;
var a: integer;
    MultiStyle,Based : Boolean;
Begin
  result := ord(FDefBrsStyle);
  MultiStyle := False;
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    if TFigure(Selection[a]).Brs <> -1 then
    begin
      if not Based then
      begin
        result := TFigure(Selection[a]).Brs;
        Based := True;
      end
      else
      begin
        if TFigure(Selection[a]).Brs <> result then MultiStyle := true;
      end;
    end;
  end;
  if MultiStyle then result := ord(FDefBrsStyle);
End;

Function TPCDrawing.GetSlcBrushColor : Integer;
var a: integer;
    MultiStyle,Based : Boolean;
Begin
  result := FDefBrsColor;
  MultiStyle := False;
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    if TFigure(Selection[a]).Brc <> -1 then
    begin
      if not Based then
      begin
        result := TFigure(Selection[a]).Brc;
        Based := True;
      end
      else
      begin
        if TFigure(Selection[a]).Brc <> result then MultiStyle := true;
      end;
    end;
  end;
  if MultiStyle then result := FDefBrsColor;
End;

Function TPCDrawing.GetSlcFontSize :Double;
var a: integer;
    MultiStyle,Based : Boolean;
Begin
  result := fDefTextHeight;
  MultiStyle := False;
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    if TFigure(Selection[a]) is TText then
    begin
      if not Based then
      begin
        result := (TFigure(Selection[a]) as TText).Height;
        Based := True;
      end
      else
      begin
        if (TFigure(Selection[a]) as TText).Height <> result then MultiStyle := true;
      end;
    end;
    if TFigure(Selection[a]) is TTextPanel then
    begin
      if not Based then
      begin
        result := (TFigure(Selection[a]) as TTextPanel).Height;
        Based := True;
      end
      else
      begin
        if (TFigure(Selection[a]) as TTextPanel).Height <> result then MultiStyle := true;
      end;
    end;
  end;
  if MultiStyle then result := fDefTextHeight;
End;


Function TPCDrawing.GetSlcPolylineClosed: Boolean;
var a: integer;
    MultiStyle,Based : Boolean;
Begin
  result := fDefPLineClosed;
  MultiStyle := False;
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    if TFigure(Selection[a]) is TPolyLine then
    begin
      if not Based then
      begin
        result := (TFigure(Selection[a]) as TPolyLine).Closed;
        Based := True;
      end
      else
      begin
        if (TFigure(Selection[a]) as TPolyLine).Closed <> result then MultiStyle := true;
      end;
    end;
  end;
  if MultiStyle then result := fDefPLineClosed;
End;

Function TPCDrawing.GetSlcImageTransparent: Boolean;
var a: integer;
    MultiStyle,Based : Boolean;
    found:Boolean;
Begin
  result := False;
  MultiStyle := False;
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    if TFigure(Selection[a]) is TBmpObject then
    begin
      if not Based then
      begin
        result := (TFigure(Selection[a]) as TBmpObject).Transparent;
        Based := True;
        Found := True;
      end
      else
      begin
        if (TFigure(Selection[a]) as TBmpObject).Transparent <> result then MultiStyle := true;
      end;
    end;
  end;
  if MultiStyle then result := False;
End;

Function TPCDrawing.GetSlcImageClipped: Boolean;
var a: integer;
    MultiStyle,Based : Boolean;
Begin
  result := False;
  MultiStyle := False;
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    if TFigure(Selection[a]) is TBmpObject then
    begin
      if not Based then
      begin
        result := ((TFigure(Selection[a]) as TBmpObject).ClipFigure <> nil);
        Based := True;
      end
      else
      begin
        if ((TFigure(Selection[a]) as TBmpObject).ClipFigure <> nil) <> result then MultiStyle := true;
      end;
    end;
  end;
  if MultiStyle then result := False;
End;

Function TPCDrawing.GetSlcLineBounded: Boolean;
var a: integer;
    MultiStyle,Based,res : Boolean;
    f:Tfigure;
Begin
  result := False;
  MultiStyle := False;
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    f := TFigure(Selection[a]);
    if (f is DrawObjects.TLine) or (f is TPolyline) then
    begin
      if f is DrawObjects.Tline then
        res := ((f as DrawObjects.Tline).JoinFigure1 <> nil) or
                  ((f as DrawObjects.Tline).JoinFigure2 <> nil)
      else if f is TPolyLine then
        res := ((f as TPolyLine).JoinFigure1 <> nil) or
                  ((f as TPolyLine).JoinFigure2 <> nil);

      if not Based then
      begin
        result := res;
        Based := True;
      end
      else
      begin
        if res <> result then MultiStyle := true;
      end;
    end;
  end;
  if MultiStyle then result := False;
End;

Function TPCDrawing.GetSlcArcStyle:TArcStyle;
var a: integer;
    MultiStyle,Based : Boolean;
Begin
  result := fDefArcStyle;
  MultiStyle := False;
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    if TFigure(Selection[a]) is TArc then
    begin
      if not Based then
      begin
        result := (TFigure(Selection[a]) as Tarc).ArcStyle;
        Based := True;
      end
      else
      begin
        if (TFigure(Selection[a]) as Tarc).ArcStyle  <> result then MultiStyle := true;
      end;
    end;
  end;
  if MultiStyle then result := fDefArcStyle;
End;

Function TPCDrawing.GetSlcFontName:String;
begin
  result := GetSlcFont.Name;
end;

Function TPCDrawing.GetSlcFontBold:Boolean;
begin
  result := (fsBold in GetSlcFont.Style);
end;

Function TPCDrawing.GetSlcFontItalic:Boolean;
begin
  result := (fsItalic in GetSlcFont.Style);
end;

Function TPCDrawing.GetSlcFontUnderline:Boolean;
begin
  result := (fsUnderline in GetSlcFont.Style);
end;

Function TPCDrawing.GetSlcFontStrike:Boolean;
begin
  result := (fsStrikeOut in GetSlcFont.Style);
end;

Function TPCDrawing.GetSlcFontCharset:Integer;
begin
  result := GetSlcFont.Charset;
end;

Function TPCDrawing.GetSlcFontColor:TColor;
begin
  result := GetSlcFont.Color;
end;

Function TPCDrawing.GetSlcFont : TFont;
var a: integer;
    MultiStyle,Based : Boolean;
Begin
  result := Font;
  MultiStyle := False;
  Based := False;
  for a := 0 to Selection.Count -1 do
  Begin
    if TFigure(Selection[a]) is TText then
    begin
      if not Based then
      begin
        result := (TFigure(Selection[a]) as TText).Font;
        Based := True;
      end
      else
      begin
        if (TFigure(Selection[a]) as TText).Font <> result then MultiStyle := true;
      end;
    end;
    if TFigure(Selection[a]) is TTextPanel then
    begin
      if not Based then
      begin
        result := (TFigure(Selection[a]) as TTextPanel).Font;
        Based := True;
      end
      else
      begin
        if (TFigure(Selection[a]) as TTextPanel).Font <> result then MultiStyle := true;
      end;
    end;

  end;
  if MultiStyle then
    result := Self.Font;
End;

Function TPCDrawing.GetSelectedHandle(index:Integer):TFigHandle;
begin
  result := 0;
  if (index > -1) and (index < Selection.Count) then result := TFigHandle(Selection[index]);
end;


Function TPCDrawing.GetSelectionHandles(var Handles: Array of TFigHandle): Integer;
var a: integer;
begin
  for a := 0 to Selection.Count -1 do
  Begin
    Handles[a] := TFigure(Selection[a]).Handle;
  end;
  result := Selection.Count;
end;

Procedure TPCDrawing.SetAutoSelect(value: Boolean);
Begin
  FAutoSelect := value;
End;

Function TPCDrawing.GetPenPatCount:Integer;
begin
  result := FPenPatList.Count;
end;

Function TPCDrawing.GetPenPattern(Index:Integer):TPattern;
begin
  result := nil;
  if (Index > FPenPatList.Count-1) or (Index < 0) then exit;
  Result := TPattern(FPenpatList[Index]);
end;

Procedure TPCDrawing.NewPattern(pat:TPattern);
begin
  FPenPatList.Add(Pat);
end;

Procedure TPCDrawing.SetRulerMode(Value:TRulerMode);
begin
  FRulerMode := Value;
  //if Value = rmWorld then begin
    //if RulerSystem = rsWhitworth then RulerSystem := rsMetric;
  //end;
  SetRulerValues(FMapScale,ord(FRulerMode));
  evRulerMode.RaiseEvent(ord(Value));
end;

Function TPCDrawing.BlockAsMetafile(bPath: String):Integer;
begin
  result := BlockAsWmf(bpath).Handle;
end;

Function TPCDrawing.BlockAsWmf(bPath: String):TMetafile;
var xStream: Tstream;
    sign:string;
    a: integer;
    xByte: Byte;
    FigGrp: TFigureGrp;
    mf : TMetafile;
    mc : TMetafileCanvas;
    r: TDoubleRect;
    w,h: Double;
    dx,dy,x1,y1,x2,y2,t: Double;
Begin
  result := nil;
  try
    xStream := TFileStream.Create(bPath,fmOpenRead or fmShareDenyNone);
  except
    exit;
  end;

  sign := ''; // Tolik 05/04/2019 --
  for a := 1 to 6 do
  begin
    xStream.Read(xByte,1);
    // Tolik 05/04/2019 --
    //sign := sign + chr(xByte);
    sign := sign + Ansichar(xByte);
    //
  end;

  FigGrp := nil;
  if Sign = 'TBlock' then
  begin
    xStream.Position := 0;
    FigGrp := TFigureGrp(TFigure.CreateFromStream(xStream,-1,mydsNormal,nil));
    xStream.free;
    xStream := nil;
  end;
  // ===
  if assigned(xStream) then
    xStream.Free;

  //if FigGrp = nil then
//    exit;
//
//  blkVz := FigGrp.VertZero;
//  blkHz := FigGrp.HorzZero;
//
//  dcDpm := DotsPerMilOrig;
//  mf := TMetafile.Create;
//  mf.Width := 100;;
//  mf.Height := 100;
//  mc := TMetafileCanvas.Create(mf,0);
//  SetEngine(mc,blkConvertXY,prDeConvertXY,blkConvertDim,prDeConvertDim,false,nil);
//  FigGrp.Draw(Dengine,false);
//  FigGrp.DrawDimLines(Dengine,false);
//
//  mc.Free;
//  mf.Free;
//
//  r := FigGrp.GetBoundRect;
//  w := abs(r.right-r.Left);
//  h := abs(r.top-r.bottom);
//
//  mf := TMetafile.Create;
//  mf.Width := Round(w * dcDpm)+1;
//  mf.Height := round(h * dcDpm)+1;
//  mc := TMetafileCanvas.Create(mf,0);
//  SetEngine(mc,blkConvertXY,prDeConvertXY,blkConvertDim,prDeConvertDim,false,nil);
//
//  if r.top < r.bottom then blkDisty := r.top else blkDisty := r.bottom;
//  if r.left < r.right then blkDistx := r.left else blkDistx := r.right;
//  if r.top > r.bottom then blkTopy := r.top else blkTopy := r.bottom;
//  if r.left > r.right then blkTopx := r.left else blkTopx := r.right;
//
//  blkH := mf.Height; blkW := mf.Width;
//  FigGrp.Draw(Dengine,false);
//  FigGrp.DrawDimlines(Dengine,false);
//  mc.Free;
//  result := mf;
  Result := BlockObjAsWmf(FigGrp);

  //FigGrp.InFigures.Clear;
  FigGrp.Free;
end;

Function TPCDrawing.BlockObjAsWmf(ABlock: TFigureGrp):TMetafile;
var
    FigGrp: TFigureGrp;
    mf : TMetafile;
    mc : TMetafileCanvas;
    r: TDoubleRect;
    w,h: Double;
    dx,dy,x1,y1,x2,y2,t: Double;
Begin
  result := nil;

  FigGrp := ABlock;
  if FigGrp = nil then
    exit;

  blkVz := FigGrp.VertZero;
  blkHz := FigGrp.HorzZero;

  dcDpm := DotsPerMilOrig;
  mf := TMetafile.Create;
  mf.Width := 100;;
  mf.Height := 100;
  mc := TMetafileCanvas.Create(mf,0);
  SetEngine(mc,blkConvertXY,prDeConvertXY,blkConvertDim,prDeConvertDim,false,nil);
  FigGrp.Draw(Dengine,false);
  FigGrp.DrawDimLines(Dengine,false);

  mc.Free;
  mf.Free;

  r := FigGrp.GetBoundRect;
  w := abs(r.right-r.Left);
  h := abs(r.top-r.bottom);

  mf := TMetafile.Create;
  mf.Width := Round(w * dcDpm)+1;
  mf.Height := round(h * dcDpm)+1;
  mc := TMetafileCanvas.Create(mf,0);

  ResetRegions;

  SetEngine(mc,blkConvertXY,prDeConvertXY,blkConvertDim,prDeConvertDim,false,nil);

  if r.top < r.bottom then blkDisty := r.top else blkDisty := r.bottom;
  if r.left < r.right then blkDistx := r.left else blkDistx := r.right;
  if r.top > r.bottom then blkTopy := r.top else blkTopy := r.bottom;
  if r.left > r.right then blkTopx := r.left else blkTopx := r.right;

  blkH := mf.Height; blkW := mf.Width;
  FigGrp.Draw(Dengine,false);
  FigGrp.DrawDimlines(Dengine,false);
  mc.Free;

  ResetRegions;
  result := mf;
  Refresh;
end;

/////////////////////////////////////////////////////


Function ProcessMFRecord(DC:HDC; HT:PHandleTable; rec:PEnhMetaRecord; count: integer; param: pointer): integer;

var cx,cy,rad,lena,lenb,a1,a2: Double;
    x1,y1,x2,y2,xx,yy: Double;
    pcnt: integer;
    arcs: Integer;
    nbrPoints,a,i,b,k,brush,pen: integer;
    nbrobjects : integer;
    pl: TPolyline;
    points: TDoublePointArr;
    expoints: TDOublePointArr;
    Segment: TPLSegment;
    wc: WideChar;
    Closed: Boolean;
    xText: String;
    ap1,ap2: TDoublePoint;

    RecPolyGon: PEMRPOLYGON;
    RecPolyGon16: PEMRPOLYGON16;
    RecMoveToEx: PEMRMOVETOEX;
    RecLineTo: PEMRLINETO;
    RecArc: PEMRARC;
    RecEllipse: PEMRELLIPSE;
    RecRectangle: PEMRRECTANGLE;
    RecPolyline: PEMRPOLYLINE;
    RecPolyLine16:PEMRPOLYLINE;
    RecPolyPGon:PEMRPolyPolygon;
    RecPolyPLine:PEMRPolyPolyLine;
    RecPolyPGon16:PEMRPolyPolygon16;
    RecPolyPLine16:PEMRPolyPolyLine16;
    RecPolyBezier16: PEMRPOLYBEZIER16;
    RecBrush: PEMRCREATEBRUSHINDIRECT;
    RecPen: PEMRCreatePen;
    RecExtPen: PEMRExtCreatePen;
    RecMBrush: PEMRCREATEMONOBRUSH;
    RecmapMode : PEMRSetMapMode;
    RecPortExt : PEMRSETVIEWPORTEXTEX;
    RecPortOrg : PEMRSETVIEWPORTORGEX;
    RecSelect: PEMRSELECTOBJECT;
    RecText:PEMRExtTextOut;
    RecFont: PEMRExtCreateFontIndirect;
    Recrestore : PEMRRestoreDC;
    RecModifyWT: PEMRModifyWorldTransform;
    RecSetWT: PEMRSetWorldTransform;
    mForm: TXForm;
    RDC: TSavedDc;
    dcIdx: Integer;
    mr: Array [0..8] of Double;
    ml: Array [0..8] of Double;
    ms: Array [0..8] of Double;
    sz: TSize;

  Function ConvertX(pointx:double):double;
  var res,dp: double;
      hz: THorzZero;
  begin
    dp := mfdpmm;
    hz := vzLeft;
    pointx := pointx * xForm.eM11 + xform.eDx;

    if wmfmapMode = MM_TEXT then begin
      res := (pointx / mfdpmm);
    end else if wmfmapMode = MM_ISOTROPIC then begin
      dp := abs(wmfwpx/wmfwex);
      pointx := pointx*dp;
      if (wmfwpx*wmfwex) < 0 then hz := vzRight else hz := vzLeft;
      res := (pointx / mfdpmm);
    end else if wmfmapMode = MM_ANISOTROPIC then
    begin
       dp := abs(wmfwpx/wmfwex);
       pointx := pointx*dp;
       if (wmfwpx*wmfwex) < 0 then hz := vzRight else hz := vzLeft;
       res := (pointx / mfdpmm);
    end else if wmfmapMode = MM_HIMETRIC then begin
      pointx := pointx/100;
      res := (pointx / 1);
    end else if wmfmapMode = MM_LOMETRIC then begin
      pointx := pointx/10;
      res := (pointx / 1);
    end else if wmfmapMode = MM_HIENGLISH then begin
      pointx := (pointx/1000)*25.4;
      res := (pointx / 1);
    end else if wmfmapMode = MM_LOENGLISH then begin
      pointx := (pointx/100)*25.4;
      res := (pointx / 1);
    end else if wmfmapMode = MM_TWIPS then begin
      pointx := (pointx/12);
      res := (pointx / mfdpmm);
    end;
    if wmfHz <> hz then res := wmfx - res;
    result := res;
  end;

  Function ConvertY(pointy:double):double;
  var res: double;
      vz: TVertZero;
      dp: Double;
  begin
    pointy := pointy * xForm.eM22 + xform.eDy;

    if wmfmapMode = MM_TEXT then begin
      vz := vzTop;
      res := (pointy / mfdpmm);
    end else if wmfmapMode = MM_ISOTROPIC then begin
      dp := abs(wmfwpy/wmfwey);
      pointy := pointy*dp;
      if (wmfwpy*wmfwey) < 0 then vz := vzBottom else vz := vzTop;
      res := (pointy / mfdpmm);
    end else if wmfmapMode = MM_ANISOTROPIC then
    begin
       dp := abs(wmfwpy/wmfwey);
       pointy := pointy*dp;
       if (wmfwpy*wmfwey) < 0 then vz := vzBottom else vz := vzTop;
       res := (pointy / mfdpmm);
    end else if wmfmapMode = MM_HIMETRIC then begin
      vz := vzBottom;
      pointy := pointy/100;
    end else if wmfmapMode = MM_LOMETRIC then begin
      vz := vzBottom;
      pointy := pointy/10;
      res := (pointy / 1);
    end else if wmfmapMode = MM_HIENGLISH then begin
      vz := vzBottom;
      pointy := (pointy/1000)*25.4;
      res := (pointy / 1);
    end else if wmfmapMode = MM_LOENGLISH then begin
      vz := vzBottom;
      pointy := (pointy/100)*25.4;
      res := (pointy / 1);
    end else if wmfmapMode = MM_TWIPS then begin
      vz := vzBottom;
      pointy := (pointy/12);
      res := (pointy / mfdpmm);
    end
    else
      vz := vzBottom;

    if wmfVz <> vz then res := wmfy - res;
    result := res;
  end;


Begin
  reccount := reccount + 1;

  Case rec.iType of
  EMR_SETVIEWPORTEXTEX:
  begin
    RecPortExt := PEMRSETVIEWPORTEXTEX(rec);
    cx := recPortExt.szlExtent.cx;
    cy := recPortExt.szlExtent.cy;
    wmfwpx := cx;
    wmfwpy := cy;
  end;

  EMR_SETWINDOWEXTEX:
  begin
    GetViewportExtEx(BufferObj.GetActiveCanvas.Handle,sz);
    RecPortExt := PEMRSETVIEWPORTEXTEX(rec);
    cx := recPortExt.szlExtent.cx;
    cy := recPortExt.szlExtent.cy;
    wmfwex := cx;
    wmfwey := cy;
  end;

  EMR_SETVIEWPORTORGEX:
  begin
    RecPortOrg := PEMRSETVIEWPORTORGEX(rec);
    cx := recPortOrg.ptlOrigin.x;
    cy := recPortOrg.ptlOrigin.y;
  end;

  EMR_SETWINDOWORGEX:
  begin
    RecPortOrg := PEMRSETVIEWPORTORGEX(rec);
    cx := recPortOrg.ptlOrigin.x;
    cy := recPortOrg.ptlOrigin.y;
  end;


  EMR_SETMAPMODE:
  begin
    RecMapMode := PEMRSETMAPMODE(rec);
    wmfMapMode := RecmapMode.iMode;
  end;

  EMR_MOVETOEX:
  Begin
    if wmfPoCount > 1 then begin
      BufferObj.PolyLine(wmfLayer,wmfPoints,pw,ps,pc,0,0,0,EQDP(wmfPoints[0],wmfPoints[wmfPoCount-1]),True);
    end;
    SetLength(wmfPoints,1);
    wmfPoCount := 1;

    RecMoveToEx := PEMRMOVETOEX(rec);
    MoveToX := Convertx(RecMoveToEx.ptl.x);
    MoveTOY := Converty(RecMoveToEx.ptl.y);
    wmfPoints[0] := DoublePoint(MoveToX,MoveTOY);
  End;

  EMR_LINETO:
  Begin
    RecLIneTo := PEMRLINETO(rec);
    XX := Convertx(RecLineTo.ptl.x);
    YY := Converty(RecLineTo.ptl.y);
    //BufferObj.Line(wmflayer,MoveToX,MoveToY,xx,yy,pw,ps,pc,0,True);
    MoveToX := XX;
    MoveToY := YY;
    wmfPoCount := wmfPoCount+1;
    SetLength(wmfPoints,wmfPoCount);
    wmfPoints[wmfPoCount-1] := DoublePoint(MoveToX,MoveTOY);
  End;


  EMR_ARC,EMR_PIE,EMR_CHORD:
  Begin
    RecArc := PEMRARC(rec);
    cx := Convertx((RecArc.rclBox.Right + RecArc.rclBox.Left) / 2);
    cy := Converty((RecArc.rclBox.Top + RecArc.rclBox.Bottom) / 2);
    rad := Convertx(RecArc.rclBox.Right) - ConvertX(RecArc.rclBox.Left);
    xx := ConvertX(RecArc.ptlStart.x);
    yy := ConvertY(RecArc.ptlStart.y);
    a1 := GetradOfLine(DoublePoint(cx,cy),DoublePOint(xx,yy));
    xx := ConvertX(RecArc.ptlEnd.x);
    yy := ConvertY(RecArc.ptlEnd.y);
    a2 := GetradOfLine(DoublePoint(cx,cy),DoublePOint(xx,yy));
    if rec.iType = EMR_ARC then arcs := ord(asOpen)
    else if rec.iType = EMR_PIE then arcs := ord(asPie)
    else if rec.iType = EMR_CHORD then arcs := ord(asChord);
    BufferObj.Arc(wmflayer,cx,cy,rad,a1,a2,pw,ps,pc,bs,bc,ord(arcs),True);
  End;

  EMR_ELLIPSE:
  Begin
    RecEllipse := PEMRELLIPSE(rec);
    cx := Convertx((RecEllipse.rclBox.left+RecEllipse.rclBox.right) / 2);
    cy := Converty((RecEllipse.rclBox.top+RecEllipse.rclBox.bottom) / 2);
    lena := abs(Convertx(RecEllipse.rclBox.right) - Convertx(RecEllipse.rclBox.left)) / 2;
    lenb := abs(Converty(RecEllipse.rclBox.bottom) - ConvertY(RecEllipse.rclBox.top)) / 2;
    BufferObj.Ellipse(wmflayer,cx,cy,lena,lenb,0,pw,ps,pc,bs,bc,True);
  End;

  EMR_RECTANGLE:
  Begin
    RecRectangle := PEMRRECTANGLE(rec);
    x1 := Convertx(RecRectangle.rclBox.right);
    y1 := Converty(RecRectangle.rclBox.top);
    x2 := Convertx(RecRectangle.rclBox.left);
    y2 := Converty(RecRectangle.rclBox.bottom);
    BufferObj.Rectangle(wmflayer,x1,y1,x2,y2,pw,ps,pc,bs,bc,True);
  End;

  EMR_POLYLINE,EMR_POLYGON:
  Begin
    RecPolyLine := PEMRPOLYLINE(rec);
    nbrPoints := RecPolyLine.cptl;
    Setlength(Points,nbrPoints);
    For a := 0 to nbrPoints-1  do
    begin
      Points[a].x := Convertx(RecPolyLine.aptl[a].y);
      Points[a].y := Converty(RecPolyLine.aptl[a].y);
    end;
    BufferObj.PolyLine(wmfLayer,points,pw,ps,pc,0,0,0,(rec.iType =EMR_POLYGON ),True);
  End;

  EMR_POLYBEZIER:
  Begin
    RecPolyLine := PEMRPOLYLINE(rec);
    nbrPoints := RecPolyLine.cptl;

    Setlength(Points,nbrPoints);
    Setlength(exPoints,nbrPoints);
    i := 0;
    k := 0;
    For a := 0 to nbrPoints-1 do
    begin
      if a mod 3 = 0 then begin
        exPoints[i].x := ConVertX(RecPolyLine.aptl[a].x);
        exPoints[i].y := ConVertX(RecPolyLine.aptl[a].y);
        i := i+1;
      end else
      begin
        Points[k].x := ConVertX(RecPolyLine.aptl[a].x);
        Points[k].y := ConVertY(RecPolyLine.aptl[a].y);
        k := k+1;
      end;
    end;
    Setlength(exPoints,i);
    wmfpl := TPolyLine(BufferObj.Polyline(wmfLayer,expoints,pw,ps,pc,0,bs,bc,false,True));
    For a := 0 to i-2 do
    begin
      Segment := TPLSegment(wmfpl.Segments[a]);
      Segment.SType := sCurve;
      Segment.TangentKnot := True;
      Segment.CPoint1 := Points[a*2];
      Segment.CPoint2 := Points[a*2+1];
    end;
  End;


  EMR_POLYGON16,EMR_POLYLINE16:
  Begin
    recPolyGon16 := PEMRPOLYGON16(Rec);
    nbrPoints := recPolyGon16.cpts;
    Setlength(Points,nbrPoints);
    For a := 0 to nbrPoints-1 do
    begin
      Points[a].x := ConVertX(recPolyGon16.apts[a].x);
      Points[a].y := ConVertY(recPolyGon16.apts[a].y);
    end;
    BufferObj.Polyline(wmfLayer,points,pw,ps,pc,0,bs,bc,(rec.iType =EMR_POLYGON16 ),True);
  End;

  EMR_POLYBEZIERTO16:
  Begin
    recPolyBezier16 := PEMRPOLYBEZIER16(Rec);
    nbrPoints := recPolyBezier16.cpts;
    Setlength(Points,nbrPoints+1);
    Setlength(exPoints,nbrPoints+1);


    exPoints[0].x := MoveToX;
    exPoints[0].y := MoveToY;
    i := 1;
    k := 0;

    For a := 0 to nbrPoints-1 do
    begin
      if (a+1) mod 3 = 0 then begin
        exPoints[i].x := ConVertX(recPolyBezier16.apts[a].x);
        exPoints[i].y := ConVertX(recPolyBezier16.apts[a].y);
        i := i+1;
      end else
      begin
        Points[k].x := ConVertX(recPolyBezier16.apts[a].x);
        Points[k].y := ConVertY(recPolyBezier16.apts[a].y);
        k := k+1;
      end;
    end;
    Closed := false;
    if (exPoints[0].x =  exPoints[i-1].x) and (exPoints[0].y =  exPoints[i-1].y)
    then begin
      i := i-1;
      Closed := True;
    end;
    Setlength(exPoints,i);
    wmfpl := TPolyLine(BufferObj.Polyline(wmfLayer,expoints,pw,ps,pc,0,bs,bc,Closed,True));
    For a := 0 to i-1 do
    begin
      Segment := TPLSegment(wmfpl.Segments[a]);
      Segment.SType := sCurve;
      Segment.TangentKnot := True;
      Segment.CPoint1 := Points[a*2];
      Segment.CPoint2 := Points[a*2+1];
      ap1 := wmfPl.ActualPoints[a+1];
      if a = i-1 then begin
        ap2 := wmfPl.ActualPoints[1];
      end else begin
        ap2 := wmfPl.ActualPoints[a+2];
      end;
      if (Segment.CPoint1.x = ap1.x) and
         (Segment.CPoint1.y = ap1.y) and
         (Segment.CPoint2.x = ap2.x) and
         (Segment.CPoint2.y = ap2.y) then Segment.SType := sLine;
    end;

  End;

  EMR_POLYBEZIER16:
  Begin

    recPolyBezier16 := PEMRPOLYBEZIER16(Rec);
    nbrPoints := recPolyBezier16.cpts;
    Setlength(Points,nbrPoints);
    Setlength(exPoints,nbrPoints);
    i := 0;
    k := 0;
    For a := 0 to nbrPoints-1 do
    begin
      if a mod 3 = 0 then begin
        exPoints[i].x := ConVertX(recPolyBezier16.apts[a].x);
        exPoints[i].y := ConVertX(recPolyBezier16.apts[a].y);
        i := i+1;
      end else
      begin
        Points[k].x := ConVertX(recPolyBezier16.apts[a].x);
        Points[k].y := ConVertY(recPolyBezier16.apts[a].y);
        k := k+1;
      end;
    end;
    Closed := false;
    if (exPoints[0].x =  exPoints[i-1].x) and (exPoints[0].y =  exPoints[i-1].y)
    then begin
      i := i-1;
      Closed := True;
    end;
    Setlength(exPoints,i);
    wmfpl := TPolyLine(BufferObj.Polyline(wmfLayer,expoints,pw,ps,pc,0,bs,bc,Closed,True));
    For a := 0 to i-1 do
    begin
      Segment := TPLSegment(wmfpl.Segments[a]);
      Segment.SType := sCurve;
      Segment.TangentKnot := True;
      Segment.CPoint1 := Points[a*2];
      Segment.CPoint2 := Points[a*2+1];
      ap1 := wmfPl.ActualPoints[a+1];
      if a = i-1 then begin
        ap2 := wmfPl.ActualPoints[1];
      end else begin
        ap2 := wmfPl.ActualPoints[a+2];
      end;
      if (Segment.CPoint1.x = ap1.x) and
         (Segment.CPoint1.y = ap1.y) and
         (Segment.CPoint2.x = ap2.x) and
         (Segment.CPoint2.y = ap2.y) then Segment.SType := sLine;
    end;

  End;

  EMR_CLOSEFIGURE:
  begin
    if assigned(wmfpl) then wmfpl.Closed := True;
  end;

  EMR_POLYPOLYGON16,EMR_POLYPOLYLINE16:
  Begin
    RecPolyPGon16 := PEMRPOLYPOLYGON16(Rec);
    nbrobjects := RecPolyPGon16.nPolys;

    i := nbrobjects-1;
    For b := 0 to nbrObjects-1 do
    begin
      pcnt := RecPolyPGon16.aPolyCounts[b];
      Setlength(Points,pcnt);
      For a := 0 to pcnt-1  do
      begin
        Points[a].x := Convertx(RecPolyPGon16.apts[i].x);
        Points[a].y := Converty(RecPolyPGon16.apts[i].y);
        inc(i);
      end;
      BufferObj.PolyLine(wmfLayer,points,pw,ps,pc,0,bs,bc,(rec.iType = EMR_POLYPOLYGON16),True);
    end;
  End;


  EMR_CREATEBRUSHINDIRECT:
  Begin
    WmfLogCnt := WmfLogCnt +1;
    RecBrush := PEMRCREATEBRUSHINDIRECT(rec);
    WmfPenBrush[WmfLogCnt].BrushLog.lbColor := RecBrush.lb.lbColor;
    WmfPenBrush[WmfLogCnt].BrushLog.lbStyle := RecBrush.lb.lbStyle;
    WmfPenBrush[WmfLogCnt].BrushLog.lbHatch := RecBrush.lb.lbHatch;
    WmfPenBrush[WmfLogCnt].index := RecBrush.ihBrush;
    WmfPenBrush[WmfLogCnt].isPen := false;
  End;

  EMR_SAVEDC:
  Begin
    SaveCnt := Savecnt+1;
    SavedDc[SaveCnt].Pen := ActivePen;
    SavedDc[SaveCnt].Brush := ActiveBrush;
  End;

  EMR_RESTOREDC:
  Begin
    Recrestore := PEMRRestoreDC(rec);
    dcIdx := SaveCnt+recrestore.iRelative+1;
    rDc := SavedDc[dcidx];
    if rdc.Pen > 0 then begin
      pc := wmfPenBrush[rDc.Pen].PenLog.lopnColor;
      ps := wmfPenBrush[rDc.Pen].PenLog.lopnStyle;
      pw := wmfPenBrush[rDc.Pen].PenLog.lopnWidth.x;
      ActivePen := rDc.Pen;
    end;
    if rdc.brush > 0 then begin
      bc := wmfPenBrush[rDc.Brush].BrushLog.lbColor;
      bs := wmfPenBrush[rDc.Brush].BrushLog.lbStyle;
      Activebrush := rdc.brush;
    end;
  End;

  EMR_CREATEMONOBRUSH:
  Begin
  End;


  EMR_SELECTOBJECT:
  Begin
    RecSelect := PEMRSELECTOBJECT(rec);

    for a := WmfLogCnt downto 1 do
    begin
      if wmfPenBrush[a].index = RecSelect.ihObject then
      begin
        if wmfPenBrush[a].isPen then
        begin
          pc := wmfPenBrush[a].PenLog.lopnColor;
          ps := wmfPenBrush[a].PenLog.lopnStyle;
          pw := wmfPenBrush[a].PenLog.lopnWidth.x;
          ActivePen := a;
        end else
        begin
          bc := wmfPenBrush[a].BrushLog.lbColor;
          bs := wmfPenBrush[a].BrushLog.lbStyle;
          ActiveBrush := a;
        end;
        if rec.itype <> EMR_EOF then result := 1 else result := 0;
        exit;
      end;
    end;
  End;


  EMR_DELETEOBJECT:
  Begin
  End;

  EMR_CREATEPEN:
  Begin
    WmfLogCnt := WmfLogCnt +1;
    RecPen := PEMRCREATEPEN(rec);
    WmfPenBrush[WmfLogCnt].PenLog.lopnColor := recPen.lopn.lopnColor;
    WmfPenBrush[WmfLogCnt].PenLog.lopnStyle := recPen.lopn.lopnStyle;
    WmfPenBrush[WmfLogCnt].PenLog.lopnWidth.x := recPen.lopn.lopnWidth.x;
    if recPen.lopn.lopnWidth.x = 0 then WmfPenBrush[WmfLogCnt].PenLog.lopnStyle := ord(psClear);
    WmfPenBrush[WmfLogCnt].index := recpen.ihPen;
    WmfPenBrush[WmfLogCnt].isPen := true;
  End;

  EMR_EXTCREATEPEN:
  Begin
    WmfLogCnt := WmfLogCnt +1;
    RecExtPen := PEMREXTCREATEPEN(rec);
    WmfPenBrush[WmfLogCnt].PenLog.lopnColor := RecExtPen.elp.elpColor;
    WmfPenBrush[WmfLogCnt].PenLog.lopnStyle := ord(psSolid);
    WmfPenBrush[WmfLogCnt].index := RecExtPen.ihPen;
    WmfPenBrush[WmfLogCnt].isPen := true;
  End;

  EMR_EXTTEXTOUTW:
  Begin
   RecText := PEMRExtTextOut(Rec);
   xx := Convertx(RecText.emrtext.ptlReference.x);
   yy := Converty(RecText.emrtext.ptlReference.y);
   xText := Copy(String(PWideChar(DWORD(Rec)+RecText.emrtext.offString)),1,RecText.emrtext.nChars);
   if Trim(xText) <> '' then begin
     lenA :=  (PInt(DWORD(Rec)+RecText.emrtext.offDx)^)/mfdpmm;
     TextObj := TText(BufferObj.TextOut(WmfLayer,xx,yy,0,FontH/mfdpmm,1,xText,FontName,162,clBlack,True));
     //TextObj.CSpace := lenA;
   end;
  end;
  EMR_EXTCREATEFONTINDIRECTW:
  Begin
    recFont := PEMRExtCreateFontIndirect(Rec);
    FontName := RecFont.elfw.elfLogFont.lfFaceName;
    FontH := RecFont.elfw.elfLogFont.lfHeight;
    FontCs := RecFont.elfw.elfLogFont.lfCharSet;
  end;

  EMR_EXTTEXTOUTA:
  Begin
  end;

  EMR_SETWORLDTRANSFORM:
  Begin
    RecSetWT :=  PEMRSetWorldTransform(Rec);
    xForm := RecSetWT.xform;
  end;

  EMR_MODIFYWORLDTRANSFORM:
  Begin
    RecModifyWT := PEMRModifyWorldTransform(Rec);
    mForm := RecModifyWT.xForm;
    xFormId := RecModifyWT.iMode;
    case xFormId of
      MWT_IDENTITY:
      begin
        xForm.eM11 := 1;
        xForm.eM22 := 1;
        xForm.eM12 := 0;
        xForm.eM21 := 0;
        xForm.eDx := 0;
        xForm.eDy := 0;
      end;

      MWT_LEFTMULTIPLY:
      begin
        ml[0] := mForm.eM11;ml[1] := mForm.eM12; ml[2] := 0;
        ml[3] := mForm.eM21;ml[4] := mForm.eM22; ml[5] := 0;
        ml[6] := mForm.eDX;ml[7] := mForm.eDy; ml[8] := 1;
        mr[0] := xForm.eM11;mr[1] := xForm.eM12; mr[2] := 0;
        mr[3] := xForm.eM21;mr[4] := xForm.eM22; mr[5] := 0;
        mr[6] := xForm.eDX;mr[7] := xForm.eDy; mr[8] := 1;

        for i := 0 to 8 do ms[i] := ml[i];
        PCTypesUtils.MatrixMultiply(3,ml,mr,ms);
        xForm.eM11 := ms[0];
        xForm.eM22 := ms[4];
        xForm.eM12 := ms[1];
        xForm.eM21 := ms[3];
        xForm.eDx := ms[6];
        xForm.eDy := ms[7];
      end;
      MWT_RIGHTMULTIPLY:
      begin
        ml[0] := mForm.eM11;ml[1] := mForm.eM12; ml[2] := 0;
        ml[3] := mForm.eM21;ml[4] := mForm.eM22; ml[5] := 0;
        ml[6] := mForm.eDX;ml[7] := mForm.eDy; ml[8] := 1;
        mr[0] := xForm.eM11;mr[1] := xForm.eM12; mr[2] := 0;
        mr[3] := xForm.eM21;mr[4] := xForm.eM22; mr[5] := 0;
        mr[6] := xForm.eDX;mr[7] := xForm.eDy; mr[8] := 1;
        for i := 0 to 8 do ms[i] := mr[i];
        PCTypesUtils.MatrixMultiply(3,mr,ml,ms);
        xForm.eM11 := ms[0];
        xForm.eM22 := ms[4];
        xForm.eM12 := ms[1];
        xForm.eM21 := ms[3];
        xForm.eDx := ms[6];
        xForm.eDy := ms[7];
      end;
    end;

  end;
  else
  Begin
  End;
  end;
  if rec.itype = EMR_EOF then begin
    if wmfPoCount > 1 then begin
      BufferObj.PolyLine(wmfLayer,wmfPoints,pw,ps,pc,0,0,0,EQDP(wmfPoints[0],wmfPoints[wmfPoCount-1]),True);
    end;
  end;
  if rec.itype <> EMR_EOF then result := 1 else result := 0;
end;

procedure TPCDrawing.ImportDXF(fileName: string; Layered, IncVertex: Boolean);
var
  DXFObj : DXF_Object;
begin
  try
    DXFObj := DXF_Object.Create_from_file(FileName, nil);
    AutoRefresh := False;
    DXFObj.ExportToPowerCad(self, layered, IncVertex);
    if assigned(FOnObjectInserted) then
      FOnObjectInserted(self, irCreate);
    ManualRefresh;
    AutoRefresh := True;
  except
    AutoRefresh := True;
  end;
end;

// ИМПОРТ СКС ДХФ
procedure TPCDrawing.SCSImportDXF(fileName: string; Layered, IncVertex: Boolean);
var
  DXFObj : DXF_ObjectSCS;
begin
  try
    DXFObj := DXF_ObjectSCS.Create_from_file(FileName, nil);
    AutoRefresh := False;
    DXFObj.ExportToPowerCad(self, layered, IncVertex);
    if assigned(FOnObjectInserted) then
      FOnObjectInserted(self, irCreate);
    AutoRefresh := True;
  except
    on E: Exception do AddExceptionToLog('TPCDrawing.SCSImportDXF' + E.Message);
  end;
end;

// ЭКСПОРТ СКС ДХФ
Procedure TPCDrawing.SCSExportDXF(FileName: string);
var
  DXFObj : DXF_ObjectSCS;
begin
  try
    DXFObj := DXF_ObjectSCS.Create_from_file(FileName, nil);
    DXFObj.save_to_file('C:\Projects\СКС\DXF\!Export\123.dxf');
  except
    on E: Exception do AddExceptionToLogEx('TPCDrawing.SCSExportDXF', E.Message);
  end;
end;

procedure TPCDrawing.ExportAsDxf(FileName: string);
  // this procedure uses the demo version DXFExport.dcu unit of cadsoftools.
  // If you want the nag message disapper, please purchase the unit from www.cadsoftttols.com
var
  E: TsgDXFExport;
begin
  E := TsgDXFExport.Create;
  E.IsParseWhite := True;
  E.Use01MM := True;
  E.PenWidthRatio := 0.3;
  DrawToCanvas(E.Canvas,0,0,25);
  E.EndDraw;
  E.SaveToFile(FileName);
end;


Procedure TPCDrawing.ExecuteTBCommand(CommandId:integer);
begin
end;

Procedure TPCDrawing.RegisterFigureClass(Fig: TFigureClass);
begin
  if FigureClasses.IndexOf(fig) = -1 then
  begin
    FigureClasses.Add(fig);
    FigureClassesSL.Addobject(Fig.ClassName, TObject(Fig)); //01.11.2011
  end;
end;


Procedure TPCDrawing.ROChanged;
var a,b: integer;
begin
 for a := 0 to layers.count-1 do begin
   TLayer(Layers[a]).VertZero := ord(verticalzero);
   TLayer(Layers[a]).HorzZero := ord(horizontalzero);
 end;
end;

procedure TPCDrawing.PrintPreview;
begin
//      Printer.Printers[Printer.PrinterIndex];
//      Printer.BeginDoc;
//      Printer.Canvas.MoveTo(0, 0);
//      Printer.Canvas.LineTo(110, 110);
//      Printer.EndDoc;
  prevForm.FIsRect := false;
  prevForm.CadControl := Self;
  prevForm.Init(true);
  prevForm.ShowModal;
end;

Procedure TPCDrawing.PrintRectPreview(ARect: TDoubleRect); //24.11.2011
begin
  prevForm.FPrRect := ARect;
  prevForm.FIsRect := true;
  prevForm.CadControl := Self;
  prevForm.Init(true);
  prevForm.ShowModal;
end;

Procedure TPCDrawing.View3D(const AFileStream: String);
var
  fig1: TFigure;
  fig2: TFigure;
begin
  {$ifdef 3D}
  // Tolik -- 01/02/2017 --
  fig1 := Nil;
  fig2 := nil;
  try
    if not Assigned(frm3D) then
      Application.CreateForm(Tfrm3D, frm3d);

    frm3d.FCAD := TF_CAD(Owner);
    // чистятся в procedure Tfrm3D.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    // и на всяк случай перед вызовом из Action-ов
    frm3d.FIdsStream.Add(frm3d.FCAD.FCADListID {GCadForm.FCADListID});
    frm3d.FFilesStream.Add(AFileStream);
    try
      fig1 := TConnectorObject.Create(0, 0, 0, GetLayerHandle(0), mydsNormal, self);
      TConnectorObject(fig1).ConnectorType := TConnectorType(0);
      Self.AddCustomFigure(0, fig1, false);
      TConnectorObject(fig1).Name := 'Anchor';
      fig2 := TConnectorObject.Create(self.WorkWidth, self.WorkHeight, 0, GetLayerHandle(0), mydsNormal, self);
      TConnectorObject(fig2).ConnectorType := TConnectorType(0);
      Self.AddCustomFigure(0, fig2, false);
      TConnectorObject(fig2).Name := 'Anchor';
      CollectFaces;

// 22.07.2011
      //16.09.2011 frm3D.LoadModelFromStream(AFileStream, GCadForm.FCADListID, Faces);
      //16.09.2011 if frm3D.F3DStreamModel = nil then
//      begin
//        frm3D.UpdateModelTree;
//        frm3D.UpdateScsModelTree;
//      end
//      else
//      begin
//        frm3D.UpdateModelTreeFromStream(Faces);
//        frm3D.UpdateScsModelTreeFromStream(Faces);
//      end;
//      frm3D.UpdateFaces(Faces, 1);

        frm3D.SyncModelFromStream(AFileStream, frm3d.FCAD.FCADListID, Faces);

    finally
      try
          TConnectorObject(fig1).Delete(false, False);
          fig1 := nil;
          TConnectorObject(fig2).Delete(false, False);
          fig2 := nil;
          Refresh;
      except
      end;
    end;
  // Tolik -- 01/02/2017 -- даже если будет ошибка - созданные коннекторы нужно
  // обязательно шлепнуть
  except
    on E: Exception do
      begin
        AddExceptionToLog('TPCDrawing.View3D: ' + E.Message);
        if fig1 <> nil then
          TConnectorObject(fig1).Delete(false, False);
        if fig2 <> nil then
          TConnectorObject(fig2).Delete(false, False);
      end;
  end;
  //
  {$endif 3D}
end;

function TPCDrawing.Get3DModel(const AFileStream: String=''): TObject;
var
  SavedCAD: TF_CAD;
begin
  Result := nil;
{$ifdef 3D}
  BeginProgress;
  SavedCAD := GCadForm;
  GCadForm := TF_CAD(Owner);
  try
    if not Assigned(frm3D) then
    begin
      Application.CreateForm(Tfrm3D, frm3d);
    end;
    if Assigned(frm3D.F3DModel) then
      FreeAndNil(frm3D.F3DModel);

    frm3D.CreateModel;

    frm3D.FIdsStream.Clear;
    frm3D.FFilesStream.Clear;

    frm3D.CreateTopNode;
    frm3D.CreateTopSCSNode;
    frm3D.FZOrder := 0;

    frm3d.FCAD := TF_CAD(Owner);
    //frm3d.FFileStream := AFileStream;
    frm3d.FIdsStream.Add(frm3d.FCAD.FCADListID {GCadForm.FCADListID});
    frm3d.FFilesStream.Add(AFileStream);

    CollectFaces;

    //16.09.2011 frm3D.UpdateFaces(Faces, 1);
    frm3D.SyncModelFromStream(AFileStream, frm3d.FCAD.FCADListID, Faces); //27.09.2011 frm3D.SyncModelFromStream(AFileStream, GCadForm.FCADListID, Faces);

    //PauseProgress(true);
    //frm3D.ShowModal;

    Result := frm3D.F3DModel;
    frm3D.F3DModel := nil;

    try
      FreeAndNil(frm3D);
    except
      on E: Exception do AddExceptionToLog(CPowerCadMessage + ' TPCDrawing.Get3DModel FreeAndNil(frm3D) ' + E.Message);
    end;

  finally
    GCadForm := SavedCAD;
    EndProgress;
  end;
{$endif 3D}
end;

(*
procedure TPCDrawing.AddCustomProperty(BlockName: String;
  CustomProp: TProperty);
var index: integer;
    CList:TList;
begin
  index := CPBlockNames.IndexOf(BlockName);
  if index = -1 then begin
    CPBlockNames.Add(BlockName);
    CList:= TList.Create;
    CPLists.Add(CList);
    CList.Add(CustomProp);
  end else begin
    CList := TList(CPLists[index]);
    CList.Add(CustomProp);
  end;
end;
*)

Function TPCDrawing.GetCustomPropList(BlockName: String):Tlist;
var index: integer;
begin
  index := CPBlockNames.IndexOf(BlockName);
  if index = -1 then
    result := nil
  else
    result := Tlist(CPLists[index]);
end;

Procedure TPCDrawing.ResetRegions;
var a: integer;
Figure: TFigure;
Begin
  For a := 0 to Figures.count - 1 do
  begin
    Figure := TFigure(Figures[a]);
    Figure.ResetRegion;
  end;
end;

Procedure TPCDrawing.RecordInsertUndo(xFig:Tfigure; aTag:Integer=0);
var
  xAction: TUndoAction;
begin
  if not RecordUndo then
    exit;
  xAction := TUndoAction.Create(uaInsert);
  xAction.List.Add(xFig);
  xAction.Tag := aTag;
  xFig.Urc := xfig.Urc+1;
  InsertUndoAction(xAction);
end;


Procedure TPCDrawing.AddFigureToModifyUndo(xAction: TUndoAction; xFig: TFigure);
var s: TMemoryStream;
begin
   xAction.List.Add(xFig);
   s := TMemoryStream.Create;
   xFig.WriteToStream(s);
   xAction.Params.Add(s);
end;

Procedure TPCDrawing.RecordModifyUndo(xFig:Tfigure);
var xAction: TUndoAction;
    a,b: integer;
    s: TMemoryStream;
    jFig: TFigure;
begin

  if not RecordUndo then exit;
  xAction := TUndoAction.Create(uaModify);
  if xFig <> nil then begin
    xAction.List.Add(xFig);
    s := TMemoryStream.Create;
    xFig.WriteToStream(s);
    xAction.Params.Add(s);
    InsertUndoAction(xAction);
  end
  else begin
    for a := 0 to figures.count - 1 do
    begin
      if TFigure(figures[a]).selected then
      begin
        xFig := TFigure(figures[a]);
        xAction.List.Add(xFig);
        s := TMemoryStream.Create;
        xFig.WriteToStream(s);
        xAction.Params.Add(s);
        for b := 0 to xFig.JoinedFigures.Count-1 do begin
          jFig := Tfigure(xFig.JoinedFigures[b]);
          xAction.List.Add(jFig);
          s := TMemoryStream.Create;
          jFig.WriteToStream(s);
          xAction.Params.Add(s);
        end;
      end;
    end;
    InsertUndoAction(xAction);
  end;
end;

Procedure TPCDrawing.InsertUndoAction(xAction:TUndoAction);
var
  i: Integer;
  cAction: TUndoAction;
  uc: Integer;
begin
 //Tolik 23/06/2021 --
 {
 if GCadForm.FListType = lt_DesignBox then
  begin
    GCadForm.SaveForUndoDesignList(uat_None, False, False);
    if xAction <> nil then
      FreeAndNil(xAction);
    exit;
  end;
  }
  //

  // Tolik 03/06/2021 -- игрушка для посмотреть
  {else
  if GCadForm.FListType = lt_ElScheme then
  begin
    SaveListToUndoStack(GCadForm.FCADListID);
    if xAction <> nil then
      FreeAndNil(xAction);
    exit;
  end;}
  {
  else
  // Tolik 13/02/2021 --
  if GCadForm.FListType = lt_ElScheme then
  begin
    GCadForm.SaveForUndoELScheme(uat_None, False, False);
    if xAction <> nil then
      FreeAndNil(xAction);
    exit;
  end;
  }

  FUndoList.Insert(0,xAction);
  FUndoIdx := 0;
  uc := FUndoList.Count;
  if (FUndoCount > 0) and (uc > FUndoCount) then
  begin
    try
      for i := uc downto FUndoCount+1 do
      begin
        cAction := FUndoList[i-1];
        KillUndoAction(cAction);
        FUndoList.Delete(i-1);
      end;
    except
//      on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawing.InsertUndoAction' + E.Message);
    end;
  end;
end;

Procedure TPCDrawing.PrintMessage(Mes:String);
begin
end;


Function TPCDrawing.GetVersion:Integer;
begin
  result := 300;
end;

Function TPCDrawing.GetBuildNumber: Integer;
begin
  result := 1000;
end;

procedure TPCDrawing.SetTool(aToolIndex: TPCTool; aToolInfo: String;aToolData:Integer);
begin
  inherited;
  evToolIndex.RaiseEvent(Integer(Self),'',0);
  ResetActions;
  //Tolik 01/10/2021 - -
  if aToolInfo <> 'TOrthoLine' then
    GNoTraceCable := False;

  if aToolInfo = 'TWallPath' then
    CreateArchGuidesLines
  else
    DestroyArchGuidesLines;
end;
(*
Procedure TPCDrawing.SetInterfaceHandle;
begin
  // set in TPowercad
end;

Procedure TPCDrawing.NilInterfaceHandle;
begin
  //SetControlForPlugins(nil);
  //SetControlForScripting(nil);
end;
*)
Procedure TPCDrawing.DoSelChange;
var Info : String;
    ar:Boolean;
begin
  if FSelection.Count = 1 then begin
    Info := TFigure(Fselection[0]).ClassName+'>'+TFigure(Fselection[0]).Name;
    PrintMessage(Info);
    SnapInfo := TFigure(Fselection[0]).ClassName;
  end else PrintMessage('');
  if assigned(FOnSelChange) and (not FSelChangeLocked) then begin
    ar := AutoRefresh;
    AutoRefresh := False;
    FOnSelChange(self);
    AutoRefresh := ar;
  end;
end;

// all figure classes
Function TPCDrawing.FigureGetHandle(FigureIndex:Integer):Integer;
begin
  result := 0;
  if (FigureIndex > -1) and (FigureIndex < Figures.Count) then
    result := TFigHandle(Figures[FigureIndex]);
end;

Function TPCDrawing.FigureGetName(FigureHandle:Integer):String;
begin
  Result := '';
  if FigureHandle <> 0 then
  begin
    Result := TFigure(FigureHandle).Name;
  end;
end;

Function TPCDrawing.FigureGetClass(FigureHandle:Integer):String;
var CName: String;
    cls: String;
    i: Integer;
begin
  Result := '';
  if FigureHandle <> 0 then
  begin
    Result := TFigure(FigureHandle).CName;
  end;
end;



Function TPCDrawing.FigureGetPointCount(FigureHandle:Integer):Integer;
begin
  Result := 0;
  if FigureHandle <> 0 then
  begin
    Result := TFigure(FigureHandle).PointCount;
  end;
end;

Function TPCDrawing.FigureGetPoint(FigureHandle,pIndex:Integer):TDoublePoint;
begin
  Result := DoublePoint(0,0);
  if FigureHandle <> 0 then
  begin
    Result := TFigure(FigureHandle).FigurePoints[pIndex];
  end;
end;

Function TPCDrawing.FigureGetDCPoint(FigureHandle,pIndex:Integer):TDoublePoint;
var p: TDoublePoint;
    z: Double;
begin
  Result := DoublePoint(0,0);
  if FigureHandle <> 0 then
  begin
    p := TFigure(FigureHandle).FigurePoints[pIndex];
    z := 0;
    DEngine.ConvertPoint(p.x,p.y,z);
    result := p;
  end;
end;

Function TPCDrawing.GetDCPoint(p:TDoublePoint):TDoublePoint;
var pp: TDoublePoint;
    z: Double;
begin
  pp := p;
  z := 0;
  DEngine.ConvertPoint(pp.x,pp.y,z);
  result := pp;
end;

Function TPCDrawing.GetDCLen(l:Double):Integer;
var ll: Double;
begin
  ll := l;
  DEngine.ConvertLen(ll);
  result := round(ll);
end;


Function TPCDrawing.FigureGetCenter(FigureHandle:Integer):TDoublePoint;
begin
  Result := DoublePoint(0,0);
  if FigureHandle <> 0 then
  begin
    Result := TFigure(FigureHandle).CenterPoint;
  end;
end;

Function TPCDrawing.FigureGetRect(FigureHandle:Integer):TDoubleRect;
begin
  Result := DoubleRect(0,0,0,0);
  if FigureHandle <> 0 then
  begin
    Result := TFigure(FigureHandle).GetBoundRect;
  end;
end;

Function TPCDrawing.FigureGetRadius(FigureHandle:Integer):Double;
begin
  Result := 0;
  if FigureHandle <> 0 then
  begin
    Result := TFigure(FigureHandle).Radius;
  end;
end;

Function TPCDrawing.FigureGetFontName(FigureHandle:Integer):String;
begin
  Result := '';
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    Result := TText(FigureHandle).Font.Name;
  end;
end;

Function TPCDrawing.FigureGetFontBold(FigureHandle:Integer):Boolean;
begin
  Result := False;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    Result := fsBold in TText(FigureHandle).Font.Style;
  end;
end;

Function TPCDrawing.FigureGetFontItalic(FigureHandle:Integer):Boolean;
begin
  Result := False;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    Result := fsItalic in TText(FigureHandle).Font.Style;
  end;
end;

Function TPCDrawing.FigureGetFontUnderline(FigureHandle:Integer):Boolean;
begin
  Result := False;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    Result := fsUnderLine in TText(FigureHandle).Font.Style;
  end;
end;

Function TPCDrawing.FigureGetFontStrike(FigureHandle:Integer):Boolean;
begin
  Result := False;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    Result := fsStrikeOut in TText(FigureHandle).Font.Style;
  end;
end;

Function TPCDrawing.FigureGetFontSize(FigureHandle:Integer):Double;
begin
  Result := 0;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    Result := TText(FigureHandle).Height;
  end;
end;

Function TPCDrawing.FigureGetFontCharset(FigureHandle:Integer):Integer;
begin
  Result := 0;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    Result := TText(FigureHandle).Font.Charset;
  end;
end;

Function TPCDrawing.FigureGetFontColor(FigureHandle:Integer):TColor;
begin
  Result := 0;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    Result := TText(FigureHandle).Color;
  end;
end;

Function TPCDrawing.FigureGetPenColor(FigureHandle:Integer):TColor;
begin
  Result := 0;
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).color;
  end;
end;

Function TPCDrawing.FigureGetBrushColor(FigureHandle:Integer):TColor;
begin
  Result := 0;
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).brc;
  end;
end;

Function TPCDrawing.FigureGetPenStyle(FigureHandle:Integer):TPenStyle;
begin
  Result :=psClear;
  if (FigureHandle <> 0) then
  begin
    Result := TPenStyle(TFigure(FigureHandle).Style);
  end;
end;

Function TPCDrawing.FigureGetBrushStyle(FigureHandle:Integer):TBrushStyle;
begin
  Result :=bsClear;
  if (FigureHandle <> 0) then
  begin
    Result := TBrushStyle(TFigure(FigureHandle).brs);
  end;
end;

Function TPCDrawing.FigureGetRowStyle(FigureHandle:Integer):TRowStyle;
begin
  Result :=rsNone;
  if (FigureHandle <> 0) then
  begin
    Result := TRowStyle(TFigure(FigureHandle).RowStyle);
  end;
end;

Function TPCDrawing.FigureGetPenWidth(FigureHandle:Integer):Integer;
begin
  Result := 0;
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).Width;
  end;
end;

Function TPCDrawing.FigureGetInfo(FigureHandle:Integer):String;
begin
  Result := '';
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).Info;
  end;
end;

Function TPCDrawing.FigureGetAngle(FigureHandle:Integer):Double;
begin
  Result := 0;
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).Angle;
  end;
end;

Function TPCDrawing.FigureGetLayerHandle(FigureHandle:Integer):Integer;
begin
  Result := 0;
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).LayerHandle;
  end;
end;

Function TPCDrawing.FigureGetDiagonal(FigureHandle:Integer):Boolean;
begin
  Result := False;
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).DiagonalScale;
  end;
end;

Function TPCDrawing.FigureGetLockMove(FigureHandle:Integer):Boolean;
begin
  Result := False;
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).LockMove;
  end;
end;

Function TPCDrawing.FigureGetLockModify(FigureHandle:Integer):Boolean;
begin
  Result := False;
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).LockModify;
  end;
end;

Function TPCDrawing.FigureGetSelected(FigureHandle:Integer):Boolean;
begin
  Result := False;
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).Selected;
  end;
end;

Function TPCDrawing.FigureTestPoint(FigureHandle:Integer;TestPoint:TDoublePoint):Boolean;
begin
  Result := False;
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).IsPointIn(TestPoint.x,TestPoint.y);
  end;
end;

Function TPCDrawing.FigureTestRect(FigureHandle:Integer;TestRect:TDoubleRect):Boolean;
begin
  Result := False;
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).CheckifInArea(TestRect);
  end;
end;

Function TPCDrawing.FigureGetRgnHandle(FigureHandle:Integer):Integer;
begin
  Result := 0;
  if (FigureHandle <> 0) then
  begin
    Result := TFigure(FigureHandle).RegHandle;
  end;
end;

Procedure TPCDrawing.FigureSelect(FigureHandle:Integer);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Select;
  end;
end;

Procedure TPCDrawing.FigureSelectAsRotate(FigureHandle:Integer);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).RotateSelect;
  end;
end;

Procedure TPCDrawing.FigureDeSelect(FigureHandle:Integer);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).DeSelect;
  end;
end;

Procedure TPCDrawing.FigureEdit(FigureHandle:Integer);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Edit;
  end;
end;

Procedure TPCDrawing.FigureMove(FigureHandle:Integer;deltax,deltay: Double);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Move(deltaX,deltaY);
  end
end;

Procedure TPCDrawing.FigureRotate(FigureHandle:Integer;Angle:Double);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Rotate(Angle,TFigure(FigureHandle).CenterPoint);
  end;
end;

Procedure TPCDrawing.FigureRotateByPoint(FigureHandle:Integer;Angle:Double; cPoint:TDoublePoint);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Rotate(Angle,cPoint);
  end;
end;

Procedure TPCDrawing.FigureMirror(FigureHandle:Integer; Point1,Point2: TDoublePoint);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Mirror(point1,point2);
  end;
end;

Procedure TPCDrawing.FigureScale(FigureHandle:Integer; px,py: Double);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Scale(px,py,TFigure(FigureHandle).CenterPoint);
  end;
end;

Procedure TPCDrawing.FigureScaleByPoint(FigureHandle:Integer; px,py: Double; rPoint: TDoublepoint);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Scale(px,py,rPoint);
  end;
end;

Procedure TPCDrawing.FigureSetFontName(FigureHandle:Integer;value:String);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    TText(FigureHandle).Font.name := Value;
    TText(FigureHandle).Modified := True;
  end;
end;

Procedure TPCDrawing.FigureSetFontBold(FigureHandle:Integer;value:Boolean);
var xfont: Tfont;
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    xfont := TText(FigureHandle).Font;
    if value then xfont.Style := xFont.Style + [fsBold]
    else xfont.Style := xFont.Style - [fsBold];
    TText(FigureHandle).Modified := True;
  end;
end;

Procedure TPCDrawing.FigureSetFontItalic(FigureHandle:Integer;value:Boolean);
var xfont: Tfont;
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    xfont := TText(FigureHandle).Font;
    if value then xfont.Style := xFont.Style + [fsItalic]
    else xfont.Style := xFont.Style - [fsItalic];
    TText(FigureHandle).Modified := True;
  end;
end;

Procedure TPCDrawing.FigureSetFontUnderline(FigureHandle:Integer;value:Boolean);
var xfont: Tfont;
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    xfont := TText(FigureHandle).Font;
    if value then xfont.Style := xFont.Style + [fsUnderLine]
    else xfont.Style := xFont.Style - [fsUnderLine];
    TText(FigureHandle).Modified := True;
  end;
end;

Procedure TPCDrawing.FigureSetFontStrike(FigureHandle:Integer;value:Boolean);
var xfont: Tfont;
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    xfont := TText(FigureHandle).Font;
    if value then xfont.Style := xFont.Style + [fsStrikeOut]
    else xfont.Style := xFont.Style - [fsStrikeOut];
    TText(FigureHandle).Modified := True;
  end;
end;

Procedure TPCDrawing.FigureSetFontSize(FigureHandle:Integer;value:Double);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    TText(FigureHandle).Height := Value;
    TText(FigureHandle).Modified := True;
  end;
end;

Procedure TPCDrawing.FigureSetFontCharset(FigureHandle:Integer;value:Integer);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    TText(FigureHandle).Font.Charset := Value;
    TText(FigureHandle).Modified := True;
  end;
end;

Procedure TPCDrawing.FigureSetFontColor(FigureHandle:Integer;value:TColor);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    TText(FigureHandle).Font.Color := Value;
    TText(FigureHandle).Color := Value;
    TText(FigureHandle).Modified := True;
  end;
end;

Procedure TPCDrawing.FigureSetPenColor(FigureHandle:Integer;value:TColor);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Color := value;
  end;
end;

Procedure TPCDrawing.FigureSetBrushColor(FigureHandle:Integer;value:TColor);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).brc := value;
  end;
end;

Procedure TPCDrawing.FigureSetPenStyle(FigureHandle:Integer;value:TPenStyle);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Style := ord(value);
  end;
end;

Procedure TPCDrawing.FigureSetBrushStyle(FigureHandle:Integer;value:TBrushStyle);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).brs := ord(value);
  end;
end;

Procedure TPCDrawing.FigureSetRowStyle(FigureHandle:Integer;value:TRowStyle);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).RowStyle := ord(value);
  end;
end;

Procedure TPCDrawing.FigureSetPenWidth(FigureHandle:Integer;value:Integer);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Width := Value;
  end;
end;

Procedure TPCDrawing.FigureSetPoint(FigureHandle,pIndex:Integer;fPoint:TDoublePoint);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).FigurePoints[pIndex] := fPoint;
  end;
end;

Procedure TPCDrawing.FigureSetInfo(FigureHandle:Integer;value:String);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Info := Value;
  end;
end;


Procedure TPCDrawing.FigureSetAngle(FigureHandle:Integer;value:Double);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).Angle := Value;
  end;
end;

Procedure TPCDrawing.FigureSetLayerHandle(FigureHandle:Integer;value:Integer);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).LayerHandle := Value;
  end;
end;

Procedure TPCDrawing.FigureSetDiagonal(FigureHandle:Integer;value:Boolean);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).DiagonalScale := Value;
  end;
end;

Procedure TPCDrawing.FigureSetLockMove(FigureHandle:Integer;value:Boolean);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).LockMove := Value;
  end;
end;

Procedure TPCDrawing.FigureSetLockModify(FigureHandle:Integer;value:Boolean);
begin
  if (FigureHandle <> 0) then
  begin
    TFigure(FigureHandle).LockModify := Value;
  end;
end;

Procedure TPCDrawing.FigureSetRgnHandle(FigureHandle,Rgn:Integer);
var r: Integer;
begin
  if (FigureHandle <> 0) then
  begin
    r := TFigure(FigureHandle).RegHandle;
    if r <> 0 then deleteobject(r);
    TFigure(FigureHandle).RegHandle := Rgn;
  end;
end;

//block - figure grp
Function TPCDrawing.FigureGrpGetFigureCount(FigureHandle:Integer):Integer;
begin
  result := 0;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TFigureGrp) then
  begin
    result := TFigureGrp(FigureHandle).InFigures.Count;
  end;
end;

Function TPCDrawing.FigureGrpGetFigureHandle(FigureHandle,fIndex:Integer):Integer;
begin
  result := 0;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TFigureGrp) then
  begin
    if (fIndex > -1) and (fIndex < TFigureGrp(FigureHandle).InFigures.Count) then
      result := Integer(TFigureGrp(FigureHandle).InFigures[fIndex]);
  end;
end;


Function TPCDrawing.FigureGrpGetCombined(FigureHandle:Integer):Boolean;
begin
  result := false;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TFigureGrp) then
  begin
    result := TFigureGrp(FigureHandle).Combined;
  end;
end;

Procedure TPCDrawing.FigureGrpSetCombined(FigureHandle:Integer;Value:Boolean);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TFigureGrp) then
  begin
    TFigureGrp(FigureHandle).Combined := value;
  end;
end;

Procedure TPCDrawing.FigureGrpUngroup(FigureHandle:Integer);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TFigureGrp) then
  begin
    TFigureGrp(FigureHandle).UnGroup;
  end;
end;

// block
Function TPCDrawing.FigureBlockGetBlockname(FigureHandle:Integer):String;
begin
  result := '';
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TBlock) then
  begin
    result := TBlock(FigureHandle).BlockName;
  end;
end;


// line - polyline
Function TPCDrawing.FigureGetJoin1(FigureHandle:Integer):Integer;
begin
  result := 0;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is DrawObjects.TLine) then
  begin
    result := Integer(DrawObjects.TLine(FigureHandle).JoinFigure1);
  end;
end;

Function TPCDrawing.FigureGetJoin2(FigureHandle:Integer):Integer;
begin
  result := 0;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is DrawObjects.TLine) then
  begin
    result := Integer(DrawObjects.TLine(FigureHandle).JoinFigure2);
  end;
end;

Procedure TPCDrawing.FigureSetJoin1(FigureHandle,JHandle:Integer);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is DrawObjects.TLine) then
  begin
    DrawObjects.TLine(FigureHandle).SetJFigure1(Tfigure(Jhandle));
  end;
end;

Procedure TPCDrawing.FigureSetJoin2(FigureHandle,JHandle:Integer);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is DrawObjects.TLine) then
  begin
    DrawObjects.TLine(FigureHandle).SetJFigure2(Tfigure(Jhandle));
  end;
end;

Function TPCDrawing.FigureGetClosed(FigureHandle:Integer):Boolean;
begin
  result := false;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TPolyline) then
  begin
    result := TPolyline(FigureHandle).Closed;
  end;
end;

Procedure TPCDrawing.FigureSetClosed(FigureHandle:Integer; Closed:Boolean);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TPolyline) then
  begin
    TPolyline(FigureHandle).Closed := Closed;
  end;
end;

Function TPCDrawing.FigureGetControlPoint(FigureHandle,SegmentIndex,pIndex:Integer):TDoublePoint;
var Seg: TPlSegment;
begin
  result := DoublePoint(0,0);
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TPolyline) then
  begin
    if (SegmentIndex > 0) and (SegmentIndex <= TPolyline(FigureHandle).Segments.Count) then
    begin
      seg := TPlSegment(TPolyline(FigureHandle).Segments[SegmentIndex-1]);
      if pIndex = 0 then result := seg.CPoint1 else result := seg.CPoint2;
    end;
  end;
end;

Procedure TPCDrawing.FigureSetControlPoints(FigureHandle,SegmentIndex:Integer;cPoint1,cPoint2:TDoublePoint);
var Seg: TPlSegment;
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TPolyline) then
  begin
    if (SegmentIndex > 0) and (SegmentIndex <= TPolyline(FigureHandle).Segments.Count) then
    begin
      seg := TPlSegment(TPolyline(FigureHandle).Segments[SegmentIndex-1]);
      seg.CPoint1 := cPoint1;
      seg.CPoint2 := cPoint2;
    end;
  end;
end;

Function TPCDrawing.FigureGetSegmentType(FigureHandle,SegmentIndex:Integer):TSegmentType;
var Seg: TPlSegment;
begin
  result := sLine;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TPolyline) then
  begin
    if (SegmentIndex > 0) and (SegmentIndex <= TPolyline(FigureHandle).Segments.Count) then
    begin
      seg := TPlSegment(TPolyline(FigureHandle).Segments[SegmentIndex-1]);
      result := seg.sType;
    end;
  end;
end;

Procedure TPCDrawing.FigureSetSegmentType(FigureHandle,SegmentIndex:Integer; SegType:TSegmentType);
var Seg: TPlSegment;
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TPolyline) then
  begin
    if (SegmentIndex > 0) and (SegmentIndex <= TPolyline(FigureHandle).Segments.Count) then
    begin
      TPolyline(FigureHandle).ArrangeSegment(SegmentIndex,SegType);
    end;
  end;
end;

Procedure TPCDrawing.FigureInvertArcSegment(FigureHandle,SegmentIndex:Integer);
var Seg: TPlSegment;
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TPolyline) then
  begin
    if (SegmentIndex > 0) and (SegmentIndex <= TPolyline(FigureHandle).Segments.Count) then
    begin
      seg := TPlSegment(TPolyline(FigureHandle).Segments[SegmentIndex-1]);
      seg.Inverted := seg.Inverted;
    end;
  end;
end;

Procedure TPCDrawing.FigureConvertPLBezier(FigureHandle:Integer);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TPolyline) then
  begin
      TPolyline(FigureHandle).ConvertToBezier;
  end;
end;

Procedure TPCDrawing.FigureConvertPLPolyline(FigureHandle:Integer);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TPolyline) then
  begin
      TPolyline(FigureHandle).ConvertToPolyline;
  end;
end;

// ellipse
Function TPCDrawing.FigureGetElpALen(FigureHandle:Integer):Double;
begin
  result := 0;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TEllipse) then
  begin
      result := TEllipse(FigureHandle).Alen;
  end else if (FigureHandle <> 0) and (TFigure(FigureHandle) is TElpArc) then
  begin
      result := TElpArc(FigureHandle).Alen;
  end;
end;

Function TPCDrawing.FigureGetElpBLen(FigureHandle:Integer):Double;
begin
  result := 0;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TEllipse) then
  begin
      result := TEllipse(FigureHandle).Blen;
  end else if (FigureHandle <> 0) and (TFigure(FigureHandle) is TElpArc) then
  begin
      result := TElpArc(FigureHandle).Blen;
  end;
end;

//arc
Function TPCDrawing.FigureGetArcStyle(FigureHandle:Integer):TArcStyle;
begin
  result := asOpen;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TArc) then
  begin
    result := TArc(FigureHandle).ArcStyle;
  end
  else if (FigureHandle <> 0) and (TFigure(FigureHandle) is TElpArc) then
  begin
    result := TElpArc(FigureHandle).ArcStyle;
  end;
end;

Procedure TPCDrawing.FigureSetArcStyle(FigureHandle:Integer;aStyle:TArcStyle);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TArc) then
  begin
    TArc(FigureHandle).ArrangeStyle(aStyle);
  end else if (FigureHandle <> 0) and (TFigure(FigureHandle) is TElpArc) then
  begin
    TElpArc(FigureHandle).ArrangeStyle(aStyle);
  end;
end;

Procedure TPCDrawing.FigureInvertArc(FigureHandle:Integer);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TArc) then
  begin
    TArc(FigureHandle).Invert;
  end else if (FigureHandle <> 0) and (TFigure(FigureHandle) is TElpArc) then
  begin
    TElpArc(FigureHandle).Invert;
  end;
end;

Function TPCDrawing.FigureGetArcSAngle(FigureHandle:Integer):Double;
begin
  result := 0;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TArc) then
  begin
    result := TArc(FigureHandle).SAngle;
  end else if (FigureHandle <> 0) and (TFigure(FigureHandle) is TElpArc) then
  begin
    result := TElpArc(FigureHandle).SAngle;
  end;
end;

Function TPCDrawing.FigureGetArcFAngle(FigureHandle:Integer):Double;
begin
  result := 0;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TArc) then
  begin
    result := TArc(FigureHandle).FAngle;
  end else if (FigureHandle <> 0) and (TFigure(FigureHandle) is TElpArc) then
  begin
    result := TElpArc(FigureHandle).FAngle;
  end;
end;

Procedure TPCDrawing.FigureSetArcAngles(FigureHandle:Integer; SAngle,FAngle:Double);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TArc) then
  begin
    TArc(FigureHandle).SAngle := SAngle;
    TArc(FigureHandle).FAngle := FAngle;
    TArc(FigureHandle).ResetRegion;
    TArc(FigureHandle).Modified := True;
  end else if (FigureHandle <> 0) and (TFigure(FigureHandle) is TElpArc) then
  begin
    TElpArc(FigureHandle).SAngle := SAngle;
    TElpArc(FigureHandle).FAngle := FAngle;
    TElpArc(FigureHandle).ResetRegion;
    TElpArc(FigureHandle).Modified := True;
  end;
end;

// rich text
Function TPCDrawing.FigureGetRichText(FigureHandle:Integer):String;
begin
  result := '';
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TRichText) then
  begin
    result := TRichText(FigureHandle).re.Lines.Text;
  end;
end;

Procedure TPCDrawing.FigureSetRichText(FigureHandle:Integer;rText:String);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TRichText) then
  begin
    TRichText(FigureHandle).re.Lines.Text := rtext;
  end;
end;

Function TPCDrawing.FigureGetPictureName(FigureHandle:Integer):String;
begin
  result := '';
  if (FigureHandle <> 0) and ((TFigure(FigureHandle) is TbmpObject) or (TFigure(FigureHandle) is TWmfObject))  then
  begin
    if (TFigure(FigureHandle) is TbmpObject) then
      result := TBmpObject(FigureHandle).PictureName
    else
      result := TWmfObject(FigureHandle).PictureName;
  end;
end;

// Bmp Object
Function TPCDrawing.FigureGetTransparent(FigureHandle:Integer):Boolean;
begin
  result := False;
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TbmpObject) then
  begin
    result := TBmpObject(FigureHandle).Transparent;
  end;
end;

Procedure TPCDrawing.FigureSetTransparent(FigureHandle:Integer;Value:Boolean);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TbmpObject) then
  begin
    TBmpObject(FigureHandle).Transparent := Value;
  end;
end;

Procedure TPCDrawing.FigureFlipHorz(FigureHandle:Integer);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TbmpObject) then
  begin
    TBmpObject(FigureHandle).FlipHorz;
  end;
end;

Procedure TPCDrawing.FigureFlipVert(FigureHandle:Integer);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TbmpObject) then
  begin
    TBmpObject(FigureHandle).FlipVert;
  end;
end;

Procedure TPCDrawing.FigureSkewBitmap(FigureHandle:Integer);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TbmpObject) then
  begin
    TBmpObject(FigureHandle).SkewShape;
  end;
end;


Procedure TPCDrawing.FigureSaveBitmapToFile(FigureHandle:Integer;FName:String);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TbmpObject) then
  begin
    TBmpObject(FigureHandle).Picture.SaveToFile(Fname);
  end;
end;

Procedure TPCDrawing.FigureLoadBitmapFromFile(FigureHandle:Integer; FName:String);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TbmpObject) then
  begin
    TBmpObject(FigureHandle).Picture.LoadFromFile(FName);
    TBmpObject(FigureHandle).Modified := True;
  end;
end;


// Text
Function TPCDrawing.FigureGetText(FigureHandle:Integer):String;
begin
  result := '';
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    result := TText(FigureHandle).Text;
  end;
end;

Procedure TPCDrawing.FigureSetText(FigureHandle:Integer;Value:String);
begin
  if (FigureHandle <> 0) and (TFigure(FigureHandle) is TText) then
  begin
    TText(FigureHandle).Text := Value;
    TText(FigureHandle).Modified := true;
  end;
end;

Function TPCDrawing.DrawUserFigureEvent(Cname:String; DC,Handle:Integer;isGrayed:Boolean):Boolean;
var res: Boolean;
Begin
  res := false;
  if assigned(FonUserDraw) then
  begin
    FOnUserDraw(Self,CName,Dc,Handle,isGrayed,res);
  end;
  result := res;
end;

Function TPCDrawing.PointInUserFigureEvent(Cname:String;Handle:Integer;x,y:Double; var Test:Boolean):Boolean;
var res: Boolean;
Begin
  res := false;
  if assigned(FOnUserHitTest) then
  begin
    FOnUserHitTest(Self,Cname,Handle,x,y,Test,Res);
  end;
  result := res;
end;

procedure TPCDrawing.LockSelChange;
begin
  FSelChangeLocked := True;
end;

procedure TPCDrawing.UnLockSelChange;
begin
  FSelChangeLocked := False;
end;


procedure TPCDrawing.DrawDetail;
var a: integer;
    Figure : TFigure;
    Layer : TLayer;
    isDraw,isFlue: Boolean;
    unreg: string;
    xFont: TFont;
    nh,nl:Integer;
    vRect: TDoubleRect;
    frect: TDoubleRect;
    cReg:HRGN;
begin
  vRect := GetVisibleRect;
  if FDetail then begin
    DEngine.Canvas.Pen.Color := clBlack;
    DEngine.Canvas.Pen.Style := psSolid;
    DEngine.Canvas.Pen.Mode := pmCopy;
    DEngine.Canvas.Pen.Width := 2;
    Dengine.Canvas.Brush.Color := PageColor;
    Dengine.Canvas.Brush.Style := bsSolid;
    if DetailActive then begin
      DEngine.Canvas.Pen.Width := 3;
      DEngine.Canvas.Pen.Color := clRed;
      DEngine.Canvas.Rectangle(FdetailPosX+1,FDetailPosY+1,FdetailPosX+FDetailWidth,FDetailPosY+FDetailHeight);
    end else
      DEngine.Canvas.Rectangle(FdetailPosX+1,FDetailPosY+1,FdetailPosX+FDetailWidth,FDetailPosY+FDetailHeight);
    DrawGrids(DEngine.Canvas);
    DrawGuides(DEngine.Canvas);
    For a := 0 to Figures.count-1 do
    begin
      Figure := TFigure(Figures[a]);
      isDraw := True;isFlue := False;
      fRect := fiGure.GetBoundRect;
      if RectOverlaps(vRect,fRect) then
      begin
        if Figure.LayerHandle > 0 then begin
          Layer := TLayer(Figure.LayerHandle);
          isDraw := (Layer.visible <> lost);
          isFlue := (Layer.visible = grayed);
        end;
        if (isDraw or (Figure is TFigureGrp))  then
        begin
          Figure.DrawDetail(Dengine,DetailStyle);
        end;
      end;
    end;
    Dengine.Canvas.Brush.Style := bsClear;
    DEngine.Canvas.Pen.Color := clBlack;
    DEngine.Canvas.Pen.Style := psSolid;
    DEngine.Canvas.Pen.Mode := pmCopy;
    DEngine.Canvas.Pen.Width := 2;
    if DetailActive then begin
      DEngine.Canvas.Pen.Width := 3;
      DEngine.Canvas.Pen.Color := clRed;
      DEngine.Canvas.Rectangle(FdetailPosX+1,FDetailPosY+1,FdetailPosX+FDetailWidth,FDetailPosY+FDetailHeight);
    end else
      DEngine.Canvas.Rectangle(FdetailPosX+1,FDetailPosY+1,FdetailPosX+FDetailWidth,FDetailPosY+FDetailHeight);
    
    DEngine.Canvas.Rectangle(FdetailPosX+1,FDetailPosY+1,FdetailPosX+FDetailWidth,FDetailPosY+FDetailHeight);
  end;

end;


function TPCDrawing.GetZAvg(dRect: TDoubleRect): Double;
var i,k: Integer;
    zMin,zMax: Double;
    fAvg: Double;
    Figure:TFigure;
    fRect:TDoubleRect;
    isDraw:Boolean;
begin
  zMin := 0;
  zMax := 0;
  k := 0;
  for i := 0 to Figures.Count-1 do
  begin
    Figure := TFigure(Figures[i]);
    isDraw := True;
    fRect := fiGure.GetBoundRect;
    if Figure.LayerHandle > 0 then begin
      isDraw := (TLayer(Figure.LayerHandle).visible <> lost);
    end;
    if isDraw and Figure.GetZAvg(dRect,fAvg) then
    begin
      if k = 0 then begin
        zMin := fAvg;
        zMax := fAvg;
      end else begin
        if fAvg < ZMin then zMin := fAvg;
        if fAvg > ZMax then zMax := fAvg;
      end;
      k := k+1;
    end;
  end;
  Result := (zMin+zMax)/2;
end;

function TPCDrawing.HitTestModPointIntVal(x, y: Integer): TModPoint;
var a: integer;
    pdim : Integer;
Begin
  result := nil;
  pdim := pointdim;
  for a := 0 to ModPoints.count-1 do
  begin
    if TModPoint(ModPoints[a]).IsPointInInt(x,y,pdim) then
    begin
      result := ModPoints[a];
      exit;
    end;
  end;
end;

function TPCDrawing.HitTestModPointDetVal(x, y: Integer): TModPoint;
var a: integer;
    pdim : Integer;
Begin
  result := nil;
  pdim := pointdim;
  for a := 0 to ModPoints.count-1 do
  begin
    if TModPoint(ModPoints[a]).IsPointInDetInt(x,y,pdim) then
    begin
      result := ModPoints[a];
      exit;
    end;
  end;
end;

function TPCDrawing.CheckByPointInt(LayerNbr, x, y: Integer): TFigure;
var a,i:integer;
    f: Tfigure;
    invis:boolean;
begin
  result := nil;
  for i := 0 to figures.count-1 do
  begin
    a := figures.count-1-i;
    f := TFigure(figures[a]);
    invis := false;
    if (f.LayerHandle <> 0) then
      invis :=  (TLayer(f.LayerHandle).Visible = lost);
    if (not invis) and ((LayerNbr = 0) or (f.LayerHandle = LongInt(Layers[LayerNbr]))) and
    (f.isPointInInt(x,y)) then
    begin
      Result := f;
      exit;
    end;
  end;
end;

Function TPCDrawing.SelectByFigure(LayerNbr: Integer; Fig: TFigHandle;
  shiftpressed: boolean):Boolean;
begin
  result := false;
  if TFigure(Fig).LockSelect then
    exit;
  FIsSelectingFig := true;
  if not TFigure(Fig).Selected then
  begin
    If (not shiftpressed) and (FAnySelected) then
    begin
      deselectall(LayerNbr);
    end;
  end
  else
  begin
    if shiftpressed then
    begin
      TFigure(Fig).DeSelect;
      If Selection.Count = 0 then
        FAnySelected := false;
      ReDrawSelection;
      SyncEnv;
      DoSelChange;
      Result := false;
    end
    else
    begin
      if TFigure(Fig).InsideSelection then
      begin
        TFigure(Fig).reselect;
        ReDrawSelection;
        DoSelChange;
      end;
      Result := True;
    end;
    Exit;
  end;
  TFigure(Fig).rMode := false;
  TF_Cad(Owner).GPCadPrevSelCount := 1; //Tolik 24/07/2021 --
  TFigure(Fig).Select;
  if assigned(FFigureSelect) then
    FFigureSelect(Self,TFigure(Fig));
  FAnySelected := true;
  ReDrawSelection;
  SyncEnv;
  DoSelChange;
  result := true;

  FIsSelectingFig := false;
end;

procedure TPCDrawing.GetIsometricBounds(var MinX, MinY, MaxX,
  MaxY: Double);
var i: Integer;
    figMaxX,figMaxY,figMinX,figMinY: Double;
    Figure: TFigure;
begin
  For i := 0 to Figures.count-1 do
  begin
    Figure := TFigure(Figures[i]);
    Figure.GetIsometricBounds(figMaxX,figMaxY,figMinX,figMinY);
    if i = 0 then begin
      MinX := figMinX;
      MinY := figMinY;
      MaxX := figMaxX;
      MaxY := figMaxY;
    end else begin
      if figMinX < MinX  then MinX := figMinX;
      if figMinY < MinY  then MinY := figMinY;
      if figMaxX > MaxX  then MaxX := figMaxX;
      if figMaxY > MaxY  then MaxY := figMaxY;
    end;
  end;
end;

procedure TPCDrawing.SetZoomRect(const Value: Boolean);
begin
  FZoomRect := Value;
end;

procedure TPCDrawing.ReDrawSelectionPoints;
begin
  if not (csDesigning in self.ComponentState)  then begin
    DrawGuideTrace(-25000,-25000);
    TempBitmap.Assign(BaseBitmap);
    DrawSelectionPoints;
    DrawFigureGuides;
    if assigned(self.parent) then Surface.Canvas.Draw(0,0,TempBitmap);
    if assigned(CustomSurface) then CustomSurface.Draw(0,0,TempBitmap);
    DoSelChange;
  end;

end;

procedure TPCDrawing.CenterPage;
var dRect:TDoubleRect;
    dx,dy: Double;
begin
  dRect := GetDrawingRect;
  dx := (WorkWidth/2)- ((dRect.Left+dRect.right)/2);
  dy := (WorkHeight/2)- ((dRect.Top+dRect.Bottom)/2);
  DeltaMoveX := dx;
  DeltaMoveY := dy;
  MoveAll(dx,dy);
end;

procedure TPCDrawing.SetRangeCheck(const Value: Boolean);
begin
  fRangeCheck := Value;
  Refresh;
end;

procedure TPCDrawing.RotateSelectionCenter(Angle: Double);
var xRect:TDoubleRect;
    cp: TDoublePOint;
begin
  cp := DoublePOint((xRect.Left+xrect.right)/2,(xRect.top+xrect.bottom)/2);
  xRect := GetSelectionRect;
  RotateSelection(Angle,cp);
end;

procedure TPCDrawing.SetFigureGuides(const Value: Boolean);
begin
  FFigureGuides := Value;
  Refresh;
end;

function TPCDrawing.GetRecordUndo: Boolean;
begin
  Result := FRecordUndo and (not assigned(FOnCustomUndo));
end;

procedure TPCDrawing.StartBlink;
begin
  FBlinkPaused := False;
  FBlinkTimer.Enabled := True;
end;

procedure TPCDrawing.OnBlinkTimer(Sender: TObject);
var i:Integer;
    mp:TmodPoint;
begin
  if not Self.Focused then begin
    StopBlink;
    FBlinkPaused := True;
    exit;
  end;
  FBlinkPaused := False;
  for i := 0 to ModPoints.COunt-1 do begin
    mp := TmodPoint(ModPOints[i]);
    if mp.isBlink then mp.isDraw := not mp.isDraw;
  end;
  FSelChangeLocked := True;
  RedrawSelectionPoints;
  FSelChangeLocked := False;
end;

procedure TPCDrawing.StopBlink;
var i:Integer;
    mp:TmodPoint;
begin
  FBlinkTimer.Enabled := False;
  for i := 0 to ModPoints.COunt-1 do begin
    mp := TmodPoint(ModPOints[i]);
    if mp.isBlink then mp.isDraw := True;
  end;
  RedrawSelectionPoints;
end;

function TPCDrawing.IsBlinking: Boolean;
begin
  result := FBlinkTimer.Enabled;
end;

procedure TPCDrawing.MoveAll(deltax, deltay: Double);
var a: integer;
begin
  if RecordUndo then RecordModifyUndo(nil);
  if assigned(FBeforeMoveAll) then FBeforeMoveAll(Self,deltaX,deltaY);

  if (deltaX = 0) and (deltaY = 0) then exit;
  for a := 0 to figures.count - 1 do
  begin
    TFigure(figures[a]).move(deltax,deltay);
    if assigned(FOnFigureMoved) then FOnFigureMoved(Self,TFigure(figures[a]),deltax,deltay);
  end;
  if assigned(FAfterMoveAll) then FAfterMoveAll(Self,deltaX,deltaY);
  Updated := True;
end;

function TPCDrawing.SelectionAsBitmap(dpi:Integer): TBitmap;
var r: TDoubleRect;
    w,h: Double;
    dx,dy: Double;
Begin
  dcDpm := dpi /25.4;
  r := GetSelectionRect;
  
  w := abs(r.right-r.Left);
  h := abs(r.top-r.bottom);

  result := TBitmap.Create;
  result.Width := Round(w * dcDpm)+1;
  result.Height := round(h * dcDpm)+1;

  if VerticalZero = vzBottom then
    dy := workheight-r.bottom
  else
    dy := r.top;

  if HorizontalZero = vzLeft then
    dx := r.left
  else
    dx := workwidth-r.right;

  dcConvertDim(dx);
  dcConvertDim(dy);
  dcCoordX := Round(-1*dx);
  dcCoordy := Round(-1*dy);
  SetEngine(result.Canvas,dcConvertXY,prDeConvertXY,dcConvertDim,prDeConvertDim,false,nil);
  DrawSelectedFigures;
end;

function TPCDrawing.DrawingasWmf(dpm: Double): TMetafile;
var mf : TMetafile;
    mc : TMetafileCanvas;
    r: TDoubleRect;
    w,h: Double;
    dx,dy: Double;
Begin
  mf := TMetafile.Create;
  dcDpm := dpm;
  r := GetDrawingRect;
  w := abs(r.right-r.Left);
  h := abs(r.top-r.bottom);
  mf.Width := Round(w * dcDpm)+1;
  mf.Height := round(h * dcDpm)+1;
  mc := TMetafileCanvas.Create(mf,0);

  if VerticalZero = vzBottom then
    dy := workheight-r.top
  else
    dy := r.bottom;

  if HorizontalZero = vzLeft then
    dx := r.left
  else
    dx := workwidth-r.right;

  dcConvertDim(dx);
  dcConvertDim(dy);
  dcCoordX := Round(-1*dx);
  dcCoordy := Round(-1*dy);
  SetEngine(mc,dcConvertXY,prDeConvertXY,dcConvertDim,dcDeConvertDim,false,nil);
  ResetRegions;
  DrawFigures;
  ResetRegions;
  mc.Free;
  result := mf;

end;

procedure TPCDrawing.dcDeConvertDim(var Dim: Double);
begin
 Dim := Dim / (dcDpm*ConvertRatio);

end;

procedure TPCDrawing.CreateDimLinesOfSelection;
var a: integer;
begin
  if RecordUndo then
    RecordModifyUndo(nil);
  for a := 0 to Figures.count - 1 do
  begin
    if TFigure(Figures[a]).selected then
    begin
      TFigure(Figures[a]).CreateDimLines;
    end;
  end;
  refresh;
  Updated := True;

end;

procedure TPCDrawing.ClearDimLinesOfSelection;
var a: integer;
begin
  if RecordUndo then
    RecordModifyUndo(nil);
  for a := 0 to Figures.count - 1 do
  begin
    if TFigure(Figures[a]).selected then
    begin
      TFigure(Figures[a]).ClearDimLines;
    end;
  end;
  refresh;
  Updated := True;
end;


procedure TPCDrawing.CancelActions;
begin
//**
end;


function TPCDrawing.FigureAsWmf(FigHandle: TFigHandle;isGrayed:Boolean): TMetafile;
var mf : TMetafile;
    mc : TMetafileCanvas;
    r: TDoubleRect;
    w,h: Double;
    dx,dy: Double;
    Figure: TFigure;
Begin
  Figure := Tfigure(FigHandle);
  mf := TMetafile.Create;
  dcDpm := DotsPerMilOrig;
  r := Figure.GetBoundRect;
  w := abs(r.right-r.Left);
  h := abs(r.top-r.bottom);
  mf.Width := Round(w * dcDpm)+1;
  mf.Height := round(h * dcDpm)+1;
  mc := TMetafileCanvas.Create(mf,0);

  if VerticalZero = vzBottom then
    dy := workheight-r.top
  else
    dy := r.top;

  if HorizontalZero = vzLeft then
    dx := r.left
  else
    dx := workwidth-r.left;

  dcConvertDim(dx);
  dcConvertDim(dy);
  dcCoordX := Round(-1*dx);
  dcCoordY := Round(-1*dy);
  SetEngine(mc,dcConvertXY,prDeConvertXY,dcConvertDim,prDeConvertDim,false,nil);
  Figure.ResetRegion;
  Figure.Draw(Dengine,isGrayed);
  mc.Free;
  result := mf;
  SetBufferEngine;
end;


procedure TPCDrawing.SetFieldText(FName, FValue: String);
var fig: TFigure;
    i: Integer;
begin
  for i := 0 to Figures.Count-1 do
  begin
    fig := Tfigure(Figures[i]);
    if (fig is TText) then TText(fig).SetField(Fname,Fvalue)
    else if (fig is TTextPanel) then TTextPanel(fig).SetField(Fname,Fvalue)
    else if (fig is TfigureGrp) then TFigureGrp(fig).SetFieldText(FName, FValue);
  end;
end;

procedure TPCDrawing.ExitClear;
var a,cnt,b: integer;
    f: TFigure;
begin
  // only called by destroy
  {cnt := figures.count;
  for a:= 0 to cnt-1 do
  begin
    b := cnt-1-a;
    f := TFigure(figures[b]);
    TFigure(figures[b]).deselect;
    TFigure(figures[b]).Deleted := True;
    TFigure(figures[b]).free;
    figures.Delete(b);
  end;
  }
  //Tolik
  //Tolik 08/11/2016--

 // Tolik -- 16/03/2017 -- закомментил нафиг по той причине, что если Кад закроется на простом
 // закрытии проекта -- сработает ClearFiguresOnListDelete, где корректно удалятся все  фигуры
 // если будет закрытие приложения -- вонда сама освободит занимаемые приложением ресурсы,
 // нефиг париться
 { try
    While Figures.Count > 0 do
    begin
      f := TFigure(figures[figures.Count - 1]);
      // TFigure(figures[figures.Count - 1]).deselect;
      figures.Delete(figures.Count - 1);
      //TFigure(figures[0]).Deleted := True;
      //TFigure(figures[b]).free;
      FreeAndNil(f);
    end;
  except
    on E: Exception do AddExceptionToLog('TPCDRawing.ExitClear: Figure Destroy Error!');
  end;}


 { cnt := figures.count - 1;
  for a := cnt downto 0 do
  begin
    f := TFigure(figures[a]);
    TFigure(figures[a]).deselect;
    TFigure(figures[a]).Deleted := True;
    //TFigure(figures[b]).free;
    FreeAndNil(f);
    figures.Delete(a);
  end;}
  ClearGuides;
end;

function TPCDrawing.PrepareBitmap(aPdfSave: Boolean = False): TBitmap;
var
  Form: TForm;
  res1: double;
  maxv: double;
  BadSize: boolean;
  PictW, PictH, PictureSize, PicturePixelSize: Int64;
  LoopDelta: Double;
  i: Integer;

begin
  prDpm := DotsPerMilOrig;
  Form := GetForm;
  if Form <> nil then
    prDpm := Form.PixelsPerInch / 25.4;

  if GExportUSeScale then
    prDpm := prDpm * self.ZoomScale / 100
  else
  begin
    // tolik 19/12/2020 --
    {if self.ZoomScale < 400 then
      prDpm := prDpm * 4}

   { if self.ZoomScale < 400 then
      prDpm := prDpm * 4
    else
    //
      prDpm := prDpm * self.ZoomScale / 100;}
    prDpm := prDpm * 4
  end;

  OFFMMX := 0;
  OFFMMY := 0;
  TileX := 0;
  TileY := 0;
  Result := TBitmap.Create;

  try
    maxv := 200000000;
    PictW := Round((WorkWidth) * prDpm);
    PictH := Round((WorkHeight) * prDpm);
    // Tolik 14/08/2019 -- тут выставляем формат картинки 24 бита железно, т.к., например ПДФ поддерживает ТОЛЬКО 24 бита!!!
    // чтобы не случилось бяки, будем подгонять размер изображения, если потребуется
    if aPdfSave then // если PDF
    begin
      //Result.PixelFormat := pf32bit;
      Result.PixelFormat := pf24bit;

      PictureSize := PictW * PictH;
      //PictureSize := PictureSize * 24;
      PicturePixelSize := PictureSize * 3; // 24 бит - 3 байта
      BadSize := True;

      if PicturePixelSize < maxv then
        BadSize := False;

      if BadSize then
      begin
        i := 0;
        LoopDelta := SimpleRoundTo(prDpm/10);
      end;

      while BadSize do
      begin
        inc(i);
        prDpm := prDpm - LoopDelta;

        PictW := Round((WorkWidth) * prDpm);
        PictH := Round((WorkHeight) * prDpm);

        PictureSize := PictW * PictH;
        PicturePixelSize := PictureSize * 3;
        if PicturePixelSize < maxv then
          break;

        if i = 9 then
          LoopDelta := SimpleRoundTo(LoopDelta/10);

        if i = 18 then // если не сможем получить приемлемое значение -- приведем картинку примерно к 120 МБ (на всякий, можно бы и больше, но хз...)
        begin
          PictW := Round(40000000/WorkHeight);
          PIctH := Round(40000000/PictW);
          break;
        end;
      end;
     {
      Result.PixelFormat := pf24bit;

      PictureSize := PictW * PictH;
      //PictureSize := PictureSize * 24;
      PicturePixelSize := PictureSize * 3; // 24 бит - 3 байта
      BadSize := True;

      if PicturePixelSize < maxv then
        BadSize := False;

      if BadSize then
      begin
        i := 0;
        LoopDelta := SimpleRoundTo(prDpm/10);
      end;

      while BadSize do
      begin
        inc(i);
        prDpm := prDpm - LoopDelta;

        PictW := Round((WorkWidth) * prDpm);
        PictH := Round((WorkHeight) * prDpm);

        PictureSize := PictW * PictH;
        PicturePixelSize := PictureSize * 3;
        if PicturePixelSize < maxv then
          break;

        if i = 9 then
          LoopDelta := SimpleRoundTo(LoopDelta/10);

        if i = 18 then // если не сможем получить приемлемое значение -- приведем картинку примерно к 120 МБ (на всякий, можно бы и больше, но хз...)
        begin
          PictW := Round(40000000/WorkHeight);
          PIctH := Round(40000000/PictW);
          break;
        end;
      end;
      }
    end
    else
    begin
      Result.PixelFormat := pf32bit;

      PictureSize := PictW * PictH;
      PicturePixelSize := PictureSize * 4; // 32 - bit
      if PicturePixelSize > maxv then
      begin
        PicturePixelSize := PictureSize * 3; //24 div 8;
        if PicturePixelSize > maxv then
        begin
          PicturePixelSize := PictureSize * 2; //16 div 8;
          if PicturePixelSize > maxv then
          begin
            Result.PixelFormat := pf8bit;
          end
          else
            Result.PixelFormat := pf16bit;
        end
        else
          Result.PixelFormat := pf24bit;
      end;
    end;

    Result.Width := PictW;
    Result.Height := PictH;
    //

    //maxv := 200000000;
    // Tolik 13/08/2019 --
    //Result.PixelFormat := pf32bit;
    //
    //res1 := Round((WorkWidth) * prDpm) * Round((WorkHeight) * prDpm) * 32 div 8;
   { res1 := Round((WorkWidth) * prDpm) * Round((WorkHeight) * prDpm) * 4;//2 div 8;
    if res1 > maxv then
    begin
      //res1 := Round((WorkWidth) * prDpm) * Round((WorkHeight) * prDpm) * 24 div 8;
      res1 := Round((WorkWidth) * prDpm) * Round((WorkHeight) * prDpm) * 3;// div 8;
      if res1 > maxv then
      begin
        //res1 := Round((WorkWidth) * prDpm) * Round((WorkHeight) * prDpm) * 16 div 8;
        res1 := Round((WorkWidth) * prDpm) * Round((WorkHeight) * prDpm) * 2;
        if res1 > maxv then
        begin
          Result.PixelFormat := pf8bit;
        end
        else
          Result.PixelFormat := pf16bit;
      end
      else
        Result.PixelFormat := pf24bit;
    end;}

    //Result.Width := Round((WorkWidth) * prDpm);
    //Result.Height := round((WorkHeight) * prDpm);

    SetEngine(Result.canvas,prConvertXY,prDeConvertXY,prConvertDim,prDeConvertDim,false,nil);
  except
    if (Result.Width = 0) or (Result.Height = 0) then
    begin
      try
        Result.PixelFormat := pf8bit;
        Result.Width := Round((WorkWidth) * prDpm);
        Result.Height := round((WorkHeight) * prDpm);
        SetEngine(Result.canvas,prConvertXY,prDeConvertXY,prConvertDim,prDeConvertDim,false,nil);
      except
      end;
    end;
  end;
end;

function TPCDrawing.ImportDrawing(LayerNbr: Integer; x, y: Double;
  fName: String; Selected: Boolean): TFigHandle;

var sBytes: array [1..8] of Byte;
    a,i: integer;
    Version: Word;
    SecCount: Byte;
    xSize: integer;
    SecStr: TMemoryStream;
    SecName: String;
    Stream: TfileStream;

    fCount: integer;
    Figure : TFigure;
    figStream:TMemoryStream;
    grp: TFigureGrp;
    LHandle: Integer;
begin
  result := 0;
  grp := nil;
  try
    Stream := TFileStream.Create(fName,fmOpenRead);
  except
    exit;
  end;

  for a := 1 to 8 do
    Stream.Read(sBytes[a],1);

  for a := 1 to 8 do
    if sBytes[a] <> signBytes[a] then
    begin
      AddExceptionToLog('TPCDrawing.LoadFromStream');    
//      ShowMessage(emInvalidStream);
      // ===
      Stream.Free;
      Exit;
    end;

  if (LayerNbr > -1) and (LayerNbr < Layers.Count) then
    LHandle := Integer(Layers[LayerNbr])
  else
    LHandle := Integer(Layers[0]);

  Stream.Read(Version,2);
  Stream.Read(SecCount,1);

  for a := 1 to SecCount do
  begin
    Stream.Read(xSize,4);
    SecName := ReadStringFromStream(Stream);
    SecStr:= TMemoryStream.Create;
    StreamToStream(Stream,SecStr,xSize);
    SecStr.Seek(0,soFromBeginning);
    if SecName = 'Figures' then begin
      grp := TfigureGrp.create(lHandle,Self);
      SecStr.Read(fCount,4);
      For i := 1 to fCount do
      begin
        SecStr.Read(xSize,4);
        figStream := TMemoryStream.Create;
        StreamToStream(SecStr,figStream,xSize);
        figStream.Seek(0,soFromBeginning);
        Figure :=  nil;
        Figure := TFigure.CreateFromStream(figStream,0,mydsNormal,self);

        figStream.Free;
        if Figure <> nil then begin
          grp.AddToGrp(Figure); //28.04.2011 grp.InFigures.Add(Figure);
        end;
      end;
    end;
    SecStr.Free;
  end;
  if assigned(grp) then
  begin
    Figures.Add(grp);
    result := grp.Handle;
    if assigned(FOnObjectInserted) then FOnObjectInserted(Self,irLoad);
    Updated := True;
  end;

  Stream.Free;
  Refresh;

end;

procedure TPCDrawing.GotFocus(Sender: TObject);
begin
  ResumeBlink;
  if FBlinkPaused then begin
    FBlinkPaused := False;
    StartBlink;
  end;
end;


function TPCDrawing.GetLayer(LayerNbr: integer): TLayer;
Begin
  if (LayerNbr > LayerCount - 1) then
  begin
    result := nil;
  end
  else
  begin
    Result := TLayer(Layers[LayerNbr]);
  end;
end;

procedure TPCDrawing.SetActiveLayer(value: integer);
var xLayer:TLayer;
begin
  inherited;
  xLayer := GetLayer(ActiveLayer);
  if xLayer.LayerWidth <> 0 then WorkWidth := xLayer.LayerWidth;
  if xLayer.LayerHeight <> 0 then WorkHeight := xLayer.LayerHeight;
end;

function TPCDrawing.GetLayerNbr(xLayer: TLayer): integer;
var a: integer;
Begin
  result := -1;
  result := Layers.IndexOf(xLayer);
end;

procedure TPCDrawing.SimplfySelectedPolyline;
var a: integer;
    xAction: TUndoAction;
    Found:Boolean;
begin
  Found := False;
  if RecordUndo then xAction := TUndoAction.Create(uaModify);
  for a := 0 to Selection.Count-1 do begin
   if TFigure(Selection[a]) is TpolyLine then
   begin
     if RecordUndo then AddFigureToModifyUndo(xAction,Selection[a]);
     TpolyLine(Selection[a]).SimplfyPoints;
     Updated := True;
     Found := True;
   end;
  end;
  if not found then fDefPLineClosed := True;
  if RecordUndo then
  begin
    if xAction.List.Count > 0 then
    begin
      InsertUndoAction(xAction);
    end else
    begin
      xAction.Free;
    end;
  end;
  refresh;
end;

procedure TPCDrawing.CalibrateLayerScale(p1, p2: TDoublePoint;cUnit:Byte);
var d: Double;
begin
  d := GetLineLength(p1,p2);
  //cUnit: Byte = 0; // 0=nm 1=mm 2=cm 3=dm 4=m 5=km
  if assigned(FCalibrateLayer) then FCalibrateLayer(Self,ActiveLayer,d,cUnit);
end;

function TPCDrawing.GetFigureByDataID(aDataID: Integer): TFigure;
var
  i: integer;
  Figure: TFigure;
begin
  Result := nil;
  for i := 0 to Figures.Count - 1 do
  begin
    Figure := TFigure(Figures[i]);
    if Figure.DataID = aDataID then
    begin
      Result := Figure;
      Break; //// BREAK ////
    end;
  end;
end;

function TPCDrawing.GetForm: TForm;
var
  Container: TWinControl;
begin
  Result := nil;
  Container := Self;
  while Container <> nil do
  begin
    if Container is TForm then
    begin
      Result := TForm(Container);
      Break; //// BREAK ////
    end;
    Container := Container.Parent;
  end;
end;

function TPCDrawing.GetLineLengthM(p1, p2: TDoublePoint): Double;
begin
  Result := GetLengthM(GetLineLenght(p1, p2));
end;

function TPCDrawing.GetLengthM(aPCLen: Double): Double;
begin
  Result := aPCLen / 1000 * Self.MapScale;
end;

procedure TPCDrawing.BeginMultiDeselect;
begin
  // Tolik 15/06/2021 --
  if Assigned(F_ProjMan) then
  begin
    if Assigned(F_ProjMan.Tree_Catalog) then
      //F_ProjMan.Tree_Catalog.Tag := 999;
      F_ProjMan.Timer_TreeCatalogChange.Tag := 999;
      F_ProjMan.Timer_Changing.Tag := 999;
  end;
  //
  if FMultiDeselectCount = 0 then
    FModPointsStartIdx := 0;
  Inc(FMultiDeselectCount);
end;

procedure TPCDrawing.EndMultiDeselect;
begin
  if FMultiDeselectCount > 0 then
  begin
    Dec(FMultiDeselectCount);
    if FMultiDeselectCount = 0 then
    begin
      ModPoints.Pack;
     // ClearTreeSelection; // Tolik 25/11/2021 - -
    end;
  end;
  // Tolik 15/06/2021 --
 if Assigned(F_ProjMan) then
  begin
    if Assigned(F_ProjMan.Tree_Catalog) then
      //F_ProjMan.Tree_Catalog.Tag := 0;
      F_ProjMan.Timer_TreeCatalogChange.Tag := 0;
      F_ProjMan.Timer_Changing.tag := 0;
  end;
end;

procedure TPCDrawing.SelectFigures(aFigures: TList); //11.05.2012
var
  i: integer;
begin
  for i := 0 to aFigures.Count - 1 do
    TFigure(aFigures[i]).Select;
end;

procedure TPCDrawing.BeginUpdate;
begin
  if FUpdateCountAdd >= 0 then
  begin
    Inc(FUpdateCount);
  end;
  Inc(FUpdateCountAdd);
end;

procedure TPCDrawing.EndUpdate(aReFresh: Boolean);
begin
  if FUpdateCount > 0 then
  begin
    Dec(FUpdateCount);
    if FUpdateCount = 0 then
      if aReFresh then
        Self.Refresh;
  end;
  Dec(FUpdateCountAdd);
end;

function TPCDrawing.PointToScreen(aPt: TDoublePoint): TPoint;
begin
  Self.ConvertXY(aPt.X, aPt.Y, aPt.Z);
  Result.x := Trunc(aPt.X);
  Result.Y := Trunc(aPt.Y);
  Result := Self.ClientToScreen(Result);
end;

function TPCDrawing.DoMagicWand(LayerNbr:Integer;x, y: Double): TFigHandle;
var i: integer;
    rFigure,Figure : TFigure;

begin
  result := 0;
  If (LayerNbr < 0) or (LayerNbr > Layers.Count - 1) then exit;
  for i:= 0 to Figures.Count-1 do
  begin
    figure := TFigure(figures[i]);
    if (figure.LayerHandle = Integer(Layers[LayerNbr])) and (figure is TBmpObject) then
    begin
      rFigure := TBmpObject(Figure).DoMagicWand(x,y);
      if assigned(rFigure) then begin
        result := rFigure.Handle;
        AddCustomFigure(LayerNbr,rFigure,True);
        Refresh;
      end;
    end;
  end;


end;

procedure TPCDrawing.PrintPageAsWmf;
var
  mf, mfx: TMetafile;
  mc, mcx: TMetafileCanvas;
  a: integer;
  Layer: TLayer;
  p1, p2, p3, p4, xp1, xp2: TDoublePOint;
  wp1, wp2, wp3, wp4: TPoint;
  reg: HRGN;
  pw, ph, xw, xh, dx, dy: Double;
  i: Integer;
  xRect: Trect;
  ww,wh: Double;
  xCopy: Integer;
  prDpmx, prDpmY: Double;
  PlotRotate: Boolean;
  pCnt: Integer;
  dCnt: Double;

Begin
  ResetRegions;
  mf := TMetafile.Create;
  prDpmx := (GetDeviceCaps(Printer.Handle, LOGPIXELSX) / 25.4);
  prDpmy := (GetDeviceCaps(Printer.Handle, LOGPIXELSY) / 25.4);

  if prDpmX > prDpmY then
    prDpm := prDpmX
  else
    prDpm := prDpmY;
  pw := (printer.PageWidth / prDpm);
  ph := (printer.PageHeight / prDpm);
  xCopy := PlotCopy;
  xw := (WorkHeight * PlotCopy);
  if (xw > pw) and (xCopy > 1) then
  begin
    xCopy := 1;
//    ShowMessage('Зoklu basэm iзin kaрэt geniюliрi uygun deрil.Gerekli Geniюlik:'+
//                inttostr(round(xw)) + ' Mevcut Geniюlik:' + inttostr(round(pw)));
  end;

  mf.Width := Round(WorkWidth * prDpm);
  if xCopy = 1 then
    mf.Height := round(WorkHeight * prDpm)
  else
    mf.Height := round(pw * prDpm);

  mc := TMetafileCanvas.Create(mf, 0);
  SetEngine(mc, prConvertXY, prDeConvertXY, prConvertDim, prDeConvertDim, false, nil);

  {$ifndef designtime}
  PenRatio := prDpm * ThickUnit;
  {$endif designtime}

  dx := printer.PageWidth / xCopy;
  for i := 1 to xcopy do
  begin
    MCopyDelta := (i - 1) * (-dx);
    DrawFigures;
  end;

  TileY := 0;
  MCopyDelta := 0;

  ww := workwidth;
  wh := workheight;
  if xCopy > 1 then
    wh := pw;
  {$ifndef designtime}
  PenRatio := 1;
  {$endif designtime}
  mc.Free;

  p1 := DoublePOint(0, 0);
  p2 := DoublePOint(ww, 0);
  p3 := DoublePOint(ww, wh);
  p4 := DoublePoint(0, wh);

  plotRotate := False;
  if (pw < ww) and (ph > wh) then
  begin
    p4 := DoublePOint(0, 0);
    p1 := DoublePOint(wh, 0);
    p2 := DoublePOint(wh, ww);
    p3 := DoublePoint(0, ww);
    plotRotate := True;
  end
  else
  if (pw > WorkWidth) and (ph < WorkHeight) then
  begin
    p4 := DoublePOint(0, 0);
    p1 := DoublePOint(wh, 0);
    p2 := DoublePOint(wh, ww);
    p3 := DoublePoint(0, ww);
  end
  else
  if (pw < ww - 10) and (ph < wh - 10) then
  begin
    p1 := DoublePOint(0, 0);
    p2 := DoublePOint(pw, 0);
    p3 := DoublePOint(pw, ph);
    p4 := DoublePoint(0, ph);
  end
  else
  if (pw > ph) and (WorkWidth > WorkHeight) then
  begin
    dy := ph - WorkHeight - 10;
    p1 := MovePoint(p1, 0, dy);
    p2 := MovePoint(p2, 0, dy);
    p3 := MovePoint(p3, 0, dy);
    p4 := MovePoint(p4, 0, dy);
  end;
  //mf.SaveToFile('c:\deneme.wmf');

  SetEngine(Printer.Canvas, prConvertXY, prDeConvertXY, prConvertDim, prDeConvertDim, true, nil);
  reg := 1;
  DEngine.DrawMetafile(p1, p2, p3, p4, clWhite, 1, ord(psClear), mf, true, reg);

  if plotRotate and (ph < WorkWidth - 50) then
  begin
    dCnt := (WorkWidth / ph);
    if Trunc(dCnt) <> dCnt then
      pCnt := Trunc(Dcnt) + 1
    else
      pCnt := Trunc(dCnt);
    for i := 1 to pCnt - 1 do
    begin
      printer.EndDoc;
      printer.BeginDoc;
      p1 := MovePoint(p1, 0, -ph);
      p2 := MovePoint(p2, 0, -ph);
      p3 := MovePoint(p3, 0, -ph);
      p4 := MovePoint(p4, 0, -ph);
      SetEngine(Printer.Canvas, prConvertXY, prDeConvertXY, prConvertDim, prDeConvertDim, true, nil);
      DEngine.DrawMetafile(p1, p2, p3, p4, clWhite, 1, ord(psClear), mf, true, reg);
    end;
  end;
  mf.Free;
  ResetRegions;
  refresh;
end;

procedure TPCDrawing.NameSelection;
var fig: TFigure;
    xName:String;
begin
  if Selection.Count = 0 then exit;
  fig := Tfigure(Selection[0]);
  xName := fig.Name;
  xName := InputBox('Edit Name','Enter the new name for the selected figure',xName);
  fig.Name := xName;
end;

function TPCDrawing.GetBrushPatCount: Integer;
begin
  result := BrushList.Count;
end;

procedure TPCDrawing.ResumeBlink;
begin
  if FBlinkPaused then begin
    FBlinkPaused := False;
    StartBlink;
  end;
end;

procedure TPCDrawing.TestPrinter;
var prW,prH: Double;
    resW,resH,mW,mH: Integer;

Begin
  tileY := 0;
  tileX := 0;
  MCopyDelta := 0;

  Printer.BeginDoc;

  Printer.Canvas.Ellipse(50-2,100-2,50+2,100+2);
  Printer.Canvas.TextOut(50,100,'C(50,100)');
  Printer.Canvas.Ellipse(50-2,Printer.PageHeight - 600-2,50+2,Printer.PageHeight - 600+2);
  Printer.Canvas.TextOut(50 ,Printer.PageHeight - 600,'C(50,'+inttostr(Printer.PageHeight-600)+')');
  Printer.Canvas.Ellipse(Printer.PageWidth-650-2,Printer.PageHeight - 600-2,Printer.PageWidth-650+2,Printer.PageHeight - 600+2);
  Printer.Canvas.TextOut(Printer.PageWidth-650 ,Printer.PageHeight - 600,'C('+inttostr(Printer.PageWidth-650)+','+inttostr(Printer.PageHeight-600)+')');
  Printer.Canvas.Ellipse(Printer.PageWidth-650-2,100-2,Printer.PageWidth-650+2,100+2);
  Printer.Canvas.TextOut(Printer.PageWidth-650 ,100,
                         'C('+inttostr(Printer.PageWidth-650)+',100)');
  Printer.Canvas.Ellipse(Printer.PageWidth div 2-2 ,Printer.PageHeight div 2-2,Printer.PageWidth div 2+2 ,Printer.PageHeight div 2+2);
  Printer.Canvas.TextOut(Printer.PageWidth div 2 ,Printer.PageHeight div 2,'C('+inttostr(Printer.PageWidth div 2)+','+inttostr(Printer.PageHeight div 2)+')');

  Printer.EndDoc;

end;

procedure TPCDrawing.AlignPageDown;
var dRect:TDoubleRect;
    dx,dy: Double;
begin
  dRect := GetDrawingRect;
  dy := WorkHeight -10 - dRect.Bottom;
  dx := 0;
  DeltaMoveX := dx;
  DeltaMoveY := dy;
  MoveAllSilent(dx,dy);
end;

procedure TPCDrawing.AlignPageUp;
var dRect:TDoubleRect;
    dx,dy: Double;
begin
  dRect := GetDrawingRect;
  dy := - dRect.Top+5;
  dx := 0;
  DeltaMoveX := dx;
  DeltaMoveY := dy;
  MoveAllSilent(dx,dy);
end;

procedure TPCDrawing.MoveAllSilent(deltax, deltay: Double);
var a: integer;
begin
  if (deltaX = 0) and (deltaY = 0) then exit;
  for a := 0 to figures.count - 1 do
  begin
    TFigure(figures[a]).move(deltax,deltay);
  end;
  Updated := True;
end;

procedure TPCDrawing.PrintDrawingAsWmf(TitleinStatusBox: String);
var prW,prH: Double;
    resW,resH,mW,mH: Integer;
    //Log: TStringList;
Begin
  tileY := 0;
  tileX := 0;
  MCopyDelta := 0;
  //Log := TStringList.Create;
  Printer.BeginDoc;
  Printer.Title := TitleinStatusBox;
  //Log.Add('Calling PrintPageAsWmf');
  PrintPageAsWmf;
  Printer.EndDoc;
  //Log.SaveToFile('c:\plotWmf.txt');
  //Log.Free;
end;

function TPCDrawing.DrawingasWmf: TMetafile;
var mf : TMetafile;
    mc : TMetafileCanvas;
    r: TDoubleRect;
    w,h: Double;
    dx,dy: Double;
Begin
  mf := TMetafile.Create;
  dcDpm := DotsPerMilOrig;
  r := GetDrawingRect;
  w := abs(r.right-r.Left);
  h := abs(r.top-r.bottom);
  mf.Width := Round(w * dcDpm)+1;
  mf.Height := round(h * dcDpm)+1;
  mc := TMetafileCanvas.Create(mf,0);

  mc.Brush.Color := PageColor;
  mc.Brush.Style := bsSolid;
  mc.FillRect(Rect(1, 1, Round(w * dcDpm) + 1, round(h * dcDpm) + 1));

  if VerticalZero = vzBottom then
    dy := workheight-r.bottom
  else
    dy := r.top;

  if HorizontalZero = vzLeft then
    dx := r.left
  else
    dx := workwidth-r.right;

  dcConvertDim(dx);
  dcConvertDim(dy);
  dcCoordX := Round(-1*dx);
  dcCoordy := Round(-1*dy);
  SetEngine(mc,dcConvertXY,prDeConvertXY,dcConvertDim,prDeConvertDim,false,nil);
  ResetRegions;
  DrawFigures;
  ResetRegions;
  mc.Free;
  result := mf;
  refresh;
end;

procedure TPCDrawing.SetSelectionGradient(GStyle: TGradStyle; ForeColor,
  BackColor: TColor);
var i: Integer;
begin
  for i := 0 to Selection.Count-1 do begin
    TFigure(Selection[i]).SetGradient(GStyle,ForeColor,BackColor);
  end;
  Refresh;
end;

procedure TPCDrawing.SetSelectionHatch(HStyle: THatchStyle; ForeColor,
  BackColor: TColor; StepSize: Double);
var i: Integer;
begin
  for i := 0 to Selection.Count-1 do begin
    TFigure(Selection[i]).SetHatch(HStyle,ForeColor,BackColor,StepSize);
  end;
  Refresh;
end;

procedure TPCDrawing.SetSelectionTexture(TStyle: TTextureStyle;
  TexSize: Integer);
var i: Integer;
begin
  for i := 0 to Selection.Count-1 do begin
    TFigure(Selection[i]).SetTexture(TStyle,TexSize);
  end;
  Refresh;
end;

function TPCDrawing.SelectionAsBmpHandle(dpi: Integer): Integer;
var xbmp:TBitmap;
begin
  xBmp := nil;
  xBmp := SelectionAsBitmap(Dpi);
  if assigned(xBmp) then result := xBmp.Handle else result := 0;
end;

function TPCDrawing.DrawingAsMetaFile: Integer;
var xwmf:TMetafile;
begin
  xWmf := nil;
  xWmf := DrawingAsWmf;
  if assigned(xWmf) then result := xWmf.Handle else result := 0;
end;

function TPCDrawing.FigureAsMetaFile(FigHandle:TFigHandle): Integer;
var xwmf:TMetafile;
begin
  xWmf := nil;
  xWmf := FigureAsWmf(FigHandle,False);
  if assigned(xWmf) then result := xWmf.Handle else result := 0;
end;

function TPCDrawing.CreatePreviewBitmapHandle: Integer;
begin
  result := CreatePreviewBitmap.Handle;
end;

function TPCDrawing.InsertBitmapHandle(LayerNbr: Integer; x, y: Double;
  xBitmap: HBitmap; transparent, selected: boolean): TFigHandle;
var bmp:TBitmap;
begin
  bmp := TBitmap.Create;
  bmp.Handle := xBitmap;
  result := InsertBitmapHandle(LayerNbr,x,y,bmp,transparent,selected);
end;

procedure TPCDrawing.Clear(LayerNbr: integer);
begin
  Clear(LayerNbr,False);
end;
// Tolik ??? что-то здесь как-то странно реализовано.....
// имхо фигуры никуда не делись, список как создался, так и очистился, а нах?
procedure TPCDrawing.ClearFigures;
var
  i: integer;
  FFigure: TFigure;
  FigList: TList;
begin
  FigList := TList.Create;
  for i := 0 to Self.FigureCount - 1 do
  begin
    FFigure := TFigure(Self.Figures[i]);
    FigList.Add(FFigure);
  end;

  for i := 0 to FigList.Count - 1 do
  begin
    FFigure := TFigure(FigList[i]);
    Figures.Remove(FFigure);
  end;
  FigList.Free;
  Self.Refresh;
end;

procedure TPCDrawing.ClearNoRect(ARect: TDoubleRect);
begin
  Dengine.drawrect(ARect.Right, ARect.Top, WorkWidth, WorkHeight, clWhite, 1, Ord(psSolid), clWhite, Ord(psSolid));
  Dengine.drawrect(ARect.Left, ARect.Bottom, WorkWidth, WorkHeight, clWhite, 1, Ord(psSolid), clWhite, Ord(psSolid));
  //ClearReg(x2, y1, WorkWidth, WorkHeight);
  //ClearReg(x1, y2, WorkWidth, WorkHeight);
end;


procedure TPCDrawing.DrawFigures;
begin
  // IGOR - для нормального экспорта цветных УГОшек
  //Важно - нужно сбросить регионы до и после экспорта на канвас с другими размерами и конвертациями
  ResetRegions;
  DrawFigures(False);
  ResetRegions;
end;

{ TlistMod }

destructor TlistMod.Destroy;
begin
  inherited;
end;

function TlistMod.RemoveItem(Item: Pointer): Integer;
begin
  Result := IndexOf(Item);
  if Result >= 0 then
  begin
    Delete(Result);
//    TFigure(Item).Destroy;
  end;
end;

function TPCDrawing.SaveSCSFiguresToFile(FileName: string): Boolean;
var
  a, fCount: integer;
  Figure: TFigure;
  xSize: Integer;
  FileStream: TStream;
  Stream: TMemoryStream;
  figStream: TMemoryStream;
  LHandle2: Integer;
  LHandle3: Integer;
  LHandle4: Integer;
  LHandle5: Integer;
  LHandle6: Integer;
  LHandle8: Integer;
  LHandle9: Integer;
  isFigureShadowObj: boolean;
begin
  Result := false;
  try
    // получить Handles для каждого сохраняемого нами слоя
    LHandle2 := GetLayerHandle(2);
    LHandle3 := GetLayerHandle(3);
    LHandle4 := GetLayerHandle(4);
    LHandle5 := GetLayerHandle(5);
    LHandle6 := GetLayerHandle(6);
    LHandle8 := GetLayerHandle(8);
    LHandle9 := GetLayerHandle(9);

    fCount := Figures.Count;
    // отобрать лист с сохраняемыми объектами
    For a := 0 to fCount - 1 do
    begin
      Figure := TFigure(Figures[a]);
      // проверить относиться ли объект к сохраняемому слою
      if (Figure.LayerHandle = LHandle2) or (Figure.LayerHandle = LHandle3) or
         (Figure.LayerHandle = LHandle4) or (Figure.LayerHandle = LHandle5) or
         (Figure.LayerHandle = LHandle6) or (Figure.LayerHandle = LHandle8) or (Figure.LayerHandle = LHandle9) then
      begin
        isFigureShadowObj := False;
        if TFigure(Figures[a]) is TFigureGrpNotMod then
          if TFigureGrpNotMod(Figures[a]).InFigures.Count = 1 then
            begin
              if TFigure(TFigureGrpNotMod(Figures[a]).InFigures[0]).ClassName = 'TLine' then
              begin
                isFigureShadowObj := True;
              end;
            end;
        if not isFigureShadowObj then
          GCadForm.FUndoFiguresList.Add(Figure);
        {
        begin
          //if (Figure.Classname = 'TConnectorObject') or (Figure.Classname = 'TOrthoLine') then
         // if ((Figure.Classname = 'TNet') or (Figure.Classname = 'TCabinet')) then
         // if Figure.Classname = 'TFigureGrpMod'  then
          if Figure.Classname = 'TFigureGrpNotMod'  then
          begin
            if TFigureGrpNotMod(Figure).InFigures.Count > 0 then
              if TFigure(TFigureGrpNotMod(Figure).InFigures[0]).ClassNAme <> 'TRectangle' then
                GCadForm.FUndoFiguresList.Add(Figure);
          end;
        end;
        }
      end;
    end;
    // из этого листа сделать сохранение
    GCadForm.FUndoStatus := True;
//    FileStream := TFileStream.Create(FileName, fmCreate);
    FileStream := SafeOpenFileStream(FileName, fmCreate, 'TPCDrawing.SaveSCSFiguresToFile', cSCSComponent_Msg22_7);
    if FileStream <> nil then
    begin
      //FileStream.Write(fCount, 4);
      // Tolik 03/02/2017 --
      FileStream.Write(Self.FMapscale, 8);
      //
      FileStream.Write(GCadForm.FUndoFiguresList.Count, 4);
      For a := 0 to GCadForm.FUndoFiguresList.Count - 1 do
      begin
        Figure := TFigure(GCadForm.FUndoFiguresList[a]);
        if Figure <> nil  then
          if not Figure.Deleted then
          begin
            figStream := TMemoryStream.Create;
            Figure.WriteToStream(figStream);
            xSize := figStream.Size;
            figStream.Seek(0, soFromBeginning);
            FileStream.Write(xSize, 4);
            StreamToStream(figStream, FileStream, xSize);
            if assigned(FOnObjectSaved) then
              FOnObjectSaved(self, Figure);
            FreeAndNil(figStream);
          end;
      end;
      FreeAndNil(FileStream);
      Result := true;
    end;
  except
    on E: Exception do AddExceptionToLog('TPCDrawing.SaveSCSFiguresToFile' + E.Message);
  end;
  GCadForm.FUndoStatus := False;  
end;

function TPCDrawing.SavePlanFiguresToFile(FileName: string): Boolean;
var
  a, fCount: integer;
  Figure: TFigure;
  xSize: Integer;
  FileStream: TStream;
  Stream: TMemoryStream;
  figStream: TMemoryStream;
  LHandle1: Integer;
begin
  Result := false;
  try
    // получить Handles для каждого сохраняемого нами слоя
    LHandle1 := GetLayerHandle(1);

    fCount := Figures.Count;
    // отобрать лист с сохраняемыми объектами
    For a := 0 to fCount - 1 do
    begin
      Figure := TFigure(Figures[a]);
      // проверить относиться ли объект к сохраняемому слою
      if (Figure.LayerHandle = LHandle1) then
      begin
        GCadForm.FUndoFiguresList.Add(Figure);
      end;
    end;
    // из этого листа сделать сохранение
    GCadForm.FUndoStatus := True;
//    FileStream := TFileStream.Create(FileName, fmCreate);
    FileStream := SafeOpenFileStream(FileName, fmCreate, 'TPCDrawing.SavePlanFiguresToFile', cSCSComponent_Msg22_7);
    if FileStream <> nil then
    begin
      //FileStream.Write(fCount, 4);
      // Tolik -- 03/02/2017 --
      FileStream.Write(Self.FMapscale, 8);
      //
      FileStream.Write(GCadForm.FUndoFiguresList.Count, 4);
      For a := 0 to GCadForm.FUndoFiguresList.Count - 1 do
      begin
        Figure := TFigure(GCadForm.FUndoFiguresList[a]);
        begin
          figStream := TMemoryStream.Create;
          Figure.WriteToStream(figStream);
          xSize := figStream.Size;
          figStream.Seek(0, soFromBeginning);
          FileStream.Write(xSize, 4);
          StreamToStream(figStream, FileStream, xSize);
          if assigned(FOnObjectSaved) then
            FOnObjectSaved(self, Figure);
          FreeAndNil(figStream);
        end;
      end;
      FreeAndNil(FileStream);
      Result := true;
    end;
  except
    on E: Exception do AddExceptionToLog('TPCDrawing.SavePlanFiguresToFile' + E.Message);
  end;
  GCadForm.FUndoStatus := False;
end;

// Tolik 12/02/2021 --
function TPCDrawing.SaveElSchemeFiguresToFile(FileName: string): Boolean; // Tolik -- 12/02/2021
var
  a, fCount: integer;
  Figure: TFigure;
  xSize: Integer;
  FileStream: TStream;
  Stream: TMemoryStream;
  figStream: TMemoryStream;
  LHandle1: Integer;
begin
  Result := false;
  try
    // получить Handles для каждого сохраняемого нами слоя

    LHandle1 := GetLayerHandle(1);
    //LHandle1 := GetLayerHandle(0); // Tolik 01/06/2021 -- тут список слоев идет с нуля (0 - подложка)

    fCount := Figures.Count;
    // отобрать лист с сохраняемыми объектами
    For a := 0 to fCount - 1 do
    begin
      Figure := TFigure(Figures[a]);
      // проверить относиться ли объект к сохраняемому слою
      if (Figure.LayerHandle = LHandle1) then
      begin
        GCadForm.FUndoFiguresList.Add(Figure);
      end;
    end;
    // из этого листа сделать сохранение
    GCadForm.FUndoStatus := True;
//    FileStream := TFileStream.Create(FileName, fmCreate);
    FileStream := SafeOpenFileStream(FileName, fmCreate, 'TPCDrawing.SaveElSchemeFiguresToFile', cSCSComponent_Msg22_7);
    if FileStream <> nil then
    begin
      //FileStream.Write(fCount, 4);
      // Tolik -- 03/02/2017 --
      FileStream.Write(Self.FMapscale, 8);
      //
      FileStream.Write(GCadForm.FUndoFiguresList.Count, 4);
      For a := 0 to GCadForm.FUndoFiguresList.Count - 1 do
      begin
        Figure := TFigure(GCadForm.FUndoFiguresList[a]);
        begin
          figStream := TMemoryStream.Create;
          Figure.WriteToStream(figStream);
          xSize := figStream.Size;
          figStream.Seek(0, soFromBeginning);
          FileStream.Write(xSize, 4);
          StreamToStream(figStream, FileStream, xSize);
          if assigned(FOnObjectSaved) then
            FOnObjectSaved(self, Figure);
          FreeAndNil(figStream);
        end;
      end;
      FreeAndNil(FileStream);
      Result := true;
    end;
  except
    on E: Exception do AddExceptionToLog('TPCDrawing.SaveElSchemeFiguresToFile' + E.Message);
  end;
  GCadForm.FUndoStatus := False;
end;

procedure TPCDrawing.LoadSCSFiguresFromFile(FileName: string);
var
  a, fCount: integer;
  Figure: TFigure;
  xSize: Integer;
  Stream: TMemoryStream;
  FileStream: TStream;
  figStream: TMemoryStream;
  // Tolik 28/08/2019 --
  //OldTick, CurTick: cardinal;
  OldTick, CurrTick: DWord;
begin
  try
//    FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
    FileStream := SafeOpenFileStream(FileName, fmOpenRead or fmShareDenyWrite, 'TPCDrawing.LoadSCSFiguresFromFile', cSCSComponent_Msg22_13);
    if FileStream <> nil then
    begin
      // Tolik -- 03/02/2017 --
      FileStream.Read(Self.FMapscale, 8);
      //
      FileStream.Read(fCount, 4);
      For a := 1 to fCount do
      begin
        FileStream.Read(xSize,4);
        figStream := TMemoryStream.Create;
        StreamToStream(FileStream, figStream, xSize);
        figStream.Seek(0, soFromBeginning);
        Figure :=  nil;
        Figure := TFigure.CreateFromStream(figStream, 0, mydsNormal, self);
        FreeAndNil(figStream);
        if Figure <> nil then
        begin
          Figures.Add(Figure);
          GCadForm.FUndoFiguresList.Add(Figure);
          if assigned(FOnObjectInserted) then
            FOnObjectInserted(self, irLoad);
        end;
      end;
      FreeAndNil(FileStream);
    end;
  except
    on E: Exception do AddExceptionToLog('TPCDrawing.LoadSCSFiguresFromFile' + E.Message);
  end;
end;

initialization
  {$ifdef demo}
    if not delphiloaded then application.terminate;
  {$endif demo}
  {$ifdef 3D}
    // !!!! НЕЛЬЗЯ ЗДЕСЬ ЭТО ДЕЛАТЬ - падает ДЛЛ на вин7 64-ке !
    //frm3D := Tfrm3d.Create(application);
  {$endif 3D}
finalization

end.

