{************************************************************}
{                   Delphi VCL Extensions                    }
{                                                            }
{                      Auxiliary tools                       }
{                                                            }
{      Copyright (c) 2002-2013 SoftGold software company     }
{                                                            }
{************************************************************}
unit sgTools;
{$INCLUDE SGDXF.INC}

interface

uses
  Windows, Messages, Classes, CADImage, DXFConv, sgConsts
  {$IFNDEF sgDXFONLY}
  , HPGL2
  {$ENDIF}
  , Graphics, ExtCtrls, Controls, SysUtils, sgSelection, sgFunction, sgLists
  {$IFDEF SGDEL_XE3}
  , System.Types, System.UITypes
  {$ENDIF}
  ;

const
  sUnits: string = 'Units';
  sInch: string = 'Inches';
  sMM: string = 'MM';
  cnstSnapDistance = 10;
  cnstSearchSnapPrecision = cnstSnapDistance * 2;


type
  TSnapPointData = record
    Point: TPoint;
    FPoint: TFPoint;
    Entity: TsgDXFEntity;
    SnapState: TObjectSnapState;
  end;

  TSnapControl = class;

  TsgObjectSnap = class(TObject)
  private
    FSnapDistance: Integer;
    FCADImage: TsgDXFImage;
    function FindSnap(APoint: TPoint): PSnapData;
    procedure SetSnapDistance(const AVal: Integer);
  public
    constructor Create;
    function GetSnapPoint(AVisiblePoint: TPoint; var AObjectSnapState: TObjectSnapState;
             var AEntity: TsgDXFEntity): TSnapData;
    function GetSnapPointUCS(AVisiblePoint: TPoint; var AObjectSnapState: TObjectSnapState;
             var AEntity: TsgDXFEntity; var CoordsInUCS: TFPoint): TSnapData; overload;
    procedure SetsgDXFImage(ACADImage: TsgDXFImage);
    property SnapDistance: Integer read FSnapDistance write SetSnapDistance;
  end;

  TSnapMarker = class(TObject)
  private
    FDrawAreaSize: Integer;
    FPoint: TPoint;
    FRealPoint: TFPoint;
    FDestinationSnap: TObjectSnapMode;
    FVisible: Boolean;
    FSnapControl: TSnapControl;
    FPen: TPen;
    FPenStore: TPen;
    FIsTraced: Boolean;
    FBaseMatrixSnapType: TObjectSnapMode;
    procedure Draw;
    procedure Repaint;
    procedure SetIsTraced(const Value: Boolean);
    procedure SetBaseMatrixSnapType(const Value: TObjectSnapMode);
  public
    constructor Create(ASnapControl: TSnapControl);
    procedure ClearPoint;
    destructor Destroy; override;
    procedure Snap(APoint: TFPoint; ASnap: TObjectSnapMode);
    property BaseMatrixSnapType: TObjectSnapMode read FBaseMatrixSnapType write SetBaseMatrixSnapType;
    property IsTraced: Boolean read FIsTraced write SetIsTraced;
  end;

  TSnapMarkerTrace = class(TSnapMarker)
  private
    FLineByShowPolar: PsgLineState;
    FLines: TList;
    FSnappedEntity: TsgDXFEntity;
    FSnappedEntityTwo: TsgDXFEntity;
    function GetRealPoint: TFPoint;
    procedure SetSnappedEntity(const Value: TsgDXFEntity);
  public
    constructor Create(ASnapControl: TSnapControl);
    destructor Destroy; override;
    property LineByShowPolar: PsgLineState read FLineByShowPolar;
    property RealPoint: TFPoint read GetRealPoint;
    property SnappedEntity: TsgDXFEntity read FSnappedEntity write SetSnappedEntity;
  end;

  TsgDXFLineTrace = class(TsgDXFLine)
  private
    FSnapType: TObjectSnapMode;
    procedure SetSnapType(const Value: TObjectSnapMode);
  public
    constructor Create; override;
    property SnapType: TObjectSnapMode read FSnapType write SetSnapType;
  end;

  TsgTracers = class
  private
    FCADImage: TsgCADImage;
    FSnapControl: TSnapControl;
    FTracers: TList;
    FTracersMatrix: TsgSelectionMatrix;
    FTracerPointsInt: array of Integer;
    FViewRect: TFRect;
    FBasePoint: TFPoint;
    FIsShiftPressed: Boolean;
    FIsShiftClicked: Boolean;
    function GetTrace(Index: Integer): TSnapMarkerTrace;
    procedure SetTracersMatrix(const Value: TsgSelectionMatrix);
    procedure SetViewRect(const Value: TFRect);
    procedure SetCADImage(const Value: TsgCADImage);
    procedure SetBasePoint(const Value: TFPoint);
    procedure SetIsShiftPressed(const Value: Boolean);
    procedure SetIsShiftClicked(const Value: Boolean);
  protected
  public
    constructor Create(AsnapControl: TSnapControl);
    destructor Destroy; override;
    function Active: Boolean;
    procedure Add(Apoint: TFPoint; ASnapControl: TSnapControl; ASnappedEntity, ASnappedEntityTwo: TsgDXFEntity);
    function AddLine(ATrace: TSnapMarkerTrace; Apoint: TFPoint; ALine: TsgDXFLine): TsgDXFLine;
    procedure AddPointsToTracerMatrix(ATrace: TSnapMarkerTrace; ALine: TsgDXFLineTrace);
    {$IFDEF SG_BTI}
    procedure AddPolyPolyline2D(ATrace: TSnapMarkerTrace; Apoint: TFPoint; APoly: TsgCADPolyPolyline2D );
    {$ENDIF}
    procedure Clear;
    procedure ClearHidden;
    function Count: Integer;
    function IndexOfEntity(AEntity: TObject): Integer;
    procedure Regen;
    function Remove(Apoint: TFPoint): Integer;
    procedure SetDisable;
    function IndexOf(Apoint: TFPoint): Integer;
    function Last: TSnapMarkerTrace;
    property BasePoint: TFPoint read FBasePoint write SetBasePoint;
    property CADImage: TsgCADImage read FCADImage write SetCADImage;
    property IsShiftPressed: Boolean read FIsShiftPressed write SetIsShiftPressed;
    property IsShiftClicked: Boolean read FIsShiftClicked write SetIsShiftClicked;
    property Tracers[Index: Integer]: TSnapMarkerTrace read GetTrace; default;
    property TracersMatrix: TsgSelectionMatrix read FTracersMatrix write SetTracersMatrix;
    property ViewRect: TFRect read FViewRect write SetViewRect;
  end;

  TSnapControl = class
  private
    FBasePoint: PFPoint;
    FImg: TsgDXFImage;
    FInsert: TObject;
    FIsTimeForTrace: Boolean;
    FObjectSnap: TsgObjectSnap;
    FControl: TControl;
    FSelectionMatrix: TsgSelectionMatrix;
    FSnapMarker: TSnapMarker;
    FSnappedEntity: TsgDXFEntity;
    FSnappedEntityForTrace: TsgDXFEntity;
    FSnappedEntityForTraceTwo: TsgDXFEntity;
    FSnapMask: TObjectSnapState;
    FTime: Cardinal;
    FUpdating: Boolean;
    FIsNewPointAdded: Boolean;
    FTracers: TsgTracers;
    FForBiddenSnapPoint: TFPoint;
    FSnapData: TSnapData;
{$IFDEF SGVER_5_2_5}
    FImageOnPaint: TNotifyEvent;
{$ENDIF}
    function GetControl: TControl;
    procedure ResetEvents;
    procedure SetControl(AValue: TControl);
    procedure SetEvents;
    procedure SetSnapMask(Value: TObjectSnapState);
    function GetCanvas: TCanvas;
    procedure SetIsNewPointAdded(const Value: Boolean);
    procedure SetSnapMarker(const Value: TSnapMarker);
    procedure SetForBiddenSnapPoint(const Value: TFPoint);
    procedure SetSnapData(const Value: TSnapData);
    procedure SetTracers(const Value: TsgTracers);
  protected
    procedure Repaint;
    function GetSelectionMatrix: TsgSelectionMatrix; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Dispatch(var Message); override;
    function GetMouseCoord(X, Y: Integer): TFPoint;
    function GetMouseCoordUCS(X, Y: Integer; var PointInUCS: TFPoint): TSnapData;
    function GetMouseCoordUCSInternal(X, Y: Integer; var PointInUCS: TFPoint): TSnapData;
    function GetMouseCoordUCSTracers(AMatrix: TsgSelectionMatrix; X, Y: Integer; var PointInUCS: TFPoint): TSnapData;
    property IsNewPointAdded: Boolean read FIsNewPointAdded write SetIsNewPointAdded;
    procedure Update;
    property BasePoint: PFPoint read FBasePoint write FBasePoint;
    property Control: TControl read GetControl write SetControl;
    property ForBiddenSnapPoint: TFPoint read FForBiddenSnapPoint write SetForBiddenSnapPoint;
    property SnapData: TSnapData read FSnapData write SetSnapData;
    property SnapMarker: TSnapMarker read FSnapMarker write SetSnapMarker;
    property SnappedEntity: TsgDXFEntity read FSnappedEntity;
    property SnapMask: TObjectSnapState read FSnapMask write SetSnapMask;
    property Tracers: TsgTracers read FTracers write SetTracers;
    property Canvas: TCanvas read GetCanvas;
  end;

  TSnapControlTracers = class(TSnapControl)
  private
    procedure SetSelectionMatrix(const Value: TsgSelectionMatrix);
  protected
    function GetSelectionMatrix: TsgSelectionMatrix; override;
  public
    property SelectionMatrix: TsgSelectionMatrix read GetSelectionMatrix write SetSelectionMatrix;
  end;

  TsgControlTool = class
  private
    FPictureRect: TFRect;
    FInvertDrawMatrix: TFMatrix;
    FImg: TsgCADImage;
    FControl: TControl;
    function GetImg: TsgCADImage;
    function GetIsNotCustomDraw: Boolean;
    procedure MatrixChanged(Sender: TObject);
  public
    constructor Create(AControl: TControl);
    destructor Destroy; override;
    procedure ApplyScale(const ARect: TRect); overload;
    procedure ApplyScale(const ARect: TF2DRect); overload;
    function ConvertUnits(Pt: TFPoint): TFPoint;
    procedure CoordinateParameters(var AName: string; var AFactor: Double);
    function GetActualGraphic: TGraphic;
    function GetDrawMatrix: TFMatrix;
    function GetRealImageMatrix: TFMatrix;
    procedure ResetRotCenter(const ACenter: TPoint);
    procedure MovePositionToPoint(const APosition: TFPoint; const APoint: TPoint);
    function GetFPictureRect: TFRect;
    function GetPictureRect2D: TF2DRect;
    function GetInvertDrawMatrix: TFMatrix;
    function PointToPosition(const APoint: TPoint): TFPoint;
    function Point2DToPosition(const APoint: TF2DPoint): TFPoint;

    function UpdateImg: Boolean;
    procedure Update(const AExpandExtents: Boolean = True);
    procedure SetDrawMatrix(const AMatrix: TFMatrix);
    property Img: TsgCADImage read GetImg;
    property IsNotCustomDraw: Boolean read GetIsNotCustomDraw;
  end;

  TsgSysMenuIcon = (smiMinimize, smiRestore, smiClose);

  TsgSysMenuIcons = class
  private
    FImageClose: TGraphic;
    FImageMinimaze: TGraphic;
    FImageRestoreDown: TGraphic;
    FColor: TColor;
    FControl: TControl;
    FControlShowHint: Boolean;
    FCursor: TCursor;
    FCursorNeedStore: Boolean;
    FDown: Boolean;
    FHeight: Integer;
    FHintClose: string;
    FHintMinimize: string;
    FHintRestoreDown: string;
    FInvertColor: Boolean;
    FWidth: Integer;
    procedure InitializeHints;
    procedure Invalidate;
    function GetHints(Index: TsgSysMenuIcon): string;
    function GetImage(Index: TsgSysMenuIcon): TGraphic;
    procedure SetButtonImage(var AImage: TGraphic; const AValue: TGraphic);
    procedure SetColor(const AValue: TColor);
    procedure SetHeight(const AValue: Integer);
    procedure SetHintClose(const AValue: string);
    procedure SetHintMinimize(const AValue: string);
    procedure SetHintRestoreDown(const AValue: string);
    procedure SetHints(Index: TsgSysMenuIcon; const AValue: string);
    procedure SetInvertColor(const AValue: Boolean);
    procedure SetWidth(const AValue: Integer);
    procedure SetImage(Index: TsgSysMenuIcon; const AValue: TGraphic);
    procedure SetImageClose(const Value: TGraphic);
    procedure SetImageMinimaze(const Value: TGraphic);
    procedure SetImageRestoreDown(const Value: TGraphic);
  protected
    function DoMouseDown(var Message: TWMMouse): Boolean;
    function DoMouseMove(var Message: TWMMouse): Boolean;
    function DoMouseUp(var Message: TWMMouse): Boolean;
    function GetIconFromPoint(const APoint: TPoint): TsgSysMenuIcon;
    procedure Paint; virtual;
    function PtInIcon(const ASysMenuIcon: TsgSysMenuIcon;
      const APoint: TPoint): Boolean;
  public
    constructor Create(AControl: TControl);
    destructor Destroy; override;
    procedure Dispatch(var Message); override;
    function GetSysMenuIconRect(const ASysMenuIcon: TsgSysMenuIcon): TRect;
    function PointInIcons(const APoint: TPoint): Boolean;
    property Color: TColor read FColor write SetColor;
    property Control: TControl read FControl;
    property Height: Integer read FHeight write SetHeight;
    property HintClose: string read FHintClose write SetHintClose;
    property HintMinimize: string read FHintMinimize write SetHintMinimize;
    property HintRestoreDown: string read FHintRestoreDown write SetHintRestoreDown;
    property Hints[Index: TsgSysMenuIcon]: string read GetHints write SetHints;
    property ImageClose: TGraphic read FImageClose write SetImageClose;
    property ImageMinimaze: TGraphic read FImageMinimaze write SetImageMinimaze;
    property ImageRestoreDown: TGraphic read FImageRestoreDown write SetImageRestoreDown;
    property Image[Index: TsgSysMenuIcon]: TGraphic read GetImage write SetImage; default;
    property InvertColor: Boolean read FInvertColor write SetInvertColor;
    property Width: Integer read FWidth write SetWidth;
  end;

  function ActiveVPort(AGraphic: TGraphic): TFRect;
  {$IFNDEF sgDXFONLY}
  function GetAreaHPGL(AList: TList; AHPGLImage: TsgHPGLImage): Double;
  {$ENDIF}
  function GetArea(AList: TList): Double; overload;
  function GetArea(AList: TFPointList): Double; overload;

  function GetActualGraphic(ACADImage: TGraphic;
    const APictureRect, AViewRect: TRect; const AUseViewRect: Boolean;
    const AViewBox: PFRect = nil): TGraphic;
  function GetDistanceUnits(ADXFImage: TsgDXFImage; ALayout: TsgDXFLayout;
         var UnitsUserName: string; var UnitsUserFactor: Double;
         var AltUnitsUserName: string; var AltUnitsUserFactor: Double): TsgDistanceUnits;
  procedure GetDrawingSize(AGraphic: TsgCADImage; ALayout: TsgDXFLayout;
    var Width, Height: TsgFloat; var Units: CADImage.TsgDistanceUnits);
  function GetRealPointUsingsgImagePoint(AImage: TImage; X, Y: Integer; var PtInUCS: TFPoint): TFPoint;
function ReloadInserts(const ABlock: TsgDXFBlock; const AConv: TsgDXFConverter;
  AEnt: TsgDXFEntity): Boolean;

implementation

uses
  Math
  {$IFDEF SGVER_6_0_0}
  , sgDrawingNavigator
  {$ENDIF}
  {$IFDEF SGVER_5_2_5}
  , sgImage
  {$ENDIF}
  {$IFDEF CS_USEFORM}
  , Forms
  {$ENDIF}
  ;

const
  cnstEdgeSnapMask: TObjectSnapState = [osMiddle, osNearest, osNormal];
  cnstExtensionSnapMask: TObjectSnapState = [osTrace, osExtension, osParallel];
  cnstFirstSnapMask: TObjectSnapState = [osDisabled, osNearest];
  cnstIntersectionSnapMask: TObjectSnapState = [osIntersection];
  cnstMaskNotUseIterate: TObjectSnapState = [osAngle, osOrtho, osGrid, osPolar,
    osTrace];
  cnstObjectSnapMask: TObjectSnapState = [osInsert, osEndPt, osCenter,
    osQuadrant];
  cnstTangentSnapMask: TObjectSnapState = [osTangent];

