Unit PCTypesUtils;

interface



uses  SysUtils, WinTypes, WinProcs, Messages,
      Classes, Graphics, Controls, Forms, Dialogs,
      ExtCtrls,comctrls,buttons,stdctrls,windows,math,
      rrEllipses,menus,oleCtnrs,InPutform,shlObj,Registry,
      U_Common_Classes, MemoForm,comObj,grids,variants,Printers,StrUtils;

function GradientFill(DC: HDC; const Vertex {PTriVertex}; NumVertex:ULONG; const Mesh {PGradientTriangle}; NumMesh,Mode: ULONG): BOOL; stdcall; external 'msimg32.dll';


var OutMemo:TMemo=nil;
    ErrorMemo:TMemo=nil;
    ErrorPrinted:Boolean=false;

var OutLabel:TLabel=nil;

var  DragStartX,DragStartY,DragOldX,DragOldY,DragDeltaX,DragDeltaY : Double;
     DragStartXInt,DragStartYInt,DragOldXInt,DragOldYInt,DragDeltaXInt,DragDeltaYInt : Double;

     DragState: integer;
     DragReady,DragReadyInt: Boolean;
(*
var  gCanvas: TCGDeviceContext;
var  gcL: TCGLight;
  *)



const dsNone = 0;
      dsMove = 1;
      dsMod = 2;
      dsHScroll = 3;
      dsVScroll = 4;
      dsPan = 7;
      dsHRuler = 5;
      dsVRuler = 6;
      dsLocate = 8;
      dsDetPan = 9;

IdLine    = 0;
IdCircle  = 1;
IdEllipse = 2;
IdRectangle = 3;
IdArc  = 4;
IdBezier  = 5;
IdPolyLine = 6;


ciFile = 0;
ciDraw = 1;
ciEdit = 2;
ciArrange = 3;
ciModify = 4;
ciTransform = 5;
ciView = 6;
ciInsert = 7;
ciOptions = 8;
ciTools = 9;
ciMacros = 10;
ciBlocks = 11;
ciPlugins = 12;
ciMenus = 13;


bFile = 1;
bEdit = 2;
bAlign = 3;
bText = 4;
bPen = 5;
bBrush = 7;
bTools = 8;
bArrange = 9;
bTransform = 10;
bMainMenu = 11;

cNew = 1;
cOpen	= 2;
cSave	= 3;
cSaveAs	= 4;
cExit	= 5;
cFile	= 99;
cPrint	= 6;
cPrintPreview	= 7;
cPrinterSetup	= 8;
cExportDrawing	= 9;
cImportDrawing	= 10;
cPageSetup	= 11;
cSelectTool	= 12;
cLine	= 13;
cRectangle	= 14;
cCircle	= 15;
cEllipse	= 16;
cArc	= 17;
cPolyline	= 18;
cPoint	= 19;
cText	= 20;
cUndo	= 21;
cRedo	= 22;
cCut	= 23;
cCopy	= 24;
cPaste	= 25;
cDelete	= 26;
cClear	= 27;
cEdit	= 100;
cTextColor	= 91;
cPenColor	= 92;
cBrushColor	= 93;
cPenStyle	= 94;
cBrushStyle	= 95;
cRowStyle	= 96;
cPenWidth	= 97;
cFontName	= 98;
cBold	= 28;
cItalic	= 29;
cUnderline	= 30;
cStrike	= 31;
cMove	= 32;
cDuplicate	= 33;
cRotate	= 34;
cMirror	= 35;
cArrayPolar	= 36;
cArrayRectangular	= 37;
cGroup	= 38;
cUnGroup	= 39;
cBringToFront	= 40;
cSendToBack	= 41;
cBringForward	= 42;
cSendBackward	= 43;
cInvertArc	= 44;
cArcStyleOpen	= 45;
cArcStylePie	= 46;
cArcStyleChord	= 47;
cFlipImageHorizontal	= 48;
cFlipImageVertical	= 49;
cTransparentImage	= 50;
cClipImage	= 51;
cBoundLine	= 52;
cWeldIntoPolyLine	= 53;
cConvertBeziertoPolyLine	= 54;
cConvertPolyLinetoBezier	= 55;
cPolyLineClosed	= 56;
cInsertPicture	= 57;
cInsertBlock	= 58;


cMakeBlock	= 59;
cAlignTops	= 60;
cAlignBottoms	= 61;
cAlignYCenters	= 62;
cAlignLefts	= 63;
cAlignRights	= 64;
cAlignXCenters	= 65;
cDistrubuteHorizontal	= 66;
cDistrubuteVertical	= 67;

cShowProperties	= 68;
cLayersDialog	= 69;
cEnvironmentOptions	= 70;
cBlocksManager	= 71;
cMacroManager	= 72;
cActualSize	= 73;
cFitToPage	= 74;
cZoom50	= 75;
cZoom75	= 76;
cZoom25	= 77;
cZoom150= 78;
cZoom200	= 79;
cZoom125	= 80;
cZoom175	= 81;
cZoomIn	= 82;
cZoomOut	= 83;
cCustomize	= 84;
cRichText	= 85;
cOleObject	= 86;
cMathGraph	= 87;
cArrange	= 101;
cOrder	= 102;
cAlign	= 103;
cArcStyle = 104;
cInsert	= 105;
cView	= 106;
cTools	= 107;
cZoom	= 108;
cModifyDialog = 109;
cNonTransparentImage = 110;
cUnBoundLine = 111;
cSelectAll = 112;
cDeSelectAll = 113;
cInvertSelection = 114;
cPolylineOpen = 115;
cUnClipImage = 116;
cZoomArea = 117;
cInsertCurrentBlock	= 118;
cRunMacro = 119;
cFontDialog = 120;
cDimLines = 121;
cHorzDim = 122;
cVertDim = 123;
cAlignedDim = 124;
cTextCharset = 125;
cTextSize = 126;
cTextRatio = 127;
cDrawTool = 128;
cFormat = 129;
cFontStyle = 130;
cAlignDlg = 131;
cTransformDlg = 132;
cOptions = 133;
cGrids = 134;
cRulers = 135;
cGuides = 136;
cSnapGrid = 137;
cSnapGuides = 138;
cSnapObject = 139;
cGridColor = 140;
cGuideColor = 141;
cAngularGuides = 142;
cRulerSystem = 143;
cInch = 144;
cMetric = 145;
cRecordUndo = 146;
cPageLo = 147;
cPageOr = 148;
cBackColor = 149;
cMacroDir = 150;
cBlockDir = 151;
cA0 = 152;
cA1 = 153;
cA2 = 154;
cA3 = 155;
cA4 = 156;
cA5 = 157;
cA6 = 158;
cB4 = 159;
cB5 = 160;
cTabloid = 161;
cLetter = 162;
cCustom = 163;
cLandscape = 164;
cPortrait = 165;
cInfoXY = 166;
cInfoDim = 167;
cInfoMes = 168;
cCommEdit = 169;
cPageColor = 170;
cRunPlugin = 171;
cGridStep = 172;
cMapScale = 173;
cArcSel = 174; // used by system itself
cBmpSel = 175; // used by system itself
cLineSel = 176; // used by system itself
cPLineSel = 177; // used by system itself
cGroupSel = 178; // used by system itself
cAnySel = 179; // used by system itself
cPluginVerbs = 180;
cCenterGuides = 181;
cPluginManager	= 182;
cPageWidth = 183;
cPageHeight = 184;
cRulerMode = 185;
cGridType = 186;
cRadiusDim = 187;
cAngleDim = 188;
cOffset	= 189;
cConvertToBezier = 190;
cDuplicateAsBezier = 191;
cElpArc = 192;
cInterbreak = 193;
cKnife = 194;
cFreeHand = 195;





//OLE Cursors
  crOleDefault  = 0;
  crOleArrow    = 1;
  crOleCross    = 2;
  crOleIBeam    = 3;
  crOleSize     = 5;

  crOleSizeNESW    = 6;
  crOleSizeNS      = 7;
  crOleSizeNWSE    = 8;
  crOleSizeWE      = 9;
  crOleUpArrow     = 10;
  crOleHourGlass   = 11;
  crOleNoDrop      = 12;
  crOleAppStart    = 13;
  crOleHelp        = 14;
  crOleSizeAll     = 15;

  crOleDrag        = 16;
  crOleHandPoint   = 17;
  crOleHSplit      = 18;
  crOleVSplit      = 19;



//ole dragsource id s
oleDS_Surface = 3;
oleDS_BlockBox = 4;


// ole shift states
oleShift = 1;
oleCtrl = 2;
oleAlt = 4;
oleLeft = 8;
oleRight= 16;
oleMiddle = 32;
oleDouble = 64;

// ole mouse buttons
oleMbLeft = 0;
oleMbRight = 1;
oleMbMiddle = 2;

//ole drag state
oledsDragEnter = 0;
oledsDragLeave = 1;
oledsDragMove=2;

var spin : integer = 0;
var tip  : integer = 0;

const rd = PI/180;




Const BasicColors : array [1..48] of TColor = (8421631,8454143,8454016,8453888,
16777088,16744448,12615935,16744703,255,65535,65408,4259584,16776960,12615680,
12615808,16711935,4210816,4227327,65280,8421376,8404992,16744576,4194432,
8388863,128,33023,32768,4227072,16711680,10485760,8388736,16711808,64,16512,
16384,4210688,8388608,4194304,4194368,8388672,0,32896,4227200,8421504,8421440,
12632256,4194368,16777215);

//03.08.2012 - Цвета для прозрачности, от светлого к темному
const GrayedColors: array[0..59] of TColor = (
  $FCFCFC,$FAFAFA,$F7F7F7,$F5F5F5,$F2F2F2,$F0F0F0,$EDEDED,$EBEBEB,$E8E8E8,$E5E5E5,
  //clSilver,
  $E3E3E3,$E0E0E0,$DEDEDE,$DBDBDB,$D9D9D9,$D6D6D6,$D4D4D4,$D1D1D1,$CFCFCF,$CCCCCC,
  $C9C9C9,$C7C7C7,$C4C4C4,$C2C2C2,$BFBFBF,$BDBDBD,$BABABA,$B8B8B8,$B5B5B5,$B3B3B3,
  clSilver,
  $B0B0B0,$ADADAD,$ABABAB,$A8A8A8,$A6A6A6,$A3A3A3,$A1A1A1,$9E9E9E,$9C9C9C,$999999,
  $969696,$949494,$919191,$8F8F8F,$8C8C8C,$8A8A8A,$878787,$858585,$828282,$7F7F7F,
  $7D7D7D,$7A7A7A,$787878,$757575,$737373,$707070,$6E6E6E,$6B6B6B,$696969);

//03.08.2012 GrayedColor = clSilver;
DefGrayedColor = clSilver;

pointdim = 3;
ElpRes = 500;  // Line resolution when drawing an ellipse

    HeadLength=3.5;
    HeadHeight=1.2;


const BoolStr: array[0..1] of String = ('False','True');
const BoolString: array[Boolean] of String = ('False','True');
const SignBytes: array[1..8] of Byte = (123,125,212,234,076,065,169,214);
const RegChars: array[1..30] of Byte =(85,110,114,101,103,105,115,116,101,114,101,100,32,67,111,112,121,32,111,102,32,80,111,119,101,114,67,65,68,46);
const CsArray : Array [0..17] of Byte = (ANSI_CHARSET,DEFAULT_CHARSET,
SYMBOL_CHARSET,SHIFTJIS_CHARSET,GB2312_CHARSET,HANGEUL_CHARSET,CHINESEBIG5_CHARSET,
OEM_CHARSET,JOHAB_CHARSET,HEBREW_CHARSET,ARABIC_CHARSET,GREEK_CHARSET,TURKISH_CHARSET,
THAI_CHARSET,EASTEUROPE_CHARSET,RUSSIAN_CHARSET,MAC_CHARSET,BALTIC_CHARSET);


Type

TLanguage = 0..$FFFF;
TLangOption = (loLocalized, loEnglish, loNative, loAbbrev);
ConvertXYProc  = Procedure (var X,Y,Z: Double) of Object;
ConvertDimProc = Procedure (var Dim: Double) of Object;
TGetValueFunc = Function (Obj:Pointer):Double;
TGetValueFuncEx = Function (Obj,Data:Pointer):Double;

TStringArray = Array of String;
T2DStringArr = Array of Array [0..1] of String;
TWebCol = String;
TwebRow = Array of TwebCol;
TwebTable = Array of TWebRow;
TwebTableArr = Array of TWebTable;
TDetailStyle = (dsZoom,dsIsometry);

TMapDirection = (mdNorth,mdEast,mdSouth,mdWest,mdNorthEast,mdSouthEast,mdSouthWest,mdNorthWest);
T3DAxis = (aZ,aY,aX);
TInsertState = (isInsert,isDontInsert,isDelete);

TPCTool = (
toSelect,
toZoom,
toInsertBlock,
toInsertCurrentBlock,
toFigure,
toOperation,
toInsertUserPicture,
toDetailZoom,
toLocate,
toDelete,
toMWand
);

TFillType = (fsNone,fsSolid,fsHatch,fsGradient,fsTexture,fsExtended);
THatchStyle = (hsNone,hsHorizontal,hsVertical,hsCross,hsRDiagonal,
               hsLDiagonal,hsDCross,hsCheckered,hsDCheckered,
               hsHBricks,hsVBricks,hsDBricks);
TGradStyle = (gsNoGrad,gsRadCenter, gsRadTop, gsRadBottom, gsRadLeft,
              gsRadRight, gsRadTopLeft, gsRadTopRight, gsRadBottomLeft, gsRadBottomRight, gsLineHorz,
              gsLineVert, gsRefHorz, gsRefVert, gsDiagLineF, gsDiagLineB,
              gsDiagRefF, gsDiagRefB, gsArrowLeft, gsArrowRight, gsArrowUp, gsArrowDown,
              gsQuadrant, gsMirrored);
TTextureStyle = (txtNone,txtNewsPrint,txtRcPaper,txtParchment,txtStationery,txtGreenMarble,
                 txtWhiteMarble,txtBrownMarble,txtGranite,txtBluePaper,txtPinkPaper,
                 txtPurpleMesh,txtBouquet,txtPapyrus,txtCanvas,txtDenim,txtWovenMat,
                 txtWaterDroplets,txtPaperBag,txtFishFossil,txtSand,txtCork,txtWalnut,
                 txtOak,txtMediumWood,txtCustom);


TDrawStyle = (dsTrace,mydsNormal,dsCanvas);
TModPointType = ( ptUnDefined,ptCirclePoint, ptLineEnd, ptPolyPoint, ptRectPoint,
                  ptTextPoint,ptGroupPoint,ptBezierPoint,ptArcEnd,ptElpArcEnd,
                  ptElpPoint,ptPictPoint,ptControlPoint,ptCustomPoint,ptArcControl,ptRotPoint,ptRotCenter);

TBezierPoint = (psCorner,psCurve,psCurveCorner);
TSegmentType = (sLine,sCurve,sArc);

TRowStyle = ( rsNone,rsRightSolid,rsLeftSolid, rsBothSolid,
              rsRightLight,rsLeftLight,rsBothLight );
TPageLayout = ( plA0,plA1,plA2,plA3,plA4,plA5,plA6,plB4,plB5,plTabloid,
                plLetter,plCustom );
TPageOrient = ( poLandscape , poPortrait);

THorzAligns = ( haNoChange, haTop, haBottom, haCenter, haDistHorz );

TVertAligns = ( vaNoChange, vaLeft, vaRight, vaCenter, vaDistVert );
TTextAlign = (taTopLeft,taTopCenter,taTopRight,taMiddleLeft,taMiddleCenter,
              taMiddleRight,taBottomLeft,taBottomCenter,taBottomRight);
TTextVAlign = (vtCenter,vtTop,vtBottom);
TTextHAlign = (htCenter,htLeft,htRight); 

TRulerSystem = (rsMetric, rsWhitworth);
TVertZero = (vzBottom,vzTop);
THorzZero = (vzLeft,vzRight);

TShow = (seen,lost,grayed);
TGuideType = (gtVert,gtHorz);
TTBCommand = Integer;

TModifyMode = ( mmPenColor,mmPenWidth,mmBrushColor,mmPenStyle,mmBrushStyle,
                mmRowStyle, mmText, mmFontName, mmFontSize, mmFontCs, mmFontColor, mmFontStyle,
                mmFontBold,mmFontItalic,mmFontUnderline,mmFontStrike);

TOrderStyle = (osBack,osFront,osBward,osFWard);
TFigurePopStyle = (fpsNone,fpsStandart,fpsAppendCustom,fpsOnlyCustom);
THDimLabelStyle = (hlsInner,hlsLeft,hlsRight,hlsLeftTop,hlsLeftBottom,
                   hlsRightTop,hlsRightBottom);
TVDimLabelStyle = (vlsInner,vlsTop,vlsBottom,vlsTopLeft,vlsTopRight,
                   vlsBottomLeft,vlsBottomRight);
TADimLabelStyle = (alsInner,alsLeft,alsRight);
TCDimLabelStyle = (clsInner,clsLeft,clsRight);
TArcDimLabelStyle = (rlsInner,rlsOuter);


TEndType = (etClear,etRow,etDot,etNick);
TDimTextPos = (tpOnLine,tpAbove,tpBelow);

TFlipMode = (fmVert,fmHorz);
TFlipModes = set of TFlipMode;
TIconVertPos = (vposTop,vposBottom,vposMiddle);
TIconHorzPos = (hposLeft,hposRight,hposMiddle);

TArcStyle = (asOpen,asPie,asChord);

TStatementType =
  ( stDocBegin, stDocEnd, stLayerBegin, stLayerEnd,stTablesBegin,stTablesEnd,
    stBlockBegin,stBlockEnd,StFigureBegin,stFigureEnd,StInFigureBegin,stInFigureEnd,
    tValue,stPoints,stDocValue,stLayerValue,stBlockValue,StFigureValue,
    stUndefined);

TGridType = (grtLine,grtPoint,grtCross);

TDoublePoint = record
  x: Double;
  y: Double;
  z: Double;
end;

T3DPoint = TDoublePoint;
P3DPoint = ^T3DPoint;

TDoubleRect = record
  Left: Double;
  Top: Double;
  Right:Double;
  Bottom: Double;
end;

TSortItem = record
  Value: Double;
  Tag:LongInt;
end;

TSortItemArr = array of TSortItem;

  TRGB = record
    R, G, B: Double;
  end;


PDoublePoint = ^TDoublePoint;

TDoublePointArr = array of TDoublePoint;
PDoublePointArr = ^TDoublePointArr;

TPointArr = array of Windows.TPoint;
TDoublePointSet = array of  TDoublePointArr;
TDoublePointGroup = array of TDoublePointArr;
T3DPointArray = array of T3DPoint;
TBoolArray = array of Boolean;
TDoubleArray = array of Double;
PDoubleArray = ^TDoubleArray;

T3DFace = T3DPointArray;
TSolid= Array of T3DFace;
TTokenArray = Array [0..99] of string;
TByteArr = array of Byte;

TLayerInfo = record
  Name : string;
  visible : boolean;
  Grayed  : boolean;
end;

TShadowType = (stNone,stLine,stRectangle,stCircle,stPolyline);
TVectorSegmentType = (vstLine,vstBezier);
TVectorObjectType = (votLine,votBezier,votEllipse,votCircle,votPolyline,votPolygon,votPoint);
TFitMode = (fmNone,fmAutoGap,fmDistEnlarge,fmDistShrink,fmEnlargeLast,fmShrinkLast);
TCadMacro = Record
  Name: string;
  lines: TStringlist;
end;

//Tolik 03/06/2021 --
//TUndoActionType = (uaModify,uaInsert,uaRemove,uaOrder,uaGroup,uaUnGroup,uaClip,uaUnClip,uaReplace,uaDimLine);
TUndoActionType = (uaModify,uaInsert,uaRemove,uaOrder,uaGroup,uaUnGroup,uaClip,uaUnClip,uaReplace,uaDimLine, uaList, uaDesignList, uaProjectPlan);
//
TUndoAction = class(TMyObject)
  ActionType : TUndoActionType;
  FIndex: Integer;
  List: TList;
  Params: TList;
  RedoList: TList;
  Tag: Integer;
  Constructor Create(aType:TUndoActionType);
  Destructor Destroy;override;
end;

TEventCallBack = Procedure (Client:TObject; EventId: Integer; Numval:Integer;
                            StrVal: String; DblVal:Double;Enabled:Boolean);stdcall;

TEventItem = class
  Client: Tobject;
  CallBack: TEventCallBack;
  Constructor Create(aClient:TObject;aCallback: TEventCallBack);
end;

TEventEngine =  class (TObject)
  EventId:Integer;
  Clients: TList;
  NumVal : Integer;
  Strval : String;
  DblVal : Double;
  Enabled: Boolean;
  Function RegisterClient(Client:TObject;CallBack: TEventCallBack):Pointer;
  Procedure UnRegisterClient(EvHandle:Pointer);
  Procedure RaiseEvent(aNumVal: Integer; aStrval:String;
                                aDblVal:Double);overload;
  Procedure RaiseEvent(bVal:Boolean);overload;
  Procedure RaiseEvent(aNumVal:Integer);overload;
  Procedure RaiseEvent(aDblVal:Double);overload;
  Procedure RaiseEvent(aStrVal:String);overload;
  Procedure RaiseEvent;overload;
  Procedure EnableEvent(xEnabled: Boolean);
  Constructor Create (Id: Integer;aNumVal: Integer; aStrval:String;
                                aDblVal:Double);
  Destructor Destroy;override;
end;

TColorMenuItem = class(TMenuItem)
Private
  FColor:TColor;
  SelectedItem: TMenuItem;
  Bitmap: Graphics.TBitmap;
  Procedure SetColor(Value: TColor);
public
  Constructor Create(aOwner:TComponent);
  procedure ChildMeasureItem(Sender: TObject; ACanvas: TCanvas;
            var Width, Height: Integer);
  procedure ChildAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; State: TOwnerDrawState);
  procedure SelfMeasureItem(Sender: TObject; ACanvas: TCanvas;
            var Width, Height: Integer);
  procedure SelfAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; State: TOwnerDrawState);
  Procedure ColorSelected(Sender:TObject);
  Procedure SetBitmap(aBitmap: Graphics.TBitmap);
  Property Color:TColor read FColor write setColor;
end;

TColorChangeEvent = Procedure (Sender:Tobject; xColor:TColor) of Object;

TColorPopUp = class(TPopUpMenu)
Private
  FColor:TColor;
  SelectedItem: TMenuItem;
  FColorChange: TColorChangeEvent;
  Procedure SetColor(Value: TColor);
public
  Constructor Create(aOwner:TComponent);
  procedure ChildMeasureItem(Sender: TObject; ACanvas: TCanvas;
            var Width, Height: Integer);
  procedure ChildAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; State: TOwnerDrawState);
  Procedure ColorSelected(Sender:TObject);
  Property Color:TColor read FColor write setColor;
  Property OnColorChange:TColorChangeEvent read FColorChange write FColorChange;
end;

// Типы обьектов для TFaceRecord
TFaceType = (ftPolygon,ftLine,ftCube,ftBar,ftPipe,ftCircle,ftSphere,ftCenterCube, ftPicture,
             ftNetPath, ftNetDoor, ftNetWindow, ftNetBalconDoor, ftNetBalconWindow, ftNetFrame,
             ftNetFloor, ftNetCeiling, ftNet3DSObject, {Tolik 18/09/2018 -- }ftCylinder, ftBooblick);
// Типы стены
TFaceWallType = (fwtNone, fwtInner, fwtOuter, fwtDoorSlope, fwtWindowSlope, fwtBalconSlope, fwtNiche, fwtArc);
// Типы граней стены
TWallSideType = (wstNone, wstUpper, wstUnder, wstLeft, wstRight, wstLeftSide, wstRightSide);
// Типы отображения части стены
TWallViewTypes = (wvtNoUpper, wvtNoUnder, wvtNoLeft, wvtNoRight, wvtNoLeftSide, wvtNoRightSide);
TWallViewType = set of TWallViewTypes;


TFaceRecord = class(TMyObject)
  Points : T3DPointArray;
  PointsForNormal : T3DPointArray;
  Normal: T3dPoint;
  Color  : TColor;
  RecType: TFaceType;  //
  Size: Double;
  Trans: Boolean;
  OpTrans: Boolean;
  Info: String;
  FFigure: TObject;
// 22.07.2011
  F3DObject: TObject;
  FFaceWallType: TFaceWallType;
  FWallSideType: TWallSideType;
  FTreeNode: TTreeNode;
  FComponID: Integer;
  FCadID: Integer;
  constructor Create(fPoints: T3DPointArray; xColor: Tcolor; xType: TFaceType; xsize:Double = 0.1;
                     oTrans: Boolean = False; aFigure: TObject = nil; aComponID: Integer = 0);
  // Tolik
  Destructor destroy; override;
end;


TBevelShapeEx = (bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine,
    bsRightLine, bsSpacer,bsVertLine,bsHorzLine);

  TBevelEx = class(TBevel)
  private
    FShape: TBevelShapeEx;
    procedure SetShape(Value: TBevelShapeEx);
  protected
    procedure Paint; override;
  published
    property Shape: TBevelShapeEx read FShape write SetShape default bsBox;
  end;

TMFSOle = class(TOleContainer)
  private
    FOnChange:TNotifyEvent;
  protected
    procedure Changed; override;
  public
    Property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;


TMGScaleStyle = (gsNone,gsTick,gsNumbers,gsBoth);

TGuideTraces  = (gtNone,gtNinty,gtThirty,gtFortyFive,gtSixty,gtCustom);

TMouseTraceEvent  = procedure (Sender: TObject; Shift: TShiftState; X,Y: Double) of object;
TMousePushEvent   = procedure (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Double) of object;
TMousePullEvent   = procedure (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Double) of object;
TDropDragEvent    = procedure (Sender, Source: TObject; X, Y: Double) of object;
TDragTraceEvent   = procedure (Sender, Source: TObject; X, Y: Double;State: TDragState; var Accept: Boolean) of object;
TDragEndEvent     = procedure (Sender, Target: TObject; X, Y: Double) of object;
TDragStartEvent   = procedure (Sender: TObject; var DragObject: TDragObject) of object;
TSnapProc         = procedure (var x,y: Double) of object;

TPointType = (ptRect,ptCircle,ptCross,ptStar,ptRow,ptRCenter,ptECircle,ptCCross,ptTarget);
TPointArray = array of TPoint;
glnarray = ARRAY [1..1000] OF real;
TFigHandle = LongInt;

  TColorSpeedButton = class(TSpeedButton)
  protected
      procedure Paint; override;
  end;

const
  MaxPixelCount   =  32768;

const penstyles   : array[0..6] of TPenStyle   = (psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear, psInsideFrame);
const brushstyles : array[0..7] of TBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical, bsFDiagonal, bsBDiagonal, bsCross, bsDiagCross);

  (*
const mval : array [1..4,1..4] of real = (
                                             ( -1,  3, -3, 1 ),
                                             (  3, -6,  3, 0 ),
                                             ( -3,  3,  0, 0 ),
                                             (  1,  0,  0, 0 )
                                             );


  { -0.5,  1.5, -1.5,  0.5 },
  {  1.0, -2.5,  2.0, -0.5 },
  { -0.5,  0.0,  0.5,  0.0 },
  {  0.0,  1.0,  0.0,  0.0 }};



const mval : array [1..4,1..4] of real = (
                                             ( -0.5,  1.5, -1.5,  0.5 ),
                                             (  1.0, -2.5,  2.0, -0.5 ),
                                             ( -0.5,  0.0,  0.5,  0.0 ),
                                             (  0.0,  1.0,  0.0,  0.0 )
                                             );
Matrix bsplinematrix = {
  { -1.0/6.0, 3.0/6.0, -3.0/6.0, 1.0/6.0 },
  {  3.0/6.0, -6.0/6.0, 3.0/6.0, 0.0     },
  { -3.0/6.0,  0.0,     3.0/6.0, 0.0     },
  {  1.0/6.0,  4.0/6.0, 1.0/6.0, 0.0     }};

const mval : array [1..4,1..4] of real = (
                                             ( -1.0/6.0, 3.0/6.0, -3.0/6.0, 1.0/6.0),
                                             (  3.0/6.0, -6.0/6.0, 3.0/6.0, 0.0 ),
                                             ( -3.0/6.0,  0.0,     3.0/6.0, 0.0 ),
                                             (  1.0/6.0,  4.0/6.0, 1.0/6.0, 0.0 )
                                             );
*)

const mval : array [1..4,1..4] of real = (
                                             ( -1,  3, -3, 1 ),
                                             (  3, -6,  3, 0 ),
                                             ( -3,  3,  0, 0 ),
                                             (  1,  0,  0, 0 )
                                             );


TYPE

  pRGBArray  =  ^TRGBArray;    // Use SysUtils.pByteArray for 8-bit color
  TRGBArray  =  ARRAY[0..MaxPixelCount-1] OF TRGBTriple;


Function ValidateString(str: String):String;

Function readInt(ptr: pointer; index: integer): Pint;
Procedure PutSign(canvas: TCanvas;point:Tpoint);
Function IspointInBezier(p1,p2,p3,p4,point:TDoublepoint):boolean;
Function IspointInPolyBezier(Points:TDoublePointArr;Point:TDoublepoint):boolean;
Function IspointInArc(hp,cp:TDoublePoint;rad: Double;arcstyle:Integer;a1,a2:Double):Boolean;overload;
Function IspointInArc(hp,cp:TDoublePoint;rad: Double;arcstyle:Integer;ap1,ap2:TDoublePoint;inverted:Boolean):Boolean;overload;
Function IspointInCircle(x,y,cx,cy,radius:Double):Boolean;
Function IspointInEllipse(x,y,cx,cy,alen,blen,angle:Double):Boolean;
Function GetArcCenter(p1,p2:TDoublepoint;Angle:Double):TDoublePoint;
Function GetBezierSample(p1,p2,p3,p4:TDoublepoint;Index,Resolution:Integer):TDoublePoint;overload;
Function GetBezierSample(p1,p2,p3,p4:TDoublepoint;tx:Double):TDoublePoint;overload;
Procedure BeziersToPolyline(bpoints:TDoublePointArr;var pPoints:TDoublePointArr; PatchLen:Double);
Procedure BezierToPolyline(p1,p2,p3,p4:TDoublePoint;var pPoints:TDoublePointArr; PatchLen:Double;incFirst:Boolean);
Function AddFileExt(Fname,FExt:String):String;
//Tolik 15/12/2021 --
function IsPointInLine3D(const m1,m2 : TDoublePoint;
                       const p : TDoublePoint;
                       PenWidth : double;
                       MarginDelta:Double = 2) : Boolean;
//
function IsPointInLine(const m1,m2 : TdoublePoint;
                       const p : TDoublePoint;
                       const PenWidth : Integer;MarginDelta:Double = 2) : Boolean;
function PointInRect(const P: TDoublePoint; const R: TDoubleRect): Boolean;
function PointInPolyRect(P: TDoublePoint; r1,r2,r3,r4: TDoublePoint): Boolean;
Function PtInPolygon(POINTS:TDoublePointArr; ptTest:TDoublePoint):Boolean;
Function RectCenter(Rect:TDoubleRect):TDoublePoint;
Procedure GetPolylineBounds(Points:TDoublePointArr;var figMaxX,figMaxY,figMinX,figMinY: double);
Procedure GetBezierBounds(p1,p2,p3,p4:TDoublePoint;var figMaxX,figMaxY,figMinX,figMinY: double);
Procedure GetPolyBezierBounds(Points:TDoublePointArr; var figMaxX,figMaxY,figMinX,figMinY: double);
Procedure GetArcBounds(p1:TDoublePoint; rad1,rad2: Double; arcstyle: Integer; a1,a2,a: Double;
                       var figMaxX,figMaxY,figMinX,figMinY: double);
Procedure GetDoubleArcPoints(cx,cy,rad1,rad2,a1,a2,a3,a4:Double; var p:TdoublePointArr);
Procedure DoubleArcToPolyGon(cx,cy,rad1,rad2,a1,a2,a3,a4:Double; var p:TdoublePointArr);

Function GetRelativePointbyAngle(angle: integer;cPoint,oPoint: TPoint) : TPoint;
Function GetRelativePointbyAngleFloat(angle: Double;cPoint,oPoint: TDoublePoint) : TDoublePoint; //#From Oleg# //12.09.2011
Procedure ScalePoints(var points:array of TPoint;percentx,percenty: integer; rPoint: TPoint);
Function GetRelativePointbyscale(percentx,percenty: integer;rPoint,oPoint: TPoint) : TPoint;
Function GetSymetricPoint(sPoint,lPoint1,lPoint2: TDoublePoint): TDoublePoint;
Function GetPointOnEllipse(cx,cy,a,b,elpAngle,pAngle:integer):TPoint;
Procedure GenerateBezierCPoints(p1,p2,p3: TDoublepoint; var cp1,cp2:TDoublepoint; Corner: Boolean);

function  Get2DPoint(X, Y, Z,dx,dy: Extended): TPoint;

Function ReadStringFromStream(Stream:TStream):String;
Procedure WriteString(Stream:TStream; str:string);
Procedure WriteStringToStream(Stream:TStream; str:string);
Procedure WriteField(Code:Byte; Stream:TStream; Const Value; Size: integer);
Procedure WriteStrField(Code:Byte;Stream:TStream; Const Value:String);
Procedure WriteBinField(Code:Byte; Stream:TStream; Const Value:pByte; Size: integer);
Procedure WriteStreamField(Code:Byte; Stream:TStream; Const Value:TStream);
Procedure StreamToStream(str:TStream; ToStr: TStream; Size:Integer);
Function StreamEqual(str1,str2:TStream):Boolean;


Procedure StreamToClipBoard(str:TMemoryStream;format:word);
Procedure ClipBoardToStream(str:TMemoryStream;format:word);
function RemoveTags(str: String; rtf: Boolean): String;
Function RemoveBlocks(str:String; s1,s2: String):String;
Function SplitWebTable(WebText:String; var TableArr: TWebTableArr):Integer;


function LanguageName(Language: TLanguage): String;
function CharSetFromLocale(Language: TLanguage): TFontCharSet;
function CodePageFromLocale(Language: TLanguage): Integer;
function OEMCodePageFromLocale(Language: TLanguage): Integer;
//function CharToWide(const S: String; CodePage: Word): WideString;
function CharToWide(const S: AnsiString; CodePage: Word): WideString;
//function WideToChar(const WS: WideString; CodePage: Word): String;
function WideToChar(const WS: WideString; CodePage: Word): AnsiString;
function CharToChar(const S: AnsiString; CP1, CP2: Word): AnsiString;
//function LengthEx(S: String; CP: Word): Integer;
function LengthEx(S: AnsiString; CP: Word): Integer;
procedure getellipseBounds(x,y,a,b,xangle: double;lines: integer; var BoundRect: TDoubleRect);
Function GetTextureBitmap(Idx:Integer):Graphics.TBitmap;


// Parser Functions

Function ParseCommand(Command: String; var StrArray: TStringArray):integer;

Procedure GetTokensInLine(statement: string; var tokencount: integer;
                          var tokens : TTokenarray);
Function CheckHeader(statement: string):TStatementType;
Function CheckStatement(statement: string; var sName: string; var sValue: string ): Boolean;
Function GetPointFromSource(index: integer; Source: string): TPoint;
Function GetValFromStrArray(index: integer; Source: string): String;
Function SplitStr(Line:string; var s:TStringArray; delim:String=','): integer;
Procedure SplitWebResult(Res:String; var sArr:T2DStringArr;delim:String='=');
Function ReadTag(tName,tDef:String;var xTags:T2DStringArr):String;
Procedure WriteTag(tName,tVal:String;var xTags:T2DStringArr);
Procedure WriteHexStringAsStream(str:String; Stream:TStream);
Function StreamAsHexString(Stream:TStream):String;
Procedure ReadTagFromStream(Stream:TStream; var TagArr: T2dStringArr);
Procedure WriteTagToStream(Stream:TStream; TagArr: T2dStringArr);


// Info Functions
Function GetAngleofLine(cp,p: TPoint; var reg:integer):integer;
//Function GetAngleOf2Lines(p11,p12, p21, p22: TDoblePoint):Double;
Function GetRadOfLine(cp,p: TPoint):Real;overload;
Function GetRadOfLine(cp,p: TDoublePoint):Real;overload;
Function GetRadOf2Lines(p1,p2,p3:TDoublePoint):Real;
Function CoRegOfLine(Rad:Double):Integer;
Function DirectionOfAngle(rad1,rad2:Double):TMapDirection;


function GetLineLenght(p1,p2: TDoublePoint; Planer:Boolean = True):Real;
function GetLineLength(p1,p2: TDoublePoint; Planer:Boolean = True):Real;