type
  TsgCADImageAccess = class(TsgCADImage);
  TsgCADConverter = class(TsgDXFConverter);
  TsgDXFInsertAccess = class(TsgDXFInsert);
  TsgDXFGroupAccess = class(TsgDXFGroup);
  TsgDXFCircleAccess = class(TsgDXFCircle);
  TsgDXFPenLineAccess = class(TsgDXFPenLine);
  PsgPoint = ^TPoint;
  {$IFDEF SGVER_6_0_0}
  TDNavigator = class(TSGDrawingNavigator);
  {$ENDIF}
  TControlAccess = class(TControl);
  TCustomControlAccess = class(TCustomControl);
  TGraphicControlAccess = class(TGraphicControl);

  TsgSnapType = (stUndefined, stArc, stLine, stSolid, stPolyline,
    stPolyPolyline, stObjects);

  TsgCrossProcs = class of TsgCrossProc;

  TsgCrossProc = class
  private
    FArc: TsgArcR;
    FBox: TFRect;
    FCrossPoint: TFPoint;
    FCrossProcArc: TsgCrossProc;
    FCrossProcLine: TsgCrossProc;
    FDistance: Double;
    FEntity1: Pointer;
    FEntity2: Pointer;
    FLine: TsgLine;
  protected
    class function CrossSegments(const AL1, AL2: TsgLine;
      var APoint: TFPoint): Boolean;
    function CrossWithArc(const Arc: TsgArcR): Boolean; virtual;
    function CrossWithLine(const ALine: TsgLine): Boolean; virtual;
    function CrossWithPts(const AP1, AP2: TFPoint): Boolean;
    procedure SetArc(const AArc: TsgArcR);
    function SetCrossPoint(const APoint: TFPoint): Boolean;
    function SetCrossPoints(const ACount: Integer;
      const ACross1, ACross2: TFPoint): Boolean;
    procedure SetCrossProc(const AClass: TsgCrossProcs;
      var ACrossProc: TsgCrossProc);
    procedure SetLine(const ALine: TsgLine);
  public
    constructor Create(const AEnt1, AEnt2: Pointer; const ABox: TFRect); virtual;
    destructor Destroy; override;
    procedure CheckType(const AType1, AType2: TsgSnapType); virtual;
    function FindCrossPoint: Boolean; virtual; abstract;
    property CrossPoint: TFPoint read FCrossPoint;
  end;

  TsgSnapCross = class
  private
    FCrossPoint: TFPoint;
  public
    function IsCross(const AEnt1, AEnt2: Pointer; const ABox: TFRect): Boolean;
    property CrossPoint: TFPoint read FCrossPoint;
  end;

  TsgCrossArcs = class(TsgCrossProc)
  private
    FArc2: TsgArcR;
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossArcAndLine = class(TsgCrossProc)
  public
    function FindCrossPoint: Boolean; override;
    procedure CheckType(const AType1, AType2: TsgSnapType); override;
  end;

  TsgCrossLines = class(TsgCrossProc)
  private
    FLine2: TsgLine;
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossSolid = class(TsgCrossProc)
  protected
    function GetEdgeOfSolid(const EdgeIndex: Integer): TsgLine;
  public
    procedure CheckType(const AType1, AType2: TsgSnapType); override;
  end;

  TsgCrossSolidAndArc = class(TsgCrossSolid)
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossSolidAndLine = class(TsgCrossSolid)
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossSolids = class(TsgCrossSolid)
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossPolyline = class(TsgCrossProc)
  private
    FClosed: Boolean;
    FPoints: TFPointList;
    FPointsCounts: TsgIntegerList;
    function SpliteOnPolylines: TList;
    function CrossPolylines(const APolylines: TList): Boolean;
    function CrossPolylinesInternal(const APolylines: TList): Boolean;
  protected
    function FindCrossByEntity: Boolean;
    function FindCrossByEntityWithPointsCounts: Boolean;
  public
    procedure CheckType(const AType1, AType2: TsgSnapType); override;
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossPolylineAndArc = class(TsgCrossPolyline)
  protected
    function CrossWithLine(const ALine: TsgLine): Boolean; override;
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossPolylineAndLine = class(TsgCrossPolyline)
  protected
    function CrossWithLine(const ALine: TsgLine): Boolean; override;
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossPolylineAndSolid = class(TsgCrossPolyline)
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossPolylines = class(TsgCrossPolyline)
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossPolyPolyline = class(TsgCrossProc)
  public
    procedure CheckType(const AType1, AType2: TsgSnapType); override;
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossPolyPolylineAndArc = class(TsgCrossPolyPolyline)
  protected
    function CrossWithArc(const Arc: TsgArcR): Boolean; override;
    function CrossWithLine(const ALine: TsgLine): Boolean; override;
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossPolyPolylineAndLine = class(TsgCrossPolyPolyline)
  protected
    function CrossWithArc(const Arc: TsgArcR): Boolean; override;
    function CrossWithLine(const ALine: TsgLine): Boolean; override;
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossPolyPolylineAndSolid = class(TsgCrossPolyPolyline)
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossPolyPolylineAndPolyline  = class(TsgCrossPolyPolyline)
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossPolyPolylines = class(TsgCrossPolyPolyline)
  public
    function FindCrossPoint: Boolean; override;
  end;

  TsgCrossInsert = class(TsgCrossProc)
  private
    FObjects: TsgDXFEntity;
    FSnapType2: TsgSnapType;
  public
    procedure CheckType(const AType1, AType2: TsgSnapType); override;
    function FindCrossPoint: Boolean; override;
  end;

const
  cnstSqrt2: Double = 1.4142135623730950488016887242097;
  cnstSqrt3: Double = 1.7320508075688772935274463415059;
  cnstMaxCountPointsInPolyLineCross: Integer = 128;
  cnstMaxCountPointsInPolyLineEdge: Integer = 4096;
{$IFDEF SG_BTI}
  cnsrEntTypeExBySnap: set of Byte = [cnstComplexBroad, cnstComplexLinear];
{$ENDIF}
  cnstIconOffset = 2;
  cnstIconWidth = 16;
  cnstIconHeight = 12;

  cnstHintMinimize = 'Minimize';
  cnstHintClose = 'Close';
  cnstHintRestoreDown = 'Restore Down';

var
  SnapCross: TsgSnapCross = nil;

procedure EICError;
begin
  raise EInvalidCast.Create('Invalid image type');
end;

function ActiveVPort(AGraphic: TGraphic): TFRect;
var
  P: TsgDXFVPort;
  vM: TFMatrix;
begin
  Result := cnstBadRect;
  if AGraphic is TsgCADImage then
  begin
    P := TsgCADConverter(TsgCADImage(AGraphic).Converter).ActiveVPort;
    vM := TsgCADConverter(TsgCADImage(AGraphic).Converter).ViewTwistMatrix;
    InvertMatrix(vM);
    Result.TopLeft := AddFPoint(P.ViewCenterPoint, P.ViewTarget);
    Result.BottomRight := Result.TopLeft;
    InflateFRect(@Result, 0.5 * P.ViewHeight * P.ViewAspectRatio, 0.5 * P.ViewHeight, 0);
    TransRectCorners(Result, vM);
  end;
end;

function AddPolylineInList(const AList: TList; const ACapacity: Integer;
  const AMode: Boolean): TFPointList;
begin
  AList.Add(Pointer(AMode));
  Result := TFPointList.Create;
  AList.Add(Result);
  Result.Capacity := ACapacity;
end;

function IsBadValue(const AValue: Double): Boolean;
begin
  Result := IsNan(AValue) or IsInfinite(AValue)
end;




function GetActualGraphic(ACADImage: TGraphic;
  const APictureRect, AViewRect: TRect; const AUseViewRect: Boolean;
  const AViewBox: PFRect = nil): TGraphic;
var
  vCoeffW, vCoeffH, BX, BY: Double;
  vClipRect, vExts, vNewExts, vViewBox: TFRect;
  vMC: TMetafileCanvas;
  vRGN: HRGN;
  vNewImg, vImg: TsgCADImageAccess;
  vRWidth, vRHeight: Integer;
  vRect, vViewRect: TRect;
  vPicRect: TF2DRect;
begin
  vRGN := 0;
  vMC := nil;
  vRect := APictureRect;
  if ACADImage is TsgCADImage then
  begin
    vPicRect := MakeF2DRect(APictureRect.Left, APictureRect.Top,
      APictureRect.Right, APictureRect.Bottom);
    Result := TGraphicClass(ACADImage.ClassType).Create;
    vNewImg := TsgCADImageAccess(Result);
    vNewImg.Assign(ACADImage);
    if AUseViewRect then
    begin
      FillChar(vClipRect, SizeOf(vClipRect), 0);
      vImg := TsgCADImageAccess(ACADImage);
      vExts := vImg.Extents;
      vNewImg.IsWithoutBorder := True;
      vNewExts := vNewImg.Extents;
      if vImg.CustomDraw then
      begin
        vViewRect := AViewRect;
        // Borders
        BX := 0.5 * (vExts.Right - vExts.Left - vNewExts.Right + vNewExts.Left);
        BY := 0.5 * (vExts.Top - vExts.Bottom - vNewExts.Top + vNewExts.Bottom);
        // Scaling coefficients
        vCoeffW := (vExts.Right - vExts.Left) / (vPicRect.Right - vPicRect.Left);
        vCoeffH := (vExts.Top - vExts.Bottom) / (vPicRect.Bottom - vPicRect.Top);
        // Clipping rectangle (ignoring Z-coordinate)
        vClipRect.Left := (vViewRect.Left - vPicRect.Left) * vCoeffW - BX;
        vClipRect.Top := (vViewRect.Top - vPicRect.Top) * vCoeffH - BY;
        vClipRect.Right := vClipRect.Left + (vViewRect.Right - vViewRect.Left) * vCoeffW;
        vClipRect.Bottom := vClipRect.Top + (vViewRect.Bottom - vViewRect.Top) * vCoeffH;
      end
      else
      begin
        vPicRect := MakeF2DRect(vNewExts.Left, vNewExts.Bottom, vNewExts.Right, vNewExts.Top);
        vNewImg.ApplyScale(vPicRect.Left, vPicRect.Top, vPicRect.Right, vPicRect.Bottom);
        if Assigned(AViewBox) then
          vViewBox := AViewBox^
        else
          vViewBox := vNewImg.CurrentLayout.Box;
        TransRectCorners(vViewBox, vNewImg.DrawMatrix);
        SwapDoubles(vViewBox.Top, vViewBox.Bottom);
        // Clipping rectangle (ignoring Z-coordinate)
        vClipRect.Left := (vViewBox.Left - vPicRect.Left);
        vClipRect.Top := (vViewBox.Top - vPicRect.Top);
        vClipRect.Right := vClipRect.Left + (vViewBox.Right - vViewBox.Left);
        vClipRect.Bottom := vClipRect.Top + (vViewBox.Bottom - vViewBox.Top);
      end;
      vNewImg.SetClippingRect(@vClipRect);
    end;
  end
  else
  begin
    Result := TMetafile.Create;
    try
      vRGN := 0;
      if AUseViewRect then
      begin
        vRect.Left := vRect.Left - AViewRect.Left;
        vRect.Top := vRect.Top - AViewRect.Top;
        vRect.Right := vRect.Right - AViewRect.Left;
        vRect.Bottom := vRect.Bottom - AViewRect.Top;
        vRWidth := AViewRect.Right - AViewRect.Left;
        vRHeight := AViewRect.Bottom - AViewRect.Top;
        TMetafile(Result).Width := vRWidth;
        TMetafile(Result).Height := vRHeight;
        vRGN := CreateRectRgn(0, 0, vRWidth, vRHeight);
      end
      else
      begin
        OffsetRect(vRect, -vRect.Left, -vRect.Top);
        TMetafile(Result).Width := vRect.Right;
        TMetafile(Result).Height := vRect.Bottom;
      end;
      vMC := TMetafileCanvas.Create(TMetafile(Result), 0);
      if vRGN <> 0 then
        SelectClipRgn(vMC.Handle, vRGN);
      vMC.StretchDraw(vRect, ACADImage);
    finally
      if vRGN <> 0 then
        DeleteObject(vRGN);
      vMC.Free;
    end;
  end;
end;

function Is3DRect(const ARect: TFRect): Boolean;
var
  vIs3DCoords: Integer;
begin
  vIs3DCoords := Integer(Abs(ARect.Right - ARect.Left) > fAccuracy);
  Inc(vIs3DCoords, Integer(Abs(ARect.Top - ARect.Bottom) > fAccuracy));
  Inc(vIs3DCoords, Integer(Abs(ARect.Z2 - ARect.Z1) > fAccuracy));
  Result := vIs3DCoords = 3;
end;

function IsEntity(const AP: Pointer): Boolean;
begin
  Result := DXFConv.IsEntity(AP);
end;

function IsEntityExtruded(const AEntity: TsgDXFEntity): Boolean;
begin
  Result := False;
  if (AEntity is TsgDXFPenLine) then
    Result := TsgDXFPenLineAccess(AEntity).IsExtruded;
end;

function IsHasSnap(const AEntity: TsgDXFEntity): Boolean;
begin
  Result := not (AEntity.EntType in [ceCircle, ceArc, ceEllipse, ceSpline]);
end;

function IsCircular(const AEntity: TsgDXFEntity): Boolean;
begin
  Result := False;
  if AEntity.EntType in [ceCircle, ceArc] then
    Result := not Extruded(TsgDXFCircle(AEntity).Extrusion);
end;

function IsSolid(const AEntity: TsgDXFEntity): Boolean;
var
  vPenLine: TsgDXFPenLine absolute AEntity;
begin
  if AEntity is TsgDXFPenLine then
    Result := (vPenLine.Lines = nil) or (vPenLine.Lines.IsSolid)
  else
    Result := True;
end;

function IsCrossRects(const AR1, AR2: TFRect): Boolean;
begin
  Result := ((AR1.Left <= AR2.Right) and (AR1.Right >= AR2.Left) and
    (AR1.Bottom <= AR2.Top) and (AR1.Top >= AR2.Bottom)) or
    ((AR1.Left <= AR2.Left) and (AR1.Right >= AR2.Right)
      and (AR1.Bottom <= AR2.Bottom) and (AR1.Top >= AR2.Top));
end;

function IsPointInFRect(const R: TFRect; const P: TFPoint): Boolean;
begin
  Result := (P.X >= R.Left) and (R.Right >= P.X) and
    (R.Top >= P.Y) and (P.Y >= R.Bottom) and
    (P.Z >= R.Z1) and (R.Z2 >= P.Z);
end;

function LoadUser32Str(const AID: Integer): string;
const
  cnstBuffSize = 4096;
var
  vBuf: PChar;
begin
  vBuf := StrAlloc(cnstBuffSize + 1);
  try
    SetString(Result, vBuf,
      LoadString(GetModuleHandle(user32), AID, vBuf, cnstBuffSize));
  finally
    StrDispose(vBuf);
  end;
end;

function GetArcR(const AEnt: TsgDXFCircle): TsgArcR;
begin
  Result.Center := AEnt.Point;
  Result.Radius := AEnt.Radius;
  if AEnt.EntType = ceArc then
  begin
    Result.AngleS := TsgDXFArc(AEnt).StartAngle;
    Result.AngleE := TsgDXFArc(AEnt).EndAngle;
  end
  else
  begin
    Result.AngleS := 0;
    Result.AngleE := 360;
  end;
end;

function GetLine(const AEnt: TsgDXFLine): TsgLine;
begin
  Result.Point1 := AEnt.Point;
  Result.Point2 := AEnt.Point1;
end;

function CreateLine(const ALine: TsgLine;
  const ASnapType: TObjectSnapMode = osDisabled): TsgDXFLineTrace;
begin
  Result := TsgDXFLineTrace.Create;
  Result.Point := ALine.Point1;
  Result.Point1 := ALine.Point2;
  Result.SnapType := ASnapType;
end;

function GetRectByPoints(const AP1, AP2: TFPoint): TFRect;
begin
  if AP1.X < AP2.X then
  begin
    Result.Left := AP1.X;
    Result.Right := AP2.X;
  end
  else
  begin
    Result.Left := AP2.X;
    Result.Right := AP1.X;
  end;
  if AP1.Y < AP2.Y then
  begin
    Result.Bottom := AP1.Y;
    Result.Top := AP2.Y;
  end
  else
  begin
    Result.Bottom := AP2.Y;
    Result.Top := AP1.Y;
  end;
  if AP1.Z < AP2.Z then
  begin
    Result.Z1 := AP1.Z;
    Result.Z2 := AP2.Z;
  end
  else
  begin
    Result.Z1 := AP2.Z;
    Result.Z2 := AP1.Z;
  end;
end;

function GetPointInVector(const AP1, AP2: TFPoint; const ADistance: Double): TFPoint;
var
  vLengthOfVector: Double;
begin
  vLengthOfVector := DistanceFPoint(AP1, AP2);
  if Abs(vLengthOfVector) > fAccuracy then
  begin
    Result.X := AP1.X + (AP2.X - AP1.X) * ADistance / vLengthOfVector;
    Result.Y := AP1.Y + (AP2.Y - AP1.Y) * ADistance / vLengthOfVector;
    Result.Z := AP1.Z + (AP2.Z - AP1.Z) * ADistance / vLengthOfVector;
  end
  else
    Result := AP1;
end;

function GetPointByCrossEntity(const AEntity1, AEntity2: TsgDXFEntity;
  const ABox: TFRect; var APt: TFPoint): TObjectSnapState;
begin
  Result := [];
  if SnapCross = nil then
    SnapCross := TsgSnapCross.Create;
  if SnapCross.IsCross(AEntity1, AEntity2, ABox) then
  begin
    APt := SnapCross.CrossPoint;
    Result := [osIntersection];
  end;
end;

function GetPointByEdgeEntity(const AEntity: TsgDXFEntity; const ABasePt: PFPoint;
  const APoint: TFPoint; const ABox: TFRect; const ActiveSnap: TObjectSnapState;
  var APt: TFPoint): TObjectSnapState;
var
  vLine: TsgDXFLIne absolute AEntity;
  vPoint: TsgDXFPoint absolute AEntity;
  vSolid: TsgDXFSolid absolute AEntity;
  vPoly: TsgCADBasePolyline absolute AEntity;
  vFlat: TsgFlatEntity absolute AEntity;
{$IFDEF SG_BTI}
  vInsert: TsgDXFInsertAccess absolute AEntity;
  vEnt: TsgDXFEntity;
{$ENDIF}
  I, J, Cnt, vIndex: Integer;
  vIsCircular: Boolean;
  vMinH: Double;
  vPts: array [0..1] of TFPoint;
  vPtsMode: Integer;
  vEntBox: TFRect;
  vTmpSnap: TObjectSnapState;

  procedure FindLine(const P1, P2: TFPoint; const AMode: Integer = 0);
  var
    A, B, C, C1, H, S, P: Double;
  begin
    C := DistanceFPoint(P1, P2);
    H := 0;
    if C > fDoubleResolution then
    begin
      A := DistanceFPoint(P1, APoint);
      B := DistanceFPoint(P2, APoint);
      P := (A + B + C) * 0.5;
      S := P * (P - A) * (P - B) * (P - C);
      if S >= 0 then
      begin
        if S > 0 then
        begin
          H := 2 * Sqrt(S) / C;
          C1 := Sqr(A) + Sqr(H);
          if C1 > 0 then
            C1 := Sqrt(C1)
          else
            C1 := 0;
          if C1 <= C then
            APt := GetPointInVector(P1, P2, C1)
          else
            Exit;
        end
        else
          APt := APoint;
        if not IsPointInFRect(ABox, APt) then
          Exit;
      end;
    end
    else
    begin
      if IsPointInFRect(ABox, P1) then
        H := DistanceFPoint(P1, APoint)
      else
        Exit;
    end;
    if H < vMinH then
    begin
      vIsCircular := False;
      vMinH := H;
      Result := Result + [osNearest];
      vPts[0] := P1;
      vPts[1] := P2;
      vPtsMode := AMode;
    end;
  end;

  function FindCircle(const ACenter: TFPoint; const ARadius, AStart,
    AEnd: Double; var AFindPoint: TFPoint; const ADelta: PDouble): Boolean;
  var
    vRadius, vAngle: Double;
  begin
    Result := False;
    vRadius :=  DistanceFPoint(ACenter, APoint);
    if Abs(vRadius / ARadius  - 1) < 0.25 then
    begin
      vAngle := GetAngleByPoints(ACenter, APoint, False);
      if IsAngleInAngles(vAngle, AStart, AEnd) then
      begin
        AFindPoint := GetPointOnCircle(ACenter, ARadius, vAngle);
        Result := True;
        if ADelta <> nil then
          ADelta^ := Abs(ARadius - vRadius);
      end;
    end;
  end;


  procedure FindArc(const Arc: TsgArcR);
  var
    H: Double;
    P: TFPoint;
  begin
    if FindCircle(Arc.Center, Arc.Radius, Arc.AngleS, Arc.AngleE, P, @H) then
    begin
      if vMinH > H then
      begin
        vIsCircular := True;
        vMinH := H;
        Result := Result + [osNearest];
        vPts[0] := P;
      end;
    end;
  end;

  procedure FindNearestPointByCircular(const AEntity: TsgDXFEntity);
  var
    vCircle: TsgDXFCircle absolute AEntity;
    vAngleS, vAngleE: Double;
  begin
    vAngleS := 0;
    vAngleE := 360;
    if AEntity.EntType = ceArc then
    begin
      vAngleS := TsgDXFArc(AEntity).StartAngle;
      vAngleE := TsgDXFArc(AEntity).EndAngle;
    end;
    if FindCircle(TsgDXFCircle(AEntity).Point, TsgDXFCircle(AEntity).Radius,
       vAngleS, vAngleE, APt, nil) then
      Result := Result + [osNearest];
  end;

  procedure SetPoint(const AP1, AP2: TFPoint; const APMode: Integer);
  var
    vD1, vD: Double;
    vHasNormal: Boolean;
  begin
    vHasNormal := False;
    if (ABasePt <> nil)  and (osNormal in ActiveSnap) then
      vHasNormal := PointCrossedPerpendicularSegments(MakeLine(AP1, AP2), ABasePt^, @APt);
    if (ABasePt <> nil) and vHasNormal and
       not IsEqualFPoints(APt, ABasePt^, fDoubleResolution) and
       IsPointInFRect(ABox, APt) and
       IsPointInFRect(ABox, APoint) then
      Result := Result + [osNormal]
    else
    begin
      vD1 := DistanceFPoint(AP1, APoint);
      vD := DistanceFPoint(AP1, AP2);
      if (APMode = 0) and IsHasSnap(AEntity) and (osMiddle in ActiveSnap) and
         (Abs(vD1 - vD * 0.5) < 0.25 * vD) then
      begin
        APt := MiddleFPoint(AP1, AP2);
        if IsPointInFRect(ABox, APt) then
          Result := Result + [osMiddle]
        else
        begin
          Result := Result + [osNearest];
          APt := GetPointInVector(AP1, AP2, vD1);
        end;
      end
      else
      begin
        Result := Result + [osNearest];
        APt := GetPointInVector(AP1, AP2, vD1);
      end;
    end;
  end;

  procedure FindNearestPointByPolyline(const AEntity: TsgDXFEntity);
  var
    vPoly: TsgDXFLWPolyline absolute AEntity;
    I, J, K, vPointCount: Integer;
  begin
    J := 0;
    for I := 0 to vPoly.PointsCounts.Count - 2 do
    begin
      vPointCount := Integer(vPoly.PointsCounts[I]);
      if vPointCount = 1 then
        FindLine(vPoly.PolyPoints[J], vPoly.PolyPoints[J + 1])
      else
        for K := J to J + vPointCount - 2 do
          FindLine(vPoly.PolyPoints[K], vPoly.PolyPoints[K + 1], 1);
      Inc(J, vPointCount);
    end;
    if vPoly.Closed and (vPoly.PointsCounts.Count > 1) then
      FindLine(vPoly.PolyPoints.First, vPoly.PolyPoints.Last,
        IfThen(Integer(vPoly.PointsCounts.Last) = 1, 0, 1));
    vTmpSnap := Result;
    if osNearest in Result then
    begin
      SetPoint(vPts[0], vPts[1], vPtsMode);
      if (Result <> vTmpSnap) then
        Result := Result - [osNearest];
    end;
  end;

{$IFDEF SG_BTI}
  procedure FindNearestPointByPolyPolyline2D(const PPoly: Pointer);
  var
    APPoly: TsgCADPolyPolyline2D absolute PPoly;
    J, Cnt: Integer;
    L: TsgLine;
  begin
    Cnt := APPoly.CurvesCount - 1;
    if (Cnt > 0) and (Cnt < cnstMaxCountPointsInPolyLineEdge) then
    begin
      for J := 0 to Cnt do
      begin
        if APPoly.CurveVisible[J] then
        begin
          if APPoly.IsCurveArc(J) then
            FindArc(APPoly.Arcs[J])
          else
          begin
            L := APPoly.Lines[J];
            FindLine(L.Point1, L.Point2);
          end;
        end;
      end;
      if osNearest in Result then
      begin
        if vIsCircular then
          APt := vPts[0]
        else
          SetPoint(vPts[0], vPts[1], vPtsMode);
      end
    end;
  end;

  procedure FindNearestPointByArc(const AArc: Pointer);
  var
    Poly: TsgCADBasePolyline absolute AArc;
    L: Integer;
  begin
    if (Poly.PolyPoints.Count > 0) and (Poly.PolyPoints.Count < cnstMaxCountPointsInPolyLineEdge) then
    begin
      Cnt := Poly.PolyPoints.Count - 2;
      for L := 0 to Cnt do
        FindLine(Poly.PolyPoints.List[L], Poly.PolyPoints.List[L + 1]);
      if Poly.Closed then
        FindLine(Poly.PolyPoints.First, Poly.PolyPoints.Last);
      vTmpSnap := Result;
      if osNearest in Result then
      begin
        SetPoint(vPts[0], vPts[1], vPtsMode);
        if (Result <> vTmpSnap) then
          Result := Result - [osNearest];
      end;
    end;
  end;

  procedure FindNearestPointByLine(const ALine: Pointer);
  begin
    SetPoint(TsgDXFLine(ALine).Point, TsgDXFLine(ALine).Point1, vPtsMode);
  end;
{$ENDIF}

begin
  Result := [];
  vPtsMode := 0;
  vMinH := MaxDouble;
  vIsCircular := False;
  vEntBox := AEntity.Box;
  if (vEntBox.Z1 = 0) and (vEntBox.Z2 = 0) then
  begin
    if AEntity is TsgDXFPoint then
    begin
      APt := vPoint.Point;
      Result := Result + [osEndPt];
    end
    else
    begin
      if AEntity is TsgDXFSolid then
      begin
        FindLine(vSolid.Point, vSolid.Point1);
        FindLine(vSolid.Point1, vSolid.Point3);
        FindLine(vSolid.Point2, vSolid.Point3);
        FindLine(vSolid.Point2, vSolid.Point);
        if osNearest in Result then
          SetPoint(vPts[0], vPts[1], vPtsMode);
      end
      else
      begin
        if AEntity is TsgDXFLine then
        begin
          SetPoint(vLine.Point, vLine.Point1, vPtsMode);
        end
        else
        begin
          if AEntity is TsgCADBasePolyline then
          begin
            if IsCircular(AEntity) then
              FindNearestPointByCircular(AEntity)
            else
            begin
              if AEntity is TsgDXFLWPolyline then
                FindNearestPointByPolyline(AEntity)
              else
              begin
                if (vPoly.PolyPoints.Count > 0) and
                  (vPoly.PolyPoints.Count < cnstMaxCountPointsInPolyLineEdge) then
                begin
                  Cnt := vPoly.PolyPoints.Count - 2;
                  for I := 0 to Cnt do
                    FindLine(vPoly.PolyPoints[I], vPoly.PolyPoints[I + 1]);
                  if vPoly.Closed then
                    FindLine(vPoly.PolyPoints.First, vPoly.PolyPoints.Last);
                  vTmpSnap := Result;
                  if osNearest in Result then
                  begin
                    SetPoint(vPts[0], vPts[1], vPtsMode);
                    if (Result <> vTmpSnap) then
                      Result := Result - [osNearest];
                  end;
                end;
              end
            end;
          end
          else
          begin
            if AEntity is TsgFlatPoly then
            begin
              Cnt := 0;
              for I := 0 to vFlat.Counts.Count - 1 do
                Inc(Cnt, Integer(vFlat.Counts[I]));
              if Cnt < cnstMaxCountPointsInPolyLineEdge then
              begin
                vIndex := 0;
                for I := 0 to vFlat.Counts.Count - 1 do
                begin
                  Cnt := Integer(vFlat.Counts[I]);
                  for J := 0 to Cnt - 2 do
                    FindLine(vFlat.XY[vIndex + J], vFlat.XY[vIndex + J + 1]);
                  Inc(vIndex, Cnt);
                end;
                vTmpSnap := Result;
                if osNearest in Result then
                begin
                  SetPoint(vPts[0], vPts[1], vPtsMode);
                  if (Result <> vTmpSnap) then
                    Result := Result - [osNearest];
                end;
              end;
            end
            else
            begin
{$IFDEF SG_BTI}
              if (AEntity is TsgDXFInsert) and (vInsert.GetEntTypeEx in cnsrEntTypeExBySnap) then
              begin
                for I := vInsert.Block.Count - 1 downto 0 do
                begin
                  vEnt := vInsert.Block[I];
                  case vEnt.EntType of
                    ceArc:            FindNearestPointByArc(vEnt);
                    ceLine:           FindNearestPointByLine(vEnt);
                    cePolyPolyline2D: FindNearestPointByPolyPolyline2D(vEnt);
                  end;
                end;
              end
              else
              begin
                if AEntity is TsgCADPolyPolyline2D then
                begin
                  if TsgCADPolyPolyline2D(AEntity).CurvesCount < cnstMaxCountPointsInPolyLineEdge then
                    FindNearestPointByPolyPolyline2D(TsgCADPolyPolyline2D(AEntity));
                end;
              end;
{$ENDIF}
            end;
          end
        end;
      end
    end;
  end;
end;

function GetPointByTargetEntity(const AEntity: TsgDXFEntity;
  const ABasePt: PFPoint;  const APoint: TFPoint; const ABox: TFRect;
  const ASnapDistance: Double; var APt: TFPoint): TObjectSnapState;
var
  vArc: TsgDXFArc absolute AEntity;
  vCircle: TsgDXFCircle absolute AEntity;
  vEllipse:  TsgDXFEllipse absolute AEntity;
  vPoly: TsgDXFLWPolyline absolute AEntity;
  vVertex1, vVertex2: TsgDXFVertex;
  vTangentPoint1, vTangentPoint2, vPoint1, vPoint2: TFPoint;
  vDistance, vDistance1, vDistance2: Double;
  I, Cnt, vFind, vFindBulge: Integer;
  vArcR: TsgArcR;
begin
  Result := [];
  if (ABasePt = nil) or IsEntityExtruded(AEntity) or (APoint.Z <> 0) then
    Exit;
  case AEntity.EntType of
    ceArc:
      vFind := IsTangentOfArc(vArc.Point, vArc.Radius, vArc.StartAngle,
        vArc.EndAngle, ABasePt^, vTangentPoint1, vTangentPoint2);
    ceCircle:
      vFind := IsTangentOfCircle(vCircle.Point, vCircle.Radius,
        ABasePt^, vTangentPoint1, vTangentPoint2);
    ceEllipse:
      begin
        vFind := IsTangentOfEllipse(vEllipse.Point, vEllipse.RadPt,
          vEllipse.Ratio, vEllipse.StartAngle, vEllipse.EndAngle,
          ABasePt^, vTangentPoint1, vTangentPoint2);
      end;
    ceLWPolyline:
      begin
        vFind := 0;
        vDistance := MaxDouble;
        Cnt := vPoly.Count - 1;
        for I := 0 to Cnt do
        begin
          vVertex1 := vPoly.Vertexes[I];
          if I >= Cnt then
             vVertex2 := vPoly.Vertexes[0]
          else
            vVertex2 := vPoly.Vertexes[I + 1];
          if (vVertex1.Bulge <> 0) and
             (not IsEqualFPoints(vVertex1.Point, vVertex2.Point)) then
          begin
            ApplyBulge(vVertex1.Point, vVertex2.Point, vVertex1.Bulge, nil, -1,
               @CreatePFPointProc, vArcR);
            vFindBulge := IsTangentOfArc(vArcR.Center, vArcR.Radius, vArcR.AngleS,
               vArcR.AngleE, ABasePt^, vPoint1, vPoint2);
            if vFindBulge > 0 then
            begin
              vDistance1 := DistanceFPointSqr(vPoint1, APoint);
              if vFindBulge > 1 then
              begin
                vDistance2 := DistanceFPointSqr(vPoint2, APoint);
                if vDistance1 > vDistance2 then
                begin
                  vPoint1 := vPoint2;
                  vDistance1 := vDistance2;
                end;
              end;
              if vDistance > vDistance1 then
              begin
                vFind := 1;
                vTangentPoint1 := vPoint1;
                vDistance := vDistance1;
              end;
            end;
          end;
        end;
      end;
  else
    vFind := 0;
    vTangentPoint1 := cnstFPointZero;
    vTangentPoint2 := cnstFPointZero;
  end;
  if vFind > 0 then
  begin
     vDistance1 := DistanceFPointSqr(vTangentPoint1, APoint);
    if vFind > 1 then
    begin
      vDistance2 := DistanceFPointSqr(vTangentPoint2, APoint);
      if vDistance1 > vDistance2 then
      begin
        vDistance1 := vDistance2;
        vTangentPoint1 := vTangentPoint2;
      end;
    end;
    if vDistance1 <= Sqr(ASnapDistance) then
    begin
      APt := vTangentPoint1;
      Result := [osTangent];
    end;
  end;
end;

constructor TsgObjectSnap.Create;
begin
  inherited Create;
  FSnapDistance := cnstSnapDistance;
end;

function TsgObjectSnap.GetSnapPointUCS(AVisiblePoint: TPoint;
  var AObjectSnapState: TObjectSnapState; var AEntity: TsgDXFEntity; var CoordsInUCS: TFPoint): TSnapData;
var
  SD: PSnapData;
begin
  ZeroMemory(@Result, SizeOf(Result));
  SD := FindSnap(AVisiblePoint);
  if SD <> nil then
  begin
    Result := SD^;
    AObjectSnapState := SD^.SnapMode;
    AEntity := TsgDXFEntity(SD^.Entity);
    CoordsInUCS := SD^.CADPointInUCS;
  end
  else
  begin
    AObjectSnapState := [];
    AEntity := nil;
    Result.CADPointInUCS := MakeFPoint(MaxTsgFloat, MaxTsgFloat, MaxTsgFloat);
    CoordsInUCS := Result.CADPointInUCS;
  end;
end;

function TsgObjectSnap.GetSnapPoint(AVisiblePoint: TPoint;
  var AObjectSnapState: TObjectSnapState; var AEntity: TsgDXFEntity): TSnapData;
var
  Temp: TFPoint;
begin
  Result := GetSnapPointUCS(AVisiblePoint, AObjectSnapState, AEntity, Temp);
end;

procedure TsgObjectSnap.SetsgDXFImage(ACADImage: TsgDXFImage);
begin
  FCADImage := ACADImage;
end;

function TsgObjectSnap.FindSnap(APoint: TPoint): PSnapData;
var
  I, J: Integer;
  SD: PSnapData;
  Pt: TPoint;
  CurrDistSqr, R: Double;
begin
  Result := nil;
  if FCADImage = nil then Exit;
  CurrDistSqr := MaxDouble;
  for I := - FSnapDistance to FSnapDistance do
  begin
    Pt.Y := APoint.Y + I;
    for J := - FSnapDistance to FSnapDistance do
    begin
      Pt.X := APoint.X + J;
      SD := FCADImage.GetSnapData(Pt);
      if SD <> nil then
      begin
        R := DistancePointSqr(Pt, APoint);
        if CurrDistSqr > R then
        begin
          CurrDistSqr := R;
          Result := SD;
        end;
      end;
    end;
  end;
end;

procedure TsgObjectSnap.SetSnapDistance(const AVal: Integer);
begin
  if AVal > 0 then
    FSnapDistance := AVal
  else
    FSnapDistance := cnstSnapDistance;
end;

{ TSnapMarker }

procedure TSnapMarker.ClearPoint;
begin
  FPoint.X := MaxInt;
  FRealPoint := BadPoint;
  FBaseMatrixSnapType := osDisabled;
end;

constructor TSnapMarker.Create(ASnapControl: TSnapControl);
begin
  inherited Create;
  FIsTraced := False;
  FSnapControl := ASnapControl;
  FPen := TPen.Create;
  FPen.Width := 1;
  FPen.Style := psSolid;
  FPen.Color := clWhite;
  FPen.Mode := pmXor;
  FPenStore := TPen.Create;
  FDrawAreaSize := cnstSnapMarkerSize;
  ClearPoint;
end;

destructor TSnapMarker.Destroy;
begin
  FPen.Free;
  FPenStore.Free;
  inherited Destroy;
end;