Function GetLineSegmentPoint(p1,p2:TDoublepoint; ratio: double):TDoublePoint;
Function GetLineFormula(p1,p2: TDoublepoint;var a,b: double):Boolean;
Function Get90LineFormula(p1,p2: TDoublepoint;var a,b: double):Boolean;
Procedure PointTo90Line(p1,p2:TDoublePoint; var x,y: Double);
Procedure PointToLine(p1,p2:TDoublePoint; var x,y: Double);
Procedure PointToLineByLen(p1,p2:TDoublePoint; var p: TDoublePoint);
Procedure PointToLineByAngle(p1,p2:TDoublePoint; var p: TDoublePoint);
Procedure PointToParallelLine(p1,p2:TDoublePoint; var x,y: Double);
Function PointByDistToLine(p1,p2:TDoublePoint; Dist:Double):TDoublePoint;
Function PointByDistToLineA(p1,p2:TDoublePoint; Dist,Angle:Double):TDoublePoint;
Function PointOutToLine(p1,p2,xp:TDoublePoint; Dist:Double):TDoublePoint;
Function GetDistToLine(p1,p2,p:TDoublePoint):Double;
Function GetAreaofPGon(p:array of Tpoint; nPoint: integer):real;overload;
Function GetAreaofPGon(p:TdoublePointArr):real;overload;
Function GetPerimeterOfCircle(r:double): real;
Function GetAreaOfCircle(r:double): real;
Function CreateLinearRgn(p1,p2: TDoublepoint): HRGN;
Function CreateRotatedRgn(p1: TDoublepoint; w,h:double;rad: double): HRGN;
Function AngleDist(a1,a2:Double):Double;
Function SurfaceColor(a,b,c,light:T3DPoint):TColor;overload;
Function SurfaceColor(Face:T3DPointArray;light:T3DPoint):TColor;overload;
Function SurfaceColor(a1,a2:TDoublePoint):TColor;overload;
Function Gray(level:Byte):TColor;
Function Bluer(level:Byte):TColor;
Function GetLineNormal(p1,p2:TDoublePoint;dist:Double):TdoublePoint;


Procedure RotateCanvas(Handle:HDC; Ang: Real);
Procedure FlipCanvas(Handle:HDC; fMode: TFlipMode;delta:double=0);
Procedure ResetCanvas(Handle:HDC);
Function RotatePoint(cpoint, opoint: Tpoint; ang: real):TPoint;overload;
Function RotatePoint(cpoint, opoint: TDoublepoint; ang: real):TDoublePoint;overload;
Function ScalePoint(cpoint, opoint: TDoublepoint; px,py: real):TDoublePoint;
//Tolik -- 12/02/2016 --
// Function RotateDPoint(cpoint, opoint: TDoublepoint; ang: real):TDoublePoint;
  Function RotateDPoint(cpoint, opoint: TDoublepoint; ang: double):TDoublePoint;
//
Function DoublePoint(x,y:Double):TDoublePoint;overload;
Function DoublePoint(pt:Tpoint):TDoublePoint;overload;
Function DoublePoint(x,y,z:Double):TDoublePoint;overload;
Function DoublePoint(p:TdoublePoint;z:Double):TDoublePoint;overload;
Function DP(pt:TPoint):TDoublePoint;
Procedure SwapPoints(var p1,p2:TDOublePoint);
Procedure ShrinkLine(var p1,p2:TDoublePoint;d:Double);
Procedure ExtendLine(var p1,p2:TDoublePoint;d:Double);
Procedure ShrinkRect(var Rect:TDoubleRect;d:Double);
Function MPoint(p1,p2:TDoublePoint):TDoublePoint;overload;
Function MPoint(r:TDoubleRect):TDoublePoint;overload;
Function MPoint(p1,p2:TDoublePoint;Step:Integer):TDoublePoint;overload;
Function MPoint(p1,p2:TDoublePoint;Delta:Double;Planer:Boolean = True):TDoublePoint;overload;
Function PushPoint(p1,p2:TDoublePoint;Delta:Double;var Ended:Boolean):TDoublePoint;
Function FindGroundPoint(xp1,xp2:TDoublePoint;gLevel: Double):TDoublePoint;
Function QrPoint(p1,p2:TDoublePoint):TDoublePoint;
Function MVPoint(p:TDoublePoint;dy:Double):TDoublePoint;
Function MHPoint(p:TDoublePoint;dx:Double):TDoublePoint;
Function MovePoint(p:TDoublePoint;dx,dy:Double):TDoublePoint;
procedure MovePt(p:PDoublePoint;dx,dy:Double);
Function MovePointTo(p,dp:TDoublePoint;dx,dy:Double):TDoublePoint;
Function GetRightPointIndex(p1,p2,eye:TDoublePoint):Integer;

Procedure DoubleBezier(p1,p2,p3,p4:TDoublePoint;var t: TDoublePointArr; thick: Double);
Function SubBezier(p0,p1,p2,p3: TDoublePoint; var dPoint,cp1,cp2,cp3,cp4:TDoublePoint; ts:Double):Boolean;overload;
Function SubBezier(p0,p1,p2,p3: TDoublePoint; var dPoint,cp1,cp2,cp3,cp4:TDoublePoint; ts:Double; bp1,bp2:TDoublepOint):Boolean;overload;
Procedure GetParallelPoints(p1,p2:TDoublePoint; var np1,np2: TDoublePoint; thick: Double);
Procedure GetShrinkedPoints(p1,p2:TDoublePoint; var np1,np2: TDoublePoint; thick: Double);
Procedure OffsetPoint(op,cp:TDoublePoint; var np:TDoublePoint; delta: Double);
Procedure SortDouble(var SArr:TDoubleArray);
Procedure SortItems(var SArr:TSortItemArr);
Procedure SortList(var sList:Tlist; GetValueFunc:TGetValueFunc);overload;
Procedure SortList(var sList:Tlist; GetValueFunc:TGetValueFuncEx; Data:Pointer);overload;

Procedure SortPointsOnLine(p1,p2: TDoublePoint;var pArr:TDoublePointArr);
Procedure InSertPointToArray(var pArr:TDoublePointArr; index:Integer; p:TDoublePoint);
Function CheckSelfIntersection(var pArr:TDoublePointArr):Boolean;
Function CheckLineOnLine(pArr:TDoublePointArr):Boolean;overload;
Function CheckLineOnLine(p1,p2,p3,p4:TDoublePoint):Boolean;overload;
Function LinesIntersect(p1,p2,p3,p4:TDoublePoint):Boolean;
Function GetInterSectionPoint(p1,p2,p3,p4:TDoublePoint; var p:TDoublePoint; extend:Boolean=True;UseTips:Boolean=False): Boolean;
Function GetLineCircleIntersection(p1,p2,cp:TdoublePoint;radius:Double; var np1,np2: TDoublePoint;var icnt:Integer; extend:Boolean = true):Boolean;
Function GetLineEllipseIntersection(p1,p2,cp:TdoublePoint;aLen,Blen,Angle:Double; var np1,np2: TDoublePoint;var icnt:Integer; extend:Boolean = true):Boolean;
Function GetCircleCircleIntersection(cp1:TdoublePoint;rad1:Double;cp2:TdoublePoint;rad2:Double; var np1,np2: TDoublePoint;var icnt: Integer):Boolean;
Function GetLineBezierIntersection(p1,p2,bp1,bp2,bp3,bp4:TDoublePoint; var pArr:TDoublePointArr;
                               var icnt:Integer; extend:Boolean = true):Boolean;
Function GetClosePoint(cPoint,p1,p2:TDoublePoint):TDoublePoint;
Function TraceBezier(bp1,bp2,bp3,bp4,tPoint:TDoublePoint; tIndex: Integer; var t1,t2: Double): integer;
Function GetBezierTime(bp1,bp2,bp3,bp4,dp:TDoublePoint):Double;overload;
Function GetBezierTime(bp1,bp2,bp3,bp4,p1,p2:TDoublePoint):Double;overload;
Function DP2P(pt:TDoublepoint):TPoint;overload;
Function DP2P(ptx,pty:Double):TPoint;overload;
Function DR2R(x1,y1,x2,y2:Double):Trect;overload;
Function DR2R(r:TDoubleRect):Trect;overload;
Function EQDP(p1,p2: TDoublePoint):Boolean;
Function EQDPZ(p1,p2: TDoublePoint):Boolean;
Function NormalizePoint(p:TDoublePoint):TDoublePoint;
Function EQD(a1,a2: Double):Boolean;
Function Sign(number:Double):Integer;
Function DoubleRect(Left,Top,Right,Bottom:Double):TDoubleRect;overload;
Function DoubleRect(iRect:Trect):TDoubleRect;overload;
Function RectOverlaps(r1,r2:TDoubleRect):Boolean;
Function BetWeen(x,x1,x2:Double):Boolean;
Function FaceOverlaps(f1,f2:T3DFace):Boolean;overload;
Function FaceOverlaps(f1,f2:TDoublePointArr;freg1,freg2:HRGN):Boolean;overload;
Function Convert3DPoint(p:T3DPoint; YHeight: Double = 0):TDoublePoint;
Function GetCloserFace(f1,f2:T3DFace;Camera:T3DPoint):Integer;
Function GetCameraPos(cPoint,oPoint:T3DPoint; HorzAngle,VertAngle:Double):T3DPoint;
Function Rotate3DPoint(cPOint,oPoint:T3DPoint; Ang:Double;axis:T3DAxis):T3DPoint;
Function Make5Face(p1,p2,p3,p4,p5:T3DPoint):T3DFace;
Function Make4Face(p1,p2,p3,p4:T3DPoint):T3DFace;
Function Make4FaceMar(p1,p2,p3,p4:T3DPoint;Mar:Double):T3DFace;
Function Make2Face(p1,p2:T3DPoint):T3DFace;
Function Make3Face(p1,p2,p3:T3DPoint):T3DFace;
Procedure GetFaceDraw(Face:T3DFace;var pArr:TdoublePointArr);
Function ConvertIsometricPoint(p:TDoublePoint;h,izalfa:Double;isoType:Byte=0):TDoublePoint;
Function DeConvertIsometricPoint(p:TDoublePoint;h,izalfa:Double;isoType:Byte=0):TDoublePoint;
procedure setupPixelFormat(DC:HDC);

procedure EllipseToBezier( elpR: TRect;var bzPoints: Array of TPoint);
//Function GetBezierPolyPoints(var polypoints: array of TPoint;
//bezPoints: array of TPoint;PointCount:integer;DEngine:Pointer):integer;
Function GetBezierDistance(p0,p1,p2,p3,p4:TDoublePoint):Real;
Function GetBezierPatch(p1,p2,p3,p4:TDoublePoint;pWidth: Double;
         var LastIndex: Integer; var pi,pf:TDoublePoint; ToEnd: Boolean;res: Integer):Double;
Function GetBezierBegin(p1,p2,p3,p4:TDoublePoint;pWidth: Double;res: Integer):TDoublePoint;
Function GetBezierEnd(p1,p2,p3,p4:TDoublePoint; pWidth: Double;res: Integer):TDoublePoint;

Function GetLinePatch(p1,p2:TDoublePoint;pWidth: Double;var cumWidth:Double;
         var pi,pf:TDoublePoint):Double;
Function GetVectorPenPoints(Style:Integer;var VectorPoints: TList): Integer;

Function InputDouble(Caption,Prompt:String; var Value:DOuble):Boolean;
Function InputInteger(Caption,Prompt:String; var Value:Integer):Boolean;
Function InputString(Caption,Prompt:String; var Value:String):Boolean;
Function InputStringEdit(Caption,Prompt:String; var Value:String; px,py:Integer):Boolean;
Function InputDoubleEdit(Prompt:String; var Value:Double; px,py:Integer):Boolean;
Function InputIntegerEdit(Prompt:String; var Value:Integer; px,py:Integer):Boolean;
Function InputMemo(Caption,Prompt:String; var Value:String):Boolean;


Procedure DrawBitmap(fCanvas:TCanvas; Fbitmap:Graphics.TBitmap;x,y: Integer; Enabled:Boolean);
Function GetPreviewImage(fileName:String): Graphics.TBitmap;
function GetBmpDPI(bmpName:String): LongInt;overload;
function GetBmpDPI(bmpStream:TStream): LongInt;overload;
function GetJpgdpi(filename:String):Integer;
Function CreateUniqueId:Integer;
Function OleShiftToDelphiSet(oleState:Integer):TShiftState;
Function DelphiSetToOleShift(Shift:TShiftState):Integer;
Function OleCursor(cr:TCursor):Integer;
function DelphiLoaded : boolean;
function FolderDialog(Caption: String) : String;
Procedure RegWrite(IName,IValue:String;Key:String='');overload;
Procedure RegRead(IName:String; var IValue:String;Key:String='');overload;
Procedure RegWrite(IName:String;IValue:Integer;Key:String='');overload;
Procedure RegRead(IName:String; var IValue:Integer;Key:String='');overload;
Procedure RegWrite(IName:String;IValue:Boolean;Key:String='');overload;
Procedure RegRead(IName:String; var IValue:Boolean;Key:String='');overload;
Procedure CloseFace(var Face:T3dFace);
Procedure MatrixMultiply( cCount: Integer; ml: array of Double; mr : array of Double; var m: array of Double);
Function RegInReg(inReg,Reg:Integer):Boolean;
Function MakeFloat(str:String;def:Extended):Extended;
Function BByte(Value:Boolean):Byte;
Function BBool(Value:Byte):Boolean;
function GetColorBetween(StartColor,EndColor: TColor; Pointvalue, Von,Bis : Extended): TColor;
procedure DrawGradientBox(DC: HDC; const R: TRect; Colors: array of TRGB);
Procedure MakeGradBitmap(ColorBegin,ColorEnd:TColor;GStyle:TGradStyle;var GradBmp:Graphics.TBitmap);
Function MakeRgb(r,g,b:Double):TRGB;
Function DoubleRound(Val:Double; Dec:Integer):Double;
Function RoundUp(Val:Double):Integer;
Function AddToFileName(FName,add:String):String;
function RegisterAssociation(const aExeName, aFileExt, aFileDesc,aFileIcon: string): Boolean;
procedure GetVerInfo(forModule: tHandle; var V1, V2, V3, V4: Word);
Function Like(s1,s2:String):Boolean;
Function GetPointsDist(Points:TDoublePOintArr):Double;
Function ByteToHexStr(val:Byte):String;
Function HexStrToByte(val:String):Byte;
Function GetHexVal(str:String):Byte;
function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
procedure PrintGrid(sGrid: TStringGrid; sTitle: string);
Function Obeb(a,b:Integer):Integer;
Function InttoStrL(val:integer; sCount:Integer):String;
Function LeadStr(val:String; sCount:Integer):String;
Function FormatSqlDate(xDate:Integer):Integer;
Function FirstWords(Str:String; cnt:Integer):String;
Procedure DrawTraceText(x,y:Integer;Color:TColor;Text,FontName:String;
                        FontSize:Integer;Canvas:TCanvas);
Function GetHatchStyle(brStyle: Byte):THatchStyle;
Function GetFillType(brStyle: Byte):TFillType;
Function GetGradStyle(brStyle: Byte):TGradStyle;
Function GetTextureStyle(brStyle: Byte):TTextureStyle;

function GetAreaFromPolygon(APolygon: TDoublePointArr): Double;
function GetLineLength3D(p1, p2: T3DPoint): Double;
//function GetLineLength3D(p1, p2: PDoublePoint): Double; overload;
function GetTriangleArea3D(p1, p2, p3: T3DPoint): Double;
function IsPointNear(APointX, ApointY, ANearX, ANearY: Double): Boolean; //#From Oleg# //05.10.2010
function Intersect(p1,p2,p3,p4:TDoublePoint):Boolean;

procedure DeletePointFromArray(var Arr: TDoublePointArr; Index: Integer);

var FigureClasses:TList;
    FigureClassesSL: TStringList; //01.11.2011
    OSVersion: TOSVersionInfo;
    GlobalZ: Double=0;
    CompSign :Double= 5298467.0876;
    TextureBmp: Graphics.TBitmap;
    GrayedColor: TColor = clSilver; //03.08.2012 - перенесена из констант


Const bsHorzGrad   = 9;
Const bsVertGrad   = 10;
Const bsRadGrad    = 11;
Const bsDiagFGrad  = 12;
Const bsDiagBGrad  = 13;
Const bsMirrorGrad   = 14;
Const bstxtNewsPrint   = 15;
Const bstxtStationery   = 16;
Const bstxtWhiteMarble   = 17;
Const bstxtWovenMat   = 18;
Const bstxtPaperBag   = 19;
Const bstxtMediumWood   = 20;
Const bsExHatch   = 21;
Const bsExGrad    = 22;
Const bsExTexture = 23;





implementation

{$R fill.RES}

(* ========================================================================== *)

//                             UTILITY IMPLEMENTATION                         //

(* ========================================================================== *)


Procedure GetTokensInLine(statement: string; var tokencount: integer;
                          var tokens : TTokenarray);
var token : string;
    ch : string[1];
    tab : boolean;
    len : integer;
    a: Integer;