procedure TSnapMarker.Draw;
var
  vCanvas: TCanvas;

  {$IFDEF SGVER_6_0_0}
  function GetCADCoords(const APt: TPoint): TFPoint;
  begin
    if FSnapControl.Control is TSGDrawingNavigator then
      Result := TSGDrawingNavigator(FSnapControl.Control).GetDrawingInternalCoordsWithoutSnap(APt.X, APt.Y)
    else
      Result := cnstFPointZero;
  end;
  {$ENDIF}

  procedure DrawNormalSnap;
  var
    vPts: array [0..2] of TPoint;
  begin
   // if FSnapControl.BasePoint = nil then
   //   Exit;
    vPts[0].X := FPoint.X - FDrawAreaSize;
    vPts[0].Y := FPoint.Y - FDrawAreaSize;
    vPts[1].X := FPoint.X - FDrawAreaSize;
    vPts[1].Y := FPoint.Y + FDrawAreaSize;
    vPts[2].X := FPoint.X + FDrawAreaSize;
    vPts[2].Y := FPoint.Y + FDrawAreaSize;
    Windows.Polyline(vCanvas.Handle, PsgPoint(@vPts)^, 3);

    vPts[0].X := FPoint.X - FDrawAreaSize + 1;
    vPts[0].Y := FPoint.Y;
    vPts[1].X := FPoint.X;
    vPts[1].Y := FPoint.Y;
    vPts[2].X := FPoint.X;
    vPts[2].Y := FPoint.Y + FDrawAreaSize - 1;
    Windows.Polyline(vCanvas.Handle, PsgPoint(@vPts)^, 3);
  end;

  procedure DrawCross;
  begin
    vCanvas.MoveTo(FPoint.X - FDrawAreaSize, FPoint.Y - FDrawAreaSize);
    vCanvas.LineTo(FPoint.X + FDrawAreaSize, FPoint.Y + FDrawAreaSize);
    vCanvas.MoveTo(FPoint.X - FDrawAreaSize, FPoint.Y + FDrawAreaSize);
    vCanvas.LineTo(FPoint.X + FDrawAreaSize, FPoint.Y - FDrawAreaSize);
  end;

  procedure DrawBox;
  begin
    vCanvas.MoveTo(FPoint.X - FDrawAreaSize, FPoint.Y - FDrawAreaSize);
    vCanvas.LineTo(FPoint.X + FDrawAreaSize, FPoint.Y - FDrawAreaSize);
    vCanvas.LineTo(FPoint.X + FDrawAreaSize, FPoint.Y + FDrawAreaSize);
    vCanvas.LineTo(FPoint.X - FDrawAreaSize, FPoint.Y + FDrawAreaSize);
    vCanvas.LineTo(FPoint.X - FDrawAreaSize, FPoint.Y - FDrawAreaSize);
  end;

  procedure DrawCircle;
  var
    vBS: TBrushStyle;
  begin
    vBS := vCanvas.Brush.Style;
    try
      vCanvas.Brush.Style := bsClear;
      vCanvas.Ellipse(FPoint.X - FDrawAreaSize, FPoint.Y - FDrawAreaSize,
                              FPoint.X + FDrawAreaSize, FPoint.Y + FDrawAreaSize);
    finally
      vCanvas.Brush.Style := vBS;
    end;
  end;

  procedure DrawCrossSnap;
  var
    vPts: array[0..1] of TPoint;
  begin
    vPts[0].X := FPoint.X - FDrawAreaSize;
    vPts[0].Y := FPoint.Y - FDrawAreaSize;
    vPts[1].X := FPoint.X + FDrawAreaSize;
    vPts[1].Y := FPoint.Y + FDrawAreaSize;
    vCanvas.Pen.Width := 3;
    Windows.Polyline(vCanvas.Handle, PsgPoint(@vPts)^, 2);
    vPts[0].X := FPoint.X - FDrawAreaSize;
    vPts[0].Y := FPoint.Y + FDrawAreaSize;
    vPts[1].X := FPoint.X + FDrawAreaSize;
    vPts[1].Y := FPoint.Y - FDrawAreaSize;
    Windows.Polyline(vCanvas.Handle, PsgPoint(@vPts)^, 2);
    vCanvas.Pen.Width := 0;
  end;

  procedure DrawNearestSnap;
  var
    vPts: array [0..4] of TPoint;
  begin
    vPts[0].X := FPoint.X - FDrawAreaSize;
    vPts[0].Y := FPoint.Y - FDrawAreaSize;
    vPts[1].X := FPoint.X + FDrawAreaSize;
    vPts[1].Y := vPts[0].Y;
    vPts[2].X := vPts[0].X;
    vPts[2].Y := FPoint.Y + FDrawAreaSize;
    vPts[3].X := vPts[1].X;
    vPts[3].Y := vPts[2].Y;
    vPts[4] := vPts[0];
    Windows.Polyline(vCanvas.Handle, PsgPoint(@vPts)^, 5);
  end;

  procedure DrawInsertSnap;
  var
    vPts: array [0..8] of TPoint;
  begin
    vPts[0].X := FPoint.X - FDrawAreaSize;
    vPts[0].Y := FPoint.Y - FDrawAreaSize;
    vPts[1].X := vPts[0].X;
    vPts[1].Y := FPoint.Y + Round(FDrawAreaSize * 0.2);
    vPts[2].X := FPoint.X;
    vPts[2].Y := vPts[1].Y;
    vPts[3].X := FPoint.X;
    vPts[3].Y := FPoint.Y + FDrawAreaSize;
    vPts[4].X := FPoint.X + FDrawAreaSize;
    vPts[4].Y := vPts[3].Y;
    vPts[5].X := vPts[4].X;
    vPts[5].Y := FPoint.Y - Round(FDrawAreaSize * 0.2);
    vPts[6].X := FPoint.X;
    vPts[6].Y := vPts[5].Y;
    vPts[7].X := FPoint.X;
    vPts[7].Y := vPts[0].Y;
    vPts[8] := vPts[0];
    Windows.Polyline(vCanvas.Handle, PsgPoint(@vPts)^, 9);
  end;

  procedure DrawMiddleSnap;
  var
    vPts: array [0..3] of TPoint;
    A, H, dH: Integer;
  begin
    H := FDrawAreaSize shl 1;
    A := Round(H / cnstSqrt3);
    dH := Round(H / 3);
    vPts[0].X := FPoint.X;
    vPts[0].Y := FPoint.Y - (H - dH);
    vPts[1].X := FPoint.X + A;
    vPts[1].Y := FPoint.Y + dH;
    vPts[2].X := FPoint.X - A;
    vPts[2].Y := vPts[1].Y;
    vPts[3] := vPts[0];
    Windows.Polyline(vCanvas.Handle, PsgPoint(@vPts)^, 4);
  end;

  procedure DrawTangent;
  begin
    vCanvas.MoveTo(FPoint.X - FDrawAreaSize, FPoint.Y - FDrawAreaSize - 1);
    vCanvas.LineTo(FPoint.X + FDrawAreaSize, FPoint.Y - FDrawAreaSize - 1);
    DrawCircle;
  end;

  procedure DrawQuadrant;
  var
    vPts: array [0..4] of TPoint;
  begin
    vPts[0] := Point(FPoint.X + FDrawAreaSize, FPoint.Y);
    vPts[1] := Point(FPoint.X, FPoint.Y - FDrawAreaSize);
    vPts[2] := Point(FPoint.X - FDrawAreaSize, FPoint.Y);
    vPts[3] := Point(FPoint.X, FPoint.Y + FDrawAreaSize);
    vPts[4] := Point(FPoint.X + FDrawAreaSize, FPoint.Y);
    Windows.Polyline(vCanvas.Handle, PsgPoint(@vPts)^, 5);
  end;

begin
  vCanvas := FSnapControl.Canvas;
  if (FPoint.X <> MaxInt) and Assigned(vCanvas) and
     Assigned(FSnapControl.FImg) then
  begin
    FVisible := not FVisible;
    FPenStore.Assign(vCanvas.Pen);
    FPoint := FSnapControl.FImg.GetPoint(FRealPoint);
    try
      vCanvas.Pen := FPen;
      case FDestinationSnap of
        osInsert:       DrawInsertSnap;
        osCenter:       DrawCircle;
        osIntersection: DrawCrossSnap;
        osMiddle:       DrawMiddleSnap;
        osEndPt:        DrawBox;
        osNearest:      DrawNearestSnap;
        osNormal:       DrawNormalSnap;
        osQuadrant:     DrawQuadrant;
        osTangent:      DrawTangent;
      end;
    finally
      vCanvas.Pen := FPenStore;
    end;
  end;
end;

procedure TSnapMarker.Repaint;
begin
  FVisible := False;
  Draw;
end;

procedure TSnapMarker.SetBaseMatrixSnapType(const Value: TObjectSnapMode);
begin
  FBaseMatrixSnapType := Value;
end;

procedure TSnapMarker.SetIsTraced(const Value: Boolean);
begin
  FIsTraced := Value;
end;

procedure TSnapMarker.Snap(APoint: TFPoint; ASnap: TObjectSnapMode);
begin
  Draw; // Hide
  FPoint := FSnapControl.FImg.GetPoint(APoint);
  FRealPoint := APoint;
  FDestinationSnap := ASnap;
  Draw; // Show
  if FDestinationSnap = osDisabled then
    ClearPoint;
end;

{ TSnapControl }

procedure TSnapControl.SetSnapData(const Value: TSnapData);
begin
  FSnapData := Value;
end;

procedure TSnapControl.SetSnapMarker(const Value: TSnapMarker);
begin
  FSnapMarker := Value;
end;

procedure TSnapControl.SetSnapMask(Value: TObjectSnapState);
var
  M1, M2: TObjectSnapState;
  vRegen: Boolean;
begin
  M1 := FSnapMask - cnstMaskNotUseIterate;
  vRegen :=  Value * cnstExtensionSnapMask <>  FSnapMask * cnstExtensionSnapMask;
  FSnapMask := Value;
  if Assigned(FImg) then
  begin
    M2 := Value - cnstMaskNotUseIterate;
    if M1 = M2 then
      TsgCADImageAccess(FImg).ObjectSnapMask := FSnapMask
    else
      FImg.SetObjectSnapMask(FSnapMask);
  end;
  if vRegen then
    FTracers.Regen;
end;

procedure TSnapControl.SetTracers(const Value: TsgTracers);
begin
  FTracers := Value;
end;

procedure TSnapControl.Update;
begin
  FUpdating := True;
  try
    SetControl(FControl);
  finally
    FUpdating := False;
  end;
end;

procedure TSnapControl.SetEvents;
{$IFDEF SGVER_5_2_5}
var
  vEv: TNotifyEvent;
  {$ENDIF}
begin
  {$IFDEF SGVER_6_0_0}
  if FControl is TsgDrawingNavigator then
    TsgDrawingNavigator(FControl).AddClient(Self);
  {$ENDIF}
  {$IFDEF SGVER_5_2_5}
    if FControl is TsgImage then
    begin
      vEv := TsgImage(FControl).OnPaint;
      if not Assigned(FImageOnPaint) and (@FImageOnPaint <> @vEv) then
      begin
        FImageOnPaint := vEv;
        TsgImage(FControl).OnPaint := Repaint;
      end;
      vEv := TsgImage(FControl).OnScaling;
    end;
  {$ENDIF}
end;

procedure TSnapControl.SetForBiddenSnapPoint(const Value: TFPoint);
begin
  FForBiddenSnapPoint := Value;
end;

procedure TSnapControl.SetIsNewPointAdded(const Value: Boolean);
begin
  FIsNewPointAdded := Value;
end;

procedure TSnapControl.SetControl(AValue: TControl);
var
  Gr: TGraphic;
begin
  FControl := AValue;
  Gr := nil;
  {$IFDEF SGVER_6_0_0}
  if not (FControl is TsgDrawingNavigator) then
  begin
    if not FUpdating then
      EICError
  end
  else
    Gr := TsgDrawingNavigator(FControl).Picture.Graphic;
  {$ENDIF}
  {$IFDEF SGVER_5_2_5}
  if not (FControl is TsgImage) then
  begin
    if not FUpdating then
      EICError
  end
  else
    Gr := TsgImage(FControl).Picture.Graphic;
  {$ENDIF}
  if Gr is TsgDXFImage then
  begin
    FObjectSnap.SetsgDXFImage(TsgDXFImage(Gr));
    FImg := TsgDXFImage(Gr);
    FTracers.CADImage := FImg;
  end
  else
  begin
    FObjectSnap.SetsgDXFImage(nil);
    FImg := nil;
  end;

  // Clear save entity
  FSnappedEntity := nil;
  FSnappedEntityForTrace := nil;
  FSnappedEntityForTraceTwo := nil;

  SetEvents;
  if not (osDisabled in FSnapMask) then
    SetSnapMask(FSnapMask);
end;

function TSnapControl.GetCanvas: TCanvas;
begin
  Result := nil;
  {$IFDEF SGVER_6_0_0}
  if FControl is TsgDrawingNavigator then
    Result := TsgDrawingNavigator(FControl).Canvas;
  {$ENDIF}
  {$IFDEF SGVER_5_2_5}
  if FControl is TsgImage then
    Result := TsgImage(FControl).Canvas;
  {$ENDIF}
end;

function TSnapControl.GetControl: TControl;
begin
  Result := FControl;
end;

constructor TSnapControl.Create;
begin
  FInsert := nil;
  FIsNewPointAdded := True;
  FTracers := TsgTracers.Create(Self);
  FIsTimeForTrace := False;
  FObjectSnap := TsgObjectSnap.Create;
  FSnappedEntity := nil;
  FSnappedEntityForTrace := nil;
  FSnappedEntityForTraceTwo := nil;
  FSnapMarker := TSnapMarker.Create(Self);
  FSnapMarker.FDestinationSnap := osDisabled;
  FBasePoint := nil;
end;

destructor TSnapControl.Destroy;
begin
  FTracers.CADImage := nil;
  FTracers.Free;
  ResetEvents;
  FObjectSnap.Free;
  FSnapMarker.Free;
  inherited Destroy;
end;

procedure TSnapControl.Repaint;
begin
  FSnapMarker.Repaint;
end;

procedure TSnapControl.ResetEvents;
begin
  {$IFDEF SGVER_6_0_0}
  if FControl is TsgDrawingNavigator then
    TsgDrawingNavigator(FControl).RemoveClient(Self);
  {$ENDIF}
  {$IFDEF SGVER_5_2_5}
  if FImage is TsgImage then
  begin
    if Assigned(FImageOnPaint) then
      TsgImage(FImage).OnPaint := FImageOnPaint;
  end;
  {$ENDIF}
end;

function TSnapControl.GetMouseCoordUCS(X, Y: Integer; var PointInUCS: TFPoint): TSnapData;
var
  vObjectSnapMode: TObjectSnapMode;
  vPoint: TFPOint;
  vSnapState: TObjectSnapState;
  vEntitiesSnapData, vTracersSnapData: TSnapData;
  vSnappedEntity: TsgDXFEntity;
  vCount: Integer;
  vIsBaseMatrixUsed: Boolean;
begin
  vCount := FTracers.Count;
  vEntitiesSnapData := GetMouseCoordUCSInternal(X, Y, PointInUCS);
  if GetSelectionMatrix = nil then
  begin
    FSnappedEntityForTrace := nil;
    FSnappedEntityForTraceTwo := nil;
    FInsert := nil;
    FTracers.Clear;
    FTracers.FTracersMatrix.ClearFull;
  end;
  FSelectionMatrix := FTracers.TracersMatrix;
//  FTracers.TracersMatrix.Bitmap.SaveToFile('d:\1.bmp');
  vPoint := FSnapMarker.FRealPoint;
  vObjectSnapMode := FSnapMarker.FDestinationSnap;
  vSnapState := FSnapMask;
  FSnapMask := FSnapMask * [osDisabled, osIntersection, osNormal];
  FSnapMask := FSnapMask + [osNearest];
  vSnappedEntity := FSnappedEntity;
  try
    vTracersSnapData := GetMouseCoordUCSInternal(X, Y, PointInUCS);
  finally
    FSnappedEntity := vSnappedEntity;
    FSnapMarker.FDestinationSnap := vObjectSnapMode;
    FSnapMarker.FRealPoint :=  vPoint;
    FSelectionMatrix := nil;
    FSnapMask := vSnapState;
  end;
  vIsBaseMatrixUsed := (vEntitiesSnapData.SnapType <> osDisabled) or (vCount <> FTracers.Count) or
    ((vTracersSnapData.SnapType = osNearest) and not (vTracersSnapData.Entity is TsgDXFLineTrace));
  // if point is on Tracer then just use base matrix to make the drawing more accurate
  if not vIsBaseMatrixUsed and (FTracers.IndexOf(vTracersSnapData.CADPointInUCS) <> -1) then
  begin
    vTracersSnapData.EntityIntersected := nil;
    vTracersSnapData.SnapType := osDisabled;
  end;
  if  vIsBaseMatrixUsed then
    Result := vEntitiesSnapData
  else
  begin
    Result := vTracersSnapData;
    if Result.SnapType in [osNearest, osMiddle] then
      Result.SnapType := osDisabled; // do not show nearest snap for tracers as a default one
    FSnappedEntity := TsgDXFEntity(Result.Entity);
  end;
  FSnapMarker.Snap(Result.CADPointInUCS, Result.SnapType);
  if vIsBaseMatrixUsed then
    FSnapMarker.FBaseMatrixSnapType := FSnapMarker.FDestinationSnap;
  FSnapData := Result;
  PointInUCS := Result.CADPointInUCS;
  FSnappedEntity := TsgDXFEntity(Result.Entity);
end;

function TSnapControl.GetMouseCoordUCSInternal(X, Y: Integer; var PointInUCS: TFPoint): TSnapData;
var
  vPt, vPt1, vPt2: TFPoint;
  vFindedSnap, vExcludeSnap, vFindedSnapByMatrix: TObjectSnapState;
  vP, vP1: TPoint;
  vBox: TFRect;
  vMatrix: TsgSelectionMatrix;
  vSnappedEntity: TsgDXFEntity;
  vSearchPrecision, vSnapDistance: Integer;
  vCadSnapDistance: Double;
  vFitrstSnapMode: TObjectSnapMode;


  function GetUCSPoint(const APoint: TFPoint): TFPoint;
  begin
    Result := APoint;
    if FImg <> nil then
      TsgCADImageAccess(FImg).TransformToUCS(Result);
  end;

  function GetFPoint(const AX, AY: Integer): TFPoint;
  begin
    Result := cnstFPointZero;
    {$IFDEF SGVER_6_0_0}
    if FControl is TsgDrawingNavigator then
      Result := TsgDrawingNavigator(FControl).GetRealPoint(AX, AY, PointInUCS);
    {$ENDIF}
    {$IFDEF SGVER_5_2_5}
      if vImage is TsgImage then
        Result := GetRealPointUsingsgImagePoint(TsgImage(vImage), AX, AY, PointInUCS);
    {$ENDIF}
  end;

  procedure SetNonSnappedResults;
  begin
    vPt := GetFPoint(X, Y);
    PointInUCS := GetUCSPoint(vPt);
    vSnappedEntity := nil;
  end;


  procedure DoSnap;
  begin
   vFitrstSnapMode := osInsert;
    if vFindedSnap <> [] then
      repeat
        vFitrstSnapMode := Succ(vFitrstSnapMode);
      until vFitrstSnapMode in vFindedSnap
    else
      vFitrstSnapMode := osDisabled;
  end;

  procedure DoTracers;
  var
    vIsActive: Boolean;
    vPoint: TFPoint;
    vIndexOf: Integer;
  begin
    if FSnapMask * cnstExtensionSnapMask = [] then
      Exit;
    vPoint := FSnapMarker.FRealPoint; // point BEFORE current!!
    vIndexOf := FTracers.IndexOf(vPoint);
    vIsActive :=  bAutoCapturePoint or FTracers.IsShiftPressed;
    if FSnapMarker.FBaseMatrixSnapType in cnstFirstSnapMask then
      FTracers.IsShiftClicked := False;
    vIsActive := vIsActive and (not (FSnapMarker.FBaseMatrixSnapType in
     cnstFirstSnapMask)) and (vFitrstSnapMode in cnstFirstSnapMask);
    if vIsActive then
    begin
      vIsActive := not IsEqualFPoints(FForBiddenSnapPoint, FSnapMarker.FRealPoint);
      vIsActive := vIsActive and not IsEqualFPoints(FSnapMarker.FRealPoint, BadPoint);
      FForBiddenSnapPoint := BadPoint;
      FTracers.IsShiftClicked := False;
    end;
    if vIsActive then
      FIsTimeForTrace := (GetTickCount - FTime) > 300;
    if (FSnapMarker.FBaseMatrixSnapType in cnstFirstSnapMask) then
      FTime := GetTickCount;
    if vIsActive and (vIndexOf <> -1) then
    begin //delete tracer
      FTracers.Remove(vPoint);
      Exit;
    end;
    if FIsNewPointAdded then
    begin
      FIsNewPointAdded  := False;
      Exit;
    end;
    if vIsActive and FIsTimeForTrace then // create tracer
    begin
      if (vIndexOf = -1) and (FSnappedEntityForTrace <> nil) and
        not (FSnappedEntityForTrace is TsgDXFLineTrace) then
        FTracers.Add(vPoint, Self, FSnappedEntityForTrace, FSnappedEntityForTraceTwo);
    end;
  end;

  procedure CrossSnap;
  var
    I, J, Cnt: Integer;
    vList: TsgList;
    vEnt1, vEnt2: Pointer;
  begin
    vList := TsgList.Create;
    try
      vList.Sorted := True;
      vList.Duplicates := dupIgnore;
      vMatrix.GetElements(X, Y, vList, vList.Duplicates = dupIgnore);
      if vList.Count > 0 then
      begin
        I := 0;
        Cnt := vList.Count;
        while (I < Cnt)  and not Assigned(vSnappedEntity) do
        begin
          vEnt1 := vList[I];
          if IsEntity(vEnt1) then
          begin
            J := I;
            while (J < Cnt)  and not Assigned(vSnappedEntity)  do
            begin
                vEnt2 := vList[J];
                if IsEntity(vEnt2) then
                begin
                  vFindedSnap := GetPointByCrossEntity(vEnt1, vEnt2, vBox, vPt);
                  if vFindedSnap <> [] then
                  begin
                    PointInUCS := GetUCSPoint(vPt);
                    vSnappedEntity := vEnt1;
                    if Result.EntityIntersected = nil then
                      Result.EntityIntersected := vEnt2;
                  end;
                end
                else
                  vList[J] := nil;
              Inc(J);
            end;
          end;
          Inc(I);
        end;
      end;
    finally
      vList.Free;
    end;
  end;

  procedure EdgeSnap(ASnapActive: TObjectSnapState);
  var
    vSearchMode: TsgSearchMode;
    vEnt: Pointer;
  begin
    vSearchMode := vMatrix.SearchMode;
    try
      vMatrix.SearchMode := smSnail;
      vEnt := vMatrix.Matrix[X, Y];
      if IsEntity(vEnt) then
      begin
        vP := vMatrix.PointByEntity;
        vPt1 := GetFPoint(vP.X, vP.Y);
        if cnstTangentSnapMask * ASnapActive <> [] then
        begin
          vFindedSnap := GetPointByTargetEntity(vEnt, BasePoint, vPt1, vBox,
            vCadSnapDistance, vPt);
          if osTangent in vFindedSnap then
            ASnapActive := [];
        end;
        if cnstEdgeSnapMask * ASnapActive <> [] then
          vFindedSnap := GetPointByEdgeEntity(vEnt, BasePoint, vPt1, vBox,
            ASnapActive, vPt);
        if vFindedSnap <> [] then
          vSnappedEntity := vEnt;
      end
      else
        SetNonSnappedResults;
    finally
      vMatrix.SearchMode := vSearchMode;
    end;
  end;

  function IsValidDrawingBySnap: Boolean;
  begin
    Result := (vMatrix <> nil) and (FImg.CurrentLayout <> nil) and (not Is3DRect(FImg.CurrentLayout.Box));
  end;

begin
  ZeroMemory(@Result, SizeOf(Result));
  vSnappedEntity := nil;
  vMatrix := GetSelectionMatrix;
  vExcludeSnap := [];
  vFindedSnap := [];
  {$IFDEF SGVER_5_2_5}
  if FControl.Left < 0 then
    X := X + FControl.Left;
  if FControl.Top < 0 then
    Y := Y + FControl.Top;
  {$ENDIF}
  if (FSnapMask <> []) and not (osDisabled in FSnapMask) then
  begin
    if FObjectSnap <> nil then
      vSnapDistance := FObjectSnap.SnapDistance
    else
      vSnapDistance := cnstSnapDistance;
    vCadSnapDistance := DistanceFPoint(GetFPoint(0, 0),
       GetFPoint(vSnapDistance, 0));

    vPt2 := MakeFPoint(MaxTsgFloat, MaxTsgFloat, MaxTsgFloat);
    PointInUCS := cnstFPointZero;
    if cnstObjectSnapMask * FSnapMask <> []  then
    begin
      vP1 := Point(X, Y);
      Result := FObjectSnap.GetSnapPointUCS(vP1, vFindedSnap, vSnappedEntity, PointInUCS);
      vPt2 := Result.CADPointInUCS;
      if vFindedSnap <> [] then
      begin
        vP := FImg.GetPoint(vPt2);
        if DistancePoint(vP, vP1) > cnstSearchSnapPrecision  then
        begin
          vFindedSnap := [];
          vSnappedEntity := nil;
        end;
      end;
    end;

    vFindedSnap := vFindedSnap * FSnapMask;
    vFindedSnapByMatrix := (cnstEdgeSnapMask + cnstTangentSnapMask +
       cnstIntersectionSnapMask) * FSnapMask;

    if (vFindedSnap = []) and (vFindedSnapByMatrix <> []) then
    begin
      if IsValidDrawingBySnap then
      begin
        vSearchPrecision := vMatrix.Precision;
        try
          vMatrix.Precision := vSnapDistance;
          vBox := cnstBadRect;
          ExpandFRect(vBox, GetFPoint(X + cnstSearchSnapPrecision, Y + cnstSearchSnapPrecision));
          ExpandFRect(vBox, GetFPoint(X + cnstSearchSnapPrecision, Y - cnstSearchSnapPrecision));
          ExpandFRect(vBox, GetFPoint(X - cnstSearchSnapPrecision, Y - cnstSearchSnapPrecision));
          ExpandFRect(vBox, GetFPoint(X - cnstSearchSnapPrecision, Y + cnstSearchSnapPrecision));
          if osIntersection in FSnapMask then
            CrossSnap;
          if not (osIntersection in vFindedSnap) then
            EdgeSnap(vFindedSnapByMatrix);
        finally
          vMatrix.Precision := vSearchPrecision;
        end;
      end
      else
        SetNonSnappedResults;
    end
    else
    begin
      if vFindedSnap = []  then
        SetNonSnappedResults
      else
      begin
        vPt := vPt2;
        PointInUCS := GetUCSPoint(vPt);
      end;
    end;
    vFindedSnap := vFindedSnap * FSnapMask;
  end
  else
  begin
    SetNonSnappedResults;
    vFindedSnap := [];
  end;
  if vFindedSnap = [] then
    SetNonSnappedResults;
  Result.CADPointInUCS := vPt;
  FSnappedEntity := vSnappedEntity;
  Result.Entity := vSnappedEntity;
  DoSnap;
  if IsValidDrawingBySnap and (FSelectionMatrix = nil) then
  begin
    DoTracers;
    if vSnappedEntity <> nil then
    begin
      FSnappedEntityForTrace := vSnappedEntity;
      FSnappedEntityForTraceTwo := TsgDXFEntity(Result.EntityIntersected);
      FInsert := Result.Insert;
    end
    else
      FSnappedEntityForTraceTwo := nil;
  end;
  Result.SnapType := vFitrstSnapMode;
end;

function TSnapControl.GetMouseCoordUCSTracers(AMatrix: TsgSelectionMatrix; X,
  Y: Integer; var PointInUCS: TFPoint): TSnapData;
var
  vObjectSnapMode: TObjectSnapMode;
  vPoint: TFPOint;
  vSnapState: TObjectSnapState;
begin
  FSelectionMatrix := AMatrix;
  vPoint := FSnapMarker.FRealPoint;
  vObjectSnapMode := FSnapMarker.FDestinationSnap;
  vSnapState := FSnapMask;
  FSnapMask := FSnapMask * [osIntersection, osNormal];
  Include(FSnapMask, osNearest);
  try
    Result.Entity := nil;
    Result.EntityIntersected := nil;
    Result := GetMouseCoordUCS(X, Y, PointInUCS);
  finally
    FSnapMarker.FDestinationSnap := vObjectSnapMode;
    FSnapMarker.FRealPoint :=  vPoint;
    FSelectionMatrix := nil;
    FSnapMask := vSnapState;
  end;
end;

function TSnapControl.GetSelectionMatrix: TsgSelectionMatrix;
begin
  if FSelectionMatrix = nil then
    Result :=  TsgCADImageAccess(FImg).SelectionMatrix
  else // for tracers
   Result := FSelectionMatrix;
end;

function TSnapControl.GetMouseCoord(X, Y: Integer): TFPoint;
var
  Temp: TFPoint;
begin
  Result := GetMouseCoordUCS(X, Y, Temp).CADPointInUCS;
end;

procedure TSnapControl.Dispatch(var Message);
var
  P: TPoint;
begin
  inherited Dispatch(Message);
  case TMessage(Message).Msg of
    WM_PAINT: Repaint;
    WM_SCALECHANGING, WM_PICTUREMOVE:
      if Assigned(FImg) and GetCursorPos(P) then
      begin
        P := FControl.ScreenToClient(P);
        GetMouseCoord(P.X, P.Y);
      end;
  end;
end;

{$IFNDEF sgDXFONLY}
function GetAreaHPGL(AList: TList; AHPGLImage: TsgHPGLImage): Double;
var
  I, Cnt: Integer;
  vList: TList;
  vPPt: PFPoint;
begin
  Result := 0.0;
  if (AHPGLImage = nil) or not(AHPGLImage is TsgHPGLImage) then Exit;
  Cnt := AList.Count;
  if Cnt < 3 then Exit;
  vList := TList.Create;
  try
    for I := 0 to Cnt - 1 do
    begin
      New(vPPt);
      vPPt^ := AHPGLImage.ConvertHPGLStepsToMM{ConvertMMToHPGLSteps}(PFPoint(AList.Items[I])^);
      vList.Add(vPPt) ;
    end;
    Result := GetArea(vList);
  finally
    ClearRecordList(vList);
    vList.Free;
  end;
end;
{$ENDIF}

function GetArea(AList: TList): Double;
var
  I, Cnt, J: Integer;
  Pt: array [0 .. 1] of PFPoint;
begin
  Result := 0.0;
  Cnt := AList.Count;
  if Cnt >= 3 then
  begin
    Dec(Cnt);
    J := 0;
    Pt[J] := PFPoint(AList.Items[Cnt]);
    for I := 0 to Cnt do
    begin
      J := J xor 1;
      Pt[J] := PFPoint(AList.Items[I]);
      Result := Result + (Pt[J]^.X + Pt[J xor 1]^.X) * (Pt[J]^.Y - Pt[J xor 1]^.Y);
    end;
    Result := Abs(Result) * 0.5;
  end;
end;

function GetArea(AList: TFPointList): Double;
var
  I, Cnt, J: Integer;
  Pt: array [0 .. 1] of TFPoint;
begin
  Result := 0.0;
  Cnt := AList.Count;
  if Cnt >= 3 then
  begin
    Dec(Cnt);
    J := 0;
    Pt[J] := AList[Cnt];
    for I := 0 to Cnt do
    begin
      J := J xor 1;
      Pt[J] := AList[I];
      Result := Result + (Pt[J].X + Pt[J xor 1].X) * (Pt[J].Y - Pt[J xor 1].Y);
    end;
    Result := Abs(Result) * 0.5;
  end;
end;

function GetDistanceUnits(ADXFImage: TsgDXFImage; ALayout: TsgDXFLayout;
         var UnitsUserName: string; var UnitsUserFactor: Double;
         var AltUnitsUserName: string; var AltUnitsUserFactor: Double): TsgDistanceUnits;
var
  R: Double;
begin
  Result := duNone;
  UnitsUserFactor := 1;
  AltUnitsUserFactor := -1;
  if (ADXFImage = nil) or (ALayout = nil) then Exit;
  if ALayout.IsModel then
  begin
    Result := ADXFImage.Measurement.DistanceUnits;
    UnitsUserName := ADXFImage.Converter.HeadVarStruct.DimProps.Post;
    UnitsUserFactor := ADXFImage.Converter.HeadVarStruct.DimProps.LFac;
    if ADXFImage.Converter.HeadVarStruct.DimProps.Alt then
    begin
      AltUnitsUserName := ADXFImage.Converter.HeadVarStruct.DimProps.APost;
      AltUnitsUserFactor := ADXFImage.Converter.HeadVarStruct.DimProps.AltF;
    end
    else
    begin
      AltUnitsUserName := '';
      AltUnitsUserFactor := 1; {-1;}
    end;
  end
  else //if layout
  begin
    if ALayout.PlotSettings.PlotPaperUnits = ppuPixels then
    begin
      Result := duMM;
      UnitsUserName := SMM;
    end
    else
    begin
      Result := duInch;
      UnitsUserName := SInch;
    end;
    R := ALayout.PlotSettings.DenominatorOfCustomPrintScale;
    if Abs(R) < fAccuracy then
      R := 1;
    UnitsUserFactor := 1 / R;
  end;
end;

procedure GetDrawingSize(AGraphic: TsgCADImage; ALayout: TsgDXFLayout;
  var Width, Height: TsgFloat; var Units: CADImage.TsgDistanceUnits);
var
  vUserName, vAltUserName: string;
  vUserFac, vAltUserFac: Double;
  //vDistUnitsSys: TDistanceUnits;
  vWidth, vHeight: Double;
  vRect: TFRect;
  vDPIX, vDPIY: Integer;
  vDC: HDC;
begin
  Units := GetDistanceUnits(TsgCADImage(AGraphic),
        TsgCADImage(AGraphic).CurrentLayout, vUserName, vUserFac,
        vAltUserName, vAltUserFac);
  vRect := TsgCADImage(AGraphic).Extents;
//  if not(AGraphic is TsgHPGLImage) then
//  begin
  vWidth := vRect.Right - vRect.Left;
  vHeight := vRect.Top - vRect.Bottom;
  if (AGraphic.Measurement.DistanceUnits = duNone) and (AGraphic.Measurement.AngularUnits = auNone) then
  begin
    vDC := GetDc(0);
    try
      vDPIX := GetDeviceCaps(vDC, LOGPIXELSX);
      vDPIY := GetDeviceCaps(vDC, LOGPIXELSY);
      vWidth := vWidth / vDPIX;
      vHeight := vHeight / vDPIY;
    finally
      ReleaseDC(0, vDc);
    end;
  end;
  vUserFac := ALayout.PlotSettings.DenominatorOfCustomPrintScale;
  if (AGraphic.CurrentLayout.IsModel)or(Abs(vUserFac - 0) < fAccuracy) then
  begin
    Width := vWidth;
    Height := vHeight;
  end
  else
  begin
    Width := vWidth / vUserFac;
    Height := vHeight / vUserFac;
  end;
//  end
//  else
//  begin
//    {vLeftTop := TsgHPGLImage(AGraphic).ConvertHPGLStepsToMM(vRect.TopLeft);
//    vRightBottom := TsgHPGLImage(AGraphic).ConvertHPGLStepsToMM(vRect.BottomRight);
//    Width := vRightBottom.X - vLeftTop.X;
//    Height := vLeftTop.Y - vRightBottom.Y;}
//    Width := TsgHPGLImage(AGraphic).MMWidth / 100;
//    HEight := TsgHPGLImage(AGraphic).MMHeight / 100;
//  end;
end;

function GetRealPointUsingsgImagePoint(AImage: TImage; X, Y: Integer; var PtInUCS: TFPoint): TFPoint;
var
  vRect: TRect;
  vXScaled, vYScaled: Extended;
begin
    {$IFDEF SGVER_5_2_5}
    if AImage is TsgImage then
      vRect := TsgImage(AImage).PictureRect
    else
    {$ENDIF}
      vRect := AImage.BoundsRect;
    if (not (AImage.Picture.Graphic is TsgDXFImage)) or
       (vRect.Right - vRect.Left = 0) or (vRect.Bottom - vRect.Top = 0) then
    begin
      Result := MakeFPoint(0, 0, 0);
      PtInUCS := Result;
      Exit;
    end;
    if ((vRect.Right - vRect.Left) <= AImage.Width) or ((vRect.Bottom - vRect.Top) <= AImage.Height) then
    begin
      vXScaled := X / (vRect.Right - vRect.Left);
      vYScaled := (AImage.Height - Y) / (vRect.Bottom - vRect.Top);
      Result := TsgDXFImage(AImage.Picture.Graphic).GetCADCoords(vXScaled, vYScaled, PtInUCS);
    end
    else
    begin
      vXScaled := (-(vRect.Left  - AImage.Left) + X) / (vRect.Right - vRect.Left);
      vYScaled := 1 - (Y - (vRect.Top - AImage.Top)) / (vRect.Bottom - vRect.Top);
      Result := TsgDXFImage(AImage.Picture.Graphic).GetCADCoords(vXScaled, vYScaled, PtInUCS);
    end;
end;

function ReloadInserts(const ABlock: TsgDXFBlock; const AConv: TsgDXFConverter;
  AEnt: TsgDXFEntity): Boolean;
var
  I: Integer;
  vBlock: TsgDXFBlock;
begin
  Result := False;
  if not (Assigned(AConv) and Assigned(ABlock) and Assigned(AEnt)) then
    Exit;
  if AEnt is TsgDXFLayout then
  begin
    if ReloadInserts(ABlock, AConv,  TsgDXFLayout(AEnt).PaperSpaceBlock) then
      Result := True;
  end
  else
  begin
    if AEnt is TsgDXFBlock then
    begin
      vBlock := TsgDXFBlock(AEnt);
      for I := 0 to vBlock.Count - 1 do
        if ReloadInserts(ABlock, AConv, vBlock.Entities[I]) then
        begin
          vBlock.IsLoaded := False;
          Result := True;
        end;
    end
    else
    begin
      if AEnt is TsgDXFInsert then
      begin
        if TsgDXFInsert(AEnt).Block = ABlock then
          Result := True
        else
          if ReloadInserts(ABlock, AConv, TsgDXFInsert(AEnt).Block) then
            Result := True;
      end;
    end;
  end;
  if Result then
    AConv.Loads(AEnt);
end;


{ TsgControlTool }

constructor TsgControlTool.Create(AControl: TControl);
begin
  inherited Create;
  FInvertDrawMatrix := cnstIdentityMat;
  FControl := AControl;
end;

destructor TsgControlTool.Destroy;
begin
  FControl := nil;
  inherited Destroy;
end;

function TsgControlTool.GetActualGraphic: TGraphic;
var
  vNav: TDNavigator;
  R: TRect;
  vVewBox: TFRect;
begin
  vNav := TDNavigator(FControl);
  if vNav.ViewRectMode then
  begin
    R := vNav.ViewRect;
    vVewBox.TopLeft := PointToPosition(Point(R.Left, R.Top));
    vVewBox.BottomRight := vVewBox.TopLeft;
    ExpandFRect(vVewBox, PointToPosition(Point(R.Right, R.Bottom)));
  end
  else
  begin
    R := vNav.Rectangle.Rect;
    vVewBox := vNav.Rectangle.Box;
  end;
  Result := sgTools.GetActualGraphic(vNav.Picture.Graphic, vNav.PictureRect, R,
    vNav.IsClipRectActive or vNav.ViewRectMode, @vVewBox);
end;

function TsgControlTool.GetDrawMatrix: TFMatrix;
begin
  Result := cnstIdentityMat;
  if Assigned(FImg) then
    Result := TsgCADImageAccess(FImg).FDraw.Matrix
end;

function TsgControlTool.GetPictureRect2D: TF2DRect;
begin
  Result := MakeF2DRect(FPictureRect.Left, FPictureRect.Bottom,
    FPictureRect.Right, FPictureRect.Top);
end;

function TsgControlTool.GetFPictureRect: TFRect;
begin
  Result := FPictureRect;
end;

function TsgControlTool.GetImg: TsgCADImage;
begin
  Result := FImg;
end;

function TsgControlTool.GetInvertDrawMatrix: TFMatrix;
begin
  Result := FInvertDrawMatrix;
end;

function TsgControlTool.GetIsNotCustomDraw: Boolean;
begin
  Result := Assigned(FImg) and not FImg.CustomDraw;
end;

function TsgControlTool.GetRealImageMatrix: TFMatrix;
begin
  Result := cnstIdentityMat;
  if Assigned(FImg) then
    Result := TsgCADImageAccess(FImg).GetRealImageMatrix;
end;

function TsgControlTool.Point2DToPosition(const APoint: TF2DPoint): TFPoint;
begin
  Result := MakeFPoint(APoint.X, APoint.Y, 0.5 * (FPictureRect.Z2 - FPictureRect.Z1));
  Result := FPointXMat(Result, FInvertDrawMatrix);
end;

function TsgControlTool.PointToPosition(const APoint: TPoint): TFPoint;
begin
  Result := Point2DToPosition(MakeF2DPoint(APoint.X, APoint.Y));
end;