begin
  len := length(statement);
  tab := true;
  token := '';
  tokencount := 0;
  for a := 1 to Len do
  begin
    ch := copy(statement,a,1);
    if ch = ' ' then
    begin
      if not tab then
      begin
        tokencount := tokencount+1;
        tokens[tokencount-1] := token;
        token := '';
      end;
    end
    else if ch = '''' then
    begin
      token := copy(statement,a+1,len-a);
      tokencount := tokencount+1;
      tokens[tokencount-1] := token;
      token := '';
      exit;
    end
    else
    begin
      tab := false;
      token := token + ch;
    end;
  end;
  if token<> '' then begin
    tokencount := tokencount+1;
    tokens[tokencount-1] := token;
  end;
end;

Function CheckStatement(statement: string; var sName: string; var sValue: string ): Boolean;
var tokencount: integer;
    tokens: TTokenArray;
Begin
  GetTokensInLine(statement,tokencount,tokens);
  result := false;
  if tokencount = 3 then
  begin
    if tokens[1] <> '=' then
    begin
      result := false;
    end
    else
    begin
      result := true;
      sName := tokens[0];
      sValue := tokens[2];
    end;
  end;
End;

Function CheckHeader(statement: string):TStatementType;
var tokencount: integer;
    tokens: TTokenArray;
    sType : TStatementType;
Begin
  GetTokensInLine(statement,tokencount,tokens);
  if tokencount = 1 then
  begin
         if tokens[0]= 'DocBegin' then sType := stDocBegin
    else if tokens[0]= 'LayerBegin' then sType := stLayerBegin
    else if tokens[0]= 'BlockBegin' then sType := stBlockBegin
    else if tokens[0]= 'FigureBegin' then sType := stFigureBegin
    else if tokens[0]= 'InFigureBegin' then sType := stInFigureBegin
    else if tokens[0]= 'DocEnd' then sType := stDocEnd
    else if tokens[0]= 'LayerEnd' then sType := stLayerEnd
    else if tokens[0]= 'BlockEnd' then sType := stBlockEnd
    else if tokens[0]= 'FigureEnd' then sType := stFigureEnd
    else if tokens[0]= 'InFigureEnd' then sType := stInFigureEnd
    else if tokens[0]= 'TablesBegin' then sType := stTablesBegin
    else if tokens[0]= 'TablesEnd' then sType := stTablesEnd
    else sType := stUndefined;
  end
    else sType := stUndefined;
  result := sType;
end;

Function GetValFromStrArray(index: integer; Source: string): String;
var a,len: integer;
    vals: string;
    vcnt: integer;
begin
  len := Length(Source);
  Source := Copy(Source,2,len-2);
  vals := '';
  vcnt := 0;
  For a := 1 to len do begin
    if Copy(source,a,1) <> ',' then begin
      vals := vals + Copy(source,a,1);
    end
    else begin
      vcnt := vcnt+1;
      if vcnt = index then begin
        result := vals;
        exit;
      end;
      vals := '';
    end;
  end;
  if (vcnt = index -1) and (vals <> '') then result := vals;
end;

Function GetPointFromSource(index: integer; Source: string): TPoint;
var len,count,start,a,b: integer;
    xstr,ystr,pstr: string;
    Opened,Closed : Boolean;
    ch : string[1];
    second : boolean;
Begin
  len := length(source);
  xstr := '';
  ystr := '';
  Opened := false; closed := TRUE; second := false;
  start := -1;
  count := 0;
  For a := 1 to len do
  begin
    ch := copy(source,a,1);
    if ch = '[' then begin
      if closed then
      begin
        opened := true;
        start := a;
      end
      else
      begin
        // error
      end;
    end;
    if ch = ']' then
    begin
      if opened then
      begin
        closed := true;
        count  := count +1;
        if count = index then
        begin
          pstr := copy(source,start+1, a -1 -start);
          for b := 1 to length(pstr) do
          begin
            ch := copy(pstr,b,1);
            if ch = ',' then
            begin
              second := true;
            end
            else
              if not second then xstr := xstr+ ch else ystr := ystr + ch;
          end;
        end;
      end
      else
      begin
        // error
      end;
    end;
  end;
  try
    result := Point(strtoInt(xstr),strtoInt(ystr));
  except
  end;
end;


Function readInt(ptr: pointer; index: integer): Pint;
begin
  result := pInt(pchar(ptr)+ (index -1)*sizeof(integer));
end;

function  Get2DPoint(X, Y, Z,dx,dy: Extended): TPoint;
var
    ratio: extended;
begin
  ratio := 30;
  Result := Point(Round(dx + Ratio * (X - Y * 1/sqrt(2))),
                  Round(dy + Ratio * (-Z + y *1/sqrt(2))));
end;

Procedure SplitWebResult(Res:String; var sArr:T2DStringArr;delim:String='=');
var sList: TStringList;
    i: Integer;
    sx:TStringArray;
begin
  Res := StringReplace(Res,'<br>',#13,[rfReplaceAll,rfIgnoreCase]);
  sList := TstringList.Create;
  sList.Text := Res;
  SetLength(sArr,0);
  for i := 0 to sList.Count-1 do
  begin
    SetLength(sArr,i+1);
    SplitStr(sList[i],sx,delim);
    sArr[i,0] := '';
    sArr[i,1] := '';
    if Length(sx) > 0 then sArr[i,0] := sx[0];
    if Length(sx) > 1 then sArr[i,1] := sx[1];
  end;
  sList.Free;
end;

Function ReadTag(tName,tDef:String;var xTags:T2DStringArr):String;
var i: Integer;
begin
  result := tDef;
  for i := 0 to Length(xTags)-1 do
  begin
    if lowercase(xTags[i,0]) = lowercase(tName) then
    begin
      result := Trim(xTags[i,1]);
      break;
    end;
  end;
end;

Procedure WriteTag(tName,tVal:String;var xTags:T2DStringArr);
var i,Len: Integer;
    found: Boolean;
begin
  found := false;
  for i := 0 to Length(xTags)-1 do
  begin
    if lowercase(xTags[i,0]) = lowercase(tName) then
    begin
      xTags[i,1] := tVal;
      found := true;
      break;
    end;
  end;
  if not found then
  begin
    Len := Length(xTags);
    SetLength(xTags,Len+1);
    xTags[Len,0] := tName;
    xTags[Len,1] := tVal;
  end;
end;

Procedure WriteHexStringAsStream(str:String; Stream:TStream);
var sText: String;
   p:Integer;
   len: Integer;
   mStream: TMemoryStream;
   hStr: String;
   val: Byte;
   i:Integer;
begin
  if str <> '' then begin
    sText := str;
    len := Length(sText) div 2;
    for i := 1 to len do begin
      hStr := Copy(sText,(i-1)*2+1,2);
      val := HexStrToByte(hStr);
      Stream.Write(val,1);
    end;
  end;
end;

Function StreamAsHexString(Stream:TStream):String;
var by:Byte;
begin
  result := '';
  Stream.Position := 0;
  repeat
    Stream.Read(by,1);
    result := result+ ByteToHexStr(by);
  until (Stream.Position >= Stream.Size);
end;


procedure ReadTagFromStream(Stream: TStream;
  var TagArr: T2dStringArr);
var done: Boolean;
    xTag: String;
    xVal: String;
    len: Integer;
    isTag: Boolean;
    xPos: Integer;
begin
  done := false;
  len := 0;
  SetLength(TagArr,0);
  isTag := False;
  xPos := Stream.Position;
  xtag := ReadstringfromStream(Stream);
  if xTag <> '<TAG>' then begin
    Stream.Position := xPos;
    exit;
  end;
  Stream.Position := xPos;
  repeat
    xtag := ReadstringfromStream(Stream);
    if xtag = '<TAG>' then begin
    end else if xTag = '<TAGEND>' then begin
      done := True;
    end else begin
      isTag := not isTag;
      if isTag then begin
        Len := Len+1;
        SetLength(TagArr,Len);
        TagArr[Len-1,0] := xTag;
      end else begin
        TagArr[Len-1,1] := xTag;
      end;
    end;
  until done or (Stream.Position >= Stream.Size);
end;

procedure WriteTagToStream(Stream: TStream; TagArr: T2dStringArr);
var xTagArr:T2dStringArr;
    DataStream: TMemoryStream;
    Len,i: Integer;
begin
{$ifndef viewer}
  Len := Length(TagArr);
  Stream.Position := 0;
  ReadTagFromStream(Stream,xTagArr);
  DataStream := TMemoryStream.Create;
  StreamToStream(Stream,DataStream,Stream.Size-Stream.Position);
  DataStream.Position := 0;
  Stream.Size := 0;
  Stream.Position := 0;

  WriteStringToStream(Stream,'<TAG>');
  for i := 0 to Len-1 do begin
    WriteStringToStream(Stream,TagArr[i,0]);
    WriteStringToStream(Stream,TagArr[i,1]);
  end;
  WriteStringToStream(Stream,'<TAGEND>');
  StreamToStream(DataStream,Stream,DataStream.Size);
  DataStream.Free;
  Stream.Position := 0;
{$endif viewer}
end;


Function SplitStr(Line: string; var s: TStringArray; delim: String = ','): Integer;
var
  a, sIdx: integer;
  temp: string;
begin
  Line := StringReplace(Line, #13, ' ', [rfReplaceAll]);
  Line := StringReplace(Line, #$D#$A, ' ', [rfReplaceAll]);
  delim := delim[1];
  try
    sIdx := 0;
    temp := '';
    for a := 1 to Length(Line) do
    begin
      if Copy(line,a, 1) <> delim then
      begin
        temp := temp + Copy(line, a, 1);
      end  
      else
      begin
        SetLength(s,sIdx + 1);
        s[sIdx] := temp;
        sIdx := sIdx + 1;
        temp := '';
      end;
    end;
    if temp <> '' then
    begin
      SetLength(s, sIdx + 1);
      s[sIdx] := temp;
      sIdx := sIdx + 1;
    end;
    if Copy(Line, Length(Line), 1) = delim then
    begin
      SetLength(s, sIdx + 1);
      s[sIdx] := '';
      sIdx := sIdx + 1;
    end;
    result := sIdx;
  except
    result := 0;
  end;
end;

Function getRelativePointbyAngle(angle: integer;cPoint,oPoint: TPoint) : TPoint;
var rad,angD, angO, angN, newY, newX: extended;
    p : TPoint;
begin
  (*
  angle := angle *-1;
  oPoint := Point (oPoint.x-cpoint.x,oPoint.y-cPoint.y);
  angD := (pi/180)*(angle/10);
  p.y := round(oPoint.x * sin(angD) + oPoint.y*cos(angD));
  p.x := round(oPoint.x * cos(angD) - oPoint.y*sin(angD));
  p := Point(p.x+cpoint.x,p.y+cpoint.y);
  result := p;
  exit;
  *)
  //Get Radius
  try
    rad := sqrt(sqr(oPoint.y - cPoint.y)+sqr(oPoint.x - cPoint.x));
  except
    rad := 0;
  end;
  //Get Orэgэnal Angle
  If oPoint.y = cPoint.y then
  begin
    if cpoint.x > oPoint.x then angO := Pi else angO := 0;
  end
  else if oPoint.x = cPoint.x then
  begin
    if cPoint.y > oPoint.y then angO := -1*(Pi/2) else angO := (Pi/2);
  end
  else
  begin
    angO := ArcTan(abs(oPoint.y - cPoint.y)/abs(oPoint.x - cPoint.x));
    if (oPoint.x > cPoint.x) and (oPoint.y > cPoint.y) then angO := angO
    else if (oPoint.x < cPoint.x) and (oPoint.y > cPoint.y) then angO := pi - angO
    else if (oPoint.x < cPoint.x) and (oPoint.y < cPoint.y) then angO := pi + angO
    else if (oPoint.x > cPoint.x) and (oPoint.y < cPoint.y) then angO := (2*Pi) - angO;
  end;
  // Covert delta angle to Radyan
  angD := (pi/180)*(angle/10);
  // New Angle
  angN := angO - angD;

  // new coords
  newx := rad * cos (angN);
  newy := rad * sin (angN);

  p.x := cPoint.x + round(newx); p.y := cPoint.y + round(newy);
  result := p;
end;

Function GetRelativePointbyAngleFloat(angle: Double;cPoint,oPoint: TDoublePoint): TDoublePoint;
var rad,angD, angO, angN, newY, newX: extended;
    p : TDoublePoint;
begin
  //Get Radius
  try
    rad := sqrt(sqr(oPoint.y - cPoint.y)+sqr(oPoint.x - cPoint.x));
  except
    rad := 0;
  end;
  //Get Orэgэnal Angle
  If oPoint.y = cPoint.y then
  begin
    if cpoint.x > oPoint.x then angO := Pi else angO := 0;
  end
  else if oPoint.x = cPoint.x then
  begin
    if cPoint.y > oPoint.y then
      angO := -1*(Pi/2)
    else
      angO := (Pi/2);
  end
  else
  begin
    angO := ArcTan(abs(oPoint.y - cPoint.y)/abs(oPoint.x - cPoint.x));
    if (oPoint.x > cPoint.x) and (oPoint.y > cPoint.y) then
      angO := angO
    else if (oPoint.x < cPoint.x) and (oPoint.y > cPoint.y) then
      angO := pi - angO
    else if (oPoint.x < cPoint.x) and (oPoint.y < cPoint.y) then
      angO := pi + angO
    else if (oPoint.x > cPoint.x) and (oPoint.y < cPoint.y) then
      angO := (2*Pi) - angO;
  end;
  // Covert delta angle to Radyan
  angD := (pi/180)*(angle);
  // New Angle
  angN := angO - angD;

  // new coords
  newx := rad * cos (angN);
  newy := rad * sin (angN);

  p.x := cPoint.x + {round(}newx{)};
  p.y := cPoint.y + {round(}newy{)};
  result := p;
end;

Procedure ScalePoints(var points:array of TPoint;percentx,percenty: integer; rPoint: TPoint);
var i: Integer;
begin
  for i := low(points) to High(Points) do
  begin
    points[i] := GetRelativePointbyScale(percentx,percenty,rPoint,points[i]);
  end;
end;

Function getRelativePointbyscale(percentx,percenty: integer; rPoint,oPoint: TPoint) : TPoint;
var respoint: TPoint;
    deltax,deltay : extended;
begin
  if percentx = 100 then begin
    respoint.x := oPoint.x;
  end else begin
    deltax := rPoint.x - oPoint.x;
    deltax := deltax * (percentx/100);
    respoint.x := rpoint.x - round(deltax);
  end;

  if percenty = 100 then begin
    respoint.y := oPoint.y;
  end else begin
    deltay := rPoint.y - oPoint.y;
    deltay := deltay * (percenty/100);
    if percenty = 100 then deltay := 0;
    respoint.y := rpoint.y - round(deltay);
  end;
  result := respoint;
end;

Procedure GenerateBezierCPoints(p1,p2,p3: TDoublepoint;
var cp1,cp2:TDoublepoint; Corner: Boolean);
var na1,na2,a1,a2,a3,a4,ra: double;
    r1,r2:Integer;
    l1,l2: integer;
    mp1,mp3 : TDoublePoint;
    pia: Double;
begin
  l1 := -1; l2 := 1;
  //a1 := GetAngleOfLine(DP2P(p2),DP2P(p1),r1);
  //a2 := GetAngleOfLine(DP2P(p2),DP2P(p3),r2);
  a1 := GetRadOfLine(p2,p1);
  a2 := GetRadOfLine(p2,p3);
  a3 := abs(a2-a1);
  if a3 > (pi) then a4 := (2*pi) -a3 else a4 := a3;
  ra := (pi-a4) /2;

  mp1 := DoublePoint((p1.x+p2.x) / 2, (p1.y+p2.y) / 2);
  mp3 := DoublePoint((p3.x+p2.x) / 2, (p3.y+p2.y) / 2);
  mp1 := DoublePoint((mp1.x+p2.x) / 2, (mp1.y+p2.y) / 2);
  mp3 := DoublePoint((mp3.x+p2.x) / 2, (mp3.y+p2.y) / 2);

  //think positive
  na1 := a1+ra; na2 := a2-ra;
  pia := abs(na1-na2) - (pi);
  if corner then ra := 2*ra;
  if (pia < 0.0001) and (pia > -0.0001)  then
  begin
    cp1 := rotatepoint(p2,mp1,ra);
    cp2 := rotatepoint(p2,mp3,-1*ra);
  end else begin
    cp1 := rotatepoint(p2,mp1,-1*ra);
    cp2 := rotatepoint(p2,mp3,ra);
  end;
    (*
  //exit;
  //ra := (1800-a4) / 2;

  if [r1,r2] = [1,2] then if r1 = 1 then begin l1 := 1; l2 := -1 end else begin l1 := -1; l2 := 1;end;
  if [r1,r2] = [2,3] then if r1 = 2 then begin l1 := 1; l2 := -1 end else begin l1 := -1; l2 := 1;end;
  if [r1,r2] = [3,4] then if r1 = 3 then begin l1 := 1; l2 := -1 end else begin l1 := -1; l2 := 1;end;
  if [r1,r2] = [4,1] then if r1 = 4 then begin l1 := 1; l2 := -1 end else begin l1 := -1; l2 := 1;end;
  if [r1,r2] = [3,1] then begin
    if r1 = 1 then begin
      if a2-1800 > a1 then l1 := -1 else l1 := 1;
    end else begin
      if a2 > a1-1800 then l1 := -1 else l1 := 1;
    end;
    l2 := l1*-1;
  end;
  if [r1,r2] = [2,4] then begin
    if r1 = 2 then begin
      if a2-2700 > a1-900 then l1 := -1 else l1 := 1;
    end else begin
      if 3600-a1 > a2-900 then l1 := -1 else l1 := 1;
    end;
    l2 := l1*-1;
  end;
  if (r1 = r2) then if a2 > a1 then begin l1 := 1; l2 := -1 end else begin l1 := -1; l2 := 1;end;



  mp1 := DoublePoint((p1.x+p2.x) / 2, (p1.y+p2.y) / 2);
  mp3 := DoublePoint((p3.x+p2.x) / 2, (p3.y+p2.y) / 2);
  mp1 := DoublePoint((mp1.x+p2.x) / 2, (mp1.y+p2.y) / 2);
  mp3 := DoublePoint((mp3.x+p2.x) / 2, (mp3.y+p2.y) / 2);
  cp1 := DoublePoint(getRelativePointbyAngle(round(l1*ra),DP2P(p2),DP2P(mp1)));
  cp2 := DoublePoint(getRelativePointbyAngle(round(l2*ra),DP2P(p2),DP2P(mp3)));
      *)
end;

Function IspointInBezier(p1,p2,p3,p4,point:TDoublepoint):boolean;
var x,y: Double;
    a: integer;
    ctrl: real;
    tx,px,py : real;
    t : array[1..4] of real;
    mcol,mrow: integer;
    pntx,pnty: array[1..4] of Double;
begin
  result := false;

  x := point.x;
  y := point.y;
  pntx[1] := p1.x;
  pntx[2] := p2.x;
  pntx[3] := p3.x;
  pntx[4] := p4.x;
  pnty[1] := p1.y;
  pnty[2] := p2.y;
  pnty[3] := p3.y;
  pnty[4] := p4.y;

    for a := 0 to 500 do
    begin
      tx := a / 500;
      t[1] := tx*tx*tx;
      t[2] := tx*tx;
      t[3] := tx;
      t[4] := 1;
      px := 0;
      py := 0;

      for mcol := 1 to 4 do begin
        for mrow := 1 to 4 do begin
          px := px + mval[mrow,mcol]* t[mrow]*pntx[mcol];
          py := py + mval[mrow,mcol]* t[mrow]*pnty[mcol];
        end;
      end;
      if (abs(px - x) <= 0.3) and (abs(py - y) <= 0.3) then
      begin
        result := true;
        exit;
      end;
    end;
end;

Procedure BeziersToPolyline(bpoints:TDoublePointArr;var pPoints:TDoublePointArr; PatchLen:Double);
var i,pCnt,cnt,lCnt: Integer;
p1,p2,p3,p4: TdoublePoint;
begin
  i := 0;
  pCnt:= Length(bPoints);
  if pCnt < 4 then exit; 
  repeat
    p1 := bPoints[i];
    p2 := bPoints[i+1];
    p3 := bPoints[i+2];
    p4 := bPoints[i+3];

    if EQDP(p1,p2) and EQDP(p3,p4) then begin
      if i = 0 then cnt := 2 else cnt := 1;
      lCnt := Length(pPoints);
      SetLength(pPoints,lCnt+cnt);
      if i = 0 then pPoints[lCnt+cnt-2] := p1;
      pPoints[lCnt+cnt-1] := p4;
    end else
      BezierToPolyline(p1,p2,p3,p4,pPoints,PatchLen,i=0);
    i := i+3;
  until i >= pCnt-1;
end;

Procedure BezierToPolyline(p1,p2,p3,p4:TDoublePoint;var pPoints:TDoublePointArr; PatchLen:Double;incFirst:Boolean);
var LastIndex,res:Integer;
rDist:Double;
xCnt,pCnt,bCnt: Integer;
pi,pf: TdoublePOint;
begin
  res := 500;
  LastIndex := 0;
  xCnt := 0;
  pCnt := 0;
  repeat
    rDist := GetBezierPatch(p1,p2,p3,p4,PatchLen,LastIndex,pi,pf,false,res);
    pCnt := pCnt +1;
  Until LastIndex = res;

  if (pCnt > 1) and (rDist < (PatchLen * 0.9)) then
  begin
    pCnt := pCnt -1;
    if rDist < (PatchLen / 2) then begin
      PatchLen := PatchLen + round(rDist/pCnt);
    end else begin
      PatchLen := ((PatchLen * pCnt)+rDist) / (pcnt+1);
      pCnt := pCnt+1;
    end;
  end;

  LastIndex := 0;
  xCnt := 0;
  bCnt := Length(pPoints);
  repeat
    xCnt := xCnt +1;
    if xCnt = pCnt then
      rDist := GetBezierPatch(p1,p2,p3,p4,PatchLen,LastIndex,pi,pf,True,res)
    else
      rDist := GetBezierPatch(p1,p2,p3,p4,PatchLen,LastIndex,pi,pf,False,res);
    if (xCnt = 1) and incFirst then begin
      bCnt := bCnt+1;
      SetLength(pPoints,bCnt);
      pPoints[bCnt-1] := pi;
    end;
    bCnt := bCnt+1;
    SetLength(pPoints,bCnt);
    pPoints[bCnt-1] := pf;
  Until LastIndex = res;

end;


Function GetBezierSample(p1,p2,p3,p4:TDoublepoint;tx:Double):TDoublePoint;overload;
var x,y,a: integer;
    ctrl: real;
    px,py : real;
    t : array[1..4] of real;
    mcol,mrow: integer;
    pntx,pnty: array[1..4] of Double;
begin
  result := DoublePoint(0,0);
  if (tx < 0) or (tx > 1) then exit;
  pntx[1] := p1.x;
  pntx[2] := p2.x;
  pntx[3] := p3.x;
  pntx[4] := p4.x;
  pnty[1] := p1.y;
  pnty[2] := p2.y;
  pnty[3] := p3.y;
  pnty[4] := p4.y;
  t[1] := tx*tx*tx;
  t[2] := tx*tx;
  t[3] := tx;
  t[4] := 1;
  px := 0;
  py := 0;
  for mcol := 1 to 4 do begin
    for mrow := 1 to 4 do begin
      px := px + mval[mrow,mcol]* t[mrow]*pntx[mcol];
      py := py + mval[mrow,mcol]* t[mrow]*pnty[mcol];
    end;
  end;
  Result := DoublePoint(px,py);
end;

Function GetBezierSample(p1,p2,p3,p4:TDoublepoint;Index,Resolution:Integer):TDoublePoint;
begin
  result := GetBezierSample(p1,p2,p3,p4,Index/Resolution);
end;

Function IspointInPolyBezier(Points:TdoublePointArr; Point:TDoublepoint):boolean;
var I: integer;
    p1,p2,p3,p4:TDoublePoint;
    nbrPoint: Integer;
begin
  nbrPoint := Length(Points);
  result := false;
  if nbrPoint < 4 then exit;
  I := 0;
  repeat
    p1 := Points[i];
    p2 := Points[i+1];
    p3 := Points[i+2];
    p4 := Points[i+3];
    I := I+3;
    result := IspointInBezier(p1,p2,p3,p4,Point);
  until (I >= nbrPoint-1) or result;
end;

Function IspointInCircle(x,y,cx,cy,radius:Double):Boolean;
var a,b,nx,ny: real;
    ctrl: real;
begin
  result := false;
  a := radius;
  b := radius;
  nx := x-cx;
  ny := y-cy;
  if (a = 0) or (b=0) then exit;
  ctrl := ((nx*nx)/(a*a))+((ny*ny)/(b*b));
  if (ctrl < 1.1) and (ctrl > 0.9) then result := true;
end;

Function IspointInEllipse(x,y,cx,cy,alen,blen,angle:Double):Boolean;
var
    ctrl,nx,ny: real;
    p2,pt,pc : TDoublePoint;
begin
  pt.x := x; pt.y := y;
  p2 := RotatePoint(DoublePoint(cx,cy),pt,-1*angle);
  nx := p2.x - cx;
  ny := p2.y - cy;
  if alen*blen = 0 then
  begin
    result := false;
    exit;
  end;
  ctrl := ((nx*nx)/(alen*alen))+((ny*ny)/(blen*blen));
  if (ctrl < 1.1) and (ctrl > 0.9) then result := true;
end;

Function IspointInArc(hp,cp:TDoublePoint;rad: Double;arcstyle:Integer;a1,a2:Double):Boolean;
var cnt,cntA,I :Integer;
    Points: T2DPointArray;
    P: TDoublePointArr;
begin
  if a1 = a2 then begin
    result := isPointInCircle(hp.x,hp.y,cp.x,cp.y,rad);
    exit;
  end;
  BezierArcPoints(Points,cp.x,cp.y,Rad,a1,a2);
  cnt := Length(Points);
  cntA := 0;
  if arcStyle = 1 then cntA := 6
  else if ArcStyle = 2 then cntA := 3;
  SetLength(p,cnt+cntA);
  for I := 0 to cnt-1 do
  begin
    P[I] := DoublePoint(Points[I].X,Points[I].Y);
  end;
  if arcStyle = 1 then begin
    P[cnt-1+1] := P[cnt-1];
    P[cnt-1+2] := DoublePoint(cp.x,cp.y);
    P[cnt-1+3] := DoublePoint(cp.x,cp.y);
    P[cnt-1+4] := DoublePoint(cp.x,cp.y);
    P[cnt-1+5] := P[0];
    P[cnt-1+6] := P[0];
    cntA := 6;
  end else if ArcStyle = 2 then begin
    P[cnt-1+1] := P[cnt-1];
    P[cnt-1+2] := P[0];
    P[cnt-1+3] := P[0];
    cntA := 3;
  end;
  result := IsPointInPolyBezier(P,hp);
  //Tolik 21/05/2018
  SetLength(p, 0);
  SetLength(Points, 0);
  //
end;

Function IspointInArc(hp,cp:TDoublePoint;rad: Double;arcstyle:Integer;ap1,ap2:TDoublepoint;inverted:Boolean):Boolean;
var cnt,cntA,I :Integer;
    Points: T2DPointArray;
    P: TDoublePointArr;
    a1,a2: Double;
begin
  if Inverted then begin
    a1 := GetRadOfLine(cp,ap1);
    a2 := GetRadOfLine(cp,ap2);
  end else begin
    a1 := GetRadOfLine(cp,ap2);
    a2 := GetRadOfLine(cp,ap1);
  end;
  result :=  IspointInArc(hp,cp,rad,arcStyle,a1,a2);
end;


Function GetArcCenter(p1,p2:TDoublepoint;Angle:Double):TDoublePoint;
var mp,cp:TDoublepoint;
    rad: Double;
    mx,my: Double;
    t : double;
begin
  mp := DoublePoint( (p1.x+p2.x) / 2, (p1.y+p2.y) / 2);
  if abs(angle - pi) < 0.001 then
  begin
    result := mp;
    exit;
  end;
  rad := GetRadOfLine(p1,mp);
  mp := RotatePoint(p1,mp,-rad);
  mx := GetLineLenght(p1,mp);
  t := tan(angle/2);
  if t<> 0 then my := mx/t else my := 0;
  cp := DoublePoint(p1.x+mx,p1.y-my);
  cp := RotatePoint(p1,cp,rad);
  result := cp;
end;

Procedure DoubleArcToPolyGon(cx,cy,rad1,rad2,a1,a2,a3,a4:Double; var p:TdoublePointArr);
var bPoints: TdoublePointArr;
begin
  GetDoubleArcPoints(cx,cy,rad1,rad2,a1,a2,a3,a4,bPoints);
  BeziersToPolyLine(bPoints,p,3);
  //Tolik 21/05/2018 --
  SetLength(bPoints, 0);
  //
end;

Procedure GetDoubleArcPoints(cx,cy,rad1,rad2,a1,a2,a3,a4:Double; var p:TdoublePointArr);
var Points: T2DPointArray;
    I,a: integer;
    cnt,pcnt : integer;
    r: Integer;
    x,y: Double;
begin
  BezierArcPoints(Points,cx,cy,Rad1,a1,a2);
  cnt := Length(Points);
  SetLength(p,cnt);
  for I := 0 to cnt-1 do
  begin
    P[I].X := Points[I].X;
    P[I].Y := Points[I].Y;
  end;

  BezierArcPoints(Points,cx,cy,Rad2,a3,a4);
  pcnt := Length(Points);

  SetLength(p,cnt+2);

  P[Cnt-2+2] := P[Cnt-1];
  P[Cnt-1+2] := DoublePoint(Points[pcnt-1].x,Points[pcnt-1].y);


  cnt := cnt+2;

  SetLength(p,cnt+pcnt);
  for I := 0 to pcnt-1 do
  begin
    P[cnt+I].X := Points[pcnt-1-I].X;
    P[cnt+I].Y := Points[pcnt-1-I].Y;
  end;

  cnt := cnt+pCnt;

  SetLength(p,cnt+3);

  P[Cnt-3+3] := P[Cnt-1];
  P[Cnt-2+3] := P[0];
  P[Cnt-1+3] := P[0];
  cnt := cnt+3;
  // Tolik --21/05/2018 --
  SetLength(Points, 0);
  //
end;


Procedure GetArcBounds(p1:TDoublePoint; rad1,rad2: Double; arcStyle: Integer;
a1,a2,a: Double; var figMaxX,figMaxY,figMinX,figMinY: double);
var cnt,cntA,I :Integer;
    Points: T2DPointArray;
    P: TDoublePointArr;
begin
  if a1 = a2 then
  begin
    figMaxX := p1.x+rad1;
    figMinX := p1.x-rad1;
    figMaxY := p1.y+rad2;
    figMinY := p1.y-rad2;
    //exit;
  end;

  BezierElpArcPoints(Points,p1.x,p1.y,Rad1,rad2,a,a1,a2);
  cnt := Length(Points);
  if cnt = 0 then exit;
  cntA := 0;
  if arcStyle = 1 then cntA := 6
  else if ArcStyle = 2 then cntA := 3;
  SetLength(p,cnt+cntA);

  for I := 0 to cnt-1 do
  begin
    P[I] := DoublePoint(Points[I].X,Points[I].Y);
  end;
  if arcStyle = 1 then begin
    P[cnt-1+1] := P[cnt-1];
    P[cnt-1+2] := DoublePoint(p1.x,p1.y);
    P[cnt-1+3] := DoublePoint(p1.x,p1.y);
    P[cnt-1+4] := DoublePoint(p1.x,p1.y);
    P[cnt-1+5] := P[0];
    P[cnt-1+6] := P[0];
    cntA := 6;
  end else if ArcStyle = 2 then begin
    P[cnt-1+1] := P[cnt-1];
    P[cnt-1+2] := P[0];
    P[cnt-1+3] := P[0];
    cntA := 3;
  end;
  GetPolyBezierBounds(P,figMaxX,figMaxY,figMinX,figMinY);
  // Tolik --21/05/2018 --
  SetLength(Points, 0);
  SetLength(P, 0);
  //
end;

Procedure GetPolyBezierBounds(Points:TdoublePointArr;var figMaxX,figMaxY,figMinX,figMinY: Double);
var I,nbrPoint: integer;
    p1,p2,p3,p4:TDoublePoint;
    bMaxX,bMaxY,bMinX,bMinY:double;
begin
  I := 0;
  nbrPoint := Length(Points);
  figMaxX := Points[0].x;
  figMinX := Points[0].x;
  figMaxY := Points[0].y;
  figMinY := Points[0].y;

  repeat
    p1 := Points[i];
    p2 := Points[i+1];
    p3 := Points[i+2];
    p4 := Points[i+3];
    I := I+3;
    GetBezierBounds(p1,p2,p3,p4,bMaxX,bMaxY,bMinX,bMinY);
    if bMaxX > figMaxX then figMaxX := bMaxX;
    if bMinX < figMinX then figMinX := bMinX;
    if bMaxY > figMaxY then figMaxY := bMaxY;
    if bMinY < figMinY then figMinY := bMinY;
  until I >= nbrPoint-1;

end;

Procedure GetPolylineBounds(Points:TDoublePointArr;var figMaxX,figMaxY,figMinX,figMinY: double);
var i: INteger;
    pt: TDoublePOint;
begin
  if Length(Points) = 0 then exit;
  figMaxX := points[0].x;
  figMinX := points[0].x;
  figMaxY := points[0].y;
  figMinY := points[0].y;
  for i := 1 to Length(Points)-1 do
  begin
    pt := Points[i];
    if pt.x > FigMaxX then FigMaxX := pt.x;
    if pt.x < FigMinX then FigMinX := pt.x;
    if pt.y > FigMaxY then FigMaxY := pt.y;
    if pt.y < FigMinY then FigMinY := pt.y;
  end;

end;

Procedure GetBezierBounds(p1,p2,p3,p4:TDoublePoint;var figMaxX,figMaxY,figMinX,figMinY: double);
var a: integer;
    ctrl: real;
    tx,px,py : real;
    t : array[1..4] of real;
    mcol,mrow: integer;
    pntx,pnty: array[1..4] of double;

begin
  pntx[1] := p1.x;
  pntx[2] := p2.x;
  pntx[3] := p3.x;
  pntx[4] := p4.x;
  pnty[1] := p1.y;
  pnty[2] := p2.y;
  pnty[3] := p3.y;
  pnty[4] := p4.y;


    figMaxX := pntx[1];
    figMinX := pntx[1];
    figMaxY := pnty[1];
    figMinY := pnty[1];

    for a := 0 to 500 do
    begin
      tx := a / 500;
      t[1] := tx*tx*tx;
      t[2] := tx*tx;
      t[3] := tx;
      t[4] := 1;
      px := 0;
      py := 0;
      for mcol := 1 to 4 do begin
        for mrow := 1 to 4 do begin
          px := px + mval[mrow,mcol]* t[mrow]*pntx[mcol];
          py := py + mval[mrow,mcol]* t[mrow]*pnty[mcol];
        end;
      end;
      if px > figMaxX then figMaxX := px;
      if px < figMinX then figMinX := px;
      if py > figMaxY then figMaxY := py;
      if py < figMinY then figMinY := py;
    end;
end;

Procedure PutSign(canvas:Tcanvas;point:Tpoint);
begin
  canvas.rectangle(point.x-4,point.y-4,point.x+4,point.y+4);
end;


procedure EllipseToBezier( elpR: TRect;var bzPoints: Array of TPoint);
var
  offsetx,offsety: integer;
  Center: TPoint;
  const EToBConst = 0.2761423749154;
begin
  offsetx := round(abs(elpR.left-elpR.right) * EToBConst);
  offsety := round(abs(elpR.top-elpR.bottom) * EToBConst);
  Center := Point( (elpR.left+elpR.right) div 2,(elpR.top+elpR.bottom) div 2);

  bzPoints[0].x := elpR.left;
  bzPoints[1].x := bzPoints[0].x;
  bzPoints[11].x := bzPoints[0].x;
  bzPoints[12].x := bzPoints[0].x;

  bzPoints[5].x := elpR.right;
  bzPoints[6].x := bzPoints[5].x;
  bzPoints[7].x := bzPoints[5].x;

  bzPoints[2].x := Center.x - offsetx;
  bzPoints[10].x := Center.x - offsetx;

  bzPoints[4].x := Center.x + offsetx;
  bzPoints[8].x := Center.x + offsetx;

  bzPoints[3].x := Center.x;
  bzPoints[9].x := Center.x;

  bzPoints[2].y := elpR.top;
  bzPoints[3].y := elpR.top;
  bzPoints[4].y := elpR.top;

  bzPoints[8].y := elpR.bottom;
  bzPoints[9].y := elpR.bottom;
  bzPoints[10].y := elpR.bottom;

  bzPoints[7].y := Center.y + offsety;
  bzPoints[11].y := Center.y + offsety;

  bzPoints[1].y := Center.y - offsety;
  bzPoints[5].y := Center.y - offsety;

  bzPoints[0].y := Center.y;
  bzPoints[6].y := Center.y;
  bzPoints[12].y := Center.y;

end;


Function GetPointOnEllipse(cx,cy,a,b,elpAngle,pAngle:integer):TPoint;
var res: TPoint;
    tanangle,m,angle: real;
    sa,sb: extended;
    top : extended;
    bot: extended;
    xs,xr: extended;
Begin
  if (pangle = 0) or (pangle = 3600) then
  begin
    res.x := cx + a;
    res.y := cy;
  end
  else if pangle = 900 then
  begin
    res.x := cx;
    res.y := cy + b;
  end
  else if pangle = 1800 then
  begin
    res.x := cx - a;
    res.y := cy;
  end
  else if pangle = 2700 then
  begin
    res.x := cx;
    res.y := cy - b;
  end
  else
  begin
    angle := (pangle / 1800) *PI;
    tanAngle := tan (angle);
    m := sqr(tanangle);
    sa := (a * a)/1000; sb := (b * b)/1000;
    top := sa * sb;
    bot := (sb + (sa*m))/(1000*1000);
    xs := top/bot;
    xr := sqrt(xs);
    res.x := round(xr);
    res.y := round(tanAngle*xr);
    res.x := res.x + cx;
    res.y := res.y + cy;
  end;
  if elpangle <> 0 then
    result := getRelativePointbyAngle(elpAngle,Point(cx,cy),res)
  else
    result := res;
end;

Function GetSymetricPoint(sPoint,lPoint1,lPoint2: TDoublePoint): TDoublePoint;
var ResPoint : TDoublePoint;
    resx, resy,mLine1,mLine2,a1,a2,b1,b2,c1,c2,interX,interY : Double;
begin
  if lpoint2.x = lpoint1.x then
  begin
    resY := sPoint.y;
    resX := lPoint1.x + (lPoint1.x - sPoint.x);
  end
  else if lpoint2.y = lpoint1.y then
  begin
    resX := sPoint.x;
    resY := lPoint1.y + (lPoint1.y - sPoint.y);
  end
  else
  begin
    // ax + by + c = 0

    mLine1 := ((lpoint1.y-lpoint2.y) / (lpoint1.x-lpoint2.x));


    a1 := -1* mLine1;
    b1 := 1;
    c1 := mLine1*lPoint1.x - lPoint1.y;

    mline2 := -1 / mLine1;

    a2 := -1* mLine2;
    b2 := 1;
    c2 := mLine2*sPoint.x - sPoint.y;

    interX := (c2*b1 - c1*b2) / (a1*b2 - b1*a2);
    interY := (c1*a2 - a1*c2) / (a1*b2 - b1*a2);

    // distance to Line1 of sPoint
    //h := abs(a1*sPoint.x + b1*sPoint.y + c1) / sqrt(a1*a1+b1*b1);

    resX := 2*InterX - sPoint.x;
    resY := 2*InterY - sPoint.Y;

  end;

  resPoint.x := resX;
  resPoint.y := resY;

  result := resPoint;

end;

Function AngleDist(a1,a2:Double):Double;
begin
  if a2 > a1 then
    result := a2-a1
  else if a2 < a1 then begin
    result := (2*pi-a1)+a2;
  end else if a2 = a1 then begin
    result := 0;
  end;
end;

Function Gray(level:Byte):TColor;
begin
  Result := RGB(level,level,level);
end;

Function Bluer(level:Byte):TColor;
begin
  Result := RGB(0,0,level);
end;

Function SurfaceColor(a1,a2:TDoublePoint):TColor;
var dp: TdoublePoint;
    rad: double;
begin
  dp := MPoint(a1,a2);
  rad := GetRadOfLine(dp,DoublePoint(0,0));
  if rad < 0 then rad := (2*pi)+rad;
  if rad > (pi/4) then begin
    rad := rad- (Trunc(rad / (pi/4))*(pi/4));
  end;
  result := Gray(100+Round(60*(rad / (pi/4))));
end;

Function SurfaceColor(Face:T3DPointArray;light:T3DPoint):TColor;
var pCnt: Integer;
    i: Integer;
    dp: TdoublePoint;
    rad: double;
begin
  result := clSilver;
  pCnt := Length(Face);
  if pcnt = 4 then begin
    if (Face[0].z = Face[1].z) and (Face[0].z = Face[2].z) and(Face[0].z = Face[3].z) then
    begin
      result := Gray(60+Round(60*(Face[0].z /60)));
    end else begin
      dP := Mpoint(DoublePoint(Face[0].x,Face[0].y),DoublePoint(Face[1].x,Face[1].y));
      rad := GetRadOfLine(dp,DoublePoint(light.x,light.y));
      if rad < 0 then rad := (2*pi)+rad;
      if rad > (pi/4) then begin
        rad := rad- (Trunc(rad / (pi/4))*(pi/4));
      end;
      result := Gray(100+Round(60*(rad / (pi/4))));
    end;
  end else if pcnt = 3 then begin
    if (Face[0].z = Face[1].z) and (Face[0].z = Face[2].z)  then
    begin
      result := Gray(100+Round(60*(Face[0].z /250)));
    end else begin
      dP := Mpoint(DoublePoint(Face[0].x,Face[0].y),DoublePoint(Face[1].x,Face[1].y));
      rad := GetRadOfLine(dp,DoublePoint(light.x,light.y));
      if rad < 0 then rad := (2*pi)+rad;
      if rad > (pi/4) then begin
        rad := rad- (Trunc(rad / (pi/4))*(pi/4));
      end;
      result := Gray(100+Round(60*(rad / (pi/4))));
    end;


  end;
end;

Function SurfaceColor(a,b,c,light:T3DPoint):TColor;
var
  Center,toA,toL: T3DPoint;
  Cos,Angle: Double;
  grayLevel: Integer;
  Function IMUL(x1,x2:Double):Double;
  begin
    result := x1*x2;
  end;
  Function Delta(p1,p2:T3DPoint):T3DPoint;
  begin
    result := DoublePOint((p1.x-p2.x),(p1.y-p2.y),(p1.z-p2.z));
  end;
  Function InnerProduct(p1,p2:T3DPoint):Double;
  begin
    result := IMUL(p1.x,p2.x)+IMUL(p1.y,p2.y)+IMUL(p1.z,p2.z);
  end;
begin
  Center := DoublePoint((a.x+b.x+c.x) / 3,
                        (a.y+b.y+c.y) / 3,
                        (a.z+b.z+c.z) / 3);
  ToA := delta(A,Center);
  ToL := Delta(Center,light);
  Try
    Cos := InnerProduct(ToA,ToL) /
           ( Sqrt(InnerProduct(ToA,ToA))*
             Sqrt(InnerProduct(ToL,ToL))
           );
    try
      Angle := ArcTan(sqrt(1-Sqr(Cos))/Cos);
    except
      Angle := pi/2;
    end;
    GrayLevel := 255 - Round(255*(Abs(Angle)/ (pi/2)));
  except
    GrayLevel := 255;
  end;
  Result := PaletteRgb(GrayLevel,GrayLevel,GrayLevel);

end;

Function DirectionOfAngle(rad1,rad2:Double):TMapDirection;
var da: Double;
r1,r2: Integer;
begin
  if rad1 > rad2 then da := rad1-rad2 else da := rad1 + ((2*pi)-rad2);
  if da < pi then begin
    r1 := CoRegOfLine(Rad1);
    r2 := CoRegOfLine(Rad2);
  end else begin
    r1 := CoRegOfLine(Rad2);
    r2 := CoRegOfLine(Rad1);
  end;
  if (r1 = 1) and (r2 = 4) then
    result := mdEast
  else if (r1 = 1) and (r2 = 1) then
    result := mdSouthEast
  else if (r1 = 2) and (r2 = 1) then
    result := mdSouth
  else if (r1 = 2) and (r2=2) then
    result := mdSouthWest
  else if (r1=3) and (r2 = 2) then
    result := mdWest
  else if (r1 = 3) and (r2 =3) then
    result := mdNorthWest
  else if (r1 = 4) and (r2 =3) then
    result := mdNorth
  else if (r1 = 4) and (r2=4) then
    result := mdNorthEast;
end;

Function CoRegOfLine(Rad:Double):Integer;
begin
  if (rad >= 0) and (rad < (pi/2)) then
    result := 1
  else if (rad >= (pi/2)) and (rad < pi) then
    result := 2
  else if (rad >= pi) and (rad < (3*(pi/2))) then
    result := 3
  else result := 4;
end;

Function GetRadOf2Lines(p1,p2,p3:TDoublePoint):Real;
var rad1,rad2: Double;
begin
  rad1 := GetRadOfLine(p1,p2);
  rad2 := GetRadOfLine(p3,p2);
  result := rad2-rad1;
end;

// Tolik 26/04/2019 - - старая закомменчена - см. ниже
Function GetRadOfLine(cp,p: TDoublePoint):Real;overload;
var //dx,dy: Real;
    dx,dy: Extended;
    ang: real;
    reg: integer;
    rx, ry : Double;
Begin
  result := 0;
  try
   // dx := RoundTo( abs(p.x - cp.x), -3);
   // dy := RoundTo( abs(p.y - cp.y), -3);
   GetPrecisionMode;
   //Tolik 23/08/2019 --
   //SetPrecisionMode(pmDouble);
   GetRoundMode;
   //
   rx := p.x - cp.x;
   ry := p.y - cp.y;
   rx := Abs(rx);
   ry := Abs(ry);
   dx := RoundTo(rx, -3);
   dy := RoundTo(ry, -3);
  except
    try
      //dx := RoundTo( abs(p.x - cp.x), -3);
      //dy := RoundTo( abs(p.y - cp.y), -3);
      rx := p.x - cp.x;
      ry := p.y - cp.y;
      rx := Abs(rx);
      ry := Abs(ry);
      dx := RoundTo(rx, -3);
      dy := RoundTo(ry, -3);
    except
    end;
  end;
  if (dx=0) and (dy=0) then // error
  begin
    //result := 0;
    exit;
  end;
  if dx = 0 then
  begin
    if p.y > cp.y then result := pi/2
    else result := pi*1.5;
  end
  else if dy = 0 then
  begin
    if p.x > cp.x then result := 0
    else result := pi;
  end
  else
  begin
    ang := arctan(dy/dx);
    if (p.x > cp.x) and (p.y > cp.y) then begin
      ang := ang; reg := 1; end
    else if (p.x < cp.x) and (p.y > cp.y) then begin
      ang := PI - ang; reg := 2; end
    else if (p.x < cp.x) and (p.y < cp.y) then begin
      ang := PI + ang; reg := 3; end
    else if (p.x > cp.x) and (p.y < cp.y) then begin
      ang := 2*PI - ang; reg := 4; end;

    Result := ang;
  end;
end;
{
Function GetRadOfLine(cp,p: TDoublePoint):Real;overload;
var dx,dy: Real;
    ang: real;
    reg:integer;
Begin
  try
    dx := RoundTo( abs(p.x - cp.x), -3);
    dy := RoundTo( abs(p.y - cp.y), -3);
  except
    try
      dx := RoundTo( abs(p.x - cp.x), -3);
      dy := RoundTo( abs(p.y - cp.y), -3);
    except
    end;
  end;
  if (dx=0) and (dy=0) then // error
  begin
    result := 0;
    exit;
  end;
  if dx = 0 then
  begin
    if p.y > cp.y then result := pi/2
    else result := pi*1.5;
  end
  else if dy = 0 then
  begin
    if p.x > cp.x then result := 0
    else result := pi;
  end
  else
  begin
    ang := arctan(dy/dx);
    if (p.x > cp.x) and (p.y > cp.y) then begin
      ang := ang; reg := 1; end
    else if (p.x < cp.x) and (p.y > cp.y) then begin
      ang := PI - ang; reg := 2; end
    else if (p.x < cp.x) and (p.y < cp.y) then begin
      ang := PI + ang; reg := 3; end
    else if (p.x > cp.x) and (p.y < cp.y) then begin
      ang := 2*PI - ang; reg := 4; end;

    Result := ang;
  end;
end;
}
Function GetRadOfLine(cp,p: TPoint):Real;
var dx,dy: integer;
    ang: real;
    reg:integer;
Begin

  dx := abs(p.x - cp.x);
  dy := abs(p.y - cp.y);

  if (dx=0) and (dy=0) then // error
  begin
    result := 0;
    exit;
  end;
  if dx = 0 then
  begin
    if p.y > cp.y then result := pi/2
    else result := pi*1.5;
  end
  else if dy = 0 then
  begin
    if p.x > cp.x then result := 0
    else result := pi;
  end
  else
  begin
    ang := arctan(dy/dx);
    if (p.x > cp.x) and (p.y > cp.y) then begin
      ang := ang; reg := 1; end
    else if (p.x < cp.x) and (p.y > cp.y) then begin
      ang := PI - ang; reg := 2; end
    else if (p.x < cp.x) and (p.y < cp.y) then begin
      ang := PI + ang; reg := 3; end
    else if (p.x > cp.x) and (p.y < cp.y) then begin
      ang := 2*PI - ang; reg := 4; end;

    Result := ang;
  end;


end;

Function GetAngleofLine(cp,p: TPoint; var reg:integer):integer;
var dx,dy: integer;
    ang: real;
Begin

  dx := abs(p.x - cp.x);
  dy := abs(p.y - cp.y);

  if (dx=0) and (dy=0) then // error
  begin
    result := 0;
    exit;
  end;
  if dx = 0 then
  begin
    if p.y > cp.y then result := 900
    else result := 2700;
  end
  else if dy = 0 then
  begin
    if p.x > cp.x then result := 0
    else result := 1800;
  end
  else
  begin
    ang := arctan(dy/dx);
    if (p.x > cp.x) and (p.y > cp.y) then begin
      ang := ang; reg := 1; end
    else if (p.x < cp.x) and (p.y > cp.y) then begin
      ang := PI - ang; reg := 2; end
    else if (p.x < cp.x) and (p.y < cp.y) then begin
      ang := PI + ang; reg := 3; end
    else if (p.x > cp.x) and (p.y < cp.y) then begin
      ang := 2*PI - ang; reg := 4; end;

    Result := round((ang/PI)*1800);
  end;

End;

{Function GetAngleOf2Lines(p11,p12, p21, p22: TDoblePoint):Double;
var
  p1, p2, cp: PDoublePoint;
begin

end;}

Function GetLineFormula(p1,p2: TDoublepoint;var a,b: double):Boolean;
var x1,x2,y1,y2: double;
    t1,t2: double;
begin
  result := true;
  p1 := NormalizePoint(p1);
  p2 := NormalizePoint(p2);
  if EQDP(p1,p2) then begin
    a:= 0;
    b:= 0;
    result := false;
    exit;
  end;
  // y = ax+b
  x1 := p1.x;
  x2 := p2.x;
  y1 := p1.y;
  y2 := p2.y;

  if EQD(y1 ,y2) then begin
    a := 0; b := y1;
  end else if EQD(x1 ,x2) then begin
    a := 0; b := 0;
  end else begin
    t1 := y1/x1;
    t2 := y2/x2;
    b := (t1-t2) / ((x2-x1)/(x1*x2));
    a := (y1-b)/x1;
    if eqd(y1,b) then a := 0;
  end;
end;

Function Get90LineFormula(p1,p2: TDoublepoint;var a,b: double):Boolean;
var x1,x2,y1,y2: double;
    t1,t2: double;
    ml,m90: double;
    mp: TDoublePoint;
begin
  result := true;
  if (p1.x = p2.x) and (p1.y = p2.y) then begin
    result := false;
    exit;
  end;
  GetLineFormula(p1,p2,a,b);
  mp := DoublePoint((p1.x+p2.x) / 2, (p1.y+p2.y) / 2);
  if (a=0) and (b=0) then begin
    a := 0; b := mp.y;
  end else if (a=0) then begin
    a := 0; b := 0;
  end else begin
    // for x 10 & 20
    x1 := 10;
    y1 := a*x1+b;
    x2 := 20;
    y2 := a*x2+b;
    ml := (y2-y1)/(x2-x1);
    m90 := -1/ml;
    a := m90;
    b := mp.y-(a*mp.x);
  end;

end;

Function GetDistToLine(p1,p2,p:TDoublePoint):Double;
var d1,d2: Double;
    mp: TDoublePoint;
begin
  mp := DoublePoint(p.x,p.y);
  PointToLine(p1,p2,mp.x,mp.y);
  if isPointInLine(p1,p2,mp,1) then begin
    result := GetLineLenght(mp,p);
  end else begin
    d1 :=  GetLineLenght(p1,p);
    d2 :=  GetLineLenght(p2,p);
    result := Min(d1,d2);
  end;


end;

Procedure PointToLineByLen(p1,p2:TDoublePoint; var p: TDoublePoint);
var len,ol: Double;
begin
  Len := GetLineLength(p1,p);
  ol := GetLineLength(p1,p2);
  if Len > ol then begin
    p := Mpoint(p2,p1,ol-Len);
  end else begin
    p := Mpoint(p1,p2,Len);
  end;
end;

Procedure PointToLineByAngle(p1,p2:TDoublePoint; var p: TDoublePoint);
var angle,dx,len,ol: Double;
begin
  len := GetLineLength(p1,p);
  ol :=  GetLineLength(p1,p2);
  angle := GetRadOf2Lines(p,p1,p2);
  dx := len*Cos(angle);
  if dx > ol then begin
    p := Mpoint(p2,p1,ol-dx);
  end else begin
    p := Mpoint(p1,p2,dx);
  end;
end;

Procedure PointToLine(p1,p2: TDoublePoint; var x,y: Double);
var mx,my: Double;
    p,px,py,mp: TDoublePoint;
    lx,ly,dx,dy: Double;
    a,b: Double;
    rad: Double;
begin
  // y = ax+b
  // x = (b-y)/a
  if isPointinLine(p1,p2,DoublePoint(x,y),1,0.1) then exit;
  if GetLineFormula(p1,p2,a,b) then
  begin
    if (a = 0) and (b = 0) then
    begin
      mx := p1.x;
      x := mx;
    end else begin
      if a = 0 then
      begin
        my := b;
        y := my;
      end else
      begin
        mx := (y-b)/a;
        my := a*x+b;
        px := DoublePoint(mx,y);
        py :=  DoublePoint(x,my);
        p := DoublePoint(x,y);
        lx := GetLineLenght(px,p);
        ly := GetLineLenght(py,p);
        if p1.y < p2.y then begin
          mp := p1;
          p1 := p2;
          p2 := mp;
        end;
        rad := GetRadOfLine(p1,p2);
        dx := lx*cos(rad);
        mp := MPoint(px,py,dx);
        x := mp.x;
        y := mp.y;
        //if lx < ly then x := mx else y := my;
      end;
    end;
  end else
  begin

  end;
end;

Procedure PointTo90Line(p1,p2: TDoublePoint; var x,y: Double);
var mx,my: double;
    p,px,py: TDoublePoint;
    lx,ly: Double;
    a,b: Double;
begin
  // y = ax+b
  // x = (b-y)/a
  if Get90LineFormula(p1,p2,a,b) then
  begin
    if (a = 0) and (b = 0) then
    begin
      mx := (p1.x+p2.x) / 2;
      x := mx;
    end else begin
      if a = 0 then
      begin
        my := round(b);
        y := my;
      end else
      begin
        mx := round((y-b)/a);
        my := round(a*x+b);
        px := DoublePoint(mx,y);
        py :=  DoublePoint(x,my);
        p := DoublePoint(x,y);
        lx := GetLineLenght(px,p);
        ly := GetLineLenght(py,p);
        if lx < ly then x := mx else y := my;
      end;
    end;
  end else
  begin

  end;
end;


Procedure PointToParallelLine(p1,p2:TDoublepoint; var x,y: Double);
var a,b,aa,bb,ix: double;
begin
  GetLineFormula(p1,p2,a,b);
  if (a = 0) and (b= 0) then begin
    y := (p1.y+p2.y) / 2;
  end else if a = 0 then begin
    x := (p1.x+p2.x) / 2;
  end else begin
    b := y-(a*x);
    Get90LineFormula(p1,p2,aa,bb);
    ix := (bb-b) / (a-aa);
    y := a*ix+b;
    x := ix;
  end;
end;

Function PointByDistToLine(p1,p2:TDoublePoint; Dist:Double):TDoublePoint;
var rad: Double;
    xp2: TDoublePoint;
    np : TDoublePoint;
begin
  rad := GetRadOfLine(p1,p2);
  xp2 := RotatePoint(p1,p2,-rad);
  np := MVPoint(xp2,dist);
  np := RotatePoint(p1,np,rad);
  result := np;
end;

Function PointByDistToLineA(p1,p2:TDoublePoint; Dist,Angle:Double):TDoublePoint;
var rad: Double;
    xp1,xp2: TDoublePoint;
    np : TDoublePoint;
begin
  rad := GetRadOfLine(p1,p2);
  xp2 := RotatePoint(p1,p2,Angle);
  xp1 := p2;
  ExtendLine(xp1,xp2,dist*2);
  np := Mpoint(p1,xp2,dist);
  result := np;
end;

Function PointOutToLine(p1,p2,xp:TDoublePoint; Dist:Double):TDoublePoint;
var rad: Double;
    xp2: TDoublePoint;
    np : TDoublePoint;
begin
  rad := GetRadOfLine(p1,p2);
  xp2 := RotatePoint(p1,xp,-rad);
  np := MVPoint(xp2,dist);
  np := RotatePoint(p1,np,rad);
  result := np;
end;
Function GetLineNormal(p1,p2:TDoublePoint;dist:Double):TDoublePoint;
var np1,np2: TdoublePoint;
begin
  GetParallelPoints(p1,p2,np1,np2,dist);
  result := MPoint(np1,np2);
end;

function GetLineLenght(p1,p2: TDoublePoint; Planer:Boolean = True):Real;
var dp,hz: Double;
    xp1,xp2: TdoublePoint;
begin
  if EQD(p1.z,p2.z) or planer then begin
    if EQDP(p1,p2) then
      result  := 0
    else
      result := sqrt(sqr(p1.x - p2.x)+sqr(p1.y - p2.y));
  end else begin
    xp1 := DoublePoint(p1.x,p1.y);
    xp2 := DoublePoint(p2.x,p2.y);
    dp := GetLineLenght(xp1,xp2,true);
    hz := p2.z -p1.z;
    result := sqrt((dp*dp)+(hz*hz));
  end;
end;

function GetLineLength(p1,p2: TDoublePoint; Planer:Boolean = True):Real;
begin
  result := GetLineLenght(p1,p2,planer);
end;

Function GetLineSegmentPoint(p1,p2:TDoublepoint; ratio: double):TDoublePoint;
var a,l: double;
    dx,dy,dx0,dy0: double;
begin
  l := GetLineLenght(p1,p2);
  if l > 0 then begin
    dx := p2.x-p1.x;
    dy := p2.y-p1.y;
    a := ratio*l;
    dx0 := (a*dx)/l;
    dy0 := (a*dy)/l;
  end else begin
    dx0 := 0;
    dy0 := 0;
  end;
  result := DoublePoint(p1.x+dx0,p1.y+dy0);
end;

Function GetAreaofPGon(p:TdoublePointArr):real;
var posSum,negSum: real;
    xidx,yidx: integer;
    i,nPoint: integer;
begin
  result := 0;
  nPoint := Length(p);
  if nPoint < 3 then exit;
  posSum := 0;negSum := 0;
  for i := 0 to nPoint-1 do
  begin
    xidx := i;
    yidx := i+1;
    if yidx = nPoint then yIdx :=0;
    posSum := posSum + (p[xidx].x*p[yidx].y);
    yidx := i;
    xidx := i+1;
    if xidx = nPoint then xIdx :=0;
    negSum := negSum + (p[xidx].x*p[yidx].y);
  end;
  result := abs((PosSum - negSum)/2);
end;


Function GetAreaofPGon(p:array of Tpoint; nPoint: integer):Real;
var posSum,negSum: real;
    xidx,yidx: integer;
    i: integer;
begin
  posSum := 0;negSum := 0;
  for i := 0 to nPoint-1 do
  begin
    xidx := i;
    yidx := i+1;
    if yidx = nPoint then yIdx :=0;
    posSum := posSum + (p[xidx].x*p[yidx].y);
    yidx := i;
    xidx := i+1;
    if xidx = nPoint then xIdx :=0;
    negSum := negSum + (p[xidx].x*p[yidx].y);
  end;
  result := abs((PosSum - negSum)/2);
end;

Function GetPerimeterOfCircle(r:double): real;
begin
  result := 2 * PI * r;
end;

Function GetAreaOfCircle(r:double): real;
begin
  result := pi * r * r;
end;

Function CreateLinearRgn(p1,p2: TDoublepoint): HRGN;
var rad: double;
    points : array [0..3] of TDoublePoint;
    ipoints: array [0..3] of TPoint;
    pt: TDoublepoint;
    a : integer;
begin
  if p1.x > p2.x then
  begin
    pt := p1;
    p1 := p2;
    p2 := pt;
  end;

  rad := GetRadOfLine(p1,p2);
  p2 := RotatePoint(p1,p2,-rad);

  points[0] := DoublePoint(p1.x-2,p1.y-2);
  points[1] := DoublePoint(p1.x-2,p1.y+2);
  points[2] := DoublePoint(p2.x+2,p2.y+2);
  points[3] := DoublePoint(p2.x-2,p2.y-2);

  for a := 0 to 3 do
    ipoints[a] := Dp2P(RotatePoint(p1,points[a],rad));

  result := CreatePolygonRgn(ipoints,4,WINDING);

end;

Function CreateRotatedRgn(p1: TDoublepoint; w,h: Double; rad: double): HRGN;
var points: array [0..3] of TDoublePoint;
    ipoints: array [0..3] of TPoint;
    a: integer;
begin

  points[0] := DoublePoint(p1.x,p1.y);
  points[1] := DoublePoint(p1.x+w,p1.y);
  points[2] := DoublePoint(p1.x+w,p1.y+h);
  points[3] := DoublePoint(p1.x,p1.y+h);

  for a := 0 to 3 do
    ipoints[a] := DP2P(RotatePoint(p1,points[a],rad));

  result := CreatePolygonRgn(ipoints,4,WINDING);

end;

Procedure FlipCanvas(Handle:HDC; fMode: TFlipMode;delta:double=0);
var xForm: TXForm;
    f: integer;
    dx,dy: Double;
begin
  dx := 0;
  dy := 0;
  if fMode = fmHorz then f := 1 else f := -1;
  if fMode = fmHorz then dx := delta else dy := delta;
  SetGraphicsMode(Handle,GM_ADVANCED);
  xform.eDx := dx;
  xform.eDy := dy;
  xform.eM11 := -1*f;
  xform.eM12 := 0;
  xform.em21 := 0;
  xform.eM22 := 1*f;
  SetWorldTransform(handle,xform);
end;


Procedure RotateCanvas(Handle:HDC; Ang: Real);
var xForm: TXForm;
begin
  SetGraphicsMode(Handle,GM_ADVANCED);
  xform.eDx := 0;
  xform.eDy := 0;
  xform.eM11 := cos(ang);
  xform.eM12 := sin(ang);
  xform.em21 := -1*sin(ang);
  xform.eM22 := cos(ang);
  SetWorldTransform(handle,xform);
end;

Procedure ResetCanvas(Handle:HDC);
var xForm: TXForm;
begin
  ModifyWorldTransform(Handle,xForm,MWT_IDENTITY);
  SetGraphicsMode(Handle,GM_COMPATIBLE);
end;

Function RotatePoint(cpoint, opoint: Tpoint; ang: real):TPoint;
var p:Tpoint;
begin
  oPoint := Point (oPoint.x-cpoint.x,oPoint.y-cPoint.y);
  p.y := round(oPoint.x * sin(ang) + oPoint.y*cos(ang));
  p.x := round(oPoint.x * cos(ang) - oPoint.y*sin(ang));
  p := Point(p.x+cpoint.x,p.y+cpoint.y);
  result := p;
end;

Function RotatePoint(cpoint, opoint: TDoublepoint; ang: real):TDoublePoint;overload;
begin
  result := RotateDPoint(cpoint, opoint, ang);
end;
//Tolik -- 12/02/2016 -- старая закомменчена (см. ниже)
// в новой выполнено округление углов
Function RotateDPoint(cpoint, opoint: TDoublepoint; ang: double):TDoublePoint;
var p:TDoublepoint;
    RotAngle: Double;
begin
  RotAngle := RoundTo(ang, -5);
  oPoint := DoublePoint (oPoint.x-cpoint.x,oPoint.y-cPoint.y,oPoint.z);
  p.y := (oPoint.x * sin(RotAngle) + oPoint.y*cos(RotAngle));
  p.x := oPoint.x * cos(RotAngle) - oPoint.y*sin(RotAngle);
  // Tolik 15/02/2018
  // Tolik 19/12/2018 -- В общем, здесь как раз округление само по себе и не нужно, т.к. собака порылась в отрисовке
  // TRichText (там исправлено)
  p := DoublePoint(p.x+cpoint.x,p.y+cpoint.y,oPoint.z);  // если это(ркругление) тут не сделать, получим произвольное поворачивание текста подписи
  // при повороте точечного объекта на какой-нить угол, например, при изменении масштаба листа ...
  //p := DoublePoint(RoundTo((p.x+cpoint.x), -3),RoundTo((p.y+cpoint.y), -3), RoundTo(oPoint.z, -3));

  //p := DoublePoint(Trunc((p.x+cpoint.x)*10000)/10000, Trunc((p.y+cpoint.y)*10000)/10000, Trunc((oPoint.z)*10000)/10000);
  //
  result := p;
end;
{
Function RotateDPoint(cpoint, opoint: TDoublepoint; ang: real):TDoublePoint;
var p:TDoublepoint;
begin
  oPoint := DoublePoint (oPoint.x-cpoint.x,oPoint.y-cPoint.y,oPoint.z);
  p.y := oPoint.x * sin(ang) + oPoint.y*cos(ang);
  p.x := oPoint.x * cos(ang) - oPoint.y*sin(ang);
  p := DoublePoint(p.x+cpoint.x,p.y+cpoint.y,oPoint.z);
  result := p;
end;
}

Function ScalePoint(cpoint, opoint: TDoublepoint; px,py: real): TDoublePoint;
var
  respoint: TDoublePoint;
  deltax,deltay: double;
begin
  // Tolik 02/05/2019 - - Init ResPoint.z;
  respoint.z := 0;
  //
  if px = 1 then
  begin
    respoint.x := oPoint.x;
  end
  else
  begin
    deltax := cPoint.x - oPoint.x;
    deltax := deltax * px;
    respoint.x := cpoint.x - deltax;
  end;

  if py = 1 then
  begin
    respoint.y := oPoint.y;
  end
  else
  begin
    deltay := cPoint.y - oPoint.y;
    deltay := deltay * py;
    respoint.y := cpoint.y - deltay;
  end;
  result := respoint;
end;

Procedure GetParallelPoints(p1,p2:TDoublePoint; var np1,np2: TDoublePoint; thick:Double);
var rad:Double;
begin
  rad := GetRadOfLine(p1,p2);
  np2 := RotatePoint(p1,p2,-rad);
  np1 := DoublePoint(p1.x,p1.y+thick);
  np2 := DoublePoint(np2.x,np2.y+thick);
  np1 := RotatePoint(p1,np1,rad);
  np2 := RotatePoint(p1,np2,rad);
end;

Procedure GetShrinkedPoints(p1,p2:TDoublePoint; var np1,np2: TDoublePoint; thick:Double);
var rad:Double;
begin
  rad := GetRadOfLine(p1,p2);
  np2 := RotatePoint(p1,p2,-rad);
  np1 := DoublePoint(p1.x+thick,p1.y);
  np2 := DoublePoint(np2.x-thick,np2.y);
  np1 := RotatePoint(p1,np1,rad);
  np2 := RotatePoint(p1,np2,rad);
end;

Procedure OffsetPoint(op,cp:TDoublePoint; var np:TDoublePoint; delta: Double);
var rad:Double;
begin
  rad := GetRadOfLine(cp,op);
  np := RotatePoint(cp,op,-rad);
  if cp.x < np.x then delta := -delta;
  np := DoublePoint(np.x+delta,np.y);
  np := RotatePoint(cp,np,rad);
end;

Function GetClosePoint(cPoint,p1,p2:TDoublePoint):TDoublePoint;
var d1,d2: Double;
begin
  d1 := GetLineLenght(cPoint,p1);
  d2 := GetLineLenght(cPoint,p2);
  if d1 < d2 then result := p1 else result := p2;
end;

Function GetBezierTime(bp1,bp2,bp3,bp4,p1,p2:TDoublePoint):Double;
var t1,t2,dt: Double;
    step: Integer;
    done: boolean;
    res: Integer;
    rp,op1,op2: TDoublePOint;
    Angle: Double;
begin
  op1 := p1;
  op2 := p2;
  result := -1;
  t1 := 0;
  t2 := 1;
  step := 0;
  done := false;

  Angle := GetRadOfLine(p1,p2);

  p2 := RotatePoint(p1,p2,-Angle);
  bp1 := RotatePoint(p1,bp1,-Angle);
  bp2 := RotatePoint(p1,bp2,-Angle);
  bp3 := RotatePoint(p1,bp3,-Angle);
  bp4 := RotatePoint(p1,bp4,-Angle);
  repeat
    res := TraceBezier(bp1,bp2,bp3,bp4,p1,2,t1,t2);
    if res = 1 then begin
      result := t1;
      done := true;
    end else if res = 2 then begin
      dt := t2-t1;
      if (dt < 0.000001) or (step > 10) then begin
        result := (t1+t2)/2;
        done := true;
      end;
    end else begin
      result := -1;
      done := true;
    end;
    step := step+1;
  until done ;
  if (result <> -1) then begin
    rp := GetBezierSample(bp1,bp2,bp3,bp4,result) ;
    rp.y := p1.y;
    rp := RotatePoint(op1,rp,Angle);
    if  not (isPOintInLine(op1,op2,rp,2)) then begin
      result := -1;
    end;
  end;
end;


Function GetBezierTime(bp1,bp2,bp3,bp4,dp:TDoublePoint):Double;
var t1,t2,dt: Double;
    step: Integer;
    done: boolean;
    res: Integer;

begin
  result := -1;
  t1 := 0;
  t2 := 1;
  step := 0;
  done := false;
  repeat
    res := TraceBezier(bp1,bp2,bp3,bp4,dp,0,t1,t2);
    if res = 1 then begin
      result := t1;
      done := true;
    end else if res = 2 then begin
      dt := t2-t1;
      if (dt < 0.000001) or (step > 10) then begin
        result := (t1+t2)/2;
        done := true;
      end;
    end else begin
      result := -1;
      done := true;
    end;
    step := step+1;
  until done ;

end;

Function GetLineBezierIntersection(p1,p2,bp1,bp2,bp3,bp4:TDoublePoint; var pArr:TDoublePointArr;
                               var icnt:Integer; extend:Boolean = true):Boolean;
var op1,op2: TDoublePoint;
    d,Angle: Double;
    t1,t2: Double;
    res: Integer;
    done: boolean;
    step: Integer;
    rp: TdoublePoint;
    dt:Double;
    valid: Boolean;
    Procedure AddPointByT(tval: Double);
    begin
      rp := GetBezierSample(bp1,bp2,bp3,bp4,tval) ;
      rp.y := p1.y;
      rp := RotatePoint(op1,rp,Angle);
      valid := true;
      if not extend then begin
        valid := (isPointInLine(op1,op2,rp,1,0.1)) and (not EQDP(op1,rp)) and (not EQDP(op2,rp));
      end;
      if valid then begin
        iCnt := iCnt+1;
        SetLength(pArr,iCnt);
        pArr[iCnt-1] := rp;
      end;
    end;
begin
  // move the system as if the line is x axis
  op1 := p1;
  op2 := p2;
  Angle := GetRadOfLine(p1,p2);

  p2 := RotatePoint(p1,p2,-Angle);
  bp1 := RotatePoint(p1,bp1,-Angle);
  bp2 := RotatePoint(p1,bp2,-Angle);
  bp3 := RotatePoint(p1,bp3,-Angle);
  bp4 := RotatePoint(p1,bp4,-Angle);

  t1 := 0;
  t2 := 1;
  step := 0;
  iCnt := 0;
  done := false;
  repeat
    res := TraceBezier(bp1,bp2,bp3,bp4,p1,2,t1,t2);
    if res = 1 then begin
      AddPointbyT(t1);
      t1 := t1+0.000001;
      t2 := 1;
      step := 0;
    end else if res = 2 then begin
      dt := t2-t1;
      if (dt < 0.000001) or (step > 10) then begin
        AddPointbyT((t1+t2)/2);
        t1 := t2;
        t2 := 1;
        step := 0;
      end;
    end else begin
      done := true;
    end;
    step := step+1;
  until done ;
  result := (icnt > 0);

end;

Function TraceBezier(bp1,bp2,bp3,bp4,tPoint:TDoublePoint; tIndex: Integer; var t1,t2: Double): integer;
var a: integer;
    tx,px,py : real;
    t : array[1..4] of real;
    mcol,mrow: integer;
    pntx,pnty: array[1..4] of Double;
    sgn:Integer;
    dx,dy,ox,oy: Double;
    dt: Double;
    sControl,sgx,sgy: Boolean;
begin
  result := 0;
  pntx[1] := bp1.x;
  pntx[2] := bp2.x;
  pntx[3] := bp3.x;
  pntx[4] := bp4.x;
  pnty[1] := bp1.y;
  pnty[2] := bp2.y;
  pnty[3] := bp3.y;
  pnty[4] := bp4.y;
  dt := t2-t1;
  for a := 0 to 500 do
  begin
    tx := t1+(dt / 500)*a;
    t[1] := tx*tx*tx;
    t[2] := tx*tx;
    t[3] := tx;
    t[4] := 1;
    px := 0;
    py := 0;
    for mcol := 1 to 4 do begin
      for mrow := 1 to 4 do begin
        px := px + mval[mrow,mcol]* t[mrow]*pntx[mcol];
        py := py + mval[mrow,mcol]* t[mrow]*pnty[mcol];
      end;
    end;
    dx := tPoint.x-px;
    dy := tPoint.y-py;
    if a = 0 then begin
      sControl := ((tIndex = 1) and (dx = 0)) or ((tIndex = 1) and (dy = 0)) or
                  ((tIndex = 2) and (dx = 0) and (dy = 0));
      if sControl then begin
        result := 1;
        t1 := tx;
        exit;
      end;
    end else begin
      sControl := ((tIndex = 1) and (dx = 0)) or ((tIndex = 2) and (dy = 0)) or
                  ((tIndex = 0) and (dx = 0) and (dy = 0));
      if sControl then begin
        result := 1;
        t1 := tx;
        exit;
      end;
      sgx := sign(ox) <> sign(dx);
      sgy := sign(oy) <> sign(dy);
      sControl := ((tIndex = 1) and (sgx)) or ((tIndex = 2) and (sgy)) or
                  ((tIndex = 0) and (sgx) and (sgy));
      if sControl then begin
        result := 2;
        t1 := t1+(dt / 500)*(a-1);
        t2 := tx;
        exit;
      end;
    end;
    ox := dx;
    oy := dy;
  end;
end;

Function GetLineEllipseIntersection(p1,p2,cp:TdoublePoint;aLen,Blen,Angle:Double;
      var np1,np2: TDoublePoint;var icnt:Integer; extend:Boolean = true):Boolean;
var D,x1,x2,y1,y2,c,k,xx,r,g,h,rx1,rx2,ry1,ry2,a,b: Double;
    op1,op2: TdoublePoint;
    i: integer;
    res1,res2: Boolean;
begin

  //move the system to the origin // rotate system
  iCnt := 0;
  result := false;
  x1 := 0; x2 := 0;
  y1 := 0; y2 := 0;
  if EQDP(p1,p2) then exit;
  op1 := p1;
  op2 := p2;
  p1 := RotatePoint(cp,p1,-Angle);
  p2 := RotatePoint(cp,p2,-Angle);

  p1 := DoublePoint(p1.x-cp.x,p1.y-cp.y);
  p2 := DoublePoint(p2.x-cp.x,p2.y-cp.y);
  a := aLen;
  b := bLen;

  x1 := p1.x; x2 := p2.x;
  y1 := p1.y; y2 := p2.y;

  GetLineformula(p1,p2,c,k);

  if c<>0 then begin
    g := (1/(a*a))+((c*c)/(b*b));
    h := (2*c*k)/(b*b);
    r := (k*k - b*b)/(b*b);
    D := (h*h)-(4*g*r);
    if d > 0 then begin
      iCnt := 2;
      rx1 := (-h+sqrt(d))/(2*g);
      rx2 := (-h-sqrt(d))/(2*g);
      ry1 := c*rx1+k;
      ry2 := c*rx2+k;
      np1 := DoublePoint(rx1,ry1);
      np2 := DoublePoint(rx2,ry2);
    end else if d = 0 then begin
      iCnt := 1;
      rx1 := (-h+sqrt(d))/(2*g);
      ry1 := c*rx1+k;
      np1 := DoublePoint(rx1,ry1);
    end else if d < 0 then begin
      iCnt := 0;
    end;

  end else begin
    if EQD(x1 ,x2) then begin
      if (EQD(abs(x1) , alen)) then begin
        icnt := 1;
        np1.x := x1;
        np1.y := bLen*sqrt(1-(x1/aLen)*(x1/aLen));
      end else if between(x1,aLen,-aLen) then begin
        icnt := 2;
        np1.x := x1; np2.x := x1;
        np1.y := bLen*sqrt(1-(x1/aLen)*(x1/aLen));
        np2.y := -1*bLen*sqrt(1-(x1/aLen)*(x1/aLen));
      end;
    end else if EQD(y1 ,y2) then begin
      if (EQD(abs(y1) , blen)) then begin
        icnt := 1;
        np1.y := y1;
        np1.x := aLen*sqrt(1-(y1/bLen)*(y1/bLen));
      end else if between(y1,bLen,-bLen) then begin
        icnt := 2;
        np1.y := y1; np2.y := y1;
        np1.x := aLen*sqrt(1-(y1/bLen)*(y1/bLen));
        np2.x := -1*aLen*sqrt(1-(y1/bLen)*(y1/bLen));
      end;
    end;
  end;

  if icnt > 0 then begin
    result := true;
    np1 := DoublePoint(np1.x+cp.x,np1.y+cp.y);
    np2 := DoublePoint(np2.x+cp.x,np2.y+cp.y);
    np1 := RotatePoint(cp,np1,Angle);
    np2 := RotatePoint(cp,np2,Angle);    
  end;

  res1 := false;
  res2 := false;
  if result and not extend then begin
    res1 := isPointinLine(op1,op2,np1,1,0.1)
            and (not EQDP(np1,op1)) and (not EQDP(np1,op2));
    res2 := isPointinLine(op1,op2,np2,1,0.1)
            and (not EQDP(np2,op1)) and (not EQDP(np2,op2));
    if icnt = 1 then begin
      result := res1;
    end else if icnt = 2 then begin
      if not res1 then begin
        icnt := 1;
        np1 := np2;
        result := res2;
      end else begin
        if not res2 then iCnt := 1;
      end;
    end;
    if not result then icnt := 0;
  end;

end;


Function GetLineCircleIntersection(p1,p2,cp:TdoublePoint;radius:Double; var np1,np2: TDoublePoint; var icnt:Integer;extend:Boolean = true):Boolean;
var dx,dy,dr,D,delta,r,x1,x2,y1,y2: Double;
    xcnt: Integer;
    op1,op2: TDoublePoint;
    res1,res2: Boolean;
  Function sgn(x:Double): Integer;
  begin
    result := sign(x);
    if result = 0 then result := 1;
  end;
begin
  //move the system to the origin
  op1 := p1;
  op2 := p2;
  x1 := 0; y1 := 0; x2 := 0; y2 := 0;
  p1 := DoublePoint(p1.x-cp.x,p1.y-cp.y);
  p2 := DoublePoint(p2.x-cp.x,p2.y-cp.y);

  r := Radius;
  dx := p2.x-p1.x;
  dy := p2.y-p1.y;
  dr := sqrt(dx*dx+dy*dy);
  D := p1.x*p2.y-p2.x*p1.y;

  Delta := r*r*dr*dr-D*D;

  if Delta < 0 then begin
    result := false;
    icnt := 0;
  end else if Delta = 0 then begin
    result := True;
    icnt := 1;
    x1 := (D*dy+sgn(dy)*dx*sqrt(delta))/(dr*dr);
    y1 := (-D*dx+abs(dy)*sqrt(delta))/(dr*dr);
    x1 := x1 + cp.x; y1 :=y1 + cp.y;
  end else if Delta > 0 then begin
    result := True;
    icnt := 2;
    x1 := (D*dy+sgn(dy)*dx*sqrt(delta))/(dr*dr);
    y1 := (-D*dx+abs(dy)*sqrt(delta))/(dr*dr);
    x1 := x1 + cp.x; y1 :=y1 + cp.y;
    x2 := (D*dy-sgn(dy)*dx*sqrt(delta))/(dr*dr);
    y2 := (-D*dx-abs(dy)*sqrt(delta))/(dr*dr);
    x2 := x2 + cp.x; y2 :=y2 + cp.y;
  end;
  if result then begin
    np1 := DoublePoint(x1,y1);
    np2 := DoublePoint(x2,y2);
  end;
  res1 := false;
  res2 := false;
  if result and not extend then begin
    res1 := isPointinLine(op1,op2,np1,1,0.1)
            and (not EQDP(np1,op1)) and (not EQDP(np1,op2));
    res2 := isPointinLine(op1,op2,np2,1,0.1)
            and (not EQDP(np2,op1)) and (not EQDP(np2,op2));
    if icnt = 1 then begin
      result := res1;
    end else if icnt = 2 then begin
      if not res1 then begin
        icnt := 1;
        np1 := np2;
        result := res2;
      end else begin
        if not res2 then iCnt := 1;
      end;
    end;
    if not result then icnt := 0;
  end;

end;
 (*
Function GetLineEllipseIntersection(p1,p2,cp:TdoublePoint;aLen,Blen,Angle:Double; var np1,np2: TDoublePoint; var icnt:Integer;extend:Boolean = true):Boolean;
var dx,dy,dr,D,delta,x1,x2,y1,y2: Double;
    xcnt: Integer;
    op1,op2: TDoublePoint;
  Function sgn(x:Double): Integer;
  begin
    result := sign(x);
    if result = 0 then result := 1;
  end;
begin
  //move the system to the origin

  iCnt := 0;
  result := false;
  if EQDP(p1,p2) then exit;

  op1 := p1;
  op2 := p2;

  p1 := RotatePoint(cp,p1,-Angle);
  p2 := RotatePoint(cp,p2,-Angle);

  x1 := 0; y1 := 0; x2 := 0; y2 := 0;
  p1 := DoublePoint(p1.x-cp.x,p1.y-cp.y);
  p2 := DoublePoint(p2.x-cp.x,p2.y-cp.y);

  dx := p2.x-p1.x;
  dy := p2.y-p1.y;
  dr := sqrt(dx*dx+dy*dy);
  D := p1.x*p2.y-p2.x*p1.y;

  Delta := aLen*bLen*dr*dr-D*D;

  if Delta < 0 then begin
    result := false;
    icnt := 0;
  end else if Delta = 0 then begin
    result := True;
    icnt := 1;
    x1 := (D*dy+sgn(dy)*dx*sqrt(delta))/(dr*dr);
    y1 := (-D*dx+abs(dy)*sqrt(delta))/(dr*dr);
    x1 := x1 + cp.x; y1 :=y1 + cp.y;
  end else if Delta > 0 then begin
    result := True;
    icnt := 2;
    x1 := (D*dy+sgn(dy)*dx*sqrt(delta))/(dr*dr);
    y1 := (-D*dx+abs(dy)*sqrt(delta))/(dr*dr);
    x1 := x1 + cp.x; y1 :=y1 + cp.y;
    x2 := (D*dy-sgn(dy)*dx*sqrt(delta))/(dr*dr);
    y2 := (-D*dx-abs(dy)*sqrt(delta))/(dr*dr);
    x2 := x2 + cp.x; y2 :=y2 + cp.y;
  end;
  if result then begin
    np1 := DoublePoint(x1,y1);
    np2 := DoublePoint(x2,y2);
    np1 := RotatePoint(cp,np1,Angle);
    np2 := RotatePoint(cp,np2,Angle);
  end;
  if result and not extend then begin
    if icnt = 1 then begin
      result := isPointinLine(op1,op2,np1,2);
    end else if icnt = 2 then begin
      if not isPointinLine(op1,op2,np1,2) then begin
        icnt := 1;
        np1 := np2;
        result := isPointinLine(op1,op2,np1,2);
      end else begin
        if not isPointinLine(op1,op2,np2,2) then iCnt := 1;
      end;
    end;
    if not result then icnt := 0;
  end;

end;

    *)
Function GetCircleCircleIntersection(cp1:TdoublePoint;rad1:Double;cp2:TdoublePoint;
                                     rad2:Double; var np1,np2: TDoublePoint; var icnt: Integer):Boolean;
var d,rad,x,y1,y2,a,f,g: Double;

begin
  /// move system to the origin based distance
  result := true;
  rad := GetRadOfLine(cp1,cp2);
  cp2 := RotatePoint(cp1,cp2,-rad);
  d := cp2.x - cp1.x;
  if (d = 0) or (abs(d) > (rad1+rad2)) or (abs(d)+rad2 < rad1) then begin
    result := false;
    icnt := 0;
    exit;
  end;

  if result then begin
    f := (d*d-rad2*rad2+rad1*rad1);
    x := f / (2*d);
    g := 4*d*d*rad1*rad1-power((f),2);
    if g > 0 then begin
    a :=  (1/d)*sqrt(g);
    if a = 0 then icnt := 1 else icnt := 2;
    y1 :=  a / 2;
    y2 := -a/2;
    np1 := DoublePOint(x,y1);
    np2 := DoublePOint(x,y2);
    np1 := DoublePoint(np1.x+cp1.x,np1.y+cp1.y);
    np2 := DoublePoint(np2.x+cp1.x,np2.y+cp1.y);
    np1 := RotatePoint(cp1,np1,rad);
    np2 := RotatePoint(cp1,np2,rad);
    end else begin
      result := false;
      icnt := 0;
      exit;
    end;
  end;
end;

Procedure SortList(var sList:Tlist; GetValueFunc:TGetValueFunc);
var i,cnt:Integer;
    SArr:TSortItemArr;
    dList: TList;
begin
  cnt := sList.Count;
  if cnt < 2 then exit;
  SetLength(sArr,cnt);
  for i := 0 to Cnt-1 do
  begin
    sArr[i].Value := GetValueFunc(sList[i]);
    sArr[i].Tag := i;
  end;
  SortItems(sArr);
  dList := TList.Create;
  for i := 0 to cnt-1 do
    dList.Add(sList[i]);
  sList.Clear;
  for i := 0 to cnt-1 do begin
    SList.Add(dList[sArr[i].Tag]);
  end;
  dList.Free;
  setLength(sArr, 0); // Tolik 21/05/2018 - -
end;

Procedure SortList(var sList:Tlist; GetValueFunc:TGetValueFuncEx; Data:Pointer);
var i,cnt:Integer; 
    SArr:TSortItemArr;
    dList: TList;
begin
  cnt := sList.Count;
  if cnt < 2 then exit;
  SetLength(sArr,cnt);
  for i := 0 to Cnt-1 do
  begin
    sArr[i].Value := GetValueFunc(sList[i],Data);
    sArr[i].Tag := i;
  end;
  SortItems(sArr);
  dList := TList.Create;
  for i := 0 to cnt-1 do
    dList.Add(sList[i]);
  sList.Clear;
  for i := 0 to cnt-1 do begin
    SList.Add(dList[sArr[i].Tag]);
  end;
  dList.Free;
  setLength(sArr, 0); // Tolik 21/05/2018 - -
end;

Procedure SortItems(var SArr:TSortItemArr);
  procedure QuickSort(var A: TSortItemArr; iLo, iHi: Integer);
  var
    Lo, Hi: Integer;
    Mid, T: TSortItem;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo].Value < Mid.Value do Inc(Lo);
      while A[Hi].Value > Mid.Value do Dec(Hi);
      if Lo <= Hi then
      begin
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(A, iLo, Hi);
    if Lo < iHi then QuickSort(A, Lo, iHi);
  end;

begin
  QuickSort(SArr, Low(SArr), High(SArr));
end;

Procedure SortDouble(var SArr:TDoubleArray);
  procedure QuickSort(var A: TDoubleArray; iLo, iHi: Integer);
  var
    Lo, Hi: Integer;
    Mid, T: Double;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo] < Mid do Inc(Lo);
      while A[Hi] > Mid do Dec(Hi);
      if Lo <= Hi then
      begin
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(A, iLo, Hi);
    if Lo < iHi then QuickSort(A, Lo, iHi);
  end;

begin
  QuickSort(SArr, Low(SArr), High(SArr));
end;

Procedure SortPointsOnLine(p1,p2: TDoublePoint; var pArr:TDoublePointArr);
var cnt,i: Integer;
    sArr: TSortItemArr;
    tArr: TDoublePointArr;
    len: Double;
begin
  cnt := Length(pArr);
  SetLength(sArr,cnt);
  SetLength(tArr,cnt);
  for i := 0 to cnt-1 do
  begin
    len := GetLineLenght(p1,pArr[i]);
    sArr[i].Value := len;
    sArr[i].Tag := i;
    tArr[i] := pArr[i];
  end;
  SortItems(sArr);
  for i := 0 to cnt-1 do
  begin
    pArr[i] := tArr[sArr[i].Tag];
  end;
  setLength(sArr, 0); // Tolik 21/05/2018 - -
end;

Procedure InSertPointToArray(var pArr:TDoublePointArr; index:Integer; p:TDoublePoint);
var cnt,i: Integer;
begin
  cnt := Length(pArr);
  if (index > cnt) or (index <0) then exit;
  SetLength(pArr,cnt+1);
  for i:= cnt downto index+1 do
  begin
    pArr[i] := pArr[i-1];
  end;
  pArr[index] := p;
end;

Function CheckLineOnLine(pArr:TDoublePointArr):Boolean;
var i,k,cnt: Integer;
p1,p2,p3,p4: TDoublePoint;
begin
  result := false;
  cnt := Length(pArr);
  for i := 0 to cnt-3 do
  begin
    p1 := pArr[i];
    p2 := pArr[i+1];
    for k := i+1 to cnt-2 do
    begin
      p3 := pArr[k];
      p4 := pArr[k+1];
      if (isPointinLine(p1,p2,p3,1,0.2) and isPointinLine(p1,p2,p4,1,0.2)) or
         (isPointinLine(p3,p4,p1,1,0.2) and isPointinLine(p3,p4,p2,1,0.2)) then
         begin
           result := true;
           exit;
         end;
    end;
  end;
end;

Function CheckLineOnLine(p1,p2,p3,p4:TDoublePoint):Boolean;overload;
begin
  result := false;
  if (isPointinLine(p1,p2,p3,1,0.2) and isPointinLine(p1,p2,p4,1,0.2)) or
     (isPointinLine(p3,p4,p1,1,0.2) and isPointinLine(p3,p4,p2,1,0.2)) then
     begin
       result := true;
       exit;
     end;
end;

Function LinesIntersect(p1,p2,p3,p4:TDoublePoint):Boolean;
var ip:TDoublePOint;

  Function EQP(x1,x2:TDoublePOint):Boolean;
  begin
    result := EQDP(x1,x2) and EQD(x1.z,x2.z);
  end;

  Function bw(d1,d2,d3:Double):Boolean;
  begin
    result := ((d1 >= d2) and (d1 <= d3)) or ((d1 >= d3) and (d1 <= d2)); 
  end;

  Function PointOnLine(x1,x2,p:TDoublePOint):Boolean;
  var z1,z2: Double;
  begin
    result := false;
    if EQD(x1.z,x2.z) then begin
      result := EQD(p.z,x1.z) and isPointinLine(x1,x2,p,1,0.1);
    end else if EQDP(x1,x2) then begin
      if x1.z < x2.z then begin
        z1 := x1.z; z2 := x2.z;
      end else begin
        z1 := x2.z; z2 := x1.z;
      end;
      result := EQDP(x1,p) and ((p.z > x1.z) and (p.z < x2.z));
    end;
  end;
begin
  result := false;
  // check points p1
  if PointOnLine(p3,p4,p1) and not (EQP(p1,p3) or EQP(p1,p3)) then
  begin
    result := true;
    exit;
  end;

  // check points p2
  if PointOnLine(p3,p4,p2) and not (EQP(p2,p3) or EQP(p2,p3)) then
  begin
    result := true;
    exit;
  end;
  // check points p3
  if PointOnLine(p1,p2,p3) and not (EQP(p3,p1) or EQP(p3,p2)) then
  begin
    result := true;
    exit;
  end;
  // check points p4
  if PointOnLine(p1,p2,p4) and not (EQP(p4,p1) or EQP(p4,p2)) then
  begin
    result := true;
    exit;
  end;

  // check same lines
  if (EQP(p1,p3) and EQP(p2,p4)) or (EQP(p2,p3) and EQP(p1,p4)) then begin
    result := true;
    exit;
  end;

  //check dikey intersect
  if EQDP(p1,p2) and EQDP(p2,p3) and EQDP(p3,p4) then begin
    if ((p1.z > p3.z) and (p1.z < p4.z)) or
       ((p1.z > p4.z) and (p1.z < p3.z)) or
       ((p2.z > p3.z) and (p2.z < p4.z)) or
       ((p2.z > p4.z) and (p2.z < p3.z)) or
       ((p3.z > p1.z) and (p3.z < p2.z)) or
       ((p3.z > p2.z) and (p3.z < p1.z)) or
       ((p4.z > p1.z) and (p4.z < p2.z)) or
       ((p4.z > p2.z) and (p4.z < p1.z)) then
    begin
      result := true;
      exit;

    end;

  end;


  // check planer intersects

  if (EQD(p1.z,p2.z) and EQD(p2.z,p3.z) and EQD(p3.z,p4.z)) then begin
    if GetIntersectionPoint(p1,p2,p3,p4,ip,false,false) then
      result := True;
  end else if (EQD(p1.z,p2.z) and (bw(p1.z,p3.z,p4.z))and EQDP(p3,p4) and not (EQDP(p3,p1) or EQDP(p3,p2))) then begin
    if isPointInLine(p1,p2,p3,1,0.1) then
      result := True;
  end else if (EQD(p3.z,p4.z) and (bw(p3.z,p1.z,p2.z)) and EQDP(p1,p2) and not (EQDP(p1,p3) or EQDP(p1,p4))) then begin
    if isPointInLine(p3,p4,p1,1,0.1) then
      result := true;
  end;  
end;

Function CheckSelfIntersection(var pArr:TDoublePointArr):Boolean;
var i,cnt,k: Integer;
    p1,p2,p3,p4,p: TDoublePOint;
    exitFor,done: Boolean;
begin
  result := True;
  repeat
    cnt := Length(pArr);
    ExitFor := False;
    done := true;
    for i := 0 to cnt-3 do
    begin
      p1 := pArr[i];
      p2 := pArr[i+1];
      for k := i+1 to cnt-2 do
      begin
        p3 := pArr[k];
        p4 := pArr[k+1];
        if GetIntersectionPoint(p1,p2,p3,p4,p,false) then
        begin
          InsertPointToArray(pArr,k+1,p);
          InsertPointToArray(pArr,i+1,p);
          done := false;
          exitFor := True;
          break;
        end;
      end;
      if ExitFor then break;
    end;
  until done;
end;

Function GetInterSectionPoint(p1, p2, p3, p4: TDoublePoint; var p: TDoublePoint; extend: Boolean = True; usetips: Boolean = False): Boolean;
var
  x, y, a1, a2, b1, b2: Double;
  v1, v2: Boolean;
  l1, l2: Boolean;
begin
  result := false;
  if (not extend) and (EQDP(p1,p2) or EQDP(p1,p3) or EQDP(p2,p3) or EQDP(p2,p4) or EQDP(p3,p4) ) then
  begin
    result := false;
    exit;
  end;
  try
    l1 := GetLineFormula(p1, p2, a1, b1);
    l2 := GetLineFormula(p3, p4, a2, b2);
    v1 := (a1 = 0) and (b1 = 0);
    v2 := (a2 = 0) and (b2 = 0);
    a1 := Trunc(a1 * 100000)/100000;
    b1 := Trunc(b1 * 100000)/100000;
    a2 := Trunc(a2 * 100000)/100000;
    b2 := Trunc(b2 * 100000)/100000;
    if (l1 and l2) and (v1 and (not v2)) then
    begin
      result := true;
      x := p1.x;
      y := a2 * x + b2;
    end
    else
    if (l1 and l2) and (v2 and (not v1)) then
    begin
      result := true;
      x := p3.x;
      y := a1 * x + b1;
    end
    else
    if EQD(a1, a2) or (not l1) or (not l2) then
    begin
      result := True;
      if EQDP(p2, p3) or EQDP(p2, p4) then
      begin
        x := p2.x;
        y := p2.y;
      end
      else
      if EQDP(p1, p3) or EQDP(p1, p4) then
      begin
        x := p1.x;
        y := p1.y;
      end
      else
        result := false;
    end
    else
    begin
      result := True;
      x := (b2 - b1) / (a1 - a2);
      y := a1 * x + b1;
    end;
  except
    result := false;
  end;
  if result then
    p := DoublePoint(x,y);
  if result and not extend then
  begin
    result := isPointInLine(p1, p2, p, 1, 0.1) and isPointInLine(p3, p4, p, 1, 0.1);
    if result and not usetips then
      result := (not EQDP(p1,p3)) and (not EQDP(p2,p3)) and (not EQDP(p1,p4)) and (not EQDP(p2,p4));
//      result := (not EQDP(p,p1)) and (not EQDP(p,p2)) and (not EQDP(p,p3)) and (not EQDP(p,p4));
  end;
end;

Function SubBezier(p0,p1,p2,p3: TDoublePoint;
                   var dPoint,cp1,cp2,cp3,cp4:TDoublePoint;
                   ts:Double; bp1,bp2:TDoublepOint):Boolean;
var A,B,C,D,E,F:TDoublePoint;
begin
   result := false;
   if (ts < 0) or (ts > 1) then begin
     ts := GetBezierTime(p0,p1,p2,p3,bp1,bp2);
   end;
   if (ts < 0) or (ts > 1) then exit;

   A := DoublePoint( (1-ts)*P0.x + ts*P1.x,(1-ts)*P0.y + ts*P1.y);
   B := DoublePoint( (1-ts)*P1.x + ts*P2.x,(1-ts)*P1.y + ts*P2.y);
   C := DoublePoint( (1-ts)*P2.x + ts*P3.x,(1-ts)*P2.y + ts*P3.y);
   D := DoublePoint( (1-ts)*A.x + ts*B.x,(1-ts)*A.y + ts*B.y);
   E := DoublePoint( (1-ts)*B.x + ts*C.x,(1-ts)*B.y + ts*C.y);
   F := DoublePoint( (1-ts)*D.x + ts*E.x,(1-ts)*D.y + ts*E.y);
   dPoint := F;
   cp1 := A;
   cp2 := D;
   cp3 := E;
   cp4 := C;
   result := true;
end;

Function SubBezier(p0,p1,p2,p3: TDoublePoint; var dPoint,cp1,cp2,cp3,cp4:TDoublePoint; ts:Double):Boolean;
var A,B,C,D,E,F:TDoublePoint;
begin
   result := false;
   if (ts < 0) or (ts > 1) then begin
     ts := GetBezierTime(p0,p1,p2,p3,dPoint);
   end;
   if (ts < 0) or (ts > 1) then exit;

   A := DoublePoint( (1-ts)*P0.x + ts*P1.x,(1-ts)*P0.y + ts*P1.y);
   B := DoublePoint( (1-ts)*P1.x + ts*P2.x,(1-ts)*P1.y + ts*P2.y);
   C := DoublePoint( (1-ts)*P2.x + ts*P3.x,(1-ts)*P2.y + ts*P3.y);
   D := DoublePoint( (1-ts)*A.x + ts*B.x,(1-ts)*A.y + ts*B.y);
   E := DoublePoint( (1-ts)*B.x + ts*C.x,(1-ts)*B.y + ts*C.y);
   F := DoublePoint( (1-ts)*D.x + ts*E.x,(1-ts)*D.y + ts*E.y);
   dPoint := F;
   cp1 := A;
   cp2 := D;
   cp3 := E;
   cp4 := C;
   result := true;
end;

Procedure DoubleBezier(p1,p2,p3,p4:TDoublePoint;var t: TDoublePointArr; thick: Double);
var p: TDoublePointArr;
    i: integer;
    l1,l2,n1,n2:TDoublePoint;
    i1,i2,i3,i4,ip:TDoublePoint;
    sCount: Integer;
begin
  sCount := 500;
  SetLength(t,sCount+1);
  SetLength(p,sCount+1);
  for i:= 0 to sCount do
  begin
    p[i] := GetBezierSample(p1,p2,p3,p4,i/SCount);
  end;

  for i:= 0 to sCount-1 do begin
    l1 := p[i];
    l2 := p[i+1];
    GetParallelPoints(l1,l2,n1,n2,thick);
    t[i+1] := n2;
    if i = 0 then
      t[i] := n1
    else begin
      i1 := t[i-1];
      i2 := t[i];
      i3 := n1;
      i4 := n2;
      if GetIntersectionPoint(i1,i2,i3,i4,ip,false) then
      begin
        t[i] := ip;
      end else begin
        t[i] := n1;
      end;
    end;
  end;
  SetLength(p,0);
end;

Function DoublePoint(pt:Tpoint):TDoublePoint;
begin
  Result.x := pt.x;
  result.y := pt.y;
  Result.z := 0;
end;

Function DP(pt:TPoint):TDoublePOint;
begin
  result := DoublePoint(pt);
end;

Procedure SwapPoints(var p1,p2:TDOublePoint);
var xp:TDoublePoint;
begin
  xp := p1;
  p1 := p2;
  p2 := xp;
end;

Function DoublePoint(x,y,z:Double):TDoublePoint;
begin
  Result.x := x;
  Result.y := y;
  Result.z := z;
end;


Function DoublePoint(p:TdoublePoint;z:Double):TDoublePoint;
begin
  Result.x := p.x;
  Result.y := p.y;
  Result.z := z;
end;

Function DoublePoint(x,y:Double):TDoublePoint;
begin
  Result.x := x;
  Result.y := y;
  Result.z := 0;
end;

Procedure ShrinkLine(var p1,p2:TDoublePoint;d:Double);
begin
  p1 := MPoint(p1,p2,d);
  p2 := Mpoint(p2,p1,d);
end;

Procedure ExtendLine(var p1,p2:TDoublePoint;d:Double);
begin
  p1 := MPoint(p1,p2,-d);
  p2 := Mpoint(p2,p1,-d);
end;

Procedure ShrinkRect(var Rect:TDoubleRect;d:Double);
begin
  rect.Left := rect.Left+d;
  rect.right := rect.right-d;
  rect.top := rect.top+d;
  rect.Bottom := rect.Bottom -d;
end;

Function MPoint(p1,p2:TDoublePoint):TDoublePoint;
begin
  Result := DoublePoint((p1.x+p2.x)/2,(p1.y+p2.y)/2,(p1.z+p2.z)/2);
end;

Function MPoint(r:TDoubleRect):TDoublePoint;overload;
begin
 Result := MPoint(DoublePoint(r.Left,r.top),DoublePoint(r.right,r.bottom));
end;

Function MPoint(p1,p2:TDoublePoint;Step:Integer):TDoublePoint;
var i: Integer;
begin
  result := p2;
  for i := 1 to step do
  begin
    Result := DoublePoint((p1.x+result.x)/2,(p1.y+result.y)/2,(p1.z+result.z)/2);
  end;
end;

Function FindGroundPoint(xp1,xp2:TDoublePoint;gLevel: Double):TDoublePoint;
var dz,dl: Double;
    z2,l2: Double;

begin
  if EQDP(xp1,xp2) then begin
    result:= DoublePoint(xp1,gLevel);
  end else begin
    dz := abs(xp1.z-xp2.z);
    z2:= abs(gLevel-xp2.z);
    dl := GetLineLenght(xp1,xp2);
    l2 := (z2*dl)/dz;
    result := MPoint(xp2,xp1,l2);
    result.z := gLevel;
  end;
end;

Function GetRightPointIndex(p1,p2,eye:TDoublePoint):Integer;
var ep: TDoublePOint;
    rad,rRad: Double;
    xp1,xp2: TDoublePOint;
begin
  ep := eye;
  PointToLine(p1,p2,ep.x,ep.y);
  rad := GetRadOfline(eye,ep);
  rRad := rad-(3*(pi/2));
  xp1 := RotatePoint(eye,p1,-RRad);
  xp2 := RotatePoint(eye,p2,-RRad);
  if xp1.x > xp2.x then result := 1 else result := 2;
end;

Function PushPoint(p1,p2:TDoublePoint;Delta:Double;var Ended:Boolean):TDoublePoint;
var l,ratio: Double;
    dl,dz,dx,dy: Double;
    xp1,xp2,xp: TdoublePoint;
begin
  if EQDP(p1,p2) then begin
    result := p1;
    Ended := True;
    exit;
  end;
  l := GetLineLenght(p1,p2);
  if l < delta then begin
    result := p2;
    Ended := True;
    exit;
  end;
  Ended := False;
  ratio := delta/l;
  Result := DoublePoint(p1.x+(p2.x-p1.x)*ratio,p1.y+(p2.y-p1.y)*ratio,p1.z+(p2.z-p1.z)*ratio);
end;


Function MPoint(p1,p2:TDoublePoint;Delta:Double;Planer:Boolean = True):TDoublePoint;
var l,ratio: Double;
    dl,dz,dx,dy: Double;
    xp1,xp2,xp: TdoublePoint;
    tanA: Double;
    a,z: Double;
begin
  if EQDP(p1,p2) and planer then
  begin
    result := p1;
    exit;
  end;
  if EQD(p1.z,p2.z) or Planer then
  begin
    l := GetLineLenght(p1,p2);
    ratio := delta/l;
    Result := DoublePoint(p1.x+(p2.x-p1.x)*ratio,p1.y+(p2.y-p1.y)*ratio,p1.z+(p2.z-p1.z)*ratio);
  end
  else
  begin
    xp1 := DoublePoint(p1.x,p1.y);
    xp2 := DoublePoint(p2.x,p2.y);
    if EQDP(xp1,xp2) then
    begin
      if p2.z > p1.z then
        z := p1.z+delta
      else
        z := p1.z-delta;
      result := DoublePoint(xp1.x,xp1.y,z);
    end
    else
    begin
      dl := GetLineLenght(xp1,xp2);
      dz := abs(p2.z-p1.z);
      tana := dz/dl;
      a := arctan(tanA);
      dx := delta*cos(a);
      dy := delta*sin(a);
      xp :=  Mpoint(xp1,xp2,dx);
      if p2.z > p1.z then
        z := p1.z+dy
      else
        z := p1.z-dy;
      result := DoublePoint(xp.x,xp.y,z);
    end;
  end;
end;


Function QrPoint(p1,p2:TDoublePoint):TDoublePoint;
var m: TDoublePOint;
begin
  m := MPoint(p1,p2);
  result := MPoint(p1,m);
end;

Function MVPoint(p:TDoublePoint;dy:Double):TDoublePoint;
begin
  Result := DoublePoint(p.x,p.y+dy);
end;

Function MHPoint(p:TDoublePoint;dx:Double):TDoublePoint;
begin
  Result := DoublePoint(p.x+dx,p.y);
end;

Function MovePoint(p:TDoublePoint;dx,dy:Double):TDoublePoint;
begin
  Result := DoublePoint(p.x+dx,p.y+dy,p.z);
end;

procedure MovePt(p:PDoublePoint; dx,dy:Double);
begin
  p^.x := p^.x + dx;
  p^.y := p^.y + dy;
end;

Function MovePointTo(p,dp:TDoublePoint;dx,dy:Double):TDoublePoint;
begin
  if dp.x < p.x then dx := -dx;
  if dp.y < p.y then dy := -dy;
  result := MovePoint(p,dx,dy);
end;

Function DoubleRect(Left,Top,Right,Bottom:Double):TDoubleRect;
begin
  Result.Left := Left;
  Result.Top := Top;
  Result.Right := Right;
  Result.Bottom := Bottom;
end;

Function DoubleRect(iRect:Trect):TDoubleRect;
begin
  Result.Left := iRect.Left;
  Result.Top := iRect.Top;
  Result.Right := iRect.Right;
  Result.Bottom := iRect.Bottom;
end;

Function BetWeen(x,x1,x2:Double):Boolean;
begin
  result := (x >= Min(x1,x2)) and (x <= Max(x1,x2));
end;

Function FaceOverlaps(f1,f2:TDoublePointArr;freg1,freg2:HRGN):Boolean;
var pCnt1,pCnt2,i,k,j: Integer;
    xp1,xp2,yp1,yp2,p: TdoublePoint;
    r:Trect;
begin

  result := false;
  pCnt1 := Length(f1);
  pCnt2 := Length(f2);

  for i := 0 to pcnt1-1 do
  begin
    xp1 := f1[i];
    if i = pcnt1-1 then xp2 := f1[0] else xp2 := f1[i+1];
    for k := 0 to pcnt2-1 do
    begin
      yp1 := f2[k];
      if k = pcnt2-1 then yp2 := f2[0] else yp2 := f2[k+1];

      if GetInterSectionPoint(xp1,xp2,yp1,yp2,p,false) then
      begin
        result := True;
        exit;
      end;

    end;
  end;

  GetRgnBox(freg1,r);
  result := RectInRegion(freg2,r);
end;

Function FaceOverlaps(f1,f2:T3DFace):Boolean;
var ps1,ps2: TDoublePointArr;
    pCnt1,pCnt2,i,k,j: Integer;
    xp1,xp2,yp1,yp2,p: TdoublePoint;
begin
  result := false;
  pCnt1 := Length(f1);
  SetLength(ps1,pcnt1);
  pCnt2 := Length(f2);
  SetLength(ps2,pcnt2);

  for i := 0 to pcnt1-1 do ps1[i] := Convert3DPoint(f1[i]);
  for i := 0 to pcnt2-1 do ps2[i] := Convert3DPoint(f2[i]);

  for i := 0 to pcnt1-1 do
  begin
    xp1 := ps1[i];
    if i = pcnt1-1 then xp2 := ps1[0] else xp2 := ps1[i+1];
    for k := 0 to pcnt2-1 do
    begin
      yp1 := ps2[k];
      if k = pcnt2-1 then yp2 := ps2[0] else yp2 := ps2[k+1];

      if GetInterSectionPoint(xp1,xp2,yp1,yp2,p,false) then
      begin
        result := True;
        exit;
      end;

    end;
  end;


end;

Function Convert3DPoint(p:T3DPoint;YHeight: Double = 0):TDoublePoint;
var x,y,z,t: Double;
    xx,yy: Double;
begin
  y := p.y;
  x := p.x;
  z := p.z;
  if yHeight <> 0 then begin
    //y := YHeight-y;
  end;
  t := tip;
  xx := cos (spin*rd)*x
        +sin(spin*rd)*y+0*z;
  yy := -1*sin(t*rd)*sin(spin*rd)*x
        + sin(t*rd)*cos(spin*rd)*y
        + cos(t*rd)*z;
  if yHeight <> 0 then begin
    //yy := YHeight-yy;
  end;
  Result := DoublePoint(xx,yy);
end;

Type
  TCGPlane = record
    A, B, C, D: Single;          // Plane equation (Ax + By + Cz + D = 0).
  end;
  TCGVector = record
    x, y, z, w: Single;          // Store w for OpenGL compatibility, but keep it 1.
  end;

function cgVector(vx, vy, vz: Single): TCGVector;
begin

  { Create a TCGVector at [vx, vy, vz]. }
  with Result do
  begin
    x := vx;
    y := vy;
    z := vz;
    w := 1;
  end;

end;

procedure cgMirror(var v: TCGVector; mx, my, mz: Boolean);
begin

  { Mirror v around any axis. }
  with v do
  begin
    if mx then x := -x;
    if my then y := -y;
    if mz then z := -z;
  end;

end;

procedure cgTranslate(var v: TCGVector; t: TCGVector);
begin

  { Translate vector v over vector t. }
  with v do
  begin
    x := x + t.x;
    y := y + t.y;
    z := z + t.z;
  end;

end;

function cgCrossProduct(v1, v2: TCGVector): TCGVector;
begin

  // Return the cross product v1 x v2.
  Result := cgVector(v1.y * v2.z - v2.y * v1.z,
                     v2.x * v1.z - v1.x * v2.z,
                     v1.x * v2.y - v2.x * v1.y);

end;

function cgVectorLength(v: TCGVector): Single;
begin

  { Calculate v's length (distance to the origin), using Pythagoras in 3D. }
  Result := sqrt(v.x*v.x + v.y*v.y + v.z*v.z);

end;

procedure cgNormalize(var v: TCGVector);
var
  l: Single;
begin

  { Normalize a vector by dividing its components by its length. }
  l := cgVectorLength(v);
  if l <> 0 then
  begin
    with v do
    begin
      x := x / l;
      y := y / l;
      z := z / l;
    end;
  end;

end;

function cgGetNormal(v1, v2, v3: TCGVector): TCGVector;
begin

  // Return the normal vector to the plane defined by v1, v2 and v3.
  cgMirror(v2, TRUE, TRUE, TRUE);
  cgTranslate(v1, v2);
  cgTranslate(v3, v2);
  Result := cgCrossProduct(v1, v3);
  cgNormalize(Result);

end;

function DistToPlane(p: TCGPlane; v: TCGVector): Single;
begin

  // Substitute a point in the plane equation and return the result.
  Result := (p.A*v.x + p.B*v.y + p.C*v.z + p.D);

end;

function cgPlaneFromPoints(p1, p2, p3: TCGVector): TCGPlane;
var
  n: TCGVector;
begin

  { Create a TCGPlane from 3 coplanar points. To do this, calculate the normal
    to the plane. The x, y and z components of the normal vector correspond to
    the A, B and C components of the plane. D can then be very easily calculated
    knowing that Ax + By + Cz + D = 0 for any point on the plane, such as p1. }
  n := cgGetNormal(p1, p2, p3);
  with Result do
  begin
    A := n.x;
    B := n.y;
    C := n.z;
    D := -(A * p1.x + B * p1.y + c * p1.z);
  end;

end;




Function PosToPlane(P:TCGPlane; v:TCGVector):Integer;overload;
var d: Double;
begin
  d := DistToPlane(p, v);
  result := 0;
  if d > 0 then result := 1
  else if d < 0 then result := -1;
end;

Function PosToPlane(P:TCGPlane; vArr: array of TCGVector):Integer;overload;
var d: Double;
    i: Integer;
    pCnt,nCnt: Integer;
begin
  result := 0;
  pCnt := 0;
  nCnt := 0;
  for i := 0 to Length(vArr) -1 do
  begin
    d := DistToPlane(p,vArr[i]);
    if d > 0 then inc(pCnt)
    else if d < 0 then inc(nCnt);
  end;
  if pCnt > nCnt then result := 1
  else if pCnt < nCnt then result := -1;
end;

Function GetCloserFace(f1,f2:T3DFace;Camera:T3DPoint):Integer;
var p1,p2: TCGPlane;
    v1,v2,v3,vcam: TCGVector;
    d1,dc: Integer;
    vArr: array of TCGVector;
begin
  v1 := cgVector(f1[0].x,f1[0].y,f1[0].z);
  v2 := cgVector(f1[1].x,f1[1].y,f1[1].z);
  v3 := cgVector(f1[2].x,f1[2].y,f1[2].z);
  p1 := cgPlaneFromPoints(v1,v2,v3);
  setLength(vArr,3);
  vArr[0] := v1; vArr[1] := v2; vArr[2] := v3;
  v1 := cgVector(f2[0].x,f2[0].y,f2[0].z);
  v2 := cgVector(f2[1].x,f2[1].y,f2[1].z);
  v3 := cgVector(f2[2].x,f2[2].y,f2[2].z);
  p2 := cgPlaneFromPoints(v1,v2,v3);
  vCam := cgVector(Camera.x,Camera.y,Camera.z);
  d1 := PosToPlane(p2,vArr);
  dc := PosToPlane(p2,vCam);
  if d1 = dc then result := 1
  else result := 2;
  setLength(vArr, 0); // Tolik 21/05/2018 - -
end;
(*
function InFrontOf(p1, p2: TTriangle): Integer;
var
  pos, neg: Integer;
  plane: TCGPlane;
  i: Integer;
  d: Single;
begin

  // Test if triangle p1 is in front of p2.
  plane := cgPlaneFromPoints(p2[0], p2[1], p2[2]);
  pos := 0;
  neg := 0;
  for i := 0 to 2 do
  begin
    d := DistToPlane(plane, p1[i]);
    if d < 0 then INC(neg)
    else INC(pos);
  end;
  if pos = 3 then Result := 1
  else if neg = 3 then Result := -1
  else Result := 0;

end;
    *)
(*
Function GetCloserFace(f1,f2:T3DFace;Camera:T3DPoint):Integer;
var d1,d2,d,dz,dMax:Double;
i: Integer;
cz: Double;
cp: TdoublePoint;
xp: TDoublePoint;
dz1,dz2: Double;
ep1,ep2: TDoublePoint;
mp1,mp2: TdoublePoint;
a1,a2,ca: Double;
begin
  result := 0;
  cz := Camera.z;
  for i := 0 to Length(f1)-1 do begin
    xp := DoublePoint(f1[i].x,f1[i].y);
    cp := DoublePoint(Camera.x,Camera.y);
    d := GetLineLenght(xp,cp);
    dz := abs(cz- f1[i].z);
    if i = 0 then begin
      d1 := d;
      dz1 := dz;
      ep1 := xp;
      mp1 := xp;
      dMax := d;
    end else begin
      if d < d1 then begin
        d1 := d;
        ep1 := xp;
      end;
      if d > DMax then begin
        dMax := d;
        mp1 := xp;
      end;
      if dz < dz1 then dz1 := d;
    end;
  end;
  for i := 0 to Length(f2)-1 do begin
    xp := DoublePoint(f2[i].x,f2[i].y);
    cp := DoublePoint(Camera.x,Camera.y);
    d := GetLineLenght(xp,cp);
    dz := abs(cz- f2[i].z);

    if i = 0 then begin
      d2 := d;
      dz2 := dz;
      ep2 := xp;
      mp2 := xp;
      dMax := d;
    end else begin
      if d < d2 then begin
        d2 := d;
        ep2 := xp;
      end;
      if d > dMax then begin
        dMax := d;
        mp2 := xp;
      end;
      if dz < dz2 then dz2:= d;
    end;
  end;
  if dz1 < dz2 then result := 1 else if dz2 < dz1 then result := 2;
  if result = 0 then begin
    if d1 < d2 then result := 1 else if d2 < d1 then result := 2;
  end;
  if result = 0 then begin
    a1 := GetRadOfLine(ep1,mp1);
    a2 := GetRadOfLine(ep1,mp2);
    ca := GetRadOfLine(ep1,cp);
    if angleDist(a1,ca) < angleDist(a2,ca) then result := 1 else result := 2;
  end;
end;
*)
Function GetCameraPos(cPoint,oPoint:T3DPoint; HorzAngle,VertAngle:Double):T3DPoint;
var ha,va,dx,dy: Double;
    op: TdoublePOint;
    cp: TdoublePOint;
    xp: TdoublePOint;
begin
  //if HorzAngle = 0 then ha := 0 else ha := 2*pi-HorzAngle;
  ha := HorzAngle;
  //va := 2*pi-VertAngle;
  //va := (pi-VertAngle);
  va := VertAngle;
  cp := DoublePoint(cPoint.x,cPoint.y);
  xp := DoublePoint(oPoint.x,oPoint.y);
  xp := RotatePoint(cp,xp,ha);

  oPoint.x  := xp.x;
  oPoint.y  := xp.y;
  if va <> 0 then
  begin
  op := DoublePoint(oPoint.x,oPoint.y);
  dx := GetLineLenght(cp, op);
  dy := oPoint.z - cPoint.z;
  xp := RotatePoint(DoublePoint(0,0),DoublePoint(dx,dy),va);
  oPoint.z := opoint.z+xp.y;
  xp := Mpoint(op,cp,dx-xp.x);
  oPoint.x := xp.x;
  oPoint.y := xp.y;
  end;
  result := opoint;
end;

procedure setupPixelFormat(DC:HDC);
const
   pfd:TPIXELFORMATDESCRIPTOR = (
        nSize:sizeof(TPIXELFORMATDESCRIPTOR);	// size
        nVersion:1;			// version
        dwFlags:PFD_SUPPORT_OPENGL or PFD_DRAW_TO_WINDOW or
                PFD_DOUBLEBUFFER;	// support double-buffering
        iPixelType:PFD_TYPE_RGBA;	// color type
        cColorBits:24;			// preferred color depth
        cRedBits:0; cRedShift:0;	// color bits (ignored)
        cGreenBits:0;  cGreenShift:0;
        cBlueBits:0; cBlueShift:0;
        cAlphaBits:0;  cAlphaShift:0;   // no alpha buffer
        cAccumBits: 0;
        cAccumRedBits: 0;  		// no accumulation buffer,
        cAccumGreenBits: 0;     	// accum bits (ignored)
        cAccumBlueBits: 0;
        cAccumAlphaBits: 0;
        cDepthBits:16;			// depth buffer
        cStencilBits:0;			// no stencil buffer
        cAuxBuffers:0;			// no auxiliary buffers
        iLayerType:PFD_MAIN_PLANE;  	// main layer
   bReserved: 0;
   dwLayerMask: 0;
   dwVisibleMask: 0;
   dwDamageMask: 0;                    // no layer, visible, damage masks
   );

var
  pixelFormat:integer;

begin
  pixelFormat := ChoosePixelFormat(DC, @pfd);
  if (pixelFormat = 0) then
    exit;
  if (SetPixelFormat(DC, pixelFormat, @pfd) <> TRUE) then
    exit;
end;


Function Make5Face(p1,p2,p3,p4,p5:T3DPoint):T3DFace;
begin
  SetLength(result,5);
  result[0] := p1;
  result[1] := p2;
  result[2] := p3;
  result[3] := p4;
  result[4] := p5;
end;

Function Make4Face(p1,p2,p3,p4:T3DPoint):T3DFace;
begin
  SetLength(result,4);
  result[0] := p1;
  result[1] := p2;
  result[2] := p3;
  result[3] := p4;
end;

Function Make4FaceMar(p1,p2,p3,p4:T3DPoint;Mar:Double):T3DFace;
var s1,s2,s3,s4: TDoublePoint;
d1z,d2z: Double;
begin
  s1 := DoublePOint(p1.x,p1.y);
  s2 := DoublePOint(p2.x,p2.y);
  s3 := DoublePOint(p3.x,p3.y);
  s4 := DoublePOint(p4.x,p4.y);

  if (p1.z = p2.z) and (p1.z = p3.z) and (p1.z = p4.z) then begin
    s1 := MPoint(s1,s2,Mar);
    s2 := MPoint(s2,s1,Mar);
    s3 := MPoint(s3,s4,Mar);
    s4 := MPoint(s4,s3,Mar);
    s1 := MPoint(s1,s4,Mar);
    s4 := MPoint(s4,s1,Mar);
    s2 := MPoint(s2,s3,Mar);
    s3 := MPoint(s3,s2,Mar);
    p1 := DoublePoint(s1,p1.z);
    p2 := DoublePoint(s2,p2.z);
    p3 := DoublePoint(s3,p3.z);
    p4 := DoublePoint(s4,p4.z);
  end else begin
    if p1.z > p4.z then
    begin
      d1z := -mar;
      d2z := +mar;
    end else begin
      d1z := -mar;
      d2z := +mar;
    end;
    s1 := MPoint(s1,s2,Mar);
    s2 := MPoint(s2,s1,Mar);
    s3 := MPoint(s3,s4,Mar);
    s4 := MPoint(s4,s3,Mar);
    p1 := DoublePoint(s1,p1.z+d1z);
    p2 := DoublePoint(s2,p2.z+d1z);
    p3 := DoublePoint(s3,p3.z+d2z);
    p4 := DoublePoint(s4,p4.z+d2z);
  end;

  SetLength(result,4);
  result[0] := p1;
  result[1] := p2;
  result[2] := p3;
  result[3] := p4;
end;


Function Make3Face(p1,p2,p3:T3DPoint):T3DFace;
begin
  SetLength(result,3);
  result[0] := p1;
  result[1] := p2;
  result[2] := p3;
end;

Function Make2Face(p1,p2:T3DPoint):T3DFace;
begin
  SetLength(result,2);
  result[0] := p1;
  result[1] := p2;
end;

Procedure GetFaceDraw(Face:T3DFace;var pArr:TdoublePointArr);
var pCnt,i: Integer;

begin
   pCnt := Length(Face);
   SetLength(pArr,pCnt);
   For i := 0 to pCnt-1 do
     pArr[i] := Convert3DPoint(Face[i]);
end;

Function ConvertIsometricPoint(p:TDoublePoint;h,izalfa:Double;isoType:Byte=0):TDoublePoint;
var x,y,z,izbeta: Double;
begin

  x := p.x;
  y := p.y;
  z := p.z;
  y := h - y;

  if isoType = 0 then begin
    x := x + (y* cos(izalfa));
    y := z + (y* sin(izalfa));
  end else if isoType = 1 then begin
    x := x*cos(izalfa)-y*cos(izalfa);
    y := p.x*sin(izalfa)+y*sin(izalfa)+z;
  end else if isoType = 2 then begin
    izbeta := pi/2 - izalfa;
    x := x*cos(izBeta)-y*cos(izalfa);
    y := p.x*sin(izBeta)+y*sin(izalfa)+z;
  end else if isoType = 3 then begin
    p := DoublepOint(x,y);
    p := RotatePoint(DoublePoint(0,0),p,izAlfa);
    x := p.x;
    y := p.y+z;
  end;

  y := h - y;
  result:= DoublePoint(x,y);
end;

Function DeConvertIsometricPoint(p:TDoublePoint;h,izalfa:Double;isoType:Byte=0):TDoublePoint;
var x,y,z: Double;
begin
  x := p.x;
  y := p.y;
  z := p.z;

  y := h-y;
  y := y-z;
  y := y / sin(izalfa);
  y := h-y;
  x := x - ((h-y)*cos(izalfa));
  result := DoublePoint(x,y,z);
end;

Function Rotate3DPoint(cPOint,oPoint:T3DPoint; Ang:Double;axis:T3DAxis):T3DPoint;
var osp:T3DPoint;
    op,cp: TdoublePoint;
    opv,cpv: TdoublePoint;
    lx,nz,nh,nx,ny: Double;
begin
  if EqD(Ang,0) then Ang := 0;

  //Move System To Origin
  osp.x := oPoint.x - CPoint.x;
  osp.y := oPoint.y - CPoint.y;
  osp.z := oPoint.z - Cpoint.z;

  // Rotating Around Origin Axis Now

  Case axis of
    aZ: begin
          nz := osp.z;
          nx := osp.x * cos(ang) - osp.y*sin(ang);
          ny := osp.x * sin(ang) + osp.y*cos(ang);
        end;
    aX: begin
          nx := osp.x;
          ny := osp.z * cos(ang) - osp.y*sin(ang);
          nz := osp.z * sin(ang) + osp.y*cos(ang);
        end;
    aY: begin
          ny := osp.y;
          nx := osp.x * cos(ang) - osp.z*sin(ang);
          nz := osp.x * sin(ang) + osp.z*cos(ang);
        end;
  end;
  if EQD(nx,0) then nx := 0;
  if EQD(ny,0) then ny := 0;
  if EQD(nz,0) then nz := 0;

  nx := nx + CPoint.x;
  ny := ny + CPoint.y;
  nz := nz + CPoint.z;
  result := DoublePoint(nx,ny,nz);
end;

Function RectOverlaps(r1,r2:TDoubleRect):Boolean;
var t,b,l,r:Double;
p1,p2,p3,p4:TDoublePoint;
t1,t2,t3,t4:TDoublePoint;

  Function CrossIntersect(a1,a2,b1,b2:TDoublePoint):Boolean;
  var x,y: Double;
      vP,hp:TdoublePoint;
      xOk,yOk:Boolean;
  begin
    Result := False;
    if a1.x = a2.x then begin
      xOk := Between(a1.x,b1.x,b2.x);
    end else if b1.x = b2.x then begin
      xOk := Between(b1.x,a1.x,a2.x);
    end else exit;

    if a1.y = a2.y then begin
      yOk := Between(a1.y,b1.y,b2.y);
    end else if b1.y = b2.y then begin
      yOk := Between(b1.y,a1.y,a2.y);
    end else exit;

    result := xOk and yOk;


  end;

begin
  t := Min(r1.Top,r1.Bottom);
  b := Max(r1.Top,r1.Bottom);
  l := Min(r1.Left,r1.Right);
  r := Max(r1.Left,r1.Right);
  p1 := DoublePoint(r2.Left,r2.Top);
  p2 := DoublePoint(r2.right,r2.Top);
  p3 := DoublePoint(r2.Left,r2.Bottom);
  p4 := DoublePoint(r2.right,r2.Bottom);
  result := false;
  if (p1.x >= l) and (p1.x <= r) and (p1.y >= t) and (p1.y <= b) then begin
    result := true;
  end else if (p1.x >= l) and (p1.x <= r) and (p1.y >= t) and (p1.y <= b) then begin
    result := true;
  end else if (p1.x >= l) and (p1.x <= r) and (p1.y >= t) and (p1.y <= b) then begin
    result := true;
  end else if (p1.x >= l) and (p1.x <= r) and (p1.y >= t) and (p1.y <= b) then begin
    result := true;
  end;

  if not result then begin
    t := Min(r2.Top,r2.Bottom);
    b := Max(r2.Top,r2.Bottom);
    l := Min(r2.Left,r2.Right);
    r := Max(r2.Left,r2.Right);
    p1 := DoublePoint(r1.Left,r1.Top);
    p2 := DoublePoint(r1.right,r1.Top);
    p3 := DoublePoint(r1.Left,r1.Bottom);
    p4 := DoublePoint(r1.right,r1.Bottom);
    result := false;
    if (p1.x >= l) and (p1.x <= r) and (p1.y >= t) and (p1.y <= b) then begin
      result := true;
    end else if (p1.x >= l) and (p1.x <= r) and (p1.y >= t) and (p1.y <= b) then begin
      result := true;
    end else if (p1.x >= l) and (p1.x <= r) and (p1.y >= t) and (p1.y <= b) then begin
      result := true;
    end else if (p1.x >= l) and (p1.x <= r) and (p1.y >= t) and (p1.y <= b) then begin
      result := true;
    end;
  end;

  if not result then begin
    p1 := DoublePoint(r1.Left,r1.Top);
    p2 := DoublePoint(r1.right,r1.Top);
    p3 := DoublePoint(r1.right,r1.Bottom);
    p4 := DoublePoint(r1.Left,r1.Bottom);
    t1 := DoublePoint(r2.Left,r2.Top);
    t2 := DoublePoint(r2.right,r2.Top);
    t3 := DoublePoint(r2.right,r2.Bottom);
    t4 := DoublePoint(r2.Left,r2.Bottom);

    if CrossIntersect(p1,p2,t1,t4) then  result := true
    else if CrossIntersect(p1,p2,t2,t3) then result := true
    else if CrossIntersect(p4,p3,t1,t4) then result := true
    else if CrossIntersect(p4,p3,t2,t3) then result := true
    else if CrossIntersect(p1,p4,t1,t2) then result := true
    else if CrossIntersect(p1,p4,t4,t3) then result := true
    else if CrossIntersect(p2,p3,t1,t2) then result := true
    else if CrossIntersect(p2,p3,t4,t4) then result := true;
  end;

end;

Function DP2P(pt:TDoublepoint):TPoint;overload;
begin
  result := Point(round(pt.x),round(pt.y));
end;

Function DP2P(ptx,pty:Double):TPoint;overload;
begin
  result := Point(round(ptx),round(pty));
end;

Function DR2R(x1,y1,x2,y2:Double):Trect;overload;
begin
  result := Rect(round(x1),round(y1),round(x2),round(y2));
end;

Function DR2R(r:TDoubleRect):Trect;overload;
begin
  result := Rect(round(r.left),round(r.top),round(r.right),round(r.bottom));
end;

Function EQDP(p1,p2: TDoublePoint):Boolean; //Проверяет, не лежат ли точки друг на друге в 2D. TRUE - лежат, FALSE - не лежат
begin
  result := (abs(p1.x - p2.x) < (1/50)) and (abs(p1.y - p2.y) < (1/50));
end;

Function EQDPZ(p1,p2: TDoublePoint):Boolean; //Проверяет, не лежат ли точки друг на друге в 3D. TRUE - лежат, FALSE - не лежат
begin
  result := (abs(p1.x - p2.x) < (1/50)) and (abs(p1.y - p2.y) < (1/50)) and (abs(p1.z - p2.z) < (1/50));
end;

Function EQD(a1,a2: Double):Boolean;
begin
  result := (abs(a1 - a2) < (1/1000));
end;

Function Sign(number:Double):Integer;
begin
  if number = 0 then result := 0
  else if number >0 then result := 1
  else if number < 0 then result := -1;
end;
Function NormalizePoint(p:TDoublePoint):TDoublePoint;
begin
result := DoublePoint( Trunc(p.x * 10000)/10000,
                      Trunc(p.y * 10000)/10000);
end;

Function ParseCommand(Command: String; var StrArray: TStringArray):integer;
var CommandLen,paramLen: integer;
    i,j,k: integer;
    c: string;
    root,param,params: string;
    isExit : Boolean;
    paramcount : integer;
begin
  CommandLen := Length(Command);
  if commandlen > 0 then
  begin
      root := '';
      isExit := False;
      i := 0;
      repeat
        i := i + 1;
        c := Copy(Command,i,1);
        if c <> ' ' then
          root := root + c
        else
          isExit := true;
      until (IsExit) or (i = CommandLen);
      SetLength(strArray,1);
      StrArray[0] := root;

      /// look at the parameters

      if CommandLen > i then
        params := copy(command,i+1,CommandLen-(i))
      else
      begin
        params := '';
        result := 0;
      end;

      if params <> '' then
      begin
        ParamLen := Length(params);
        param := '';
        paramcount := 0;
        for k := 1 to ParamLen do
        begin
          c := copy(params,k,1);
          if (c = ',') or (c = ' ') then
          begin
            inc(paramcount);
            SetLength(strArray,paramcount+1);
            strArray[paramCount] := param;
            param := '';
          end
          else
            param := param + c;
        end;
        if param <> '' then
        begin
          inc(paramcount);
          SetLength(strArray,paramcount+1);
          strArray[paramCount] := param;
        end;
        result := paramcount;
      end;
  end
  else
    result := -1;
end;

(*
Function GetBezierPolyPoints(var polypoints: array of TPoint;
                                 bezPoints: array of TPoint;
                                 PointCount:integer;
                                 DEngine:Pointer):integer;
var a,b:integer;
    tx,px,py : real;
    ipx,ipy: integer;
    t : array[1..4] of real;
    mcol,mrow,pIdx: integer;
    pntx,pnty: array[1..4] of integer;
    DrawEng:TPCDrawEngine;
begin
  pIdx := 0;
  if DEngine <> nil then
    DrawEng := TPCDrawEngine(DEngine)
  else
    DrawEng := nil;
  for b := 1 to ((PointCount-1) div 3) do begin
    pntx[1] := bezPoints[((b-1)*3)+0].x;
    pntx[2] := bezPoints[((b-1)*3)+1].x;
    pntx[3] := bezPoints[((b-1)*3)+2].x;
    pntx[4] := bezPoints[((b-1)*3)+3].x;
    pnty[1] := bezPoints[((b-1)*3)+0].y;
    pnty[2] := bezPoints[((b-1)*3)+1].y;
    pnty[3] := bezPoints[((b-1)*3)+2].y;
    pnty[4] := bezPoints[((b-1)*3)+3].y;
    for a := 0 to 100 do
    begin
      tx := a / 100;
      t[1] := tx*tx*tx;
      t[2] := tx*tx;
      t[3] := tx;
      t[4] := 1;
      px := 0;
      py := 0;
      for mcol := 1 to 4 do begin
        for mrow := 1 to 4 do begin
          px := px + mval[mrow,mcol]* t[mrow]*pntx[mcol];
          py := py + mval[mrow,mcol]* t[mrow]*pnty[mcol];
        end;
      end;
      ipx := Round(px);
      ipy := Round(py);
      if DrawEng <> nil then DrawEng.ConvertPoint(ipx,ipy);
      polyPoints[pIdx].x := ipx;
      polyPoints[pIdx].y := ipy;
      inc(pIdx);
    end;
  end;
  result := pIdx;
end;
  *)

Function GetBezierDistance(p0,p1,p2,p3,p4:TDoublePoint):Real;
var res: Integer;
    i: integer;
    dp: TDoublePoint;
    dist,mdist : double;
    x,y,dx,dy: double;
begin
  res := 500;
  x := p0.x;
  y := p0.y;

  dp := GetBezierSample(p1,p2,p3,p4,0,res);
  dx := dp.x-x; dy := dp.y - y;
  mdist := sqrt(dx*dx+dy*dy);
  for i := 0 to res do
  begin
    dp := GetBezierSample(p1,p2,p3,p4,i,res);
    dx := dp.x-x; dy := dp.y - y;
    dist := sqrt(dx*dx+dy*dy);
    if dist < mdist then mdist := dist;
  end;
  result := mdist;
end;

Function GetLinePatch(p1,p2:TDoublePoint;pWidth: Double;var cumWidth: Double;
         var pi,pf:TDoublePoint):Double;
var hy,hx,nx,ny,len: double;
    s : Integer;
begin
  if (p1.x = p2.x) and (p1.y = p2.y) then begin

  end else if p1.x = p2.x then begin
    if p2.y > p1.y then s := 1 else s := -1;
    pf := DoublePoint(pi.x,pi.y+(s)*pWidth);
  end else if p1.y = p2.y then begin
    if p2.x > p1.x then s := 1 else s := -1;
    pf := DoublePoint(pi.x+(s)*pWidth,pi.y);
  end else begin
    if cumwidth = 0 then
    begin
      len := GetLineLenght(p1,p2);
      hy := len/(p2.y-p1.y);
      hx := len/(p2.x-p1.x);
    end else begin
      hy := cumWidth / (pi.y-p1.y);
      hx := cumWidth / (pi.x-p1.x);
    end;
    nx := (cumWidth+pWidth) / hx;
    ny := (cumWidth+pWidth) / hy;
    pf.x := p1.x+nx;
    pf.y := p1.y+ny;
    cumWidth := cumWidth+pWidth;
  end;
  result := pWidth;
end;


Function GetBezierPatch(p1,p2,p3,p4:TDoublePoint;pWidth:Double;
         var LastIndex: Integer; var pi,pf:TDoublePoint;ToEnd:Boolean;res: Integer):Double;
var x,y,i,sIdx: integer;
    dp: TDoublePoint;
    dist : double;
    dx,dy: double;
begin
  sIdx := LastIndex;
  for i := sIdx to res do
  begin
    dp := GetBezierSample(p1,p2,p3,p4,i,res);
    if i = sIdx then
      pi := dp
    else begin
      dx := dp.x-pi.x; dy := dp.y - pi.y;
      dist := sqrt(dx*dx+dy*dy);
      if (not toEnd) and (dist >= pWidth) then
      begin
        LastIndex := i;
        pf := dp;
        Result := Round(dist);
        Exit;
      end;
    end;
  end;
  LastIndex := res;
  pf := dp;
  Result := Dist;
end;

Function GetBezierBegin(p1,p2,p3,p4:TDoublePoint;pWidth: Double;res: Integer):TDoublePoint;
var i: integer;
    dp,pi: TDoublePoint;
    dist : double;
    dx,dy: double;
begin
  Result := p1;
  for i := 0 to res do
  begin
    dp := GetBezierSample(p1,p2,p3,p4,i,res);
    if i = 0 then pi := dp;
    dx := dp.x-pi.x; dy := dp.y - pi.y;
    dist := sqrt(dx*dx+dy*dy);
    if (dist >= pWidth) then
    begin
      Result := dp;
      Exit;
    end;
  end;
end;

Function GetBezierEnd(p1,p2,p3,p4:TDoublePoint; pWidth: Double;res: Integer):TDoublePoint;
var i: integer;
    dp,pi: TDoublePoint;
    dist : double;
    dx,dy: double;
begin
  Result := p1;
  for i := res downto 0 do
  begin
    dp := GetBezierSample(p1,p2,p3,p4,i,res);
    if i = res then pi := dp;
    dx := dp.x-pi.x; dy := dp.y - pi.y;
    dist := sqrt(dx*dx+dy*dy);
    if (dist >= pWidth) then
    begin
      Result := dp;
      Exit;
    end;
  end;
end;
//Tolik 25/03/2019
Function ReadStringFromStream(stream:TStream):String;
var xByte: Byte;
   res:string;
   TempStr: AnsiString;
   cnt: Integer;
begin
  xByte := 0;
  res := '';
  cnt := 0;
  TempStr := '';
  repeat
    stream.Read(xByte,1);
    //if xByte <> 0 then res := res+ chr(xByte);
    if xByte <> 0 then TempStr := TempStr + AnsiChar(xByte);
    cnt := cnt + 1;
    if cnt = 15000 then begin
      xByte := 0;
      TempStr := 'LONG STRING';
    end;
  until xByte = 0;
  //result := res;
  result := String(TempStr);
end;
{
Function ReadStringFromStream(stream:TStream):String;
var xByte: Byte;
   res:string;
   cnt: Integer;
begin
  xByte := 0;
  res := '';
  cnt := 0;
  repeat
    stream.Read(xByte,1);
    if xByte <> 0 then res := res+ chr(xByte);
    cnt := cnt+1;
    if cnt = 15000 then begin
      xByte := 0;
      res := 'LONG STRING';
    end;
  until xByte = 0;
  result := res;
end;
}

Procedure WriteString(Stream:TStream; Str:string);
var xByte: Byte;
    TempStr: AnsiString;
begin
  xByte := 0;
  TempStr := AnsiString(Str);
  //Stream.Write(pchar(str)^,length(str));
  Stream.Write(PAnsiChar(TempStr)^,length(TempStr));
  Stream.Write(xByte,1);
end;
{
Procedure WriteString(Stream:TStream; str:string);
var xByte: Byte;
begin
  xByte := 0;
  Stream.Write(pchar(str)^,length(str));
  Stream.Write(xByte,1);
end;
}
//
Procedure WriteStringToStream(Stream:TStream; str:string);
begin
  WriteString(Stream,Str);
end;

Procedure WriteField(Code:Byte;Stream:TStream; Const Value; Size: integer);
begin
  Stream.Write(Code,1);
  Stream.Write(Value,Size);
end;

Procedure WriteStrField(Code:Byte;Stream:TStream; Const Value:String);
begin
  Stream.Write(Code,1);
  WriteString(Stream,Value);
end;

Procedure WriteBinField(Code:Byte; Stream:TStream; Const Value:pByte; Size: integer);
begin
  Stream.Write(Code,1);
  Stream.Write(Size,4);
  Stream.Write(Value^,Size);
end;

Procedure WriteStreamField(Code:Byte; Stream:TStream; Const Value:TStream);
var Size:Integer;
begin
  Stream.Write(Code,1);
  Size := Value.Size;
  Stream.Write(Size,4);
  Value.Seek(0,soFromBeginning);
  StreamToStream(Value,Stream,Size);
end;

Procedure StreamToStream(str:TStream; ToStr: TStream; Size:Integer);
var xByte: pByte;
    oSize: Integer;
begin
  GetMem(xByte,Size);
  oSize := Size;
  Size := str.read(xByte^,Size);
  tostr.Write(xByte^,Size);
  FreeMem(xByte,osize);
end;

Function StreamEqual(str1,str2:TStream):Boolean;
var b1,b2: Byte;
i: Integer;
begin
  result := true;
  str1.Position := 0;
  str2.Position := 0;
  if str1.Size <> str2.Size then begin
    result := false;
  end else begin
    for i := 1 to str1.Size do begin
      Str1.Read(b1,1) ;
      Str2.Read(b2,1) ;
      if b1 <> b2 then begin
        result := false;
        //showmessage(inttostr(i)); 
        exit;
      end;
    end;
  end;
end;

Procedure StreamToClipBoard(str:TMemoryStream;format:Word);
var
    Data: THandle;
    DataPtr: Pointer;

begin
  if OpenClipBoard(0) then
  begin
    EmptyClipBoard;
    try
      Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, str.Size);
      try
        DataPtr := GlobalLock(Data);
        try
          Move((str.Memory)^, DataPtr^, str.Size);
          SetClipboardData(format, Data);
        finally
          GlobalUnlock(Data);
        end;
      except
        GlobalFree(Data);
        raise;
      end;
    finally
      CloseClipBoard;
    end;
  end;
end;

Procedure ClipBoardToStream(str:TMemoryStream;format:word);
var
  Data: THandle;
  DataPtr: Pointer;
  MemStream: TMemoryStream;
begin
  if OpenClipBoard(0) then
  begin
    try
      Data := GetClipboardData(format);
      if Data = 0 then Exit;
      DataPtr := GlobalLock(Data);
      if DataPtr = nil then Exit;
        try
          Str.WriteBuffer(DataPtr^, GlobalSize(Data));
          Str.Position := 0;
        except
        end;
    finally
        GlobalUnlock(Data);
    end;
    CloseClipBoard;
  end;
end;

{This is a proper declaration of TranslateCharsetInfo}
function TranslateCharsetInfo(lpSrc: Pointer; var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall;external gdi32;
function LengthEx(S: AnsiString; CP: Word): Integer;
var
  P: PAnsiChar;
begin
  Result:= 0;
  P:= @S[1];
  while (P^<>#0) do
    begin
      Inc(Result);
      P:= CharNextEx(CP, P, 0);
    end;
end;

function LanguageName(Language: TLanguage): String;
var
  Buf: array[0..255] of Char;
begin
  GetLocaleInfo(Language, LOCALE_SLanguage, Buf, 255);
  Result:= StrPas(Buf);
end;

function CodePageFromLocale(Language: TLanguage): Integer;
var
  Buf: array[0..6] of Char;
begin
  GetLocaleInfo(Language, LOCALE_IDefaultAnsiCodePage, Buf, 6);
  Result:= StrToIntDef(Buf, GetACP);
end;

function OEMCodePageFromLocale(Language: TLanguage): Integer;
var
  Buf: array[0..6] of Char;
begin
  GetLocaleInfo(Language, LOCALE_IDefaultCodePage, Buf, 6);
  Result:= StrToIntDef(Buf, GetOEMCP);
end;

function CharSetFromLocale(Language: TLanguage): TFontCharSet;
var
  CP: Integer;
  CSI: TCharsetInfo;
begin
  CP:= CodePageFromLocale(Language);
  TranslateCharsetInfo(Pointer(CP), CSI, TCI_SRCCODEPAGE);
  Result:= CSI.ciCharset;
end;

function CharToWide(const S:AnsiString; CodePage: Word): WideString;
var
  L: Integer;
begin
  if S='' then
    Result:= ''
  else
    begin
      L:= MultiByteToWideChar(CodePage, 0, PAnsiChar(@S[1]), -1, nil, 0);
      SetLength(Result, L-1);
      MultiByteToWideChar(CodePage, 0, PAnsiChar(@S[1]), -1, PWideChar(@Result[1]), L-1);
   end;
end;

function WideToChar(const WS: WideString; CodePage: Word): AnsiString;
var
  L: Integer;
begin
  if WS='' then
    Result:= ''
  else
    begin
      L:= WideCharToMultiByte(CodePage, 0, @WS[1], -1, nil, 0, nil, nil);
      SetLength(Result, L-1);
      WideCharToMultiByte(CodePage, 0, @WS[1], -1, @Result[1], L-1, nil, nil);
    end;
end;

function CharToChar(const S: AnsiString; CP1, CP2: Word): AnsiString;
begin
  Result:= WideToChar(CharToWide(S, CP1), CP2);
end;

function LanguageToIdent(Language: Longint; var Ident: string): Boolean;
var
  Buf: array[0..255]of Char;
begin
  Result:= IsValidLocale(Language, LCID_INSTALLED);
  if Result then
    begin
      GetLocaleInfo(Language, LOCALE_SLANGUAGE, Buf, 255);
      SetString(Ident, Buf, StrLen(Buf));
    end;
end;

var
  SearchId: String;
  SearchLang: Integer;
  LCType: Integer;

function EnumGetLang(LocaleStr: LPSTR): Integer;
stdcall;
var
  Buf: array[0..255]of Char;
  Locale: LCID;
  Z: Integer;
begin
  Val('$'+StrPas(LocaleStr), Locale, Z);
  Result:= 1;
  GetLocaleInfo(Locale, LCType, Buf, 255);
  if AnsiCompareText(SearchId, Buf)=0 then
    begin
      SearchLang:= Locale;
      Result:= 0;
    end;
end;

function IdentToLanguage(const Ident: string; var Language: Longint): Boolean;
begin
  SearchId:= Ident;
  SearchLang:= -1;
  LCType:= LOCALE_SLANGUAGE;
  EnumSystemLocales(@EnumGetLang, LCID_INSTALLED);
  if SearchLang<0 then
    begin
      LCType:= LOCALE_SENGLANGUAGE;
      EnumSystemLocales(@EnumGetLang, LCID_INSTALLED);
    end;
  if SearchLang<0 then
    begin
      LCType:= LOCALE_SABBREVLANGNAME;
      EnumSystemLocales(@EnumGetLang, LCID_INSTALLED);
    end;
  Result:= SearchLang>-1;
  if Result then
    Language:= SearchLang;
end;

function GetTextureBitmap(idx: integer): Graphics.TBitmap;
var sRect: Trect;
begin
  result := Graphics.TBitmap.Create;
  result.Width := 128;
  result.Height := 128;
  Srect := Rect (0,(idx-1)*128,128,(idx)*128);
  result.Canvas.CopyRect(Rect(0,0,128,128),TextureBmp.Canvas,sRect);
end;

function PointInRect(const P: TDoublePoint; const R: TDoubleRect): Boolean;
begin
  with R do
    Result := (Left <= P.X) and (Top <= P.Y) and
      (Right >= P.X) and (Bottom >= P.Y);
end;

function PointInPolyRect(P: TDoublePoint; r1,r2,r3,r4: TDoublePoint): Boolean;
var rad:Double;
begin
  rad := GetRadOfLine(r1,r2);
  r2 := RotatePoint(r1,r2,-rad);
  r3 := RotatePoint(r1,r3,-rad);
  r4 := RotatePoint(r1,r4,-rad);
  p := RotatePoint(r1,p,-rad);
  result := PointInRect(p,DoubleRect(r1.x,r1.y,r3.x,r3.y));
end;

Function RectCenter(Rect:TDoubleRect):TDoublePoint;
begin
  result := MPoint(DoublePOint(rect.Left,rect.top),DoublePoint(Rect.right,rect.bottom));
end;
function NormalizeRect(const x1,y1,x2,y2 : Double;MarginDelta:Double) : TDoubleRect;
begin
  Result := DoubleRect(x1,y1,x2,y2);
  if (x1 > x2) then if (y1 > y2) then Result := DoubleRect(x2,y2,x1,y1) else Result:=DoubleRect(x2,y1,x1,y2)
               else if (y1 > y2) then Result := DoubleRect(x1,y2,x2,y1);
  Result := DoubleRect(Result.Left - MarginDelta, Result.Top - MarginDelta, Result.Right + MarginDelta, Result.Bottom + MarginDelta);
end;

//Tolik 15/12/2021 --
function IsPointInLine3D(const m1,m2 : TDoublePoint;
                       const p : TDoublePoint;
                       PenWidth : double;
                       MarginDelta:Double = 2) : Boolean;
var l2,d12,d22 : Double;
    dist2 : Double;
begin
  Result := False;

  try
    l2 := (m1.X - m2.X)*(m1.X - m2.X) + (m1.Y - m2.Y)*(m1.Y - m2.Y);
    if (l2 = 0) then
    begin
      Result := ((Abs(p.X - m1.X) <= (MarginDelta + sqrt(PenWidth))) and
                (Abs(p.Y - m1.Y) <= (MarginDelta + sqrt(PenWidth))));
      Exit;
    end;
    d12 := (m1.X - p.X)*(m1.X - p.X) + (m1.Y - p.Y)*(m1.Y - p.Y);
    d22 := (m2.X - p.X)*(m2.X - p.X) + (m2.Y - p.Y)*(m2.Y - p.Y);
    dist2 := Abs(4*d12*d22 - (l2 - d12 - d22)*(l2 - d12 - d22)) / (4*l2);
    Result := (dist2 <= (MarginDelta + sqrt(PenWidth))*(MarginDelta + sqrt(PenWidth))) and
                 PointInRect(p,NormalizeRect(m1.X,m1.Y,m2.X,m2.Y,MarginDelta));

  except
    on E: Exception do
    begin
      Result := False;
    end;
  end;
end;
//Tolik 27/08/2019 --
function IsPointInLine(const m1,m2 : TDoublePoint;
                       const p : TDoublePoint;
                       const PenWidth : Integer;
                       MarginDelta:Double = 2) : Boolean;
var l2,d12,d22 : Double;
    dist2 : Double;
begin
  Result := False;

  try
    l2 := (m1.X - m2.X)*(m1.X - m2.X) + (m1.Y - m2.Y)*(m1.Y - m2.Y);
    if (l2 = 0) then begin
      Result := ((Abs(p.X - m1.X) <= (MarginDelta + PenWidth)) and
                (Abs(p.Y - m1.Y) <= (MarginDelta + PenWidth)));
      Exit;
    end;
    d12 := (m1.X - p.X)*(m1.X - p.X) + (m1.Y - p.Y)*(m1.Y - p.Y);
    d22 := (m2.X - p.X)*(m2.X - p.X) + (m2.Y - p.Y)*(m2.Y - p.Y);
    dist2 := Abs(4*d12*d22 - (l2 - d12 - d22)*(l2 - d12 - d22)) / (4*l2);
    Result := (dist2 <= (MarginDelta + PenWidth)*(MarginDelta + PenWidth)) and
                 PointInRect(p,NormalizeRect(m1.X,m1.Y,m2.X,m2.Y,MarginDelta));

  except
    on E: Exception do
    begin
      Result := False;
    end;
  end;

end;
{
function IsPointInLine(const m1,m2 : TDoublePoint;
                       const p : TDoublePoint;
                       const PenWidth : Integer;
                       MarginDelta:Double = 2) : Boolean;
var l2,d12,d22 : Double;
    dist2 : Double;
begin
  Result := False;
  l2 := (m1.X - m2.X)*(m1.X - m2.X) + (m1.Y - m2.Y)*(m1.Y - m2.Y);
  if (l2 = 0) then begin
    Result := ((Abs(p.X - m1.X) <= (MarginDelta + PenWidth)) and
              (Abs(p.Y - m1.Y) <= (MarginDelta + PenWidth)));
    Exit;
  end;
  d12 := (m1.X - p.X)*(m1.X - p.X) + (m1.Y - p.Y)*(m1.Y - p.Y);
  d22 := (m2.X - p.X)*(m2.X - p.X) + (m2.Y - p.Y)*(m2.Y - p.Y);
  dist2 := Abs(4*d12*d22 - (l2 - d12 - d22)*(l2 - d12 - d22)) / (4*l2);
  Result := (dist2 <= (MarginDelta + PenWidth)*(MarginDelta + PenWidth)) and
               PointInRect(p,NormalizeRect(m1.X,m1.Y,m2.X,m2.Y,MarginDelta));

  //Result := false;
  //dist2 := Abs((m2.x - m1.x)*(m1.y - p.y) - (m1.x - p.x)*(m2.y - m1.y)) / Sqrt(sqr(m2.x - m1.x) + sqr(m2.y-m1.y));
  //Result := (dist2 <= (MarginDelta + PenWidth)*(MarginDelta + PenWidth)) and
  //             PointInRect(p,NormalizeRect(m1.X,m1.Y,m2.X,m2.Y,MarginDelta));
end;
}
//


Function GetVectorPenPoints(Style:Integer;var VectorPoints: TList):Integer;
var Pnt: PPoint;
begin
   Result := 0;
   if Style = 1 then begin
     VectorPoints := TList.Create;
     New(Pnt);pnt.x := 0;pnt.y := 0;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 15;pnt.y := 15;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 30;pnt.y := 0;VectorPoints.Add(pnt);
     Result := 30;
   end
   else if Style = 2 then begin
     VectorPoints := TList.Create;
     New(Pnt);pnt.x := 0;pnt.y := -10;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 0;pnt.y := 10;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 10;pnt.y := 10;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 10;pnt.y := -10;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 0;pnt.y := -10;VectorPoints.Add(pnt);
     Result := 15;
   end
   else if Style = 3 then begin
     VectorPoints := TList.Create;
     New(Pnt);pnt.x := 0;pnt.y := 0;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 0;pnt.y := 5;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 20;pnt.y := 5;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 20;pnt.y := -15;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 5;pnt.y := -15;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 5;pnt.y := 0;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 25;pnt.y := 0;VectorPoints.Add(pnt);
     Result := 25;
   end
   else if Style = 4 then begin
     VectorPoints := TList.Create;
     New(Pnt);pnt.x := 0;pnt.y := 0;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 20;pnt.y := 0;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 20;pnt.y :=-10;VectorPoints.Add(pnt);
     New(Pnt);pnt.x := 0;pnt.y := -10;VectorPoints.Add(pnt);
     Result := 20;
   end;

end;

 function DelphiLoaded : boolean;
   function WindowExists(ClassName, WindowName: string): boolean;
   {------------------------------------------------------}
   { Checks for the existence of the specified Window,    }
   { conveniently using Pascal strings instead of PChars. }
   {------------------------------------------------------}
    var
     PClassName, PWindowName: PChar;
     AClassName, AWindowName: array[0..63] of char;
     h:HWND;
   begin
    if ClassName = ''
     then PClassName := nil
     else PClassName := StrPCopy(@AClassName[0], ClassName);
    if WindowName = ''
     then PWindowName := nil
     else PWindowName := StrPCopy(@AWindowName[0], WindowName);
    h := FindWindow(PClassName, PWindowName);
    if h <> 0
     then WindowExists := true
     else WindowExists := false;
   end;  {WindowExists}

 begin
  DelphiLoaded := false;
  if WindowExists('TPropertyInspector', 'Object Inspector') and
     WindowExists('TMenuBuilder','Menu Designer') and
     WindowExists('TAlignPalette','Align') Then DelphiLoaded := true;
 end;




{ TUndoAction }

constructor TUndoAction.Create(aType: TUndoActionType);
begin
  inherited create;
  ActionType := aType;
  List := Tlist.Create;
  Params := TList.Create;
  RedoList := TList.Create;
  Tag := 0;
end;

Destructor TUndoAction.Destroy;
begin
  List.Free;
  Params.Free;
  RedoList.Free;
  inherited;
end;

{ TColorSpeedButton }

procedure TColorSpeedButton.Paint;
begin
  inherited;
  Canvas.Brush.Color := tag;
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Color := clBlack;
  canvas.Rectangle(2,2,13,13);
end;

Function ValidateString(str: String):String;
var i: integer;
    c: string;
begin
  result := '';
  for i := 1 to length(str) do
  begin
    c := copy(str,i,1);
    if ((c >= '0') and (c <= '9')) or
       ((c >= 'a') and (c <= 'z')) or
       ((c >= 'A') and (c <= 'Z')) then
      result := result + c;
  end;
end;

{ TEventEngine }

constructor TEventEngine.Create(Id: Integer;aNumVal: Integer; aStrval:String;
                                aDblVal:Double);
begin
  inherited Create;
  NumVal := aNumVal;
  Strval := aStrval;
  DblVal := aDblval;
  EventId := Id;
  Enabled := True;
  Clients := TList.Create;
end;

destructor TEventEngine.Destroy;
begin
  Clients.Free;
  Inherited;
end;

procedure TEventEngine.RaiseEvent(aNumVal: Integer; aStrval:String;
                                aDblVal:Double);
var CallBack: TEventCallBack;
    i: Integer;
    eItem: TEventItem;
begin
  NumVal := aNumVal;
  Strval := aStrval;
  DblVal := aDblval;
  For i := 0 to Clients.Count - 1 do
  begin
   eItem := TEventItem(Clients[i]);
   eItem.CallBack(eItem.Client,EventId,NumVal,StrVal,DblVal,True);
  end;
end;

procedure TEventEngine.RaiseEvent(bVal: Boolean);
var CallBack: TEventCallBack;
    i: Integer;
    eItem: TEventItem;
begin
  NumVal := 0;
  if bval then numval := 1;
  For i := 0 to Clients.Count - 1 do
  begin
   eItem := TEventItem(Clients[i]);
   eItem.CallBack(eItem.Client,EventId,NumVal,StrVal,DblVal,True);
  end;
end;

procedure TEventEngine.RaiseEvent(aNumVal: Integer);
var CallBack: TEventCallBack;
    i: Integer;
    eItem: TEventItem;
begin
  Numval := aNumVal;
  For i := 0 to Clients.Count - 1 do
  begin
   eItem := TEventItem(Clients[i]);
   eItem.CallBack(eItem.Client,EventId,NumVal,StrVal,DblVal,True);
  end;
end;

procedure TEventEngine.RaiseEvent(aDblVal: Double);
var CallBack: TEventCallBack;
    i: Integer;
    eItem: TEventItem;
begin
  DblVal := aDblVal;
  For i := 0 to Clients.Count - 1 do
  begin
   eItem := TEventItem(Clients[i]);
   eItem.CallBack(eItem.Client,EventId,NumVal,StrVal,DblVal,True);
  end;
end;

Procedure TEventEngine.RaiseEvent(aStrVal:String);
var CallBack: TEventCallBack;
    i: Integer;
    eItem: TEventItem;
begin
  StrVal := aStrVal;
  For i := 0 to Clients.Count - 1 do
  begin
   eItem := TEventItem(Clients[i]);
   eItem.CallBack(eItem.Client,EventId,NumVal,StrVal,DblVal,True);
  end;
end;

Procedure TEventEngine.EnableEvent(xenabled: Boolean);
var CallBack: TEventCallBack;
    i: Integer;
    eItem: TEventItem;
begin
  Enabled := xEnabled;
  For i := 0 to Clients.Count - 1 do
  begin
   eItem := TEventItem(Clients[i]);
   eItem.CallBack(eItem.Client,EventId,NumVal,StrVal,DblVal,Enabled);
  end;
end;

Function TEventEngine.RegisterClient(Client:TObject;CallBack: TEventCallBack):Pointer;
var eItem: TEventItem;
begin
  result := nil;
  if assigned(Callback) then
  begin
    eItem := TEventItem.Create(Client,CallBack);
    Clients.Add(eItem);
    result := eItem;
    Callback(Client,EventId,Numval,Strval,Dblval,True);
  end;
end;

Procedure TEventEngine.UnRegisterClient(EvHandle: Pointer);
Begin
  if assigned(EvHandle) then Clients.Remove(EvHandle);
End;

procedure TEventEngine.RaiseEvent;
var CallBack: TEventCallBack;
    i: Integer;
    eItem: TEventItem;
begin
  For i := 0 to Clients.Count - 1 do
  begin
   eItem := TEventItem(Clients[i]);
   eItem.CallBack(eItem.Client,EventId,NumVal,StrVal,DblVal,True);
  end;
end;

{ TEventItem }

constructor TEventItem.Create(aClient: TObject; aCallback: TEventCallback);
begin
  inherited Create;
  Client := aClient;
  Callback := aCallback;
end;

{ TColorMenuItem }

constructor TColorMenuItem.Create(aOwner: TComponent);
var cItem:TMenuItem;
    i,k:integer;
begin
  inherited;
  OnMeasureItem := SelfMeasureItem;
  OnAdvancedDrawItem  := SelfAdvancedDrawItem;

  for i := 1 to 5 do
  begin
    for k := 1 to 10 do
    begin
      cItem := TMenuItem.Create(self);
      Self.Add(cItem);
      if (i = 1) and (k = 1) then
      begin
       CItem.Tag := -255;CItem.Hint := 'Layer Default';
      end
      else if (i = 5) and (k = 10) then
      begin
       CItem.Tag := -500;Citem.Hint := 'More Colors';
      end
      else
        cItem.Tag := BasicColors[((k-1)*5+i)-1];
      cItem.Caption := inttostr(k);
      cItem.OnMeasureItem := ChildMeasureItem;
      cItem.OnAdvancedDrawItem  := ChildAdvancedDrawItem;
      cItem.OnClick := ColorSelected;
      if (i>1) and (k=1) then cItem.Break := mbBreak;
      if (k = 4) and (i=3) then begin
        cItem.Checked := true;
        SelectedItem := cItem;
      end;
    end;
  end;
end;

Procedure TColorMenuItem.SetColor(Value: TColor);
var i: Integer;
    cItem: TmenuItem;
begin
  For i := 0 to Count-1 do
  begin
    cItem := Items[i];
    cItem.Checked := False;
    if cItem.Tag = Value then begin
      cItem.Checked := true;
      SelectedItem := cItem;
    end;
  end;
  FColor := Value;
end;
procedure TColorMenuItem.SelfMeasureItem(Sender: TObject; ACanvas: TCanvas;
            var Width, Height: Integer);
Begin
  Width := ACanvas.TextWidth(Caption)+20;
  if assigned(Bitmap) then Width := Width + 20;
end;

procedure TColorMenuItem.SelfAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; State: TOwnerDrawState);
var ctext,xCaption: String;
    i: Integer;
    textStart,rectStart: Integer;
Begin
  xCaption := '';
  for i := 0 to Length(Caption) do
  begin
    if copy(Caption,i,1) <> '&' then
      xCaption := xCaption + copy(Caption,i,1);
  end;
  Acanvas.Brush.Color := clMenu;
  Acanvas.Brush.Style := bsSolid;
  ACanvas.FillRect(ARect);
  Acanvas.Pen.Style := psSolid;
  ACanvas.Pen.Color := ClBlack;

  if odSelected in State then
  begin
    Acanvas.Brush.Color := clHighLight;
    ACanvas.FillRect(ARect);
    ACanvas.Pen.Color := ClWhite;
  end;

  if assigned(Bitmap) then
  begin
    if odSelected in State then
    begin
      Acanvas.Brush.Color := clMenu;
      ACanvas.FillRect(Rect(Arect.Left+5,ARect.top+2,Arect.Left+21,ARect.top+17));
    end;
    Bitmap.Transparent := True;
    ACanvas.Draw(Arect.Left+5,ARect.top+2,Bitmap);
  end;


  if fColor = -255 then
  begin
    Acanvas.Brush.Color := clRed;
    cText:= 'L';
  end else begin
    Acanvas.Brush.Color := FColor;
    cText:= '';
  end;

  if assigned(Bitmap) then
  begin
    RectStart := aRect.left + 25;
    TextStart := aRect.left + 40;
  end else begin
    RectStart := aRect.left + 5;
    TextStart := aRect.left + 20;
  end;


  if odDisabled in State then begin
    Acanvas.Brush.Color := clSilver;
    ACanvas.Pen.Color := clGray;
    if not (odselected in State) then
      Acanvas.Rectangle(RectStart, Arect.Top+5,RectStart+10,Arect.Top+15);
  end else
    Acanvas.Rectangle(RectStart, Arect.Top+5,RectStart+10,Arect.Top+15);

  Acanvas.Brush.Style := bsClear;

  if odDisabled in State then begin
    if not (odselected in State) then
    begin
      ACanvas.Font.Color := clWhite;
      Acanvas.TextOut(TextStart+1,Arect.Top+4,xCaption);
    end;
    ACanvas.Font.Color := clGray;
    Acanvas.TextOut(TextStart,Arect.Top+3,xCaption);
  end else begin
    Acanvas.TextOut(TextStart,Arect.Top+3,xCaption);
  end;

  if Ctext <> '' then
  begin
    ACanvas.Font.Name := 'Tahoma';
    ACanvas.Font.Style := [fsBold];
    ACanvas.Font.Size := 7;
    ACanvas.Font.Color := clWhite;
    Acanvas.TextOut(RectStart + 2,Arect.Top+4,Ctext);
  end;

end;

Procedure TColorMenuItem.ColorSelected(Sender:TObject);
var dlg: TColorDialog;
    sColor:TColor;
begin
  sColor := (Sender as TmenuItem).Tag;
  if SColor <> - 500 then
  begin
    (Sender as TMenuItem).Checked := True;
    FColor := SColor;
    SelectedItem.Checked := False;
    SelectedItem := (Sender as TMenuItem);
  end
  else begin
    dlg := TColorDialog.Create(Self);
    dlg.Color := FColor;
    if dlg.Execute then
    begin
      SelectedItem.Checked := False;
      Color := dlg.Color;
    end;
  end;
end;

Procedure TColorMenuItem.SetBitmap(aBitmap: Graphics.TBitmap);
begin
  if not assigned(aBitmap) then
  begin
    if assigned(Bitmap) then Bitmap.Free;
    Bitmap := nil;
  end else begin
    if not assigned(Bitmap) then
    begin
      Bitmap := Graphics.TBitmap.Create;
      Bitmap.Width := 16;
      Bitmap.Height :=16;
    end;
    Bitmap.Canvas.Draw(0,0,aBitmap);
  end;
end;


procedure TColorMenuItem.ChildMeasureItem(Sender: TObject; ACanvas: TCanvas;
            var Width, Height: Integer);
begin
  width := 2;
  Height := 16;
end;


procedure TColorMenuItem.ChildAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; State: TOwnerDrawState);
var xRect: Trect;
    xColor:Integer;
    text: string;
begin
  text := '';
  Acanvas.Brush.Color := clMenu;
  Acanvas.Brush.Style := bsSolid;
  Acanvas.FillRect(aRect);
  xColor := TMenuItem(Sender).Tag;
  if xColor = -255 then
  begin
    Acanvas.Brush.Color := 255;Text := 'L';
  end
  else if xColor = -500 then
  begin
    Acanvas.Brush.Color := clNavy;Text := 'M';
  end
  else
    Acanvas.Brush.Color := xColor;

  Acanvas.Pen.Color := clBlack;
  Acanvas.Pen.Style := psSolid;
  Acanvas.Pen.Width := 1;
  xRect := Rect(Arect.left+1,ARect.Top+2,Arect.Right-1,Arect.Bottom-2);

  if odSelected in State then begin
    Acanvas.Rectangle(aRect);
  end else begin
    Acanvas.Rectangle(xRect);
  end;

  if odChecked in State then begin
    Acanvas.Pen.Color := clMenu;
    Acanvas.Pen.Style := psSolid;
    Acanvas.Pen.Width := 2;
    DrawEdge(Acanvas.handle,xRect,EDGE_SUNKEN,BF_RECT);
  end;
  If text <> '' then begin
    ACanvas.Font.Name := 'Tahoma';
    ACanvas.Font.Size := 7;
    ACanvas.Font.Style := [fsBold];
    Acanvas.Font.Color := clWhite;
    Acanvas.Brush.Style := bsClear;
    Drawtext(Acanvas.handle,pChar(Text),1,xRect,DT_VCENTER or DT_CENTER);
  end;


end;



{ TColorPopUp }

procedure TColorPopUp.ChildAdvancedDrawItem(Sender: TObject;
  ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var xRect: Trect;
    xColor:Integer;
    text: string;
begin
  text := '';
  Acanvas.Brush.Color := clMenu;
  Acanvas.Brush.Style := bsSolid;
  Acanvas.FillRect(aRect);
  xColor := TMenuItem(Sender).Tag;
  if xColor = -255 then
  begin
    Acanvas.Brush.Color := 255;Text := 'L';
  end
  else if xColor = -500 then
  begin
    Acanvas.Brush.Color := clNavy;Text := 'M';
  end
  else
    Acanvas.Brush.Color := xColor;

  Acanvas.Pen.Color := clBlack;
  Acanvas.Pen.Style := psSolid;
  Acanvas.Pen.Width := 1;
  xRect := Rect(Arect.left+1,ARect.Top+2,Arect.Right-1,Arect.Bottom-2);

  if odSelected in State then begin
    Acanvas.Rectangle(aRect);
  end else begin
    Acanvas.Rectangle(xRect);
  end;

  if odChecked in State then begin
    Acanvas.Pen.Color := clMenu;
    Acanvas.Pen.Style := psSolid;
    Acanvas.Pen.Width := 2;
    DrawEdge(Acanvas.handle,xRect,EDGE_SUNKEN,BF_RECT);
  end;
  If text <> '' then begin
    ACanvas.Font.Name := 'Tahoma';
    ACanvas.Font.Size := 7;
    ACanvas.Font.Style := [fsBold];
    Acanvas.Font.Color := clWhite;
    Acanvas.Brush.Style := bsClear;
    Drawtext(Acanvas.handle,pChar(Text),1,xRect,DT_VCENTER or DT_CENTER);
  end;

end;

procedure TColorPopUp.ChildMeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
begin
  width := 2;
  Height := 16;

end;

procedure TColorPopUp.ColorSelected(Sender: TObject);
var dlg: TColorDialog;
    sColor:TColor;
begin
  sColor := (Sender as TmenuItem).Tag;
  if SColor <> - 500 then
  begin
    (Sender as TMenuItem).Checked := True;
    FColor := SColor;
    SelectedItem.Checked := False;
    SelectedItem := (Sender as TMenuItem);
  end
  else begin
    dlg := TColorDialog.Create(Self);
    dlg.Color := FColor;
    if dlg.Execute then
    begin
      SelectedItem.Checked := False;
      Color := dlg.Color;
    end;
  end;
  If assigned(FColorChange) then FColorChange(sender,Color);
end;


constructor TColorPopUp.Create(aOwner: TComponent);
var cItem:TMenuItem;
    i,k:integer;
begin
  inherited;
  ownerDraw := True;
  for i := 1 to 5 do
  begin
    for k := 1 to 10 do
    begin
      cItem := TMenuItem.Create(self);
      Items.Add(cItem);
      if (i = 1) and (k = 1) then
      begin
       CItem.Tag := -255;CItem.Hint := 'Layer Default';
      end
      else if (i = 5) and (k = 10) then
      begin
       CItem.Tag := -500;Citem.Hint := 'More Colors';
      end
      else
        cItem.Tag := BasicColors[((k-1)*5+i)-1];
      cItem.Caption := inttostr(k);
      cItem.OnMeasureItem := ChildMeasureItem;
      cItem.OnAdvancedDrawItem  := ChildAdvancedDrawItem;
      cItem.OnClick := ColorSelected;
      if (i>1) and (k=1) then cItem.Break := mbBreak;
      if (k = 4) and (i=3) then begin
        cItem.Checked := true;
        SelectedItem := cItem;
      end;
    end;
  end;
end;


procedure TColorPopUp.SetColor(Value: TColor);
var i: Integer;
    cItem: TmenuItem;
begin
  For i := 0 to Items.Count-1 do
  begin
    cItem := Items[i];
    cItem.Checked := False;
    if cItem.Tag = Value then begin
      cItem.Checked := true;
      SelectedItem := cItem;
    end;
  end;
  FColor := Value;
end;

procedure getellipseBounds(x, y, a, b, xangle:Double;
  lines: integer; var BoundRect: TDoubleRect);
var   sinAngle : real;
      cosAngle : real;
      angle : real;
      theta    : real;
      xp,yp    : real;
      xr, yr   : double;
      li       : integer;
begin

  sinAngle := sin (xangle);
  cosAngle := cos (xangle);

  if xangle = 0 then
  begin
    BoundRect.Left := x-a;
    BoundRect.Right := x+a;
    BoundRect.Top := y-b;
    BoundRect.Bottom := y+b;
  end
  else
  begin
    BoundRect.Left := x;
    BoundRect.Right := x;
    BoundRect.Top := y;
    BoundRect.Bottom := y;

    for li := 0 to lines
    do begin
      theta := (li/lines) * 2*PI;   // angle step
      xp := a * cos(theta);         // ellipse point
      yp := b * sin(theta);
      // rotate ellipse point around center
      xr := (x - xp * cosAngle + yp * sinAngle);
      yr := (y + xp * sinAngle + yp * cosAngle);
      if xr > BoundRect.Right then BoundRect.Right := xr
      else if xr< BoundRect.Left then BoundRect.Left := xr;
      if yr > BoundRect.Bottom then BoundRect.Bottom := yr
      else if yr < BoundRect.Top then BoundRect.Top := yr;
    end;
  end;
end;


{ TBevelEx }

procedure TBevelEx.Paint;
const
  XorColor = $00FFD8CE;
var
  Color1, Color2: TColor;
  Temp: TColor;

  procedure BevelRect(const R: TRect);
  begin
    with Canvas do
    begin
      Pen.Color := Color1;
      PolyLine([Point(R.Left, R.Bottom), Point(R.Left, R.Top),
        Point(R.Right, R.Top)]);
      Pen.Color := Color2;
      PolyLine([Point(R.Right, R.Top), Point(R.Right, R.Bottom),
        Point(R.Left, R.Bottom)]);
    end;
  end;

  procedure BevelLine(C: TColor; X1, Y1, X2, Y2: Integer);
  begin
    with Canvas do
    begin
      Pen.Color := C;
      MoveTo(X1, Y1);
      LineTo(X2, Y2);
    end;
  end;

begin
  with Canvas do
  begin
    if (csDesigning in ComponentState) then
    begin
      if (FShape = bsSpacer) then
      begin
        Pen.Style := psDot;
        Pen.Mode := pmXor;
        Pen.Color := XorColor;
        Brush.Style := bsClear;
        Rectangle(0, 0, ClientWidth, ClientHeight);
        Exit;
      end
      else
      begin
        Pen.Style := psSolid;
        Pen.Mode  := pmCopy;
        Pen.Color := clBlack;
        Brush.Style := bsSolid;
      end;
    end;

    Pen.Width := 1;

    if Style = bsLowered then
    begin
      Color1 := clBtnShadow;
      Color2 := clBtnHighlight;
    end
    else
    begin
      Color1 := clBtnHighlight;
      Color2 := clBtnShadow;
    end;

    case FShape of
      bsBox: BevelRect(Rect(0, 0, Width - 1, Height - 1));
      bsFrame:
        begin
          Temp := Color1;
          Color1 := Color2;
          BevelRect(Rect(1, 1, Width - 1, Height - 1));
          Color2 := Temp;
          Color1 := Temp;
          BevelRect(Rect(0, 0, Width - 2, Height - 2));
        end;
      bsTopLine:
        begin
          BevelLine(Color1, 0, 0, Width, 0);
          BevelLine(Color2, 0, 1, Width, 1);
        end;
      bsBottomLine:
        begin
          BevelLine(Color1, 0, Height - 2, Width, Height - 2);
          BevelLine(Color2, 0, Height - 1, Width, Height - 1);
        end;
      bsHorzLine:
        begin
          BevelLine(Color1, 0, (Height div 2)-2, Width, (Height div 2)-2);
          BevelLine(Color2, 0, (Height div 2)-1, Width, (Height div 2)-1);
        end;

      bsLeftLine:
        begin
          BevelLine(Color1, 0, 0, 0, Height);
          BevelLine(Color2, 1, 0, 1, Height);
        end;
      bsRightLine:
        begin
          BevelLine(Color1, Width - 2, 0, Width - 2, Height);
          BevelLine(Color2, Width - 1, 0, Width - 1, Height);
        end;
      bsVertLine:
        begin
          BevelLine(Color1, (Width div 2) -2, 0, (Width div 2) -2, Height);
          BevelLine(Color2, (Width div 2) -1, 0, (Width div 2) -1, Height);
        end;

    end;
  end;
end;

procedure TBevelEx.SetShape(Value: TBevelShapeEx);
begin
  if Value <> FShape then
  begin
    FShape := Value;
    Invalidate;
  end;
end;

{ TMFSOle }

procedure TMFSOle.Changed;
begin
  if assigned(FonChange) then FOnChange(Self);
end;

//***

Function InputDouble(Caption,Prompt:String; var Value:Double):Boolean;
var frm: TFrmInput;
    oldval: double;
begin
  oldval := value;
  frm := TFrmInput.Create(application);
  result := frm.InputDouble(Caption,Prompt,Value);
  //if Value = oldVal then result := False;
  frm.free;
end;

Function InputMemo(Caption,Prompt:String; var Value:String):Boolean;
var frm: TFrmMemo;
begin
  frm := TFrmMemo.Create(application);
  result := frm.InPutMemo(Caption,Prompt,Value);
  frm.free;
end;

Function InputInteger(Caption,Prompt:String; var Value:Integer):Boolean;
var frm: TFrmInput;
    oldval: Integer;
begin
  oldval := value;
  frm := TFrmInput.Create(application);
  result := frm.InputInteger(Caption,Prompt,Value);
  //if Value = oldVal then result := False;

  frm.free;
end;

Function InputString(Caption,Prompt:String; var Value:String):Boolean;
var frm: TFrmInput;
    oldval: String;
begin
  oldval := value;
  frm := TFrmInput.Create(application);
  result := frm.InputString(Caption,Prompt,Value);
  //if Value = oldVal then result := False;

  frm.free;
end;

Function InputDoubleEdit(Prompt:String; var Value:Double; px,py:Integer):Boolean;
var frm: TFrmInput;
    oldval: double;
begin
  oldval := value;
  frm := TFrmInput.Create(application);
  frm.SetAsEdit(px,py);
  result := frm.InputDouble('',Prompt,Value);
  //if Value = oldVal then result := False;
  frm.free;
end;
Function InputStringEdit(Caption,Prompt:String; var Value:String; px,py:Integer):Boolean;
var frm: TFrmInput;
    oldval: String;
begin
  oldval := value;
  frm := TFrmInput.Create(application);
  frm.SetAsEdit(px,py);
  result := frm.InputString('',Prompt,Value);
  //if Value = oldVal then result := False;
  frm.free;
end;
Function InputIntegerEdit(Prompt:String; var Value:Integer; px,py:Integer):Boolean;
var frm: TFrmInput;
    oldval: Integer;
begin
  oldval := value;
  frm := TFrmInput.Create(application);
  frm.SetAsEdit(px,py);
  result := frm.InputInteger('',Prompt,Value);
  //if Value = oldVal then result := False;
  frm.free;
end;


Function CreateUniqueId:Integer;
var h,m,s,ms: Word;
begin
  DecodeTime(now,h,m,s,ms);
  result := ms*234+h*100+m+s*24+random(100);
end;

Function DelphiSetToOleShift(Shift:TShiftState):Integer;
begin
  result := 0;
  if ssShift in Shift then result := result or oleShift;
  if ssAlt in Shift then result := result or oleAlt;
  if ssCtrl in Shift then result := result or oleCtrl;
  if ssLeft in Shift then result := result or oleLeft;
  if ssRight in Shift then result := result or oleRight;
  if ssMiddle in Shift then result := result or oleMiddle;
  if ssDouble in Shift then result := result or oleDouble;
end;

Function OleShiftToDelphiSet(oleState:Integer):TShiftState;
begin
  result := [];
  if (oleState and oleShift) = oleShift then result := result+[ssShift];
  if (oleState and oleAlt) = oleAlt then result := result+[ssAlt];
  if (oleState and oleCtrl) = oleCtrl then result := result+[ssCtrl];
  if (oleState and oleLeft) = oleLeft then result := result+[ssLeft];
  if (oleState and oleRight) = oleRight then result := result+[ssRight];
  if (oleState and oleMiddle) = oleMiddle then result := result+[ssMiddle];
  if (oleState and oleDouble) = oleDouble then result := result+[ssDouble];
end;


function GetJpgdpi(filename:String):Integer;
CONST
    BufferSize = 50;
    DPI=1;  //inch
    DPC=2;  //cm
VAR
    Buffer     :  STRING;
    index      :  INTEGER;
    FileStream :  TFileStream;
    xResolution:  WORD;
    yResolution:  WORD;
    typ:Word;
begin
    result := 0;
    FileStream := TFileStream.Create(filename,
                                     fmOpenReadWrite);
    TRY
      SetLength(Buffer, BufferSize);
      FileStream.Read(buffer[1], BufferSize);
      index := POS('JFIF'+#$00, buffer);
      IF   index > 0
      THEN BEGIN
        FileStream.Seek(index+6, soFromBeginning);
        FileStream.read(typ, 2);
        FileStream.read(xresolution, 2);
        FileStream.read(yresolution, 2);
        result := xresolution;
        if typ = dpc then result := round (result*2.54)
      END
    FINALLY
      FileStream.Free;
    END;
end;

function GetBmpDPI(bmpStream:TStream): LongInt;
var
   Data: Word;
   A: Double;
begin
    try
       Result := 0;
       bmpStream.Position := 38;
       if bmpStream.Read(Data,2) = 2 then
          begin
          A := Data;
          Result := Round(A / 39.370079);
          end;
    except
           result := 0;
    end;
end;

function GetBmpDPI(bmpName:String): LongInt;
var
   Stream: TMemoryStream;
   Data: Word;
   A: Double;
begin
    try
       Result := 0;
       Stream := TMemoryStream.Create;
       Stream.LoadFromFile(bmpName);
       Stream.Position := 38;
       if Stream.Read(Data,2) = 2 then
          begin
          A := Data;
          Result := Round(A / 39.370079);
          end;
    finally
           Stream.Free;
    end;
end;


//


Function GetPreviewImage(fileName:String): Graphics.TBitmap;
var xBmp : Graphics.TBitmap;
    Stream: TFileStream;
    xSize,a: Integer;
    secName:String;
    Version: Word;
    SecCount: Byte;
    sBytes: array [1..8] of Byte;
begin
  result := nil;

  Stream := TFileStream.Create(FileName,fmOpenRead or fmShareExclusive);
  for a := 1 to 8 do
    Stream.Read(sBytes[a],1);
  for a := 1 to 8 do
    if sBytes[a] <> signBytes[a] then
    begin
      Stream.free;
      Exit;
    end;

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

  Stream.Read(xSize,4);
  SecName := ReadStringFromStream(Stream);
  if SecName = 'Preview' then
  begin
    xBmp:= Graphics.Tbitmap.Create;
    xBmp.LoadFromStream(Stream);
    result := xbmp;
  end;
  stream.free;
end;

Procedure DrawBitmap(fCanvas:TCanvas; Fbitmap:Graphics.TBitmap;x,y:Integer; Enabled:Boolean);
const
  ROP_DSPDxax = $00E20746;
var monobmp:Graphics.Tbitmap;
  IWidth, IHeight: Integer;
  IRect: TRect;
begin
  if enabled then begin
    fCanvas.Draw(x,y,FBitmap);
  end else begin
    IWidth := Fbitmap.Width;
    IHeight := Fbitmap.Height;
    IRect := Rect(x, y, x+IWidth, y+IHeight);
    MonoBmp := nil;
    MonoBmp := Graphics.TBitmap.Create;
    with MonoBmp do
    begin
      Assign(FBitmap);
      HandleType := bmDDB;
      Canvas.Brush.Color := clBlack;
      Width := IWidth;
      if Monochrome then
      begin
        Canvas.Font.Color := clWhite;
        Monochrome := False;
        Canvas.Brush.Color := clWhite;
      end;
      Monochrome := True;
    end;
    with FCanvas do
    begin
      Brush.Color := clBtnFace;
      FillRect(IRect);
      Brush.Color := clBtnHighlight;
      SetTextColor(Handle, clBlack);
      SetBkColor(Handle, clWhite);
      BitBlt(Handle, x+1, y+1, IWidth, IHeight,
        MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
      Brush.Color := clBtnShadow;
      SetTextColor(Handle, clBlack);
      SetBkColor(Handle, clWhite);
      BitBlt(Handle, x, y, IWidth, IHeight,
        MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
    end;
    monobmp.free;
  end;
end;

Function OleCursor(cr:TCursor):Integer;
begin
  result := 0;
  case cr of
    crDefault: result := crOleDefault;
    crArrow: result := crOleArrow;
    crCross: result := crOleCross;
    crIBeam: result := crOleIBeam;
    crSize: result := crOleSize;
    crSizeNESW: result := crOleSizeNESW;
    crSizeNS: result := crOleSizeNS;
    crSizeNWSE: result := crOleSizeNWSE;
    crSizeWE: result := crOleSizeWE;
    crUpArrow: result := crOleUpArrow;
    crHourGlass: result := crOleHourGlass;
    crDrag: result := crOleSizeAll;
    crNoDrop: result := crOleNoDrop;
    crHSplit: result := crOleSizeWE;
    crVSplit: result := crOleSizeNS;
    crMultiDrag: result := crOleSizeAll;
    crNo: result := crOleNoDrop;
    crAppStart: result := crOleAppStart;
    crHelp: result := crOleHelp;
    crHandPoint: result := crOleHandPoint;
  end;
end;


type
FreePIDLProc  =  procedure (PIDL: PItemIDList); stdcall;
var
ShellHandle: THandle=0;

function FolderDialog(Caption: String) : String;
var
  BrowseInfo: TBrowseInfo;
  ItemIDList: PItemIDList;
  ItemSelected : PItemIDList;
  NameBuffer: array[0..MAX_PATH] of Char;
  WindowList: Pointer;
  Res: Boolean;

  FreePIDL : FreePIDLProc;
begin
  Result := '';
  if ShellHandle = 0 then ShellHandle := Windows.LoadLibrary(PChar('shell32.dll'));
  if ShellHandle <> 0 then
    FreePIDL :=  GetProcAddress(ShellHandle, PChar(155))
  else
    exit;
  itemIDList := nil;
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  BrowseInfo.hwndOwner := Application.Handle;
  BrowseInfo.pidlRoot := ItemIDList;
  BrowseInfo.pszDisplayName := NameBuffer;
  BrowseInfo.lpszTitle := PChar(Caption);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  WindowList := DisableTaskWindows(0);
  try
    ItemSelected := SHBrowseForFolder(BrowseInfo);
    Res := ItemSelected <> nil;
  finally
    EnableTaskWindows(WindowList);
  end;

  if Res then
   begin
    SHGetPathFromIDList(ItemSelected,NameBuffer);
    Result := NameBuffer;
   end;
  Freepidl(BrowseInfo.pidlRoot);

end;

Procedure RegWrite(IName,IValue:String;Key:String='');overload;
var
  Reg: TRegistry;
begin
  try
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if key = '' then key := '\Software\Tekhnelogos\PowerCad\Settings\';
    if Reg.OpenKey(key,True) then begin
      Reg.WriteString(Iname,IValue);
    end;
    Reg.Free;
  except
  end;
end;


Procedure RegRead(IName:String; var IValue:String;Key:String='');overload;
var
  Reg: TRegistry;
begin
  try
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if key = '' then key := '\Software\Tekhnelogos\PowerCad\Settings\';
    if Reg.OpenKey(key, True) then begin
      IValue := Reg.readString(Iname);
    end;
    Reg.Free;
  except
  end;
end;

Procedure RegWrite(IName:String;IValue:Integer;Key:String='');overload;
var
  Reg: TRegistry;
begin
  try
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if key = '' then key := '\Software\Tekhnelogos\PowerCad\Settings\';
    if Reg.OpenKey(key, True) then begin
      Reg.WriteInteger(Iname,IValue);
    end;
    Reg.Free;
  except
  end;
end;

Procedure RegRead(IName:String; var IValue:Integer;Key:String='');overload;
var
  Reg: TRegistry;
begin
  try
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if key = '' then key := '\Software\Tekhnelogos\PowerCad\Settings\';
    if Reg.OpenKey(key, True) then begin
      if reg.ValueExists(Iname) then IValue := Reg.readInteger(Iname);
    end;
    Reg.Free;
  except
  end;
end;

Procedure RegWrite(IName:String;IValue:Boolean;Key:String='');overload;
var
  Reg: TRegistry;
begin
  try
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if key = '' then key := '\Software\Tekhnelogos\PowerCad\Settings\';
    if Reg.OpenKey(key, True) then begin
      Reg.WriteBool(Iname,IValue);
    end;
    Reg.Free;
  except
  end;
end;

Procedure RegRead(IName:String; var IValue:Boolean;Key:String='');overload;
var
  Reg: TRegistry;
begin
  try
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if key = '' then key := '\Software\Tekhnelogos\PowerCad\Settings\';
    if Reg.OpenKey(key, True) then begin
      IValue := Reg.readBool(Iname);
    end;
    Reg.Free;
  except
  end;
end;

Procedure MatrixMultiply( cCount: Integer; ml: array of Double; mr : array of Double; var m: array of Double);
var a,b,c: Integer;
begin
 for a:=0 to cCount-1 do
  for b:=0 to cCount-1 do
   for c:=0 to cCount-1 do
   begin
     m[(a*4)+b] := m[(a*4)+b] + mr[(a*4)+c] * ml[(c*4)+b];
   end;
end;
Procedure CloseFace(var Face:T3dFace);
begin
  SetLength(Face,Length(Face)+1);
  Face[Length(Face)-1] := Face[0];
end;
                   
Function MakeFloat(str:String;def:Extended):Extended;
begin
  if not TextToFloat(PChar(str), result, fvExtended) then result := def;
end;

Function BByte(Value:Boolean):Byte;
begin
  result := 0;
  if Value then result := 1;
end;

Function BBool(Value:Byte):Boolean;
begin
  Result := (Value =1);
end;

Function DoubleRound(Val:Double; Dec:Integer):Double;
begin
  result := Round(Val* Power(10,Dec))/Power(10,Dec);
end;

Function RoundUp(Val:Double):Integer;
begin
  SetRoundMode(rmUp);
  result := Round(Val);
  SetRoundMode(rmNearest);
end;

Function AddToFileName(FName,add:String):String;
var fExt:String;
begin
  fExt := ExtractFileExt(Fname);
  FName := Copy(Fname,1,Length(Fname)-Length(fExt));
  FName := Fname+add+fExt;
  result := fName;
end;

Function RegInReg(inReg,Reg:Integer):Boolean;
var r: TRect;
p1,p2,p3,p4:TPoint;
a1,a2,a3,a4: Boolean;
begin
  GetRgnBox(inReg,r);
  p1 := Point(r.left+2,r.top+2);
  p2 := Point(r.right-2,r.top+2);
  p3 := Point(r.right-2,r.Bottom-2);
  p4 := Point(r.Left+2,r.Bottom-2);

  a1 := ptInRegion(reg,p1.x,p1.y);
  a2 := ptInRegion(reg,p2.x,p2.y);
  a3 := ptInRegion(reg,p3.x,p3.y);
  a4 := ptInRegion(reg,p4.x,p4.y);
  result := a1 and a2 and a3 and a4;
end;

function GetColorBetween(StartColor, EndColor: TColor; Pointvalue,
                                    Von, Bis : Extended): TColor;
var
   F: Extended; r1, r2, r3, g1, g2, g3, b1, b2, b3: Byte;

   function CalcColorBytes(fb1, fb2: Byte): Byte;
   begin
     result := fb1;
     if fb1 < fb2 then Result := FB1 + Trunc(F * (fb2 - fb1));
     if fb1 > fb2 then Result := FB1 - Trunc(F * (fb1 - fb2));
   end;

begin
   if Pointvalue <= Von then begin
     result := StartColor;
     exit;
   end;
   if Pointvalue >= Bis then begin
     result := EndColor;
     exit;
   end;
   F := (Pointvalue - von) / (Bis - Von);
   asm
      mov EAX, Startcolor
      cmp EAX, EndColor
      je @@exit
      mov r1, AL
      shr EAX,8
      mov g1, AL
      shr Eax,8
      mov b1, AL
      mov Eax, Endcolor
      mov r2, AL
      shr EAX,8
      mov g2, AL
      shr EAX,8
      mov b2, AL
      push ebp
      mov al, r1
      mov dl, r2
      call CalcColorBytes
      pop ecx
      push ebp
      Mov r3, al
      mov dL, g2
      mov al, g1
      call CalcColorBytes
      pop ecx
      push ebp
      mov g3, Al
      mov dL, B2
      mov Al, B1
      call CalcColorBytes
      pop ecx
      mov b3, al
      XOR EAX,EAX
      mov AL, B3
      SHL EAX,8
      mov AL, G3
      SHL EAX,8
      mov AL, R3
@@Exit:
      mov @result, eax
   end;
end;

  Function MakeRgb(r,g,b:Double):TRGB;
  begin
    result.R := r;
    result.G := g;
    result.B := b;
  end;
procedure DrawGradientBox(DC: HDC; const R: TRect; Colors: array of TRGB);

// Draws a box with a gradient for all four corners.
// The Colors parameter carries the required colors where
// index 0 contains the color for the left-upper corner and the others keep the colors for the remaining vertices
// in clock-wise direction. If there are less color than there are corners then the missing colors are derived from the
// last given color by simply copying it.

var
  Vertices: array[0..3] of TTriVertex;
  Triangles: array[0..1] of TGradientTriangle;
  LastColor: TRGB;

  //--------------- local functions


  procedure FillVertex(Index: Integer; X, Y: Integer);

  begin
    Vertices[Index].x := X;
    Vertices[Index].y := Y;
    if Length(Colors) > Index then
    begin
      Vertices[Index].Red := Round($FF00 * Colors[Index].R);
      Vertices[Index].Green := Round($FF00 * Colors[Index].G);
      Vertices[Index].Blue := Round($FF00 * Colors[Index].B);
      LastColor := MakeRGB(Vertices[Index].Red, Vertices[Index].Green,Vertices[Index].Blue);
    end
    else
    begin
      Vertices[Index].Red := Round(LastColor.R);
      Vertices[Index].Green := Round(LastColor.R);
      Vertices[Index].Blue := Round(LastColor.R);
    end;
    // Alpha is ignored by GradientFill.
    Vertices[Index].Alpha := 0;
  end;

  //--------------- end local functions 


begin
  // Colors in GradientFill are scaled by 256 to enhance resolution.
  LastColor := MakeRGB($FF00, $FF00, $FF00);

  // Fill 4 vertices...
  FillVertex(0, R.Left, R.Top);
  FillVertex(1, R.Right, R.Top);
  FillVertex(2, R.Right, R.Bottom);
  FillVertex(3, R.Left, R.Bottom);

  // ... and 2 triangles. Two vertices are shared between both triangles.
  Triangles[0].Vertex1 := 0;
  Triangles[0].Vertex2 := 1;
  Triangles[0].Vertex3 := 2;

  Triangles[1].Vertex1 := 2;
  Triangles[1].Vertex2 := 3;
  Triangles[1].Vertex3 := 0;

  GradientFill(DC, Vertices[0], 4, Triangles[0], 2,GRADIENT_FILL_TRIANGLE);

end;

Type
  TScanRow = array[0..1024] of TRGBTriple;
  PScanRow = ^TScanRow;


Procedure MakeGradBitmap(ColorBegin,ColorEnd:TColor;GStyle:TGradStyle;var GradBmp:Graphics.TBitmap);
var rgbBegin,rgbEnd: TColor;
    rgbTriple1,rgbTriple2: TRGBTriple;
    i,m: Integer;
    deltaRed, deltaGreen, deltaBlue: Integer;
    GradColors: array[0..255] of TRGBTriple;
    X, Y: Integer;
    Row: PScanRow;
    TempX,TempY: Integer;
    TempXs: array[0..500] of Integer;
    TempYs: array[0..500] of Integer;
begin
  if GradBmp = nil then begin
    GradBmp := Graphics.TBitmap.Create;
    GradBmp.PixelFormat := pf24bit;
  end;

  rgbBegin := ColorToRGB(ColorBegin);
  rgbEnd := ColorToRGB(ColorEnd);
  rgbTriple1.rgbtRed := GetRValue(rgbBegin);
  rgbTriple1.rgbtGreen := GetGValue(rgbBegin);
  rgbTriple1.rgbtBlue := GetBValue(rgbBegin);

  rgbTriple2.rgbtRed := GetRValue(rgbEnd);
  rgbTriple2.rgbtGreen := GetGValue(rgbEnd);
  rgbTriple2.rgbtBlue := GetBValue(rgbEnd);

  deltaRed := rgbTriple2.rgbtRed - rgbTriple1.rgbtRed;
  deltaGreen := rgbTriple2.rgbtGreen - rgbTriple1.rgbtGreen;
  deltaBlue := rgbTriple2.rgbtBlue - rgbTriple1.rgbtBlue;
  m := MulDiv(255, 0, 100);
  if m = 0 then begin
    for i := 0 to 255 do
      with GradColors[i] do
      begin
        rgbtRed := rgbTriple1.rgbtRed + (i * deltaRed) div 255;
        rgbtGreen := rgbTriple1.rgbtGreen + (i * deltaGreen) div 255;
        rgbtBlue := rgbTriple1.rgbtBlue + (i * deltaBlue) div 255;
      end;
  end else if m > 0 then
  begin
    m := 255 - m;
    for i := 0 to m - 1 do
      with GradColors[i] do
      begin
        rgbtRed := rgbTriple1.rgbtRed + (i * deltaRed) div m;
        rgbtGreen := rgbTriple1.rgbtGreen + (i * deltaGreen) div m;
        rgbtBlue := rgbTriple1.rgbtBlue + (i * deltaBlue) div m;
      end;
    for i := m to 255 do
      with GradColors[i] do
      begin
        rgbtRed := rgbTriple1.rgbtRed + ((255 - i) * deltaRed) div (255 - m);
        rgbtGreen := rgbTriple1.rgbtGreen + ((255 - i) * deltaGreen) div (255 - m);
        rgbtBlue := rgbTriple1.rgbtBlue + ((255 - i) * deltaBlue) div (255 - m);
      end;
  end
  else if m < 0 then
  begin
    m := -m;
    for i := 0 to m do
      with GradColors[i] do
      begin
        rgbtRed := rgbTriple2.rgbtRed - (m * deltaRed) div m;
        rgbtGreen := rgbTriple2.rgbtGreen - (m * deltaGreen) div m;
        rgbtBlue := rgbTriple2.rgbtBlue - (m * deltaBlue) div m;
      end;
    for i := m + 1 to 255 do
      with GradColors[i] do
      begin
        rgbtRed := rgbTriple2.rgbtRed - ((255 - i) * deltaRed) div (255 - m);
        rgbtGreen := rgbTriple2.rgbtGreen - ((255 - i) * deltaGreen) div (255 - m);
        rgbtBlue := rgbTriple2.rgbtBlue - ((255 - i) * deltaBlue) div (255 - m);
      end;
  end;

  Case GStyle of
    gsRadCenter:
    begin
      GradBmp.Width := 362;
      GradBmp.Height := 362;
      for X := 0 to 180 do
      begin
        TempX := 180 - X;
        TempXs[X] := TempX * TempX;
      end;
      for X := 181 to 361 do
      begin
        TempX := X - 181;
        TempXs[X] := TempX * TempX;
      end;
      for Y := 0 to 361 do
      begin
        TempY := 180 - Y;
        TempY := TempY * TempY;
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 361 do
          Row[X] := GradColors[Round(Sqrt(TempXs[X] + TempY))];
      end;
    end;

    gsRadTop:
    begin
      GradBmp.Width := 362;
      GradBmp.Height := 181;
      for X := 0 to 180 do
      begin
        TempX := 180 - X;
        TempXs[X] := TempX * TempX;
      end;
      for X := 181 to 361 do
      begin
        TempX := X - 181;
        TempXs[X] := TempX * TempX;
      end;
      for Y := 0 to 180 do
      begin
        TempY := Y * Y;
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 361 do
          Row[X] := GradColors[Round(Sqrt(TempXs[X] + TempY))];
      end;
    end;
    gsRadBottom:
    begin
      GradBmp.Width := 362;
      GradBmp.Height := 181;
      for X := 0 to 180 do
      begin
        TempX := 180 - X;
        TempXs[X] := TempX * TempX;
      end;
      for X := 181 to 361 do
      begin
        TempX := X - 181;
        TempXs[X] := TempX * TempX;
      end;
      for Y := 0 to 180 do
      begin
        TempY := 180 - Y;
        TempY := TempY * TempY;
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 361 do
          Row[X] := GradColors[Round(Sqrt(TempXs[X] + TempY))];
      end;
    end;
    gsRadLeft:
    begin
      GradBmp.Width := 181;
      GradBmp.Height := 362;
      for Y := 0 to 180 do
      begin
        TempY := 180 - Y;
        TempYs[Y] := TempY * TempY;
      end;
      for Y := 181 to 361 do
      begin
        TempY := Y - 181;
        TempYs[Y] := TempY * TempY;
      end;
      for Y := 0 to 361 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 180 do
          Row[X] := GradColors[Round(Sqrt(X * X + TempYs[Y]))];
      end;
    end;
    gsRadRight:
    begin
      GradBmp.Width := 181;
      GradBmp.Height := 362;
      for X := 0 to 180 do
      begin
        TempX := 180 - X;
        TempXs[X] := TempX * TempX;
      end;
      for Y := 0 to 180 do
      begin
        TempY := 180 - Y;
        TempYs[Y] := TempY * TempY;
      end;
      for Y := 181 to 361 do
      begin
        TempY := Y - 181;
        TempYs[Y] := TempY * TempY;
      end;
      for Y := 0 to 361 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 180 do
          Row[X] := GradColors[Round(Sqrt(TempXs[X] + TempYs[Y]))];
      end;
    end;
    gsRadTopLeft:
    begin
      GradBmp.Width := 181;
      GradBmp.Height := 181;
      for X := 0 to 180 do
        TempXs[X] := X * X;
      for Y := 0 to 180 do
      begin
        TempY := Y * Y;
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 180 do
          Row[X] := GradColors[Round(Sqrt(TempXs[X] + TempY))];
      end;
    end;
    gsRadTopRight:
    begin
      GradBmp.Width := 181;
      GradBmp.Height := 181;
      for X := 0 to 180 do
      begin
        TempX := 180 - X;
        TempXs[X] := TempX * TempX;
      end;
      for Y := 0 to 180 do
      begin
        TempY := Y * Y;
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 180 do
          Row[X] := GradColors[Round(Sqrt(TempXs[X] + TempY))];
      end;
    end;
    gsRadBottomLeft:
    begin
      GradBmp.Width := 181;
      GradBmp.Height := 181;
      for X := 0 to 180 do
        TempXs[X] := X * X;
      for Y := 0 to 180 do
      begin
        TempY := 180 - Y;
        TempY := TempY * TempY;
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 180 do
          Row[X] := GradColors[Round(Sqrt(TempXs[X] + TempY))];
      end;
    end;
    gsRadBottomRight:
    begin
      GradBmp.Width := 181;
      GradBmp.Height := 181;
      for X := 0 to 180 do
      begin
        TempX := 180 - X;
        TempXs[X] := TempX * TempX;
      end;
      for Y := 0 to 180 do
      begin
        TempY := 180 - Y;
        TempY := TempY * TempY;
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 180 do
          Row[X] := GradColors[Round(Sqrt(TempXs[X] + TempY))];
      end;
    end;
    gsLineHorz:
    begin
      GradBmp.Width := 1;
      GradBmp.Height := 256;
      for Y := 0 to 255 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        Row[0] := GradColors[Y];
      end;
    end;
    gsLineVert:
    begin
      GradBmp.Width := 256;
      GradBmp.Height := 1;
      Row := PScanRow(GradBmp.ScanLine[0]);
      for X := 0 to 255 do
        Row[X] := GradColors[X];
    end;
    gsRefHorz:
    begin
      GradBmp.Width := 1;
      GradBmp.Height := 512;
      for Y := 0 to 255 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        Row[0] := GradColors[255 - Y];
        Row := PScanRow(GradBmp.ScanLine[511 - Y]);
        Row[0] := GradColors[255 - Y];
      end;
    end;
    gsRefVert:
    begin
      GradBmp.Width := 512;
      GradBmp.Height := 1;
      Row := PScanRow(GradBmp.ScanLine[0]);
      for X := 0 to 255 do
      begin
        Row[X] := GradColors[255 - X];
        Row[511 - X] := GradColors[255 - X];
      end;
    end;
    gsDiagLineF:
    begin
      GradBmp.Width := 128;
      GradBmp.Height := 129;
      for Y := 0 to 128 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 127 do
          Row[X] := GradColors[127 + (Y - X)];
      end;
    end;
    gsDiagLineB:
    begin
      GradBmp.Width := 128;
      GradBmp.Height := 129;
      for Y := 0 to 128 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 127 do
          Row[X] := GradColors[X + Y];
      end;
    end;
    gsDiagRefF:
    begin
      GradBmp.Width := 256;
      GradBmp.Height := 256;
      for Y := 0 to 255 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 255 do
          if X > Y then
            Row[X] := GradColors[X - Y]
          else
            Row[X] := GradColors[Y - X];
      end;
    end;
    gsDiagRefB:
    begin
      GradBmp.Width := 256;
      GradBmp.Height := 256;
      for Y := 0 to 255 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 255 do
          if X + Y < 255 then
            Row[X] := GradColors[255 - (X + Y)]
          else
            Row[X] := GradColors[(Y + X) - 255];
      end;
    end;
    gsArrowLeft:
    begin
      GradBmp.Width := 129;
      GradBmp.Height := 256;
      for Y := 0 to 127 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 128 do
          Row[X] := GradColors[255 - (X + Y)];
      end;
      for Y := 128 to 255 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 128 do
          Row[X] := GradColors[Y - X];
      end;
    end;
    gsArrowRight:
    begin
      GradBmp.Width := 129;
      GradBmp.Height := 256;
      for Y := 0 to 127 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 128 do
          Row[X] := GradColors[(X - Y) + 127];
      end;
      for Y := 128 to 255 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 128 do
          Row[X] := GradColors[(X + Y) - 128];
      end;
    end;
    gsArrowUp:
    begin
      GradBmp.Width := 256;
      GradBmp.Height := 129;
      for Y := 0 to 128 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 127 do
          Row[X] := GradColors[255 - (X + Y)];
        for X := 128 to 255 do
          Row[X] := GradColors[X - Y];
      end;
    end;
    gsArrowDown:
    begin
      GradBmp.Width := 256;
      GradBmp.Height := 129;
      for Y := 0 to 128 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 127 do
          Row[X] := GradColors[127 + (Y - X)];
        for X := 128 to 255 do
          Row[X] := GradColors[(X + Y) - 128];
      end;
    end;
    gsQuadrant:
    begin
      GradBmp.Width := 256;
      GradBmp.Height := 256;
      for Y := 0 to 127 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 127 do
          Row[X] := GradColors[255 - (X + Y)];
        for X := 128 to 255 do
          Row[X] := GradColors[X - Y];
      end;
      for Y := 128 to 255 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 127 do
          Row[X] := GradColors[Y - X];
        for X := 128 to 255 do
          Row[X] := GradColors[(X + Y) - 255];
      end;
    end;
    gsMirrored:
    begin
      GradBmp.Width := 256;
      GradBmp.Height := 256;
      for Y := 0 to 127 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 127 do
          Row[X] := GradColors[(X - Y) + 128];
        for X := 128 to 255 do
          Row[X] := GradColors[383 - (X + Y)];
      end;
      for Y := 128 to 255 do
      begin
        Row := PScanRow(GradBmp.ScanLine[Y]);
        for X := 0 to 127 do
          Row[X] := GradColors[(X + Y) - 128];
        for X := 128 to 255 do
          Row[X] := GradColors[128 + (Y - X)];
      end;
    end;
  end;

end;


Function AddFileExt(Fname,FExt:String):String;
var xExt: String;
begin
  xExt:= lowercase(ExtractFileExt(fNAme));
  if xExt <> lowercase(fExt) then fName := fName+fExt;
  result := fName;
end;

function RegisterAssociation(const aExeName, aFileExt, aFileDesc,aFileIcon: string): Boolean;
{
  This function registers a file association.

  ExeName   is the full path and name of the exe that will be associated
            with the extension.
  FileExt   is the extension of the file to register i.e. ".dxf" or ".ord".
  FileDesc  is the description of the file. i.e. "Drawing Exchange File".
  FileIcon  is the location of the icon to associate with this file type.
            For example "C:\MyApplicationLocation\Myapplication.exe,0"
            Note the ",0" means use the icon associated with the .exe.
            You can also say ",1" to use the next icon, if one exists.
            Or you can pass the name of the icon itself such as:
            "C:\MyApplication\Icons\MyIcon.ico".
  Note: You may have to re-boot the PC before the associated icon will
        change.
  Note: When end user double clicks on the registered file type, your .exe
        will launch, and the file name will be passed via ParamStr(1).
        (If the file name contains spaces, then it may also be passed in
         ParamStr(2), etc.)
}
var
  sFileClass, sFileExt: string;
begin
  Result := False;

  sFileExt := Trim(aFileExt);

  if (sFileExt = '') then
    Exit;

  if (sFileExt[1] <> '.') then
    sFileExt := '.' + sFileExt;

  sFileClass := Copy(sFileExt, 2, Length(sFileExt)) + 'file';

  with TRegistry.Create do begin
    try
      RootKey := HKEY_CLASSES_ROOT;

      if OpenKey(sFileExt, True) then begin
        WriteString('', sFileClass);
        CloseKey;
      end;

      if OpenKey(sFileClass, True) then begin
        WriteString('', aFileDesc);
        CloseKey;
      end;

      if OpenKey(sFileClass + '\Shell\Open', True) then begin
        WriteString('', '&Open');
        CloseKey;
      end;

      if OpenKey(sFileClass + '\Shell\Open\command', True) then begin
        WriteString('', aExeName + ' %1');
        CloseKey;
        Result := True;
      end;

      {Register an icon file with the application.}
      if OpenKey(sFileClass + '\DefaultIcon', True) then begin
        WriteString('', aFileIcon);
        CloseKey;
      end;

    finally
      Free;
    end;
  end;
end;


{ TFaceRecord }

constructor TFaceRecord.Create(fPoints: T3DPointArray; xColor: Tcolor; xType:TFaceType; xsize:Double=0.1;oTrans:Boolean=False; aFigure: TObject = nil; aComponID: Integer = 0);
var
  pCnt, i: Integer;
begin
  inherited Create;
  SetLength(PointsForNormal, 0);
  pCnt := Length(fPoints);
  SetLength(Points,pCnt);
  for i := 0 to pCnt - 1 do
    Points[i] := fPoints[i];
  Color := xColor;
  RecType := xType;
  Normal := DoublePOint(0,0,1);
  Size := xSize;
  Trans := False;
  OpTrans := oTrans;
  FFigure := aFigure;
  FFaceWallType := fwtNone;
  FWallSideType := wstNone;
  FComponID := aComponID;
  FTreeNode := nil;
// 22.07.2011
  F3DObject := nil;
end;
Destructor TFaceRecord.Destroy;
begin
  FFigure := nil;
  SetLength(Points, 0);
  SetLength(PointsForNormal, 0);
  inherited;
end;

procedure GetVerInfo(forModule: tHandle; var V1, V2, V3, V4: Word);
var
  VerInfoSize: {$IFDEF WIN32} DWORD {$ELSE} WORD {$ENDIF};
  VerInfo:Pointer;
  VerValueSize: {$IFDEF WIN32} DWORD {$ELSE} WORD {$ENDIF};
  VerValue:{$IFDEF WIN32} PVSFixedFileInfo {$ELSE} Pvs_FixedFileInfo
{$ENDIF};
  Dummy:{$IFDEF WIN32}DWORD{$ELSE}Longint{$ENDIF};
  ForFile: pChar;//array[0..max_path] of char;
  fName: String;
begin
  V1 := 0;
  V2 := 0;
  V3 := 0;
  V4 := 0;
  //if forModule = 0 then exit;
  //if GetModuleFilename(forModule,@ForFile,max_path)  = 0 then exit;
  fName := application.ExeName;
  ForFile := pChar(fName);
  VerInfoSize := GetFileVersionInfoSize(ForFile, Dummy);
  if VerInfoSize  = 0 then exit;
  GetMem(VerInfo, VerInfoSize);
  GetFileVersionInfo(ForFile, 0, VerInfoSize, VerInfo);
  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  with VerValue^ do
  begin
    V1 := dwFileVersionMS shr 16;
    V2 := dwFileVersionMS and $FFFF;
    V3 := dwFileVersionLS shr 16;
    V4 := dwFileVersionLS and $FFFF;
  end;
  FreeMem(VerInfo, VerInfoSize);
end;

Function Like(s1,s2:String):Boolean;
var sarr1,sarr2:TStringArray;
begin
  s1 := uppercase(Trim(s1));
  s2 := uppercase(Trim(s2));
  result := (s1 =s2);

  if not result then begin
    splitstr(s1,sarr1,' ');
    splitstr(s2,sarr2,' ');
    if (length(sarr1) > 0) and (length(sarr2) > 0) then
      result := (sarr1[0] = sarr2[0]);
  end;
end;

Function GetPointsDist(Points:TDoublePOintArr):Double;
var i,k,cnt:Integer;
    len:Double;
    p1,p2:TDoublePoint;
begin
  result := 0;
  cnt := Length(points);
  for i := 0 to cnt-2 do begin
    p1 := Points[i];
    for k := i+1 to cnt-1 do
    begin
      p2 := points[k];
      len := GetLineLength(p1,p2,false);
      if len > result then result := len;
    end;
  end;
end;

Const
   HexDigits:String = '0123456789ABCDEF';


Function ByteToHexStr(val:Byte):String;
var c1,c2: Byte;
begin
  c2 := val div 16;
  c1 := val mod 16;
  result := HexDigits[c2+1]+HexDigits[c1+1];
end;


Function GetHexVal(str:String):Byte;
begin
  if str = '0' then result := 0
  else if str = '1' then result := 1
  else if str = '2' then result := 2
  else if str = '3' then result := 3
  else if str = '4' then result := 4
  else if str = '5' then result := 5
  else if str = '6' then result := 6
  else if str = '7' then result := 7
  else if str = '8' then result := 8
  else if str = '9' then result := 9
  else if str = 'A' then result := 10
  else if str = 'B' then result := 11
  else if str = 'C' then result := 12
  else if str = 'D' then result := 13
  else if str = 'E' then result := 14
  else if str = 'F' then result := 15;

end;

Function HexStrToByte(val:String):Byte;
var c1,c2: String;
begin

  c2 := val[1];
  c1 := val[2];
  result :=  GetHexVal(c2)*16+GetHexVal(c1);

end;

function RefToCell(ARow, ACol: Integer): string;
var ch: AnsiChar;
begin
  Ch := 'A';
  //Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
  Result := String(AnsiChar(ORD(Ch) + ACol - 1) + IntToStr(ARow));
end;

function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
const
  xlWBATWorksheet = -4167;
var
  Row, Col: Integer;
  GridPrevFile: string;
  XLApp, Sheet, Data: OLEVariant;
  i, j: Integer;
  cText: String;
begin
  // Prepare Data
  Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
  for i := 0 to AGrid.ColCount - 1 do
    for j := 0 to AGrid.RowCount - 1 do
    begin
      cText := AGrid.Cells[i, j];
      cText := StringReplace(cText,'<B>','',[rfReplaceAll]);
      cText := StringReplace(cText,'<C>','',[rfReplaceAll]);
      cText := StringReplace(cText,'<L>','',[rfReplaceAll]);
      cText := StringReplace(cText,'<I>','',[rfReplaceAll]);
      cText := StringReplace(cText,'YTL','',[rfReplaceAll]);
      cText := StringReplace(cText,'.','',[rfReplaceAll]);
      cText := StringReplace(cText,',','.',[rfReplaceAll]);
      Data[j + 1, i + 1] := cText;
    end;
  // Create Excel-OLE Object
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    XLApp.Visible := True;
    // Add new Workbook
    XLApp.Workbooks.Add(xlWBatWorkSheet);
    Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet.Name := ASheetName;
    // Fill up the sheet
    Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
      AGrid.ColCount)].Value := Data;
    // Save Excel Worksheet
    try
      XLApp.Workbooks[1].SaveAs(AFileName);
      Result := True;
    except
      // Error ?
    end;
  finally
    // Quit Excel
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.DisplayAlerts := False;
      //XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;

procedure PrintGrid(sGrid: TStringGrid; sTitle: string);
var
  X1, X2: Integer;
  Y1, Y2: Integer;
  TmpI: Integer;
  F: Integer;
  TR: TRect;
  cText: String;
begin
  Printer.Title := sTitle;
  Printer.BeginDoc;
  Printer.Canvas.Pen.Color  := 0;
  Printer.Canvas.Font.Name  := 'Times New Roman';
  Printer.Canvas.Font.Size  := 12;
  Printer.Canvas.Font.Style := [fsBold, fsUnderline];
  Printer.Canvas.TextOut(0, 100, Printer.Title);
  for F := 1 to sGrid.ColCount - 1 do 
  begin
    X1 := 0;
    for TmpI := 1 to (F - 1) do
      X1 := X1 + 5 * (sGrid.ColWidths[TmpI]);
    Y1 := 300;
    X2 := 0;
    for TmpI := 1 to F do
      X2 := X2 + 5 * (sGrid.ColWidths[TmpI]);
    Y2 := 450;
    TR := Rect(X1, Y1, X2 - 30, Y2);
    Printer.Canvas.Font.Style := [fsBold];
    Printer.Canvas.Font.Size := 7;
    Printer.Canvas.TextRect(TR, X1 + 50, 350, sGrid.Cells[F, 0]);
    Printer.Canvas.Font.Style := [];
    for TmpI := 1 to sGrid.RowCount - 1 do 
    begin
      Y1 := 150 * TmpI + 300;
      Y2 := 150 * (TmpI + 1) + 300;
      TR := Rect(X1, Y1, X2 - 30, Y2);
      cText := sGrid.Cells[F, TmpI];
      cText := StringReplace(cText,'<B>','',[rfReplaceAll]);
      cText := StringReplace(cText,'<C>','',[rfReplaceAll]);
      cText := StringReplace(cText,'<L>','',[rfReplaceAll]);
      cText := StringReplace(cText,'<I>','',[rfReplaceAll]);
      cText := StringReplace(cText,'YTL','',[rfReplaceAll]);

      Printer.Canvas.TextRect(TR, X1 + 50, Y1 + 50,cText );
    end;
  end;
  Printer.EndDoc;
end;

Function InttoStrL(val:integer; sCount:Integer):String;
var l,i:Integer;
begin
  result := inttostr(val);
  l:= Length(result);
  for i:= 1 to sCount-l do Result := '0'+Result;
end;

Function LeadStr(val:String; sCount:Integer):String;
var l,i:Integer;
begin
  result := val;
  l:= Length(result);
  for i:= 1 to sCount-l do Result := '0'+Result;
end;

Function FormatSqlDate(xDate:Integer):Integer;
begin
  result := StrToInt(FormatDateTime('yyyymmdd',xDate));
end;

Function GetGradStyle(brStyle: Byte):TGradStyle;
begin
  if brStyle = ord(bsHorzGrad) then begin
    result := gsLineHorz;
  end else if brStyle = ord(bsVertGrad) then begin
    result := gsLineVert;
  end else if brStyle = ord(bsRadGrad) then begin
    result := gsRadCenter;
  end else if brStyle = ord(bsDiagFGrad) then begin
    result := gsDiagLineF;
  end else if brStyle = ord(bsDiagBGrad) then begin
    result := gsDiagLineB;
  end else if brStyle = ord(bsMirrorGrad) then begin
    result := gsMirrored;
  end else begin
    result := gsNoGrad;
  end;
end;

Function GetTextureStyle(brStyle: Byte):TTextureStyle;
begin
  if brStyle = ord(bstxtNewsPrint) then begin
    result := txtNewsPrint;
  end else if brStyle = ord(bstxtStationery) then begin
    result := txtStationery;
  end else if brStyle = ord(bstxtWhiteMarble) then begin
    result := txtWhiteMarble;
  end else if brStyle = ord(bstxtWovenMat) then begin
    result := txtWovenMat;
  end else if brStyle = ord(bstxtPaperBag) then begin
    result := txtPaperBag;
  end else if brStyle = ord(bstxtMediumWood) then begin
    result := txtMediumWood;
  end else begin
    result := txtNone;
  end;
end;

Function GetHatchStyle(brStyle: Byte):THatchStyle;
begin
  if brStyle = ord(bsSolid) then begin
    result := hsNone;
  end else if brStyle = ord(bsClear) then begin
    result := hsNone;
  end else if brStyle = ord(bsHorizontal) then begin
    result := hsHorizontal;
  end else if brStyle = ord(bsVertical) then begin
    result := hsVertical;
  end else if brStyle = ord(bsFDiagonal) then begin
    result := hsLDiagonal;
  end else if brStyle = ord(bsBDiagonal) then begin
    result := hsRDiagonal;
  end else if brStyle = ord(bsCross) then begin
    result := hsCross;
  end else if brStyle = ord(bsDiagCross) then begin
    result := hsDCross;
  end else begin
    result := hsNone;
  end;
end;

Function GetFillType(brStyle: Byte):TFillType;
begin
  if brStyle = ord(bsSolid) then begin
    result := fsSolid;
  end else if brStyle = ord(bsClear) then begin
    result := fsNone;
  end else if brStyle = ord(bsExHatch) then begin
    result := fsHatch;
  end else if brStyle = ord(bsExGrad) then begin
    result := fsGradient;
  end else if brStyle = ord(bsExTexture) then begin
    result := fsTexture;
  end else if brStyle = ord(bsHorizontal) then begin
    result := fsHatch;
  end else if brStyle = ord(bsVertical) then begin
    result := fsHatch;
  end else if brStyle = ord(bsFDiagonal) then begin
    result := fsHatch;
  end else if brStyle = ord(bsBDiagonal) then begin
    result := fsHatch;
  end else if brStyle = ord(bsCross) then begin
    result := fsHatch;
  end else if brStyle = ord(bsDiagCross) then begin
    result := fsHatch;
  end else if brStyle = ord(bsHorzGrad) then begin
    result := fsGradient;
  end else if brStyle = ord(bsVertGrad) then begin
    result := fsGradient;
  end else if brStyle = ord(bsRadGrad) then begin
    result := fsGradient;
  end else if brStyle = ord(bsDiagFGrad) then begin
    result := fsGradient;
  end else if brStyle = ord(bsDiagBGrad) then begin
    result := fsGradient;
  end else if brStyle = ord(bsMirrorGrad) then begin
    result := fsGradient;
  end else if brStyle = ord(bstxtNewsPrint) then begin
    result := fsTexture;
  end else if brStyle = ord(bstxtStationery) then begin
    result := fsTexture;
  end else if brStyle = ord(bstxtWhiteMarble) then begin
    result := fsTexture;
  end else if brStyle = ord(bstxtWovenMat) then begin
    result := fsTexture;
  end else if brStyle = ord(bstxtPaperBag) then begin
    result := fsTexture;
  end else if brStyle = ord(bstxtMediumWood) then begin
    result := fsTexture;
  end;
end;


Function FirstWords(Str:String; cnt:Integer):String;
var s: TStringArray;
    xCnt,i:Integer;
begin
  result := '';
  str := stringreplace(str,'  ',' ',[rfReplaceAll]);
  SplitStr(str,s,' ');
  xCnt := 0;
  for i := 0 to Length(s)-1 do
  begin
    if (Trim(s[i]) <> '') then begin
      if xCnt < Cnt then begin
        result := result+' '+s[i];
        xcnt := xcnt+1;
      end else begin
        break;
      end;
    end;
  end;
end;

Procedure DrawTraceText(x,y:Integer;Color:TColor;
                        Text,FontName:String;FontSize:Integer;Canvas:TCanvas);
var bmp: Graphics.Tbitmap;
begin
  bmp := Graphics.Tbitmap.Create;
  bmp.Canvas.Font.Name := FontName;
  bmp.Canvas.Font.Size := FontSize;
  bmp.Width := bmp.Canvas.TextWidth(text)+10;
  bmp.Height := bmp.Canvas.TextHeight(text)+10;;
  bmp.Canvas.Brush.Color := clBlack;
  bmp.Canvas.Brush.Style := bsSolid;
  bmp.Canvas.FillRect(Rect(0,0,bmp.Width,bmp.Height));

  bmp.Canvas.Font.Color := Color;
  bmp.Canvas.TextOut(0,0,Text);

  Canvas.CopyMode := SRCINVERT;
  Canvas.Draw(x,y,bmp);
  bmp.Free;
  Canvas.CopyMode := SRCCOPY;
end;

Function Obeb(a,b:Integer):Integer;
var x: Integer;
begin
  if a < b then begin
    x := a;
    a := b;
    b := x;
  end;
  x := 1;

  repeat
    x := a mod b;
    if x > 0 then begin
      a := b;
      b := x;
    end;
  until x = 0;
  result := b;
end;

procedure PrinterCustomSize(w,h: Integer);
var 
   Device : array[0..255] of char; 
   Driver : array[0..255] of char; 
   Port   : array[0..255] of char; 
   hDMode : THandle; 
   PDMode : PDEVMODE; 
begin 
  Printer.PrinterIndex := Printer.PrinterIndex; 
  Printer.GetPrinter(Device, Driver, Port, hDMode); 
  if hDMode <> 0 then begin 
    pDMode := GlobalLock(hDMode); 
    if pDMode <> nil then begin 


     // set as legal legal 
      //pDMode^.dmFields := pDMode^.dmFields or dm_PaperSize;
      //pDMode^.dmPaperSize := DMPAPER_LEGAL;


      // set to custom size 
      pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE or DM_PAPERWIDTH or  DM_PAPERLENGTH;
      pDMode^.dmPaperSize := DMPAPER_USER;
      pDMode^.dmPaperWidth  := w;    // SomeValueInTenthsOfAMillimeter
      pDMode^.dmPaperLength := h;    // SomeValueInTenthsOfAMillimeter


      //Set the bin to use
      //pDMode^.dmFields := pDMode^.dmFields or BinNumber;
      //pDMode^.dmDefaultSource := BinNumber;


      GlobalUnlock(hDMode);
    end;
  end;
end;

(*************************************************************************

   * FUNCTION:   CCW (CounterClockWise)
   *
   * PURPOSE
   * Determines, given three points, if when travelling from the first to
   * the second to the third, we travel in a counterclockwise direction.
   *
   * RETURN VALUE
   * (int) 1 if the movement is in a counterclockwise direction, -1 if
   * not.
 *************************************************************************)

  Function CCW(p0,p1,p2:TDoublePoint):Integer;

  var
   m1,m2: Double;
   dx1, dx2 :Double;
   dy1, dy2 :Double;
  begin
   dx1 := p1.x - p0.x ; dx2 := p2.x - p0.x ;
   dy1 := p1.y - p0.y ; dy2 := p2.y - p0.y ;
   m1 := dx1 * dy2;
   m2 := dy1 * dx2;
   if m1 > m2 then result := 1 else result := -1;
  end;

(*************************************************************************
   * FUNCTION:   Intersect
   *
   * PURPOSE
   * Given two line segments, determine if they intersect.
   *
   * RETURN VALUE
   * TRUE if they intersect, FALSE if not.
 *************************************************************************)

  Function Intersect(p1,p2,p3,p4:TDoublePoint):Boolean;
  var
    c1,c2,c3,c4: Integer;
  begin
    c1 := CCW(p1, p2, p3);
    c2 := CCW(p1, p2, p4);
    c3 := CCW(p3, p4, p1);
    c4 := CCW(p3, p4, p2);

    result := (( c1 * c2) <= 0) and (( c3 * c4)  <= 0) ;

   end;



 (*************************************************************************

   * FUNCTION:   G_PtInPolygon
   *
   * PURPOSE
   * This routine determines if the point passed is in the polygon. It uses

   * the classical polygon hit-testing algorithm: a horizontal ray starting

   * at the point is extended infinitely rightwards and the number of
  * polygon edges that intersect the ray are counted. If the number is odd,

   * the point is inside the polygon.
   *
   * RETURN VALUE
   * (BOOL) TRUE if the point is inside the polygon, FALSE if not.
 *************************************************************************)

Function PtInPolygon(POINTS:TDoublePointArr; ptTest:TDoublePoint):Boolean;
var
  wnumpts,i,wnumintsct:Integer;
  pt1,pt2,ppt :TDoublePoint;
  r: TDoubleRect;
  bx,by,sx,sy: Double;

begin
  wnumintsct := 0 ;
  wnumpts := Length(Points);
  result := false;
  if wnumpts < 3 then exit;
  pt1 := ptTest;
  pt2 := ptTest;
  GetPolylineBounds(points,bx,by,sx,sy);
  r := DoubleRect(sx,sy,bx,by);
  if not PointInRect(ptTest,r) then begin
    result := false;
    exit;
  end;

  pt2.x := r.right + 50 ;

  for i := 0 to wnumpts-2 do
  begin
   if Intersect(ptTest,pt2,points[i],points[i+1]) then inc(wnumintsct);
  end;
  // And the last line
  if Intersect(ptTest, pt2, points[0], points[wnumpts-1]) then inc(wnumintsct);
  result := odd(wnumintsct);

end;

function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;
var
  I,X: Integer;
  Len, LenSubStr: Integer;
begin
  if Offset = 1 then
    Result := Pos(SubStr, S)
  else
  begin
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S) - LenSubStr + 1;
    while I <= Len do
    begin
      if S[I] = SubStr[1] then
      begin
        X := 1;
        while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
          Inc(X);
        if (X = LenSubStr) then
        begin
          Result := I;
          exit;
        end;
      end;
      Inc(I);
    end;
    Result := 0;
  end;
end;

Function SplitWebTable(WebText:String; var TableArr: TWebTableArr):Integer;
var p,pOld,i,k,j:Integer;
ucWebText,xText,table,row,col: String;
xList: TStringList;
sArr,sArr1,sArr2: TStringArray;
begin
  result := 0;
  ucWebtext := UpperCase(Webtext);
  p := Pos('<TABLE',ucWebText);
  if p = 0 then exit;
  WebText := Copy(Webtext,p,Length(WebText));
  ucWebtext := UpperCase(Webtext);
  p := 0;
  repeat
    pOld := p;
    p := PosEx('</TABLE>',ucWebText,p+8);
  until p = 0;
  p := pOld;
  if p = 0 then exit;
  WebText := Copy(Webtext,1,p+7);
  //xList := TStringList.Create;
  WebText := StringReplace(WebText,'|','-',[rfReplaceAll]);
  WebText := StringReplace(WebText,'<TABLE','|<TABLE',[rfReplaceAll, rfIgnoreCase]);
  SplitStr(WebText,sArr,'|');
  if Length(sArr) = 0 then exit;
  Setlength(TableArr,Length(SArr));
  for i := 0 to Length(sArr)-1 do
  begin
    table := sArr[i];
    table := StringReplace(table,'<TR','|<TR',[rfReplaceAll, rfIgnoreCase]);
    SplitStr(table,sArr1,'|');
    SetLength(tableArr[i],Length(sArr1));
    for k := 0 to Length(sArr1)-1 do
    begin
      row := sArr1[k];
      row := StringReplace(row,'<TD','|<TD',[rfReplaceAll, rfIgnoreCase]);
      SplitStr(row,sArr2,'|');
      SetLength(tableArr[i][k],Length(sArr2));
      for j := 0 to Length(sArr2)-1 do
      begin
        TableArr[i][k][j] := RemoveTags(sArr2[j],false);
        //xList.Add(inttostr(i)+','+inttostr(k)+','+inttostr(j)+' '+TableArr[i][k][j]);
      end;
    end;
  end;
  //xList.SaveToFile('c:\webtext.txt');

end;

function RemoveTags(str: String; rtf: Boolean): String;
var ok: Boolean;
p,pe: Integer;
s: String;
sx: String;
ch: Integer;
chs: string;
chars: TStringlist;
len,i: Integer;
begin
  str := removeblocks(str,'<script','</script>');
  str := removeblocks(str,'<style>','</style>');
  str := StringReplace(str,'&copy;','©',[rfReplaceAll, rfIgnoreCase]);
  str := StringReplace(str,'&amp;','&',[rfReplaceAll, rfIgnoreCase]);
  str := StringReplace(str,#160,'',[rfReplaceAll, rfIgnoreCase]);
  chars := TstringList.Create;
  ok := false;
  s := str;
  repeat
    p := pos('&#',s);
    if p > 0 then begin
      sx := copy(s,p,Length(s));
      pe := pos(';',sx);
      if pe > 0 then
      begin
        chs := copy(sx,3,pe-3);
        ch := StrToIntDef(chs,0);
        if ch > 0 then begin
          chars.Add(chs);
        end;
        s := copy(sx,pe+1,length(sx));
      end
      else ok := true;

    end else ok := true;
  until ok;

  for i := 0 to chars.Count-1 do
  begin
    chs := '&#'+chars[i]+';';
    str := StringReplace(str,chs,chr(StrToIntDef(chars[i],0)),[rfReplaceAll, rfIgnoreCase]);
  end;

  str := StringReplace(str,'’','''',[rfReplaceAll, rfIgnoreCase]);
  str := StringReplace(str,'”','"',[rfReplaceAll, rfIgnoreCase]);
  str := StringReplace(str,'“','"',[rfReplaceAll, rfIgnoreCase]);


  if rtf then begin
    str := StringReplace(str,'<tr>','\par',[rfReplaceAll, rfIgnoreCase]);
    str := StringReplace(str,'<table ','\par<table',[rfReplaceAll, rfIgnoreCase]);
    str := StringReplace(str,'</p>','\par',[rfReplaceAll, rfIgnoreCase]);
    str := StringReplace(str,'<p>','\par',[rfReplaceAll, rfIgnoreCase]);
    str := StringReplace(str,'<br>','\par',[rfReplaceAll, rfIgnoreCase]);
    str := StringReplace(str,'<b>','\b ' ,[rfReplaceAll, rfIgnoreCase]);
    str := StringReplace(str,'</b>','\b0 ' ,[rfReplaceAll, rfIgnoreCase]);
  end;
  ok := false;
  s := str;
  repeat
    p := pos('<',s);
    if p > 0 then begin
      sx := copy(s,p+1,Length(s)-p);
      pe := pos('>',sx);
      if pe > 0 then
        s := copy(s,1,p-1)+''+copy(s,p+pe+1,length(s))
      else ok := true;
    end else ok := true;
  until ok;
  s := StringReplace(s,'&nbsp;',' ',[rfReplaceAll, rfIgnoreCase]);
  s := StringReplace(s,'&nbsp',' ',[rfReplaceAll, rfIgnoreCase]);
  s := Trim(s);
  result := s;
  chars.Free; // Tolik 21/05/2018 --