procedure TsgControlTool.MatrixChanged(Sender: TObject);
begin
  FInvertDrawMatrix := FImg.DrawMatrix;
  FPictureRect := FImg.CurrentLayout.Box;
  TransRectCorners(FPictureRect, FInvertDrawMatrix);
  InvertMatrix(FInvertDrawMatrix);
end;

procedure TsgControlTool.MovePositionToPoint(const APosition: TFPoint;
  const APoint: TPoint);
var
  vPos: TFPoint;
begin
  vPos := FPointXMat(APosition, Img.DrawMatrix);
  FImg.TranslateDrawMatrix(APoint.X - vPos.X, APoint.Y - vPos.Y,
    0.5 * (FPictureRect.Z2 - FPictureRect.Z1) - vPos.Z);
end;

procedure TsgControlTool.ResetRotCenter(const ACenter: TPoint);
begin
  if IsNotCustomDraw then
    if not TDNavigator(FControl).OrbitAutoTarget then
      Img.Offset := PointToPosition(ACenter)
    else
      Img.Offset := Img.Center;
end;

procedure TsgControlTool.SetDrawMatrix(const AMatrix: TFMatrix);
begin
  FImg.SetDrawMatrix(AMatrix);
end;

procedure TsgControlTool.Update;
begin
  UpdateImg;
end;

function TsgControlTool.UpdateImg: Boolean;
begin
  if TDNavigator(FControl).Picture.Graphic is TsgCADImage then
  begin
    FImg := TsgCADImage(TDNavigator(FControl).Picture.Graphic);
    TsgCADImageAccess(FImg).FCanvas := TDNavigator(FControl).Canvas;
    TsgCADImageAccess(FImg).OnMatrixChanged := MatrixChanged;
    MatrixChanged(Self);
  end
  else
    FImg := nil;
  Result := Assigned(FImg);
end;

procedure TsgControlTool.ApplyScale(const ARect: TRect);
begin
  if Assigned(FImg) then
    TsgCADImageAccess(FImg).ApplyScale(ARect);
end;

procedure TsgControlTool.ApplyScale(const ARect: TF2DRect);
begin
  if UpdateImg then
    TsgCADImageAccess(FImg).ApplyScale(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;

procedure TsgControlTool.CoordinateParameters(var AName: string;
  var AFactor: Double);
var
  vName, vAltName: string;
  vFactor, vAltFactor: Double;
  vSystem: TsgDistanceUnits;
begin
  vFactor := 1;
  vName := '';
  if Assigned(FImg) then
  begin
    vSystem := GetDistanceUnits(FImg, FImg.CurrentLayout, vName, vFactor, vAltName, vAltFactor);
    case TDNavigator(FControl).LinearDimensionsMode of
      umDrawing:
        begin
          case vSystem of
            duInch: vName := SInch;
            duMM: vName := SMM;
          else
            vName := '';
          end;
          if (not FImg.CurrentLayout.IsModel)and(Abs(vFactor - 1) > fAccuracy) then
            vName := '';
          vFactor := 1;
        end; { case vSystem }
      umAltUser:
        begin
          vName := vAltName;
          vFactor := vFactor * vAltFactor;
        end;
    end; { case LinearDimensionsMode }
  end;
  if TDNavigator(FControl).LinearDimensionsScale <> 1 then
    vFactor := vFactor * TDNavigator(FControl).LinearDimensionsScale;
  AName := vName;
  AFactor := vFactor;
end;

function TsgControlTool.ConvertUnits(Pt: TFPoint): TFPoint;
begin
  if Assigned(FImg) then
    Result := FImg.InternalToCommonUnits(Pt)
  else Result := Pt;
end;

{ TsgSysMenuIcons }

procedure TsgSysMenuIcons.SetButtonImage(var AImage: TGraphic; const AValue: TGraphic);
begin
  AImage.Free;
  if Assigned(AValue) then
  begin
    AImage := TGraphic(AValue.ClassType.Create);
    AImage.Assign(AValue);
  end
  else
    AImage := nil;
end;

procedure TsgSysMenuIcons.SetColor(const AValue: TColor);
begin
  if FColor <> AValue then
  begin
    FColor := AValue;
    Invalidate;
  end;
end;

procedure TsgSysMenuIcons.SetHeight(const AValue: Integer);
begin
  if FHeight <> AValue then
  begin
    FHeight := AValue;
    Invalidate;
  end;
end;

procedure TsgSysMenuIcons.SetHintClose(const AValue: string);
begin
  FHintClose := AValue;
end;

procedure TsgSysMenuIcons.SetHintMinimize(const AValue: string);
begin
  FHintMinimize := AValue;
end;

procedure TsgSysMenuIcons.SetHintRestoreDown(const AValue: string);
begin
  FHintRestoreDown := AValue;
end;

procedure TsgSysMenuIcons.SetHints(Index: TsgSysMenuIcon; const AValue: string);
begin
  case Index of
    smiMinimize: HintMinimize := AValue;
    smiRestore: HintRestoreDown := AValue;
    smiClose: HintClose := AValue;
  end;
end;

procedure TsgSysMenuIcons.SetImage(Index: TsgSysMenuIcon;
  const AValue: TGraphic);
begin
  case Index of
    smiMinimize: ImageMinimaze := AValue;
    smiRestore: ImageRestoreDown := AValue;
    smiClose: ImageClose := AValue;
  end;
end;

procedure TsgSysMenuIcons.SetImageClose(const Value: TGraphic);
begin
  SetButtonImage(FImageClose, Value);
end;

procedure TsgSysMenuIcons.SetImageMinimaze(const Value: TGraphic);
begin
  SetButtonImage(FImageMinimaze, Value);
end;

procedure TsgSysMenuIcons.SetImageRestoreDown(const Value: TGraphic);
begin
  SetButtonImage(FImageRestoreDown, Value);
end;

procedure TsgSysMenuIcons.SetInvertColor(const AValue: Boolean);
begin
  if FInvertColor <> AValue then
  begin
    FInvertColor := AValue;
    Invalidate;
  end;
end;

procedure TsgSysMenuIcons.SetWidth(const AValue: Integer);
begin
  if FWidth <> AValue then
  begin
    FWidth := AValue;
    Invalidate;
  end;
end;

function TsgSysMenuIcons.DoMouseDown(var Message: TWMMouse): Boolean;
begin
  Result := DoMouseMove(Message);
  if Result then
    FDown := True;
end;

function TsgSysMenuIcons.DoMouseMove(var Message: TWMMouse): Boolean;
{$IFDEF CS_USEFORM}
var
  vForm: TCustomForm;
  vIcon: TsgSysMenuIcon;
{$ENDIF}
begin
  Result := False;
{$IFDEF CS_USEFORM}
  vIcon := Pred(smiMinimize);
  vForm := GetParentForm(FControl{$IFDEF SGDEL_2005}, False{$ENDIF});
  if Assigned(vForm) and (vForm.WindowState = wsMaximized) then
  begin
    vIcon := GetIconFromPoint(Point(Message.XPos, Message.YPos));
    if vIcon in [smiMinimize .. smiClose] then
    begin
      if FControl.Cursor <> crDefault then
      begin
        FCursor := FControl.Cursor;
        FCursorNeedStore := False;
        try
          FControl.Cursor := crDefault;
        finally
          FCursorNeedStore := True;
        end;
      end;
      Result := True;
    end
    else
      FControl.Cursor := FCursor;
  end;
  if FControl.Hint <> Hints[vIcon] then
    Application.CancelHint;
  FControl.Hint := Hints[vIcon];
{$ENDIF}
end;

function TsgSysMenuIcons.DoMouseUp(var Message: TWMMouse): Boolean;
{$IFDEF CS_USEFORM}
var
  vForm: TCustomForm;
{$ENDIF}
begin
  Result := False;
  if FDown then
  begin
    FDown := False;
{$IFDEF CS_USEFORM}
    vForm := GetParentForm(FControl{$IFDEF SGDEL_2005}, False{$ENDIF});
    if Assigned(vForm) and (vForm.WindowState = wsMaximized) then
    begin
      Result := True;
      case GetIconFromPoint(Point(Message.XPos, Message.YPos)) of
        smiMinimize: vForm.WindowState := wsMinimized;
        smiRestore: vForm.WindowState := wsNormal;
        smiClose: vForm.Close;
      else
        Result := False;
      end;
    end;
{$ENDIF}
  end;
end;

procedure TsgSysMenuIcons.Paint;
{$IFDEF CS_USEFORM}
var
  vRect: TRect;
  vForm: TCustomForm;
  vCanvas: TCanvas;
  vColor, vCtrlColor: TColor;

  procedure RectToSquare(var ARect: TRect);
  var
    vRectSize: Integer;
    vW, vH: Integer;
  begin
    vW := ARect.Right - ARect.Left;
    vH := ARect.Bottom - ARect.Top;
    vRectSize := Min(vW, vH);
    InflateRect(ARect, -((vW - vRectSize) div 2), -((vH - vRectSize) div 2));
  end;
{$ENDIF}
begin
{$IFDEF CS_USEFORM}
  vForm := GetParentForm(FControl{$IFDEF SGDEL_2005}, False{$ENDIF});
  if Assigned(vForm) and (vForm.WindowState = wsMaximized) then
  begin
    vCanvas := TControlCanvas.Create;
    try
      if FInvertColor then
      begin
        vCtrlColor := ColorToRGB(TControlAccess(FControl).Color);
        vColor := not vCtrlColor and $FFFFFF;
        if Sqrt(Sqr(128 - vColor and $FF) +
           Sqr(128 - (vColor shr 8) and $FF) +
           Sqr(128 - (vColor shr 16) and $FF)) < 32 then
          vColor := clBlack;
      end
      else
        vColor := FColor;
      TControlCanvas(vCanvas).Control := FControl;
      vCanvas.Pen.Width := 2;
      vCanvas.Pen.Color := vColor;
      vRect := GetSysMenuIconRect(smiClose);
      if Assigned(FImageClose) then
        vCanvas.Draw(vRect.Left, vRect.Bottom - FImageClose.Height, FImageClose)
      else
      begin
        RectToSquare(vRect);
        InflateRect(vRect, -2, -2);
        OffsetRect(vRect, 0, 1);
        vCanvas.MoveTo(vRect.Left, vRect.Top);
        vCanvas.LineTo(vRect.Right, vRect.Bottom);
        vCanvas.MoveTo(vRect.Right, vRect.Top);
        vCanvas.LineTo(vRect.Left, vRect.Bottom);
      end;
      vRect := GetSysMenuIconRect(smiRestore);
      if Assigned(FImageRestoreDown) then
        vCanvas.Draw(vRect.Left, vRect.Bottom - FImageRestoreDown.Height, FImageRestoreDown)
      else
      begin
        vCanvas.Brush.Style := bsClear;
        vCanvas.Pen.Width := 1;
        RectToSquare(vRect);
        InflateRect(vRect, -2, -3);
        OffsetRect(vRect, 0, -1);
        vCanvas.MoveTo(vRect.Left, vRect.Top);
        vCanvas.LineTo(vRect.Right, vRect.Top);
        vCanvas.LineTo(vRect.Right, vRect.Bottom);
        vCanvas.LineTo(vRect.Right - 2, vRect.Bottom);
        vCanvas.MoveTo(vRect.Right, vRect.Top + 1);
        vCanvas.LineTo(vRect.Left, vRect.Top + 1);
        vCanvas.LineTo(vRect.Left, vRect.Top + 3);
        OffsetRect(vRect, -2, 3);
        vCanvas.MoveTo(vRect.Left, vRect.Top);
        vCanvas.LineTo(vRect.Right, vRect.Top);
        vCanvas.LineTo(vRect.Right, vRect.Bottom);
        vCanvas.LineTo(vRect.Left, vRect.Bottom);
        vCanvas.LineTo(vRect.Left, vRect.Top);
        vCanvas.MoveTo(vRect.Left, vRect.Top + 1);
        vCanvas.LineTo(vRect.Right, vRect.Top + 1);
      end;

      vCanvas.Pen.Width := 2;
      vRect := GetSysMenuIconRect(smiMinimize);

      if Assigned(FImageMinimaze) then
        vCanvas.Draw(vRect.Left, vRect.Bottom - FImageMinimaze.Height + 1, FImageMinimaze)
      else
      begin
        RectToSquare(vRect);
        InflateRect(vRect, -2, 0);
        OffsetRect(vRect, -2, 0);
        vRect.Top := vRect.Bottom - 2;
        vCanvas.Brush.Style := bsSolid;
        vCanvas.Brush.Color := vColor;
        vCanvas.FillRect(vRect);
      end;
    finally
      vCanvas.Free;
    end;
  end;
{$ENDIF}
end;

function TsgSysMenuIcons.PointInIcons(const APoint: TPoint): Boolean;
begin
  Result := PtInIcon(smiClose, APoint) or PtInIcon(smiRestore, APoint) or
    PtInIcon(smiMinimize, APoint);
end;

function TsgSysMenuIcons.PtInIcon(const ASysMenuIcon: TsgSysMenuIcon;
  const APoint: TPoint): Boolean;
begin
  Result := PtInRect(GetSysMenuIconRect(ASysMenuIcon), APoint);
end;

constructor TsgSysMenuIcons.Create(AControl: TControl);
begin
  inherited Create;
  FColor := clDkGray;
  FWidth := cnstIconWidth;
  FHeight := cnstIconHeight;
  FInvertColor := False;
  InitializeHints;
  FControl := AControl;
  FControlShowHint := FControl.ShowHint;
  FControl.ShowHint := True;
  FCursor := TCursor(6);
  FCursorNeedStore := True;
  if FControl is TsgDrawingNavigator then
    TsgDrawingNavigator(FControl).AddClient(Self);
end;

destructor TsgSysMenuIcons.Destroy;
begin
  if Assigned(FControl) then
  begin
    if FControl.InheritsFrom(TsgDrawingNavigator) then
      TsgDrawingNavigator(FControl).RemoveClient(Self);
    FControl.ShowHint := FControlShowHint;
  end;
  FreeAndNil(FImageClose);
  FreeAndNil(FImageMinimaze);
  FreeAndNil(FImageRestoreDown);
  inherited Destroy;
end;

procedure TsgSysMenuIcons.Dispatch(var Message);
begin
  inherited Dispatch(Message);
  case TMessage(Message).Msg of
    WM_PAINT:
      Paint;
    WM_LBUTTONUP:
      if DoMouseUp(TWMMouse(Message)) then
        TWMMouse(Message).Result := 1;
    WM_MOUSEMOVE:
      if DoMouseMove(TWMMouse(Message)) then
        TWMMouse(Message).Result := 1;
    WM_LBUTTONDOWN:
      if DoMouseDown(TWMMouse(Message)) then
        TWMMouse(Message).Result := 1;
    CM_CURSORCHANGED:
      if FCursorNeedStore then
        FCursor := FControl.Cursor;
  end;
end;

function TsgSysMenuIcons.GetHints(Index: TsgSysMenuIcon): string;
begin
  case Index of
    smiMinimize: Result := HintMinimize;
    smiRestore: Result := HintRestoreDown;
    smiClose: Result := HintClose;
  else
    Result := '';
  end;
end;

function TsgSysMenuIcons.GetIconFromPoint(
  const APoint: TPoint): TsgSysMenuIcon;
begin
  Result := Pred(smiMinimize);
  if PtInIcon(smiClose, APoint) then
    Result := smiClose
  else
    if PtInIcon(smiRestore, APoint) then
      Result := smiRestore
    else
      if PtInIcon(smiMinimize, APoint) then
        Result := smiMinimize;
end;

function TsgSysMenuIcons.GetImage(Index: TsgSysMenuIcon): TGraphic;
begin
  case Index of
    smiMinimize: Result := ImageMinimaze;
    smiRestore: Result := ImageRestoreDown;
    smiClose: Result := ImageClose;
  else
    Result := nil;
  end;
end;

function TsgSysMenuIcons.GetSysMenuIconRect(
  const ASysMenuIcon: TsgSysMenuIcon): TRect;
begin
  Result := FControl.ClientRect;
  Result.Left := Result.Right - FWidth;
  Result.Bottom := Result.Top + FHeight;
  OffsetRect(Result, -cnstIconOffset, cnstIconOffset);
  case ASysMenuIcon of
    smiRestore: OffsetRect(Result, -FWidth, 0);
    smiMinimize: OffsetRect(Result, -2 * FWidth, 0);
  end;
end;

procedure TsgSysMenuIcons.InitializeHints;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    FHintMinimize := LoadUser32Str(900);
    FHintClose := LoadUser32Str(905);
    FHintRestoreDown := LoadUser32Str(903);
  end
  else
  begin
    FHintMinimize := cnstHintMinimize;
    FHintClose := cnstHintClose;
    FHintRestoreDown := cnstHintRestoreDown;
  end;
end;

procedure TsgSysMenuIcons.Invalidate;
begin
  if Assigned(FControl) then
    FControl.Invalidate;
end;

{ TsgTracers }

function TsgTracers.Active: Boolean;
begin
  Result := Count > 0;
end;

procedure TsgTracers.Add(Apoint: TFPoint; ASnapControl: TSnapControl; ASnappedEntity, ASnappedEntityTwo: TsgDXFEntity);
var
  vTrace: TSnapMarkerTrace;
  vLine: TsgDXFLineTrace;
  vsgLine: TsgLine;
  vSnapState: TObjectSnapState;
  vSnappedEntity: TsgDXFEntity;

  procedure AddTracerEntities;
  var
    vFRect: TFRect;
    vFP: TFPoint;
    vSnappedPoly: TsgDXFPolyline;
    vIntersectionMode: TIntersectionMode;
    I, vIndBefore, vIndAfter: Integer;
{$IFDEF SG_BTI}
    vInsert: TsgDXFInsertAccess absolute vSnappedEntity;
{$ENDIF}
  begin
    vFRect := ViewRect;
    if osTrace in vSnapState then
    begin
      //horizontal
      vLine := TsgDXFLineTrace.Create;
      vFP := APoint;
      vFP.X := vFRect.Left;
      vLine.Point := vFP;
      vFP := APoint;
      vFP.X := vFRect.Right;
      vLine.Point1 := vFP;
      AddPointsToTracerMatrix(vTrace, vLine);
      //vertical
      vLine := TsgDXFLineTrace.Create;
      vFP := APoint;
      vFP.Y := vFRect.Top;
      vLine.Point := vFP;
      vFP := APoint;
      vFP.Y := vFRect.Bottom;
      vLine.Point1 := vFP;
      AddPointsToTracerMatrix(vTrace, vLine);
      if not IsEqualFPoints(BasePoint, BadPoint) then
      begin
        vsgLine := GetIntresectingRectAndLine(vFRect, MakeLine(Apoint, FBasePoint), vIntersectionMode);
        if vIntersectionMode <> imNone then
          AddPointsToTracerMatrix(vTrace, CreateLine(vsgLine));
      end;
    end;
    if (FSnapControl.FInsert <> nil)
    {$IFDEF SG_BTI}
      and not (TsgDXFInsertAccess(FSnapControl.FInsert).GetEntTypeEx in cnsrEntTypeExBySnap)
    {$ENDIF}
      then
        Exit;
    if vSnappedEntity is TsgDXFLine then
    begin
      // the following is bad, normal is commented!!!!
     { vLine := TsgDXFLineTrace.Create;
      vLine.Point := TsgDXFLine(vSnappedEntity).Point;
      vLine.Point1 := TsgDXFLine(vSnappedEntity).Point1;
      AddLine(vTrace, Apoint, vLine);
      vLine.Free; }
      AddLine(vTrace, Apoint, TsgDXFLine(vSnappedEntity));
    end;
    if vSnappedEntity is TsgDXFPolyline then
    begin
      vIndBefore := -1;
      vIndAfter := -1;
      vSnappedPoly := TsgDXFPolyline(vSnappedEntity);
      for I := 0 to vSnappedPoly.Count - 1 do
        if IsEqualFPoints(vSnappedPoly.Vertexes[I].Point, Apoint) then
        begin
          if I > 0 then
            vIndBefore := I - 1;
          if I < vSnappedPoly.Count - 1 then
            vIndAfter := I + 1;
          if vSnappedPoly.Closed then
          begin
            if I = 0 then
              vIndBefore := -2;
            if I = vSnappedPoly.Count - 1 then
              vIndAfter := -2;
          end;
        end;
    //extension 1
      if vIndBefore <> -1 then
      begin
        if vIndBefore = -2 then
          vsgLine := GetIntresectingRectAndLine(vFRect, MakeLine(vSnappedPoly.Vertexes[0].Point, vSnappedPoly.Vertexes[vSnappedPoly.Count - 1].Point), vIntersectionMode)
        else
          vsgLine := GetIntresectingRectAndLine(vFRect, MakeLine(vSnappedPoly.Vertexes[vIndBefore].Point, vSnappedPoly.Vertexes[vIndBefore + 1].Point), vIntersectionMode);
        if (vIntersectionMode <> imNone) then
          AddLine(vTrace, Apoint, CreateLine(vsgLine)).Free;
      end;
    //extension 2
      if vIndAfter <> -1 then
      begin
        if vIndAfter = -2 then
          vsgLine := GetIntresectingRectAndLine(vFRect, MakeLine(vSnappedPoly.Vertexes[0].Point, vSnappedPoly.Vertexes[vSnappedPoly.Count - 1].Point), vIntersectionMode)
        else
          vsgLine := GetIntresectingRectAndLine(vFRect, MakeLine(vSnappedPoly.Vertexes[vIndAfter].Point, vSnappedPoly.Vertexes[vIndAfter - 1].Point), vIntersectionMode);
        if (vIntersectionMode <> imNone) then
          AddLine(vTrace, Apoint, CreateLine(vsgLine)).Free;
      end;
    end;
    {$IFDEF SG_BTI}
    if vSnappedEntity is TsgCADPolyPolyline2D then
      AddPolyPolyline2D(vTrace, Apoint, TsgCADPolyPolyline2D(vSnappedEntity));
    {$ENDIF}
  end;

begin
  vTrace := TSnapMarkerTrace.Create(ASnapControl);
  FTracers.Add(vTrace);
  vTrace.FRealPoint := Apoint;
  vTrace.FSnappedEntity := ASnappedEntity;
  vTrace.FSnappedEntityTwo := ASnappedEntityTwo;
  vSnapState := FSnapControl.SnapMask;
  vSnappedEntity := ASnappedEntity;
  AddTracerEntities;
  if ASnappedEntityTwo <> nil then
  begin
    vSnappedEntity := ASnappedEntityTwo;
    AddTracerEntities;
  end;
end;

function TsgTracers.AddLine(ATrace: TSnapMarkerTrace; Apoint: TFPoint; ALine: TsgDXFLine): TsgDXFLine;
var
  vFRect: TFRect;
  vsgLine: TsgLine;
  vSnapState: TObjectSnapState;
  vIntersectionMode: TIntersectionMode;

  procedure AddParallel;
  var
    vIntersectionMode: TIntersectionMode;
  begin
    if not (osParallel in vSnapState) then
      Exit;
    if IsEqualFPoints(BasePoint, BadPoint) then
      Exit;
    vsgLine := GetLineParalleniar(BasePoint, vsgLine.Point1, vsgLine.Point2, 1000);
    vsgLine := GetIntresectingRectAndLine(ViewRect, vsgLine, vIntersectionMode);
    if vIntersectionMode <> imNone then
      AddPointsToTracerMatrix(ATrace, CreateLine(vsgLine, osParallel));
  end;

begin
  Result := ALine;
  vFRect := ViewRect;
  vSnapState := FSnapControl.SnapMask;
  vsgLine := GetIntresectingRectAndLine(vFRect, MakeLine(ALine.Point, ALine.Point1), vIntersectionMode);
//extension
  if (vIntersectionMode <> imNone) and (osExtension in vSnapState) then
    AddPointsToTracerMatrix(ATrace, CreateLine(vsgLine, osExtension));
  AddParallel;
// normal
  vsgLine.Point1 := Apoint;
  vsgLine.Point2 := GetNormalPt(Result.Point , Result.Point1, Apoint, 1000);
  vsgLine := GetIntresectingRectAndLine(vFRect, vsgLine, vIntersectionMode);
  if (vIntersectionMode <> imNone) and (vSnapState * [osNormal, osTrace] = [osNormal, osTrace]) then
    AddPointsToTracerMatrix(ATrace, CreateLine(vsgLine, osOrtho));
end;

procedure TsgTracers.AddPointsToTracerMatrix(ATrace: TSnapMarkerTrace; ALine: TsgDXFLineTrace);
var
  P: TPoint;
begin
  FTracersMatrix.AddElement(ALine);
  ATrace.FLines.Add(ALine);
  FTracersMatrix.Changed;
  P := FCADImage.GetPoint(ALine.Point);
  FTracerPointsInt[0] := P.X;
  FTracerPointsInt[1] := P.Y;
  P := FCADImage.GetPoint(ALine.Point1);
  FTracerPointsInt[2] := P.X;
  FTracerPointsInt[3] := P.Y;
  FTracerPointsInt[4] := P.X;
  FTracerPointsInt[5] := P.Y + 1;
  FTracersMatrix.Size := Point(FSnapControl.Control.ClientWidth, FSnapControl.Control.ClientHeight);
  Windows.Polyline(FTracersMatrix.Handle, FTracerPointsInt[0], 3);
end;

{$IFDEF SG_BTI}
procedure TsgTracers.AddPolyPolyline2D(ATrace: TSnapMarkerTrace;
  Apoint: TFPoint; APoly: TsgCADPolyPolyline2D);
var
  J, Cnt: Integer;
  L: TsgLine;
begin
  Cnt := APoly.CurvesCount - 1;
  if (Cnt > 0) and (Cnt < cnstMaxCountPointsInPolyLineEdge) then
  begin
    for J := 0 to Cnt do
    begin
      if APoly.CurveVisible[J] then
      begin
        if APoly.IsCurveArc(J) then
        //  FindArc(PPoly.Arcs[J])
        else
        begin
          L := APoly.Lines[J];
          if IsEqualFPoints(L.Point1, Apoint) or IsEqualFPoints(L.Point2, Apoint) then
            AddLine(ATrace, Apoint, CreateLine(L)).Free;
        end;
      end;
    end;
  end;
end;
{$ENDIF}

procedure TsgTracers.Clear;
var
  I: Integer;
begin
  FBasePoint := BadPoint;
  for I := Count - 1 downto 0 do
    Tracers[I].Free;
  FTracers.Clear;

  if (FCADImage <> nil) and (FCADImage.SelectionMatrix <> nil) then
    FTracersMatrix.Assign(FCADImage.SelectionMatrix);
end;

procedure TsgTracers.ClearHidden;
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do
    Tracers[I].Free;
  FTracers.Clear;
  FTracersMatrix.ClearFull;
end;

function TsgTracers.Count: Integer;
begin
  Result := FTracers.Count;
end;

constructor TsgTracers.Create(AsnapControl: TSnapControl);
begin
  FIsShiftClicked := False;
  FIsShiftPressed := False;
  FSnapControl := AsnapControl;
  FBasePoint := BadPoint;
  FTracers := TList.Create;
  FTracersMatrix := TsgSelectionMatrix.Create;
  SetLength(FTracerPointsInt, 6);
end;

destructor TsgTracers.Destroy;
begin
  Clear;
  FTracers.Free;
  FTracersMatrix.Free;
  inherited Destroy;
end;

function TsgTracers.GetTrace(Index: Integer): TSnapMarkerTrace;
begin
  Result := nil;
  if Index < FTracers.Count then
    Result := TSnapMarkerTrace(FTracers[Index]);
end;

function TsgTracers.IndexOf(Apoint: TFPoint): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to Count - 1 do
    if IsEqualFPoints(Tracers[I].FRealPoint, Apoint) then
      Result := I;
end;

function TsgTracers.IndexOfEntity(AEntity: TObject): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to Count - 1 do
    if Tracers[I].FLines.IndexOf(AEntity) <> -1 then
      Result := I;
end;

function TsgTracers.Last: TSnapMarkerTrace;
begin
  Result := TSnapMarkerTrace(FTracers.Last);
end;

procedure TsgTracers.Regen;
var
  I: Integer;
  vList: TList;
  vMarker: TSnapMarkerTrace;
begin
  if FCADImage = nil then
    Exit;
  vList := TList.Create;
  try
    CopyLists(vList, FTracers);
    FTracers.Clear;
    if FCADImage.SelectionMatrix <> nil then
    begin
      TracersMatrix.Assign(FCADImage.SelectionMatrix);
      for I := 0 to vList.Count - 1 do
      begin
        vMarker := TSnapMarkerTrace(vList[I]);
        Add(vMarker.FRealPoint, vMarker.FSnapControl, vMarker.FSnappedEntity, vMarker.FSnappedEntityTwo);
        vMarker.Free;
      end;
    end;
  finally
    vList.Free;
  end;
end;

function TsgTracers.Remove(Apoint: TFPoint): Integer;
begin
  Result := IndexOf(Apoint);
  if Result >= 0 then
  begin
    Tracers[Result].Free;
    FTracers.Delete(Result);
    Regen;
  end;
end;

procedure TsgTracers.SetBasePoint(const Value: TFPoint);
begin
  FBasePoint := Value;
end;

procedure TsgTracers.SetCADImage(const Value: TsgCADImage);
begin
  if Value = FCADImage then
    Exit;
  FCADImage := Value;
  if (Value <> nil) and (Value.SelectionMatrix <> nil) then
    FTracersMatrix.Assign(Value.SelectionMatrix);
end;

procedure TsgTracers.SetDisable;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Tracers[I].LineByShowPolar.State := 0;
end;

procedure TsgTracers.SetIsShiftClicked(const Value: Boolean);
begin
  FIsShiftClicked := Value;
end;

procedure TsgTracers.SetIsShiftPressed(const Value: Boolean);
begin
  FIsShiftPressed := Value;
end;

procedure TsgTracers.SetTracersMatrix(const Value: TsgSelectionMatrix);
begin
  FTracersMatrix := Value;
end;

procedure TsgTracers.SetViewRect(const Value: TFRect);
begin
  FViewRect := Value;
end;

{ TSnapMarkerTrace }

constructor TSnapMarkerTrace.Create(ASnapControl: TSnapControl);
begin
  inherited Create(ASnapControl);
  New(FLineByShowPolar);
  FLines := TList.Create;
end;

destructor TSnapMarkerTrace.Destroy;
var
  I: Integer;
begin
  for I := 0 to FLines.Count - 1 do
    TObject(FLines[I]).Free;
  FLines.Free;
  Dispose(FLineByShowPolar);
  inherited;
end;

function TSnapMarkerTrace.GetRealPoint: TFPoint;
begin
  Result := FRealPoint;
end;

procedure TSnapMarkerTrace.SetSnappedEntity(const Value: TsgDXFEntity);
begin
  FSnappedEntity := Value;
end;

{ TSnapControlTracers }

function TSnapControlTracers.GetSelectionMatrix: TsgSelectionMatrix;
begin
  Result := FSelectionMatrix;
end;

procedure TSnapControlTracers.SetSelectionMatrix(
  const Value: TsgSelectionMatrix);
begin
  FSelectionMatrix := Value;
end;

{ TsgDXFLineTrace }

constructor TsgDXFLineTrace.Create;
begin
  inherited;
  FSnapType := osDisabled;
end;

procedure TsgDXFLineTrace.SetSnapType(const Value: TObjectSnapMode);
begin
  FSnapType := Value;
end;

{ TsgSnapCross }

function GetSnapType(const AEntity: TObject): TsgSnapType;
begin
  Result := stUndefined;
  if AEntity is TsgDXFSolid then
    Result := stSolid
  else
    if AEntity is TsgDXFLine then
      Result := stLine
    else
      if AEntity is TsgCADBasePolyline then
      begin
        Result := stPolyline;
        if IsCircular(TsgDXFEntity(AEntity)) then
          Result := stArc;
      end
      else
{$IFDEF SG_BTI}
        if (AEntity is TsgDXFInsert) and (TsgDXFInsertAccess(AEntity).GetEntTypeEx in cnsrEntTypeExBySnap) then
          Result := stObjects
        else
          if AEntity is TsgCADPolyPolyline2D then
            Result := stPolyPolyline;
{$ENDIF}
//          if AEntity is TsgFlatPoly then
//            Result := 5;
  end;

function GetCrossClass(const AType1, AType2: TsgSnapType):  TsgCrossProcs;
const
  cnstCrossClasses: array [TsgSnapType, TsgSnapType] of TsgCrossProcs =
  ( (nil, nil, nil, nil, nil, nil, nil),//stUndefined
    (nil, TsgCrossArcs, TsgCrossArcAndLine, TsgCrossSolidAndArc,
       TsgCrossPolylineAndArc, TsgCrossPolyPolylineAndArc, TsgCrossInsert),//stArc
    (nil, nil, TsgCrossLines, TsgCrossSolidAndLine, TsgCrossPolylineAndLine,
       TsgCrossPolyPolylineAndLine, TsgCrossInsert),//stLine
    (nil, nil, nil, TsgCrossSolids, TsgCrossPolylineAndSolid,
       TsgCrossPolyPolylineAndSolid, TsgCrossInsert),//stSolid
    (nil, nil, nil, nil, TsgCrossPolylines, TsgCrossPolyPolylineAndPolyline,
       TsgCrossInsert),//stPolyline
    (nil, nil, nil, nil, nil, TsgCrossPolyPolylines, TsgCrossInsert),//stPolyPolyline
    (nil, nil, nil, nil, nil, nil, TsgCrossInsert) //stObjects
  );
begin
  Result := cnstCrossClasses[AType1][AType2];
  if Result = nil then
    Result := cnstCrossClasses[AType2][AType1];
end;

function TsgSnapCross.IsCross(const AEnt1, AEnt2: Pointer;
  const ABox: TFRect): Boolean;
var
  vSnapType1, vSnapType2: TsgSnapType;
  vCrossClass: TsgCrossProcs;
  vCross: TsgCrossProc;
  vBox1, vBox2: TFRect;
begin
  Result := False;
  FCrossPoint := cnstFPointZero;
  vBox1 := TsgDXFEntity(AEnt1).Box;
  vBox2 := TsgDXFEntity(AEnt2).Box;
  if (vBox1.Z1 = 0) and (vBox1.Z2 = 0) and (vBox2.Z1 = 0) and (vBox2.Z2 = 0) then
  begin
    vSnapType1 := GetSnapType(AEnt1);
    if vSnapType1 <> stUndefined then
    begin
      vSnapType2 := GetSnapType(AEnt2);
      vCrossClass := GetCrossClass(vSnapType1, vSnapType2);
      if vCrossClass <> nil then
      begin
        vCross := vCrossClass.Create(AEnt1, AEnt2, ABox);
        try
          vCross.CheckType(vSnapType1, vSnapType2);
          if vCross.FindCrossPoint then
          begin
            FCrossPoint := vCross.CrossPoint;
            Result := True;
          end;
        finally
          vCross.Free;
        end;
      end;
    end;
  end;
end;

{ TsgCrossArcs }

function TsgCrossArcs.FindCrossPoint: Boolean;
var
  vCount: Integer;
  vCross1, vCross2: TFPoint;
begin
  if FEntity1 <> FEntity2 then
  begin
    FArc := GetArcR(FEntity1);
    FArc2 := GetArcR(FEntity2);
    vCount := IsCrossArcsAP(FArc, FArc2, @vCross1, @vCross2);
    Result := SetCrossPoints(vCount, vCross1, vCross2);
  end
  else
    Result := False;
end;

{ TsgCrossProc }

procedure TsgCrossProc.CheckType(const AType1, AType2: TsgSnapType);
begin
end;

constructor TsgCrossProc.Create(const AEnt1, AEnt2: Pointer; const ABox: TFRect);
begin
  FBox := ABox;
  FEntity1 := AEnt1;
  FEntity2 := AEnt2;
  FDistance := MaxDouble;
end;

class function TsgCrossProc.CrossSegments(const AL1, AL2: TsgLine;
  var APoint: TFPoint): Boolean;
const
  cnstMax: Double = 1.0 + fAccuracy;
  cnstMin: Double = 0.0 - fAccuracy;
var
  Denom, R, S: Double;
begin
  Result := False;
  Denom := (AL1.Point2.X - AL1.Point1.X) * (AL2.Point2.Y - AL2.Point1.Y) -
    (AL1.Point2.Y - AL1.Point1.Y) * (AL2.Point2.X - AL2.Point1.X);
  if Abs(Denom) > fAccuracy then
  begin
    try
      R := ((AL1.Point1.Y - AL2.Point1.Y)*(AL2.Point2.X - AL2.Point1.X) - (AL1.Point1.X - AL2.Point1.X)*(AL2.Point2.Y - AL2.Point1.Y) ) / Denom;
      S := ((AL1.Point1.Y - AL2.Point1.Y)*(AL1.Point2.X - AL1.Point1.X) - (AL1.Point1.X - AL2.Point1.X)*(AL1.Point2.Y - AL1.Point1.Y) ) / Denom;
    except
      Exit;
    end;
    Result := (R >= cnstMin) and (R <= cnstMax) and (S >= cnstMin) and (S <= cnstMax);
    if Result then
    begin
      APoint.X := AL1.Point1.X + R * (AL1.Point2.X - AL1.Point1.X);
      APoint.Y := AL1.Point1.Y + R * (AL1.Point2.Y - AL1.Point1.Y);
      APoint.Z := AL1.Point1.Z;
    end;
  end;
end;

function TsgCrossProc.CrossWithArc(const Arc: TsgArcR): Boolean;
begin
  FCrossProcArc.SetArc(Arc);
  Result := FCrossProcArc.FindCrossPoint;
  if Result then
    FCrossPoint := FCrossProcArc.FCrossPoint;
end;

function TsgCrossProc.CrossWithLine(const ALine: TsgLine): Boolean;
begin
  FCrossProcLine.SetLine(ALine);
  Result := FCrossProcLine.FindCrossPoint;
  if Result then
    FCrossPoint := FCrossProcLine.FCrossPoint;
end;

function TsgCrossProc.CrossWithPts(const AP1, AP2: TFPoint): Boolean;
begin
  Result := CrossWithLine(MakeLine(AP1, AP2));
end;

destructor TsgCrossProc.Destroy;
begin
  FreeAndNil(FCrossProcArc);
  FreeAndNil(FCrossProcLine);
  inherited Destroy;
end;

procedure TsgCrossProc.SetArc(const AArc: TsgArcR);
begin
  FArc := AArc;
end;

function TsgCrossProc.SetCrossPoint(const APoint: TFPoint): Boolean;
begin
  Result := IsPointInFRect(FBox, APoint);
  if Result then
    FCrossPoint := APoint;
end;

function TsgCrossProc.SetCrossPoints(const ACount: Integer; const ACross1,
  ACross2: TFPoint): Boolean;
begin
  case ACount of
    1:  Result := SetCrossPoint(ACross1);
    2:
      begin
        Result := SetCrossPoint(ACross1);
        if not Result then
          Result := SetCrossPoint(ACross2);
      end;
  else
    Result := False;
  end;
end;

procedure TsgCrossProc.SetCrossProc(const AClass: TsgCrossProcs;
  var ACrossProc: TsgCrossProc);
begin
  if ACrossProc = nil then
    ACrossProc := AClass.Create(FEntity2, nil, FBox)
  else
  begin
    ACrossProc.FEntity1 := FEntity2;
    ACrossProc.FBox := FBox;
  end;
end;

procedure TsgCrossProc.SetLine(const ALine: TsgLine);
begin
  FLine := ALine;
end;

{ TsgCrossArcAndLine }

procedure TsgCrossArcAndLine.CheckType(const AType1, AType2: TsgSnapType);
begin
  if AType1 <> stArc then
    SwapPointers(FEntity1, FEntity2);
end;

function TsgCrossArcAndLine.FindCrossPoint: Boolean;
var
  vCount: Integer;
  vCross1, vCross2: TFPoint;
begin
  if FEntity1 <> nil then
    FArc := GetArcR(FEntity1);
  if FEntity2 <> nil then
    FLine := GetLine(FEntity2);
  vCount := IsCrossArcAndSegmentAP(FArc, FLine, @vCross1, @vCross2);
  Result := SetCrossPoints(vCount, vCross1, vCross2);
end;

{ TsgCrossLines }

function TsgCrossLines.FindCrossPoint: Boolean;
var
  vCross: TFPoint;
begin
  Result := False;
  if (FEntity1 <> FEntity2) or (FEntity1 = nil) then
  begin
    if FEntity1 <> nil then
      FLine := GetLine(FEntity1);
    if FEntity2 <> nil then
      FLine2 := GetLine(FEntity2);
    if IsCrossLines(FLine, FLine2, @vCross) then
      Result := SetCrossPoint(vCross);
  end;
end;

{ TsgCrossSolidAndLine }

function TsgCrossSolidAndLine.FindCrossPoint: Boolean;
var
  I: Integer;
  vCross: TFPoint;
begin
  Result := False;
  if FEntity2 <> nil then
    FLine := GetLine(FEntity2);
  for I := 0 to 3 do
  begin
    if IsCrossLines(FLine, GetEdgeOfSolid(I), @vCross) then
    begin
      if SetCrossPoint(vCross) then
      begin
        Result := True;
        Break;
      end;
    end;
  end;
end;

{ TsgCrossSolidAndArc }

function TsgCrossSolidAndArc.FindCrossPoint: Boolean;
var
  I, vCrossCount: Integer;
  vCross1, vCross2: TFPoint;
begin
  Result := False;
  if FEntity2 <> nil then
    FArc := GetArcR(FEntity2);
  for I := 0 to 3 do
  begin
    vCrossCount := IsCrossArcAndSegmentAP(FArc, GetEdgeOfSolid(I),
      @vCross1, @vCross2);
    if SetCrossPoints(vCrossCount, vCross1, vCross2) then
    begin
      Result := True;
      Break;
    end;
  end;
end;

{ TsgCrossSolid }

procedure TsgCrossSolid.CheckType(const AType1, AType2: TsgSnapType);
begin
  if AType1 <> stSolid then
    SwapPointers(FEntity1, FEntity2);
end;

function TsgCrossSolid.GetEdgeOfSolid(const EdgeIndex: Integer): TsgLine;
begin
  case EdgeIndex of
    1:
      begin
        Result.Point1 := TsgDXFSolid(FEntity1).Point1;
        Result.Point2 := TsgDXFSolid(FEntity1).Point3;
      end;
    2:
      begin
        Result.Point1 := TsgDXFSolid(FEntity1).Point2;
        Result.Point2 := TsgDXFSolid(FEntity1).Point3;
      end;
    3:
      begin
        Result.Point1 := TsgDXFSolid(FEntity1).Point;
        Result.Point2 := TsgDXFSolid(FEntity1).Point2;
      end;
  else
    Result.Point1 := TsgDXFSolid(FEntity1).Point;
    Result.Point2 := TsgDXFSolid(FEntity1).Point1;
  end;
end;

{ TsgCrossSolids }

function TsgCrossSolids.FindCrossPoint: Boolean;
var
  I: Integer;
  vCrossSolidLine: TsgCrossSolidAndLine;
begin
  Result := False;
  vCrossSolidLine := TsgCrossSolidAndLine.Create(nil, nil, FBox);
  try
    vCrossSolidLine.FEntity1 := FEntity2;
    for I := 0 to 3 do
    begin
      vCrossSolidLine.FLine := GetEdgeOfSolid(I);
      if vCrossSolidLine.FindCrossPoint then
      begin
        FCrossPoint := vCrossSolidLine.CrossPoint;
        Result := True;
        Break;
      end;
    end;
  finally
    vCrossSolidLine.Free;
  end;
end;

{ TsgCrossPolyline }

procedure TsgCrossPolyline.CheckType(const AType1, AType2: TsgSnapType);
begin
  if AType1 <> stPolyline then
    SwapPointers(FEntity1, FEntity2);
end;

function TsgCrossPolyline.CrossPolylines(const APolylines: TList): Boolean;
var
  I, J, PI, PJ: Integer;
  vPolyline: TFPointList;
  vLine1, vLine2: TsgLine;
  vCross: TFPoint;
begin
  Result := False;
  I := 1;
  while (not Result) and (I < APolylines.Count - 1) do
  begin
    FPoints := TFPointList(APolylines[I]);
    Inc(I, 2);
    for PI := 0 to FPoints.Count - 2 do
    begin
      vLine1.Point1 := FPoints.List[PI];
      vLine1.Point2 := FPoints.List[PI + 1];
      J := I;
      while (not Result) and (J < APolylines.Count) do
      begin
        vPolyline := TFPointList(APolylines[J]);
        Inc(J, 2);
        for PJ := 0 to vPolyline.Count - 2 do
        begin
          vLine2.Point1 := vPolyline.List[PJ];
          vLine2.Point2 := vPolyline.List[PJ + 1];
          if CrossSegments(vLine1, vLine2, vCross) and SetCrossPoint(vCross) then
          begin
            Result := True;
            Break;
          end;
        end;
      end;
      if Result then
        Break;
    end;
  end;
end;

function TsgCrossPolyline.CrossPolylinesInternal(
  const APolylines: TList): Boolean;
var
  I: Integer;
begin
  Result := False;
  I := 0;
  while I < APolylines.Count do
  begin
    if Boolean(APolylines[I]) then
    begin
      FPoints := TFPointList(APolylines[I + 1]);
      Result := FindCrossByEntity;
      if Result then
        Break;
    end;
    Inc(I, 2);
  end;
end;

function TsgCrossPolyline.FindCrossByEntity: Boolean;
var
  I, J, Cnt: Integer;
  vLine1, vLine2: TsgLine;
  vCross: TFPoint;
begin
  Result := False;
  try
    if FClosed then
      FPoints.Add(FPoints.First);
    Cnt := FPoints.Count - 2;
    for I := 0 to FPoints.Count - 3 do
    begin
      vLine1.Point1 := FPoints.List[I];
      vLine1.Point2 := FPoints.List[I + 1];
      for J := I + 1 to Cnt do
      begin
        vLine2.Point1 := FPoints.List[J];
        vLine2.Point2 := FPoints.List[J + 1];
        if CrossSegments(vLine1, vLine2, vCross) and SetCrossPoint(vCross) then
        begin
          Result := True;
          Break;
        end;
      end;
      if Result then
        Break;
    end;
  finally
    if FClosed then
      FPoints.Count := FPoints.Count - 1;
  end;
end;

function TsgCrossPolyline.FindCrossByEntityWithPointsCounts: Boolean;
var
  I: Integer;
  vPolyLines: TList;
  vHasBulges: Boolean;
begin
  Result := False;
  vHasBulges := False;
  for I := 0 to FPointsCounts.Count - 1 do
    if Integer(FPointsCounts[I]) > 1 then
    begin
      vHasBulges := True;
      Break;
    end;
  if vHasBulges then
  begin
    vPolyLines := SpliteOnPolylines;
    try
      FClosed := False;
      FPointsCounts := nil;
      Result := CrossPolylinesInternal(vPolyLines);
      if not Result then
        Result := CrossPolylines(vPolyLines);
    finally
      I := 1;
      while I < vPolyLines.Count do
      begin
        TObject(vPolyLines[I]).Free;
        Inc(I, 2);
      end;
      vPolyLines.Free;
    end;
  end
  else
    if FindCrossByEntity then
      Result := True;
end;

function TsgCrossPolyline.FindCrossPoint: Boolean;
var
  I: Integer;
begin
  Result := False;
  FPoints := TsgCADBasePolyline(FEntity1).PolyPoints;
  FClosed := TsgCADBasePolyline(FEntity1).Closed;
  FPointsCounts := nil;
  if TObject(FEntity1) is TsgDXFLWPolyline then
    FPointsCounts := TsgDXFLWPolyline(FEntity1).PointsCounts;
  if (FPoints.Count > 1) and (FPoints.Count < cnstMaxCountPointsInPolyLineCross) then
  begin
    if FEntity1 = FEntity2 then
    begin
      if IsHasSnap(FEntity1) then
      begin
        if FPointsCounts = nil then
          Result := FindCrossByEntity
        else
          Result := FindCrossByEntityWithPointsCounts;
      end;
    end
    else
    begin
      for I := 0 to FPoints.Count - 2 do
      begin
        if CrossWithPts(FPoints.List[I], FPoints.List[I + 1]) then
          Result := True;
      end;
      if (not Result) and FClosed then
      begin
        if CrossWithPts(FPoints.First, FPoints.Last) then
          Result := True;
      end;
    end;
  end;
end;

function TsgCrossPolyline.SpliteOnPolylines: TList;
var
  I, J, P, vPointsCount: Integer;
  vPolyline, vPolylineOfBulge: TFPointList;
begin
  Result := TList.Create;
  try
    if FClosed then
    begin
      FPoints.Add(FPoints.First);
      FPointsCounts.Add(1);
    end;
    vPolyline := AddPolylineInList(Result, FPoints.Count, True);
    P := 0;
    for I := 0 to FPointsCounts.Count - 1 do
    begin
      vPointsCount := Integer(FPointsCounts[I]);
      if vPointsCount = 1 then
        AddLastFPointUnique(vPolyline, FPoints[P])
      else
      begin
        if vPolyline.Count > 0 then
        begin
          AddLastFPointUnique(vPolyline, FPoints[P]);
          vPolylineOfBulge := AddPolylineInList(Result, vPointsCount, False);
        end
        else
        begin
          Result[Result.Count - 2] := Pointer(False);
          vPolylineOfBulge := vPolyline;
        end;
        for J := P to P + vPointsCount - 1 do
          AddLastFPointUnique(vPolylineOfBulge, FPoints[J]);
        vPolyline := AddPolylineInList(Result, FPoints.Count - P - vPointsCount, True);
        AddLastFPointUnique(vPolyline, vPolylineOfBulge.Last);
      end;
      Inc(P, vPointsCount);
    end;
    I := 1;
    while I < Result.Count do
    begin
      if TFPointList(Result[I]).Count < 2 then
      begin
        TFPointList(Result[I]).Free;
        Result.Delete(I);
        Result.Delete(I - 1);
      end
      else
        Inc(I, 2);
    end;
  finally
    if FClosed then
    begin
      FPoints.Count := FPoints.Count - 1;
      FPointsCounts.Count := FPointsCounts.Count - 1;
    end;
  end;
end;

{ TsgCrossPolyPolyline }

procedure TsgCrossPolyPolyline.CheckType(const AType1, AType2: TsgSnapType);
begin
  if AType1 <> stPolyPolyline then
    SwapPointers(FEntity1, FEntity2);
end;

function TsgCrossPolyPolyline.FindCrossPoint: Boolean;
{$IFDEF SG_BTI}
var
  I: Integer;
  vPPPoly: TsgCADPolyPolyline2D;
{$ENDIF}
begin
  Result := False;
{$IFDEF SG_BTI}
  vPPPoly := TsgCADPolyPolyline2D(FEntity1);
  for I := 0 to vPPPoly.CurvesCount - 1 do
  begin
    if vPPPoly.CurveVisible[I] then
    begin
      if vPPPoly.IsCurveArc(I) then
        Result := CrossWithArc(vPPPoly.Arcs[I])
      else
        Result := CrossWithLine(vPPPoly.Lines[I]);
      if Result then
        Break;
    end;
  end;
{$ENDIF}
end;

{ TsgCrossPolyPolylineAndArc }

function TsgCrossPolyPolylineAndArc.CrossWithArc(const Arc: TsgArcR): Boolean;
var
  vCrossCount: Integer;
  vCross1, vCross2: TFPoint;
begin
  vCrossCount := IsCrossArcsAP(FArc, Arc, @vCross1, @vCross2);
  Result := SetCrossPoints(vCrossCount, vCross1, vCross2);
end;

function TsgCrossPolyPolylineAndArc.CrossWithLine(const ALine: TsgLine): Boolean;
var
  vCrossCount: Integer;
  vCross1, vCross2: TFPoint;
begin
  vCrossCount := IsCrossArcAndSegmentAP(FArc, ALine, @vCross1, @vCross2);
  Result := SetCrossPoints(vCrossCount, vCross1, vCross2);
end;

function TsgCrossPolyPolylineAndArc.FindCrossPoint: Boolean;
begin
  if FEntity2 <> nil then
    FArc := GetArcR(FEntity2);
  Result := inherited FindCrossPoint;
end;

{ TsgCrossPolylineAndArc }

function TsgCrossPolylineAndArc.CrossWithLine(const ALine: TsgLine): Boolean;
var
  vCrossCount: Integer;
  vCross1, vCross2: TFPoint;
begin
  vCrossCount := IsCrossArcAndSegmentAP(FArc, ALine, @vCross1, @vCross2);
  Result := SetCrossPoints(vCrossCount, vCross1, vCross2);
end;

function TsgCrossPolylineAndArc.FindCrossPoint: Boolean;
begin
  if FEntity2 <> nil then
    FArc := GetArcR(FEntity2);
  Result := inherited FindCrossPoint;
end;

{ TsgCrossPolylineAndLine }

function TsgCrossPolylineAndLine.CrossWithLine(const ALine: TsgLine): Boolean;
var
  vCross: TFPoint;
begin
  Result := False;
  if CrossSegments(FLine, ALine, vCross) then
    Result := SetCrossPoint(vCross);
end;

function TsgCrossPolylineAndLine.FindCrossPoint: Boolean;
begin
  if FEntity2 <> nil then
    FLine := GetLine(FEntity2);
  Result := inherited FindCrossPoint;
end;

{ TsgCrossPolylineAndSolid }

function TsgCrossPolylineAndSolid.FindCrossPoint: Boolean;
begin
  SetCrossProc(TsgCrossSolidAndLine, FCrossProcLine);
  Result := inherited FindCrossPoint;
end;

{ TsgCrossPolylines }

function TsgCrossPolylines.FindCrossPoint: Boolean;
begin
  SetCrossProc(TsgCrossPolylineAndLine, FCrossProcLine);
  Result := inherited FindCrossPoint;
end;

{ TsgCrossPolyPolylineAndLine }

function TsgCrossPolyPolylineAndLine.CrossWithArc(const Arc: TsgArcR): Boolean;
var
  vCrossCount: Integer;
  vCross1, vCross2: TFPoint;
begin
  vCrossCount := IsCrossArcAndSegmentAP(Arc, FLine, @vCross1, @vCross2);
  Result := SetCrossPoints(vCrossCount, vCross1, vCross2);
end;

function TsgCrossPolyPolylineAndLine.CrossWithLine(const ALine: TsgLine): Boolean;
var
  vCross: TFPoint;
begin
  Result := False;
  if CrossSegments(FLine, ALine, vCross) then
    Result := SetCrossPoint(vCross);
end;

function TsgCrossPolyPolylineAndLine.FindCrossPoint: Boolean;
begin
  if FEntity2 <> nil then
    FLine := GetLine(FEntity2);
  Result := inherited FindCrossPoint;
end;

{ TsgCrossPolyPolylines }

function TsgCrossPolyPolylines.FindCrossPoint: Boolean;
begin
  SetCrossProc(TsgCrossPolyPolylineAndArc, FCrossProcArc);
  SetCrossProc(TsgCrossPolyPolylineAndLine, FCrossProcLine);
  Result := inherited FindCrossPoint;
end;

{ TsgCrossPolyPolylineAndSolid }

function TsgCrossPolyPolylineAndSolid.FindCrossPoint: Boolean;
begin
  SetCrossProc(TsgCrossSolidAndArc, FCrossProcArc);
  SetCrossProc(TsgCrossSolidAndLine, FCrossProcLine);
  Result := inherited FindCrossPoint;
end;

{ TsgCrossPolyPolylineAndPolyline }

function TsgCrossPolyPolylineAndPolyline.FindCrossPoint: Boolean;
begin
  SetCrossProc(TsgCrossPolylineAndArc, FCrossProcArc);
  SetCrossProc(TsgCrossPolylineAndLine, FCrossProcLine);
  Result := inherited FindCrossPoint;
end;


{ TsgCrossInsert }

procedure TsgCrossInsert.CheckType(const AType1, AType2: TsgSnapType);
begin
  if AType1 <> stObjects then
    SwapPointers(FEntity1, FEntity2);
end;

function TsgCrossInsert.FindCrossPoint: Boolean;
var
  I: Integer;
  vEntity: Pointer;
  vSnapType: TsgSnapType;
  vClass: TsgCrossProcs;
  vCrossProc: TsgCrossProc;
begin
  Result := False;
  FObjects :=  TsgDXFInsert(FEntity1).Block;
  FSnapType2 := GetSnapType(FEntity2);
  for I := 0 to FObjects.Count - 1 do
  begin
    vEntity := FObjects[I];
    vSnapType := GetSnapType(vEntity);
    vClass := GetCrossClass(FSnapType2, vSnapType);
    if vClass <> nil then
    begin
      vCrossProc := vClass.Create(FEntity2, vEntity, FBox);
      try
        vCrossProc.CheckType(FSnapType2, vSnapType);
        if vCrossProc.FindCrossPoint then
        begin
          FCrossPoint := vCrossProc.FCrossPoint;
          Result := True;
          Break;
        end;
      finally
        vCrossProc.Free;
      end;
    end;
  end;
end;

initialization
  SnapCross := nil;

finalization
  FreeAndNil(SnapCross);

end.