end;

Function RemoveBlocks(str:String; s1,s2: String):String;
var p,pe: Integer;
    s: string;
    ok: boolean;
    sx: string;
begin
  s1 := trim(s1);
  s2 := trim(s2);
  if (s1 = '') and (s2 = '') then
  begin
    result := str;
  end else if (s1 = '') then begin
    result := StringReplace(str,s2,'',[rfReplaceAll, rfIgnoreCase]);
  end else if (s2 = '') then begin
    result := StringReplace(str,s1,'',[rfReplaceAll, rfIgnoreCase]);
  end else if (s1=s2) then begin
    result := StringReplace(str,s1,'',[rfReplaceAll, rfIgnoreCase]);
  end else begin
    ok := false;
    s := str;
    repeat
      p := Pos(lowercase(s1),lowercase(s));
      if p > 0 then begin
        sx := Copy(s,p+Length(s1),Length(s));
        pe := pos(lowercase(s2),lowercase(sx));
        if pe > 0 then begin
          pe := pe+p+length(s1)-1;
          s := copy(s,1,p-1)+' '+copy(s,pe+length(s2),length(s));
        end else ok := true;
      end else ok := true;
    until ok;
    result := s;
  end;
end;

function GetAreaFromPolygon(APolygon: TDoublePointArr): Double;
var
  i, j: Integer;
  HighP: Integer;
begin
  Result := 0;
  HighP := High(APolygon);
  for i := Low(APolygon) to HighP do
  begin
    if i = HighP then
      j := 0
    else
      j := i+1;

    Result := Result + ((APolygon[i].x * APolygon[j].y) - (APolygon[j].x * APolygon[i].y));
  end;
  Result := abs(Result) / 2;
end;

function GetLineLength3D(p1, p2: T3DPoint): Double;
begin
  Result := sqrt(sqr(p2.x - p1.x)+sqr(p2.y - p1.y)+sqr(p2.z - p1.z));
end;



function GetTriangleArea3D(p1, p2, p3: T3DPoint): Double;
var
  len1, len2, len3: Double;
  p: Double;
begin
  Result := 0;
  len1 := GetLineLength3D(p1, p2);
  len2 := GetLineLength3D(p2, p3);
  len3 := GetLineLength3D(p3, p1);
  p := (len1 + len2 + len3) / 2;
  Result := SQRT(p*(p-len1) * (p-len2) * (p-len3));
end;

function IsPointNear(APointX, ApointY, ANearX, ANearY: Double): Boolean;
var
  pdim : Double;
begin

end;

procedure DeletePointFromArray(var Arr: TDoublePointArr; Index: Integer);
begin
  if Index < Length(Arr) then
  begin
    System.Move(Arr[Index + 1], Arr[Index],
      (Length(Arr) - Index) * SizeOf(TDoublePoint));
    SetLength(Arr, Length(Arr)-1);
  end;
end;

initialization
  {$ifdef demo}
    if not delphiloaded then application.terminate;
  {$endif demo}
  figureclasses := TList.create;
  FigureClassesSL := TStringList.Create; //01.11.2011
  FigureClassesSL.Sorted := true;
  OsVersion.dwOSVersionInfoSize := SizeOf(OSVersion);
  getVersionEx(OSVersion);
  TextureBmp := Graphics.TBitmap.Create;
  TextureBmp.LoadFromResourceName(hInstance, 'textures');
  Randomize;
finalization
  figureclasses.free;
  FigureClassesSL.Free; //01.11.2011
  TextureBmp.Free;
end.

