123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055 |
- {
- This file is part of the Free Pascal run time library.
- Copyright (c) 2002 by Florian Klaempfl,
- member of the Free Pascal development team.
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- {$MODE OBJFPC}
- {$IFNDEF FPC_DOTTEDUNITS}
- unit Types;
- {$ENDIF FPC_DOTTEDUNITS}
- interface
- {$modeswitch advancedrecords}
- {$modeswitch class}
- {$if defined(win32) or defined(win64) or defined(wince)}
- uses
- {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows;
- {$elseif defined(win16)}
- uses
- {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}WinTypes;
- {$endif}
- {$if defined(win32) or defined(win64)}
- const
- RT_RCDATA = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.RT_RCDATA deprecated 'Use Windows.RT_RCDATA instead';
- {$elseif defined(win16)}
- const
- RT_RCDATA = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}WinTypes.RT_RCDATA deprecated 'Use WinTypes.RT_RCDATA instead';
- {$endif}
- Const
- Epsilon: Single = 1E-40;
- Epsilon2: Single = 1E-30;
- CurveKappa = 0.5522847498;
- CurveKappaInv = 1 - CurveKappa;
- type
- TEndian = Objpas.TEndian;
- TDirection = (FromBeginning, FromEnd);
- TValueRelationship = -1..1;
- const
- LessThanValue = Low(TValueRelationship);
- EqualsValue = 0;
- GreaterThanValue = High(TValueRelationship);
- type
- DWORD = LongWord;
- PLongint = System.PLongint;
- PSmallInt = System.PSmallInt;
- {$ifndef FPUNONE}
- PDouble = System.PDouble;
- {$endif}
- PByte = System.PByte;
- Largeint = int64;
- LARGE_INT = LargeInt;
- PLargeInt = ^LargeInt;
- LargeUint = qword;
- LARGE_UINT= LargeUInt;
- PLargeuInt = ^LargeuInt;
- { Null dummy type, for compile time null passing }
- TNullPtr = record
- { Some operators to make it (more or less) nil compatible }
- class operator :=(None: TNullPtr): Pointer; inline;
- class operator :=(None: TNullPtr): TObject; inline;
- class operator =(LHS: TNullPtr; RHS: Pointer): Boolean; inline;
- class operator =(LHS: TNullPtr; RHS: TObject): Boolean; inline;
- class operator =(LHS: Pointer; RHS: TNullPtr): Boolean; inline;
- class operator =(LHS: TObject; RHS: TNullPtr): Boolean; inline;
- class operator <>(LHS: TNullPtr; RHS: Pointer): Boolean; inline;
- class operator <>(LHS: TNullPtr; RHS: TObject): Boolean; inline;
- class operator <>(LHS: Pointer; RHS: TNullPtr): Boolean; inline;
- class operator <>(LHS: TObject; RHS: TNullPtr): Boolean; inline;
- end;
- {$Push}
- {$WriteableConst Off}
- const
- NullPtr: TNullPtr = ();
- {$Pop}
- type
- TBooleanDynArray = array of Boolean;
- TByteDynArray = array of Byte;
- TClassicByteDynArray = TByteDynArray;
- TCardinalDynArray = array of Cardinal;
- TInt64DynArray = array of Int64;
- TIntegerDynArray = array of Integer;
- TLongWordDynArray = array of LongWord;
- TPointerDynArray = array of Pointer;
- TQWordDynArray = array of QWord;
- TShortIntDynArray = array of ShortInt;
- TSmallIntDynArray = array of SmallInt;
- TRTLStringDynArray = array of RTLString;
- TAnsiStringDynArray = Array of AnsiString;
- TWideStringDynArray = array of WideString;
- TUnicodeStringDynArray = array of UnicodeString;
- {$if SIZEOF(CHAR)=2}
- TStringDynArray = Array of UnicodeString;
- {$ELSE}
- TStringDynArray = Array of AnsiString;
- {$ENDIF}
- TClassicStringDynArray = TStringDynArray;
- TObjectDynArray = array of TObject;
- TWordDynArray = array of Word;
- TCurrencyArray = Array of currency;
- {$ifndef FPUNONE}
- TSingleDynArray = array of Single;
- TDoubleDynArray = array of Double;
- TExtendedDynArray = array of Extended;
- TCompDynArray = array of Comp;
- {$endif}
- {$if defined(win32) or defined(win64) or defined(wince)}
- TArray4IntegerType = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TArray4IntegerType;
- TSmallPoint = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TSmallPoint;
- PSmallPoint = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.PSmallPoint;
- TSize = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TSize;
- TagSize = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.tagSize deprecated;
- PSize = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.PSize;
- TPoint = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TPoint;
- TagPoint = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TagPoint deprecated;
- PPoint = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.PPoint;
- TRect = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TRect;
- PRect = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.PRect;
- TSplitRectType = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TSplitRectType;
- const
- srLeft = TSplitRectType.srLeft;
- srRight = TSplitRectType.srRight;
- srTop = TSplitRectType.srTop;
- srBottom = TSplitRectType.srBottom;
- type
- {$else}
- {$i typshrdh.inc}
- TagSize = tSize deprecated;
- TagPoint = TPoint deprecated;
- {$endif}
- { TPointF }
- PPointF = ^TPointF;
- TPointF =
- {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
- packed
- {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
- record
- x,y : Single;
- public
- function Add(const apt: TPoint): TPointF;
- function Add(const apt: TPointF): TPointF;
- function Distance(const apt : TPointF) : Single;
- function DotProduct(const apt : TPointF) : Single;
- function IsZero : Boolean;
- function Subtract(const apt : TPointF): TPointF;
- function Subtract(const apt : TPoint): TPointF;
- procedure SetLocation(const apt :TPointF);
- procedure SetLocation(const apt :TPoint);
- procedure SetLocation(ax,ay : Single);
- procedure Offset(const apt :TPointF);
- procedure Offset(const apt :TPoint);
- procedure Offset(dx,dy : Single);
- function EqualsTo(const apt: TPointF; const aEpsilon : Single): Boolean; overload;
- function EqualsTo(const apt: TPointF): Boolean; overload;
- function Scale (afactor:Single) : TPointF;
- function Ceiling : TPoint;
- function Truncate: TPoint;
- function Floor : TPoint;
- function Round : TPoint;
- function Length : Single;
-
- function Rotate(angle: single): TPointF;
- function Reflect(const normal: TPointF): TPointF;
- function MidPoint(const b: TPointF): TPointF;
- class function PointInCircle(const pt, center: TPointF; radius: single): Boolean; static;
- class function PointInCircle(const pt, center: TPointF; radius: integer): Boolean; static;
- class function Zero: TPointF; inline; static;
- function Angle(const b: TPointF): Single;
- function AngleCosine(const b: TPointF): single;
- function CrossProduct(const apt: TPointF): Single;
- function Normalize: TPointF;
- function ToString(aSize,aDecimals : Byte) : RTLString; overload;
- function ToString : RTLString; overload; inline;
- class function Create(const ax, ay: Single): TPointF; overload; static; inline;
- class function Create(const apt: TPoint): TPointF; overload; static; inline;
- class operator = (const apt1, apt2 : TPointF) : Boolean;
- class operator <> (const apt1, apt2 : TPointF): Boolean;
- class operator + (const apt1, apt2 : TPointF): TPointF;
- class operator - (const apt1, apt2 : TPointF): TPointF;
- class operator - (const apt1 : TPointF): TPointF;
- class operator * (const apt1, apt2: TPointF): TPointF;
- class operator * (const apt1: TPointF; afactor: single): TPointF;
- class operator * (afactor: single; const apt1: TPointF): TPointF;
- class operator / (const apt1: TPointF; afactor: single): TPointF;
- class operator := (const apt: TPoint): TPointF;
- class operator ** (const apt1, apt2: TPointF): Single; // scalar product
- end;
- { TSizeF }
- PSizeF = ^TSizeF;
- TSizeF =
- {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
- packed
- {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
- record
- cx,cy : Single;
- public
- function Add(const asz: TSize): TSizeF;
- function Add(const asz: TSizeF): TSizeF;
- function Distance(const asz : TSizeF) : Single;
- function IsZero : Boolean;
- function Subtract(const asz : TSizeF): TSizeF;
- function Subtract(const asz : TSize): TSizeF;
- function SwapDimensions:TSizeF;
- function Scale (afactor:Single) : TSizeF;
- function Ceiling : TSize;
- function Truncate: TSize;
- function Floor : TSize;
- function Round : TSize;
- function Length : Single;
- function ToString(aSize,aDecimals : Byte) : RTLString; overload;
- function ToString : RTLString; overload; inline;
- class function Create(const ax, ay: Single): TSizeF; overload; static; inline;
- class function Create(const asz: TSize): TSizeF; overload; static; inline;
- class operator = (const asz1, asz2 : TSizeF) : Boolean;
- class operator <> (const asz1, asz2 : TSizeF): Boolean;
- class operator + (const asz1, asz2 : TSizeF): TSizeF;
- class operator - (const asz1, asz2 : TSizeF): TSizeF;
- class operator - (const asz1 : TSizeF): TSizeF;
- class operator * (const asz1: TSizeF; afactor: single): TSizeF;
- class operator * (afactor: single; const asz1: TSizeF): TSizeF;
- class operator := (const apt: TPointF): TSizeF;
- class operator := (const asz: TSize): TSizeF;
- class operator := (const asz: TSizeF): TPointF;
- property Width: Single read cx write cx;
- property Height: Single read cy write cy;
- end;
- {$SCOPEDENUMS ON}
- TVertRectAlign = (Center, Top, Bottom);
- THorzRectAlign = (Center, Left, Right);
- {$SCOPEDENUMS OFF}
- { TRectF }
- PRectF = ^TRectF;
- TRectF =
- {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
- packed
- {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
- record
- private
- function GetLocation: TPointF;
- function GetSize: TSizeF;
- procedure SetSize(AValue: TSizeF);
- function GetHeight: Single; inline;
- function GetWidth: Single; inline;
- procedure SetHeight(AValue: Single);
- procedure SetWidth (AValue: Single);
- public
- constructor Create(Origin: TPointF); // empty rect at given origin
- constructor Create(Origin: TPointF; AWidth, AHeight: Single);
- constructor Create(ALeft, ATop, ARight, ABottom: Single);
- constructor Create(P1, P2: TPointF; Normalize: Boolean = False);
- constructor Create(R: TRectF; Normalize: Boolean = False);
- constructor Create(R: TRect; Normalize: Boolean = False);
- class operator = (L, R: TRectF): Boolean;
- class operator <> (L, R: TRectF): Boolean;
- class operator + (L, R: TRectF): TRectF; // union
- class operator * (L, R: TRectF): TRectF; // intersection
- class operator := (const arc: TRect): TRectF;
- class function Empty: TRectF; static;
- class function Intersect(R1: TRectF; R2: TRectF): TRectF; static;
- class function Union(const Points: array of TPointF): TRectF; static;
- class function Union(R1, R2: TRectF): TRectF; static;
- Function Ceiling : TRectF;
- function CenterAt(const Dest: TRectF): TRectF;
- function CenterPoint: TPointF;
- function Contains(Pt: TPointF): Boolean;
- function Contains(R: TRectF): Boolean;
- function EqualsTo(const R: TRectF; const Epsilon: Single = 0): Boolean;
- function Fit(const Dest: TRectF): Single; deprecated 'Use FitInto';
- function FitInto(const Dest: TRectF): TRectF; overload;
- function FitInto(const Dest: TRectF; out Ratio: Single): TRectF; overload;
- function IntersectsWith(R: TRectF): Boolean;
- function IsEmpty: Boolean;
- function PlaceInto(const Dest: TRectF; const AHorzAlign: THorzRectAlign = THorzRectAlign.Center; const AVertAlign: TVertRectAlign = TVertRectAlign.Center): TRectF;
- function Round: TRect;
- function SnapToPixel(AScale: Single; APlaceBetweenPixels: Boolean = True): TRectF;
- function Truncate: TRect;
- procedure Inflate(DL, DT, DR, DB: Single);
- procedure Inflate(DX, DY: Single);
- procedure Intersect(R: TRectF);
- procedure NormalizeRect;
- procedure Offset (const dx,dy : Single); inline;
- procedure Offset (DP: TPointF); inline;
- procedure SetLocation(P: TPointF);
- procedure SetLocation(X, Y: Single);
- function ToString(aSize,aDecimals : Byte; aUseSize : Boolean = False) : RTLString; overload;
- function ToString(aUseSize : Boolean = False) : RTLString; overload; inline;
- procedure Union (const r: TRectF); inline;
- property Width : Single read GetWidth write SetWidth;
- property Height : Single read GetHeight write SetHeight;
- property Size : TSizeF read getSize write SetSize;
- property Location: TPointF read getLocation write setLocation;
- case Integer of
- 0: (Left, Top, Right, Bottom: Single);
- 1: (TopLeft, BottomRight: TPointF);
- end;
- TDuplicates = (dupIgnore, dupAccept, dupError);
- TPoint3D =
- {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
- packed
- {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
- record
- public
- Type TSingle3Array = array[0..2] of single;
- constructor Create(const ax,ay,az:single);
- procedure Offset(const adeltax,adeltay,adeltaz:single); inline;
- procedure Offset(const adelta:TPoint3D); inline;
- function ToString(aSize,aDecimals : Byte) : RTLString; overload;
- function ToString : RTLString; overload; inline;
- public
- case Integer of
- 0: (data:TSingle3Array);
- 1: (x,y,z : single);
- end;
- type
- TOleChar = WideChar;
- POleStr = PWideChar;
- PPOleStr = ^POleStr;
- TListCallback = procedure(data,arg:pointer) of object;
- TListStaticCallback = procedure(data,arg:pointer);
- const
- GUID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';
- STGTY_STORAGE = 1;
- STGTY_STREAM = 2;
- STGTY_LOCKBYTES = 3;
- STGTY_PROPERTY = 4;
- STREAM_SEEK_SET = 0;
- STREAM_SEEK_CUR = 1;
- STREAM_SEEK_END = 2;
- LOCK_WRITE = 1;
- LOCK_EXCLUSIVE = 2;
- LOCK_ONLYONCE = 4;
- STATFLAG_DEFAULT = 0;
- STATFLAG_NONAME = 1;
- STATFLAG_NOOPEN = 2;
- {$ifndef Wince}
- // in Wince these are in unit windows. Under 32/64 in ActiveX.
- // for now duplicate them. Not that bad for untyped constants.
- E_FAIL = HRESULT($80004005);
- E_INVALIDARG = HRESULT($80070057);
- STG_E_INVALIDFUNCTION = HRESULT($80030001);
- STG_E_FILENOTFOUND = HRESULT($80030002);
- STG_E_PATHNOTFOUND = HRESULT($80030003);
- STG_E_TOOMANYOPENFILES = HRESULT($80030004);
- STG_E_ACCESSDENIED = HRESULT($80030005);
- STG_E_INVALIDHANDLE = HRESULT($80030006);
- STG_E_INSUFFICIENTMEMORY = HRESULT($80030008);
- STG_E_INVALIDPOINTER = HRESULT($80030009);
- STG_E_NOMOREFILES = HRESULT($80030012);
- STG_E_DISKISWRITEPROTECTED = HRESULT($80030013);
- STG_E_SEEKERROR = HRESULT($80030019);
- STG_E_WRITEFAULT = HRESULT($8003001D);
- STG_E_READFAULT = HRESULT($8003001E);
- STG_E_SHAREVIOLATION = HRESULT($80030020);
- STG_E_LOCKVIOLATION = HRESULT($80030021);
- STG_E_FILEALREADYEXISTS = HRESULT($80030050);
- STG_E_INVALIDPARAMETER = HRESULT($80030057);
- STG_E_MEDIUMFULL = HRESULT($80030070);
- STG_E_PROPSETMISMATCHED = HRESULT($800300F0);
- STG_E_ABNORMALAPIEXIT = HRESULT($800300FA);
- STG_E_INVALIDHEADER = HRESULT($800300FB);
- STG_E_INVALIDNAME = HRESULT($800300FC);
- STG_E_UNKNOWN = HRESULT($800300FD);
- STG_E_UNIMPLEMENTEDFUNCTION = HRESULT($800300FE);
- STG_E_INVALIDFLAG = HRESULT($800300FF);
- STG_E_INUSE = HRESULT($80030100);
- STG_E_NOTCURRENT = HRESULT($80030101);
- STG_E_REVERTED = HRESULT($80030102);
- STG_E_CANTSAVE = HRESULT($80030103);
- STG_E_OLDFORMAT = HRESULT($80030104);
- STG_E_OLDDLL = HRESULT($80030105);
- STG_E_SHAREREQUIRED = HRESULT($80030106);
- STG_E_EXTANTMARSHALLINGS = HRESULT($80030108);
- STG_E_DOCFILECORRUPT = HRESULT($80030109);
- STG_E_BADBASEADDRESS = HRESULT($80030110);
- STG_E_INCOMPLETE = HRESULT($80030201);
- STG_E_TERMINATED = HRESULT($80030202);
- STG_S_CONVERTED = $00030200;
- STG_S_BLOCK = $00030201;
- STG_S_RETRYNOW = $00030202;
- STG_S_MONITORING = $00030203;
- {$endif}
- {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
- type
- PCLSID = PGUID;
- TCLSID = TGUID;
- PDWord = ^DWord;
- PDisplay = Pointer;
- PEvent = Pointer;
- TXrmOptionDescRec = record
- end;
- XrmOptionDescRec = TXrmOptionDescRec;
- PXrmOptionDescRec = ^TXrmOptionDescRec;
- Widget = Pointer;
- WidgetClass = Pointer;
- ArgList = Pointer;
- Region = Pointer;
- _FILETIME =
- {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
- packed
- {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
- record
- dwLowDateTime : DWORD;
- dwHighDateTime : DWORD;
- end;
- TFileTime = _FILETIME;
- FILETIME = _FILETIME;
- PFileTime = ^TFileTime;
- {$else}
- type
- PCLSID = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.PCLSID;
- TCLSID = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.CLSID;
- TFiletime = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TFileTime;
- Filetime = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.FileTime;
- PFiletime = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.PFileTime;
- {$endif Windows}
- type
- tagSTATSTG = record
- pwcsName : POleStr;
- dwType : DWord;
- cbSize : Large_uint;
- mtime : TFileTime;
- ctime : TFileTime;
- atime : TFileTime;
- grfMode : DWord;
- grfLocksSupported : DWord;
- clsid : TCLSID;
- grfStateBits : DWord;
- reserved : DWord;
- end;
- TStatStg = tagSTATSTG;
- STATSTG = TStatStg;
- PStatStg = ^TStatStg;
- { classes depends on these interfaces, we can't use the activex unit in classes though }
- IClassFactory = Interface(IUnknown) ['{00000001-0000-0000-C000-000000000046}']
- Function CreateInstance(Const unkOuter : IUnknown;Const riid : TGUID;Out vObject) : HResult;StdCall;
- Function LockServer(fLock : LongBool) : HResult;StdCall;
- End;
- ISequentialStream = interface(IUnknown)
- ['{0c733a30-2a1c-11ce-ade5-00aa0044773d}']
- function Read(pv : Pointer;cb : DWORD;pcbRead : PDWORD) : HRESULT;stdcall;
- function Write(pv : Pointer;cb : DWORD;pcbWritten : PDWORD): HRESULT;stdcall;
- end;
- IStream = interface(ISequentialStream) ['{0000000C-0000-0000-C000-000000000046}']
- function Seek(dlibMove : LargeInt; dwOrigin : DWORD; out libNewPosition : LargeUInt) : HResult;stdcall;
- function SetSize(libNewSize : LargeUInt) : HRESULT;stdcall;
- function CopyTo(stm: IStream;cb : LargeUInt;out cbRead : LargeUInt; out cbWritten : LargeUInt) : HRESULT;stdcall;
- function Commit(grfCommitFlags : DWORD) : HRESULT;stdcall;
- function Revert : HRESULT;stdcall;
- function LockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
- function UnlockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
- Function Stat(out statstg : TStatStg;grfStatFlag : DWORD) : HRESULT;stdcall;
- function Clone(out stm : IStream) : HRESULT;stdcall;
- end;
- function EqualRect(const r1,r2 : TRect) : Boolean;
- function EqualRect(const r1,r2 : TRectF) : Boolean;
- function NormalizeRectF(const Pts: array of TPointF): TRectF; overload;
- function NormalizeRect(const ARect: TRectF): TRectF; overload;
- function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
- function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
- function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
- function Point(x,y : Integer) : TPoint; inline;
- function PointF(x,y: Single) : TPointF; inline;
- function PtInRect(const Rect : TRect; const p : TPoint) : Boolean;
- function PtInRect(const Rect : TRectF; const p : TPointF) : Boolean;
- function IntersectRect(const Rect1, Rect2: TRect): Boolean;
- function IntersectRect(const Rect1, Rect2: TRectF): Boolean;
- function IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
- function IntersectRect(var Rect : TRectF; const R1,R2 : TRectF) : Boolean;
- function RectCenter(var R: TRect; const Bounds: TRect): TRect;
- function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
- function RectHeight(const Rect: TRect): Integer; inline;
- function RectHeight(const Rect: TRectF): Single; inline;
- function RectWidth(const Rect: TRect): Integer; inline;
- function RectWidth(const Rect: TRectF): Single; inline;
- function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
- function UnionRect(var Rect : TRectF; const R1,R2 : TRectF) : Boolean;
- function UnionRect(const R1,R2 : TRect) : TRect;
- function UnionRect(const R1,R2 : TRectF) : TRectF;
- function IsRectEmpty(const Rect : TRectF) : Boolean;
- function IsRectEmpty(const Rect : TRect) : Boolean;
- function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
- function OffsetRect(var Rect : TRectF;DX : Single;DY : Single) : Boolean;
- procedure MultiplyRect(var R: TRectF; const DX, DY: Single);
- function CenterPoint(const Rect: TRect): TPoint;
- function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
- function InflateRect(var Rect: TRectF; dx: single; dy: Single): Boolean;
- function Size(AWidth, AHeight: Integer): TSize; inline;
- function Size(const ARect: TRect): TSize; inline;
- function ScalePoint(const P: TPointF; dX, dY: Single): TPointF; overload;
- function ScalePoint(const P: TPoint; dX, dY: Single): TPoint; overload;
- function MinPoint(const P1, P2: TPointF): TPointF; overload;
- function MinPoint(const P1, P2: TPoint): TPoint; overload;
- function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Size: Integer): TRect; overload;
- function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Percent: Double): TRect; overload;
- function CenteredRect(const SourceRect: TRect; const aCenteredRect: TRect): TRect;
- function IntersectRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
- function UnionRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
- type
- TBitConverter = class
- generic class procedure UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static; {inline;}
- generic class procedure From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static;
- generic class function UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static; {inline;}
- generic class function InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static;
- end;
- Const
- cPI: Single = 3.141592654;
- cPIdiv180: Single = 0.017453292;
- cPIdiv2: Single = 1.570796326;
- cPIdiv4: Single = 0.785398163;
- implementation
- {$IFDEF FPC_DOTTEDUNITS}
- Uses System.Math;
- {$ELSE FPC_DOTTEDUNITS}
- Uses Math;
- {$ENDIF FPC_DOTTEDUNITS}
- {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
- {$i typshrd.inc}
- {$endif}
- function SmallPoint(X, Y: Integer): TSmallPoint; inline; overload;
- begin
- Result.X:=X;
- Result.Y:=Y;
- end;
- function SmallPoint(XY: LongWord): TSmallPoint; overload;
- begin
- Result.X:=SmallInt(XY and $0000FFFF);
- Result.Y:=SmallInt(XY shr 16);
- end;
- function MinPoint(const P1, P2: TPointF): TPointF; overload;
- begin
- Result:=P1;
- if (P2.Y<P1.Y)
- or ((P2.Y=P1.Y) and (P2.X<P1.X)) then
- Result:=P2;
- end;
- function MinPoint(const P1, P2: TPoint): TPoint; overload;
- begin
- Result:=P1;
- if (P2.Y<P1.Y)
- or ((P2.Y=P1.Y) and (P2.X<P1.X)) then
- Result:=P2;
- end;
- function ScalePoint(const P: TPointF; dX, dY: Single): TPointF; overload;
- begin
- Result.X:=P.X*dX;
- Result.Y:=P.Y*dY;
- end;
- function ScalePoint(const P: TPoint; dX, dY: Single): TPoint; overload;
- begin
- Result.X:=Round(P.X*dX);
- Result.Y:=Round(P.Y*dY);
- end;
- function NormalizeRectF(const Pts: array of TPointF): TRectF;
- var
- Pt: TPointF;
- begin
- Result.Left:=$FFFF;
- Result.Top:=$FFFF;
- Result.Right:=-$FFFF;
- Result.Bottom:=-$FFFF;
- for Pt in Pts do
- begin
- Result.Left:=Min(Pt.X,Result.left);
- Result.Top:=Min(Pt.Y,Result.Top);
- Result.Right:=Max(Pt.X,Result.Right);
- Result.Bottom:=Max(Pt.Y,Result.Bottom);
- end;
- end;
- function NormalizeRect(const aRect : TRectF): TRectF;
- begin
- With aRect do
- Result:=NormalizeRectF([PointF(Left,Top),
- PointF(Right,Top),
- PointF(Right,Bottom),
- PointF(Left,Bottom)]);
- end;
- function EqualRect(const r1,r2 : TRect) : Boolean;
- begin
- EqualRect:=(r1.left=r2.left) and (r1.right=r2.right) and (r1.top=r2.top) and (r1.bottom=r2.bottom);
- end;
- function EqualRect(const r1,r2 : TRectF) : Boolean;
- begin
- EqualRect:=r1.EqualsTo(r2);
- end;
- function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
- begin
- Rect.Left:=Left;
- Rect.Top:=Top;
- Rect.Right:=Right;
- Rect.Bottom:=Bottom;
- end;
- function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
- begin
- RectF.Left:=Left;
- RectF.Top:=Top;
- RectF.Right:=Right;
- RectF.Bottom:=Bottom;
- end;
- function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
- begin
- Bounds.Left:=ALeft;
- Bounds.Top:=ATop;
- Bounds.Right:=ALeft+AWidth;
- Bounds.Bottom:=ATop+AHeight;
- end;
- function Point(x,y : Integer) : TPoint; inline;
- begin
- Point.x:=x;
- Point.y:=y;
- end;
- function PointF(x,y: Single) : TPointF; inline;
- begin
- PointF.x:=x;
- PointF.y:=y;
- end;
- function PtInRect(const Rect : TRect;const p : TPoint) : Boolean;
- begin
- PtInRect:=(p.y>=Rect.Top) and
- (p.y<Rect.Bottom) and
- (p.x>=Rect.Left) and
- (p.x<Rect.Right);
- end;
- function PtInRect(const Rect : TRectF;const p : TPointF) : Boolean;
- begin
- PtInRect:=(p.y>=Rect.Top) and
- (p.y<Rect.Bottom) and
- (p.x>=Rect.Left) and
- (p.x<Rect.Right);
- end;
- function IntersectRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
- begin
- Result:=IntersectRect(Rect,R1,R2);
- end;
- function UnionRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
- begin
- Result:=UnionRect(Rect,R1,R2);
- end;
- function IntersectRect(const Rect1, Rect2: TRect): Boolean;
- begin
- Result:=(Rect1.Left<Rect2.Right)
- and (Rect1.Right>Rect2.Left)
- and (Rect1.Top<Rect2.Bottom)
- and (Rect1.Bottom>Rect2.Top);
- end;
- function IntersectRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
- var
- lRect: TRect;
- begin
- lRect := R1;
- if R2.Left > R1.Left then
- lRect.Left := R2.Left;
- if R2.Top > R1.Top then
- lRect.Top := R2.Top;
- if R2.Right < R1.Right then
- lRect.Right := R2.Right;
- if R2.Bottom < R1.Bottom then
- lRect.Bottom := R2.Bottom;
- // The var parameter is only assigned in the end to avoid problems
- // when passing the same rectangle in the var and const parameters.
- // See http://bugs.freepascal.org/view.php?id=17722
- Result:=not IsRectEmpty(lRect);
- if Result then
- Rect := lRect
- else
- FillChar(Rect,SizeOf(Rect),0);
- end;
- function IntersectRect(const Rect1, Rect2: TRectF): Boolean;
- begin
- Result:=(Rect1.Left<Rect2.Right)
- and (Rect1.Right>Rect2.Left)
- and (Rect1.Top<Rect2.Bottom)
- and (Rect1.Bottom>Rect2.Top);
- end;
- function IntersectRect(var Rect : TRectF;const R1,R2 : TRectF) : Boolean;
- var
- lRect: TRectF;
- begin
- lRect := R1;
- if R2.Left > R1.Left then
- lRect.Left := R2.Left;
- if R2.Top > R1.Top then
- lRect.Top := R2.Top;
- if R2.Right < R1.Right then
- lRect.Right := R2.Right;
- if R2.Bottom < R1.Bottom then
- lRect.Bottom := R2.Bottom;
- // The var parameter is only assigned in the end to avoid problems
- // when passing the same rectangle in the var and const parameters.
- // See http://bugs.freepascal.org/view.php?id=17722
- Result:=not IsRectEmpty(lRect);
- if Result then
- Rect := lRect
- else
- FillChar(Rect,SizeOf(Rect),0);
- end;
- function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Size: Integer): TRect; overload;
- begin
- Result:=Rect.SplitRect(SplitType,Size);
- end;
- function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Percent: Double): TRect; overload;
- begin
- Result:=Rect.SplitRect(SplitType,Percent);
- end;
- function CenteredRect(const SourceRect: TRect; const aCenteredRect: TRect): TRect;
- var
- W,H: Integer;
- Center : TPoint;
- begin
- W:=aCenteredRect.Width;
- H:=aCenteredRect.Height;
- Center:=SourceRect.CenterPoint;
- With Center do
- Result:= Rect(X-(W div 2),Y-(H div 2),X+((W+1) div 2),Y+((H+1) div 2));
- end;
- function RectWidth(const Rect: TRect): Integer;
- begin
- Result:=Rect.Width;
- end;
- function RectWidth(const Rect: TRectF): Single;
- begin
- Result:=Rect.Width;
- end;
- function RectHeight(const Rect: TRect): Integer; inline;
- begin
- Result:=Rect.Height;
- end;
- function RectHeight(const Rect: TRectF): Single; inline;
- begin
- Result:=Rect.Height
- end;
- function RectCenter(var R: TRect; const Bounds: TRect): TRect;
- var
- C : TPoint;
- CS : TPoint;
- begin
- C:=Bounds.CenterPoint;
- CS:=R.CenterPoint;
- OffsetRect(R,C.X-CS.X,C.Y-CS.Y);
- Result:=R;
- end;
- function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
- Var
- C,CS : TPointF;
- begin
- C:=Bounds.CenterPoint;
- CS:=R.CenterPoint;
- OffsetRect(R,C.X-CS.X,C.Y-CS.Y);
- Result:=R;
- end;
- procedure MultiplyRect(var R: TRectF; const DX, DY: Single);
- begin
- R.Left:=DX*R.Left;
- R.Right:=DX*R.Right;
- R.Top:=DY*R.Top;
- R.Bottom:=DY*R.Bottom;
- end;
- function UnionRect(const R1,R2 : TRect) : TRect;
- begin
- Result:=Default(TRect);
- UnionRect(Result,R1,R2);
- end;
- function UnionRect(const R1,R2 : TRectF) : TRectF;
- begin
- Result:=Default(TRectF);
- UnionRect(Result,R1,R2);
- end;
- function UnionRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
- var
- lRect: TRect;
- begin
- if IsRectEmpty(R1) then
- lRect:=R2
- else if IsRectEmpty(R2) then
- lRect:=R1
- else
- begin
- lRect:=R1;
- if R2.Left<R1.Left then
- lRect.Left:=R2.Left;
- if R2.Top<R1.Top then
- lRect.Top:=R2.Top;
- if R2.Right>R1.Right then
- lRect.Right:=R2.Right;
- if R2.Bottom>R1.Bottom then
- lRect.Bottom:=R2.Bottom;
- end;
- Result:=not IsRectEmpty(lRect);
- if Result then
- Rect:=lRect
- else
- FillChar(Rect,SizeOf(Rect),0);
- end;
- function UnionRect(var Rect : TRectF;const R1,R2 : TRectF) : Boolean;
- var
- lRect: TRectF;
- begin
- lRect:=R1;
- if R2.Left<R1.Left then
- lRect.Left:=R2.Left;
- if R2.Top<R1.Top then
- lRect.Top:=R2.Top;
- if R2.Right>R1.Right then
- lRect.Right:=R2.Right;
- if R2.Bottom>R1.Bottom then
- lRect.Bottom:=R2.Bottom;
- Result:=not IsRectEmpty(lRect);
- if Result then
- Rect := lRect
- else
- FillChar(Rect,SizeOf(Rect),0);
- end;
- function IsRectEmpty(const Rect : TRect) : Boolean;
- begin
- IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
- end;
- function IsRectEmpty(const Rect : TRectF) : Boolean;
- begin
- IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
- end;
- function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
- begin
- Result:=assigned(@Rect);
- if Result then
- with Rect do
- begin
- inc(Left,dx);
- inc(Top,dy);
- inc(Right,dx);
- inc(Bottom,dy);
- end;
- end;
- function Avg(a, b: Longint): Longint;
- begin
- if a < b then
- Result := a + ((b - a) shr 1)
- else
- Result := b + ((a - b) shr 1);
- end;
- function OffsetRect(var Rect: TRectF; DX: Single; DY: Single): Boolean;
- begin
- Result:=assigned(@Rect);
- if Result then
- with Rect do
- begin
- Left:=Left+dx;
- Right:=Right+dx;
- Top:=Top+dy;
- Bottom:=Bottom+dy;
- end;
- end;
- function CenterPoint(const Rect: TRect): TPoint;
- begin
- with Rect do
- begin
- Result.X := Avg(Left, Right);
- Result.Y := Avg(Top, Bottom);
- end;
- end;
- function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
- begin
- Result:=assigned(@Rect);
- if Result then
- with Rect do
- begin
- dec(Left, dx);
- dec(Top, dy);
- inc(Right, dx);
- inc(Bottom, dy);
- end;
- end;
- function InflateRect(var Rect: TRectF; dx: Single; dy: Single): Boolean;
- begin
- Result:=assigned(@Rect);
- if Result then
- with Rect do
- begin
- Left:=Left-dx;
- Top:=Top-dy;
- Right:=Right+dx;
- Bottom:=Bottom+dy;
- end;
- end;
- function Size(AWidth, AHeight: Integer): TSize; inline;
- begin
- Result.cx := AWidth;
- Result.cy := AHeight;
- end;
- function Size(const ARect: TRect): TSize; inline;
- begin
- Result.cx := ARect.Right - ARect.Left;
- Result.cy := ARect.Bottom - ARect.Top;
- end;
- Function SingleToStr(aValue : Single; aSize,aDecimals : Byte) : ShortString; inline;
- var
- S : ShortString;
- Len,P : Byte;
-
- begin
- Str(aValue:aSize:aDecimals,S);
- Len:=Length(S);
- P:=1;
- While (P<=Len) and (S[P]=' ') do
- Inc(P);
- if P>1 then
- Delete(S,1,P-1);
- Result:=S;
- end;
- { TNullPtr }
- class operator TNullPtr.:=(None: TNullPtr): Pointer;
- begin
- Result := nil;
- end;
- class operator TNullPtr.:=(None: TNullPtr): TObject;
- begin
- Result := nil;
- end;
- class operator TNullPtr.=(LHS: TNullPtr; RHS: Pointer): Boolean;
- begin
- Result := not Assigned(RHS);
- end;
- class operator TNullPtr.=(LHS: TNullPtr; RHS: TObject): Boolean;
- begin
- Result := not Assigned(RHS);
- end;
- class operator TNullPtr.=(LHS: Pointer; RHS: TNullPtr): Boolean;
- begin
- Result := not Assigned(LHS);
- end;
- class operator TNullPtr.=(LHS: TObject; RHS: TNullPtr): Boolean;
- begin
- Result := not Assigned(LHS);
- end;
- class operator TNullPtr.<>(LHS: TNullPtr; RHS: Pointer): Boolean;
- begin
- Result := Assigned(RHS);
- end;
- class operator TNullPtr.<>(LHS: TNullPtr; RHS: TObject): Boolean;
- begin
- Result := Assigned(RHS);
- end;
- class operator TNullPtr.<>(LHS: Pointer; RHS: TNullPtr): Boolean;
- begin
- Result := Assigned(LHS);
- end;
- class operator TNullPtr.<>(LHS: TObject; RHS: TNullPtr): Boolean;
- begin
- Result := Assigned(LHS);
- end;
- { TPointF}
- function TPointF.ToString : RTLString;
- begin
- Result:=ToString(8,2);
- end;
- function TPointF.ToString(aSize,aDecimals : Byte) : RTLString;
- var
- Sx,Sy : shortstring;
- begin
- Sx:=SingleToStr(X,aSize,aDecimals);
- Sy:=SingleToStr(Y,aSize,aDecimals);
- Result:='('+Sx+','+Sy+')';
- end;
- function TPointF.Add(const apt: TPoint): TPointF;
- begin
- result.x:=x+apt.x;
- result.y:=y+apt.y;
- end;
- function TPointF.Add(const apt: TPointF): TPointF;
- begin
- result.x:=x+apt.x;
- result.y:=y+apt.y;
- end;
- function TPointF.Subtract(const apt : TPointF): TPointF;
- begin
- result.x:=x-apt.x;
- result.y:=y-apt.y;
- end;
- function TPointF.Subtract(const apt: TPoint): TPointF;
- begin
- result.x:=x-apt.x;
- result.y:=y-apt.y;
- end;
- function TPointF.Distance(const apt : TPointF) : Single;
- begin
- result:=sqrt(sqr(apt.x-x)+sqr(apt.y-y));
- end;
- function TPointF.DotProduct(const apt: TPointF): Single;
- begin
- result:=x*apt.x+y*apt.y;
- end;
- function TPointF.IsZero : Boolean;
- begin
- result:=SameValue(x,0.0) and SameValue(y,0.0);
- end;
- procedure TPointF.Offset(const apt :TPointF);
- begin
- x:=x+apt.x;
- y:=y+apt.y;
- end;
- procedure TPointF.Offset(const apt: TPoint);
- begin
- x:=x+apt.x;
- y:=y+apt.y;
- end;
- procedure TPointF.Offset(dx,dy : Single);
- begin
- x:=x+dx;
- y:=y+dy;
- end;
- function TPointF.EqualsTo(const apt: TPointF): Boolean;
- begin
- Result:=EqualsTo(apt,0);
- end;
- function TPointF.EqualsTo(const apt: TPointF; const aEpsilon: Single): Boolean;
- function Eq(a,b : single) : boolean; inline;
- begin
- result:=abs(a-b)<=aEpsilon;
- end;
- begin
- Result:=Eq(X,apt.X) and Eq(Y,apt.Y);
- end;
- function TPointF.Scale(afactor: Single): TPointF;
- begin
- result.x:=afactor*x;
- result.y:=afactor*y;
- end;
- function TPointF.Ceiling: TPoint;
- begin
- result.x:=ceil(x);
- result.y:=ceil(y);
- end;
- function TPointF.Truncate: TPoint;
- begin
- result.x:=trunc(x);
- result.y:=trunc(y);
- end;
- function TPointF.Floor: TPoint;
- begin
- result.x:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(x);
- result.y:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(y);
- end;
- function TPointF.Round: TPoint;
- begin
- result.x:=System.round(x);
- result.y:=System.round(y);
- end;
- function TPointF.Length: Single;
- begin
- result:=sqrt(sqr(x)+sqr(y));
- end;
- function TPointF.Rotate(angle: single): TPointF;
- var
- sina, cosa: single;
- begin
- sincos(angle, sina, cosa);
- result.x := x * cosa - y * sina;
- result.y := x * sina + y * cosa;
- end;
- function TPointF.Reflect(const normal: TPointF): TPointF;
- begin
- result := self + (-2 * normal ** self) * normal;
- end;
- function TPointF.MidPoint(const b: TPointF): TPointF;
- begin
- result.x := 0.5 * (x + b.x);
- result.y := 0.5 * (y + b.y);
- end;
- class function TPointF.Zero: TPointF;
- begin
- Result.X:=0;
- Result.Y:=0;
- end;
- class function TPointF.PointInCircle(const pt, center: TPointF; radius: single): Boolean;
- begin
- result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(radius);
- end;
- class function TPointF.PointInCircle(const pt, center: TPointF; radius: integer): Boolean;
- begin
- result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(single(radius));
- end;
- function TPointF.Angle(const b: TPointF): Single;
- begin
- result := ArcTan2(y - b.y, x - b.x);
- end;
- function TPointF.AngleCosine(const b: TPointF): single;
- begin
- result := EnsureRange((self ** b) / sqrt((sqr(x) + sqr(y)) * (sqr(b.x) + sqr(b.y))), -1, 1);
- end;
- class operator TPointF.= (const apt1, apt2 : TPointF) : Boolean;
- begin
- result:=SameValue(apt1.x,apt2.x) and SameValue(apt1.y,apt2.y);
- end;
- class operator TPointF.<> (const apt1, apt2 : TPointF): Boolean;
- begin
- result:=NOT (SameValue(apt1.x,apt2.x) and Samevalue(apt1.y,apt2.y));
- end;
- class operator TPointF. * (const apt1, apt2: TPointF): TPointF;
- begin
- result.x:=apt1.x*apt2.x;
- result.y:=apt1.y*apt2.y;
- end;
- class operator TPointF. * (afactor: single; const apt1: TPointF): TPointF;
- begin
- result:=apt1.Scale(afactor);
- end;
- class operator TPointF. * (const apt1: TPointF; afactor: single): TPointF;
- begin
- result:=apt1.Scale(afactor);
- end;
- class operator TPointF. ** (const apt1, apt2: TPointF): Single;
- begin
- result:=apt1.x*apt2.x + apt1.y*apt2.y;
- end;
- class operator TPointF.+ (const apt1, apt2 : TPointF): TPointF;
- begin
- result.x:=apt1.x+apt2.x;
- result.y:=apt1.y+apt2.y;
- end;
- class operator TPointF.- (const apt1, apt2 : TPointF): TPointF;
- begin
- result.x:=apt1.x-apt2.x;
- result.y:=apt1.y-apt2.y;
- end;
- class operator TPointF. - (const apt1: TPointF): TPointF;
- begin
- Result.x:=-apt1.x;
- Result.y:=-apt1.y;
- end;
- class operator TPointF. / (const apt1: TPointF; afactor: single): TPointF;
- begin
- result:=apt1.Scale(1/afactor);
- end;
- class operator TPointF. := (const apt: TPoint): TPointF;
- begin
- Result.x:=apt.x;
- Result.y:=apt.y;
- end;
- procedure TPointF.SetLocation(const apt :TPointF);
- begin
- x:=apt.x; y:=apt.y;
- end;
- procedure TPointF.SetLocation(const apt: TPoint);
- begin
- x:=apt.x; y:=apt.y;
- end;
- procedure TPointF.SetLocation(ax,ay : Single);
- begin
- x:=ax; y:=ay;
- end;
- class function TPointF.Create(const ax, ay: Single): TPointF;
- begin
- Result.x := ax;
- Result.y := ay;
- end;
- class function TPointF.Create(const apt: TPoint): TPointF;
- begin
- Result.x := apt.X;
- Result.y := apt.Y;
- end;
- function TPointF.CrossProduct(const apt: TPointF): Single;
- begin
- Result:=X*apt.Y-Y*apt.X;
- end;
- function TPointF.Normalize: TPointF;
- var
- L: Single;
- begin
- L:=Sqrt(Sqr(X)+Sqr(Y));
- if SameValue(L,0,Epsilon) then
- Result:=Self
- else
- begin
- Result.X:=X/L;
- Result.Y:=Y/L;
- end;
- end;
- { TSizeF }
- function TSizeF.ToString(aSize,aDecimals : Byte) : RTLString;
- var
- Sx,Sy : shortstring;
- begin
- Sx:=SingleToStr(cx,aSize,aDecimals);
- Sy:=SingleToStr(cy,aSize,aDecimals);
- Result:='('+Sx+'x'+Sy+')';
- end;
- function TSizeF.ToString : RTLString;
- begin
- Result:=ToString(8,2);
- end;
- function TSizeF.Add(const asz: TSize): TSizeF;
- begin
- result.cx:=cx+asz.cx;
- result.cy:=cy+asz.cy;
- end;
- function TSizeF.Add(const asz: TSizeF): TSizeF;
- begin
- result.cx:=cx+asz.cx;
- result.cy:=cy+asz.cy;
- end;
- function TSizeF.Subtract(const asz : TSizeF): TSizeF;
- begin
- result.cx:=cx-asz.cx;
- result.cy:=cy-asz.cy;
- end;
- function TSizeF.SwapDimensions:TSizeF;
- begin
- result.cx:=cy;
- result.cy:=cx;
- end;
- function TSizeF.Subtract(const asz: TSize): TSizeF;
- begin
- result.cx:=cx-asz.cx;
- result.cy:=cy-asz.cy;
- end;
- function TSizeF.Distance(const asz : TSizeF) : Single;
- begin
- result:=sqrt(sqr(asz.cx-cx)+sqr(asz.cy-cy));
- end;
- function TSizeF.IsZero : Boolean;
- begin
- result:=SameValue(cx,0.0) and SameValue(cy,0.0);
- end;
- function TSizeF.Scale(afactor: Single): TSizeF;
- begin
- result.cx:=afactor*cx;
- result.cy:=afactor*cy;
- end;
- function TSizeF.Ceiling: TSize;
- begin
- result.cx:=ceil(cx);
- result.cy:=ceil(cy);
- end;
- function TSizeF.Truncate: TSize;
- begin
- result.cx:=trunc(cx);
- result.cy:=trunc(cy);
- end;
- function TSizeF.Floor: TSize;
- begin
- result.cx:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(cx);
- result.cy:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(cy);
- end;
- function TSizeF.Round: TSize;
- begin
- result.cx:=System.round(cx);
- result.cy:=System.round(cy);
- end;
- function TSizeF.Length: Single;
- begin //distance(self) ?
- result:=sqrt(sqr(cx)+sqr(cy));
- end;
- class operator TSizeF.= (const asz1, asz2 : TSizeF) : Boolean;
- begin
- result:=SameValue(asz1.cx,asz2.cx) and SameValue(asz1.cy,asz2.cy);
- end;
- class operator TSizeF.<> (const asz1, asz2 : TSizeF): Boolean;
- begin
- result:=NOT (SameValue(asz1.cx,asz2.cx) and Samevalue(asz1.cy,asz2.cy));
- end;
- class operator TSizeF. * (afactor: single; const asz1: TSizeF): TSizeF;
- begin
- result:=asz1.Scale(afactor);
- end;
- class operator TSizeF. * (const asz1: TSizeF; afactor: single): TSizeF;
- begin
- result:=asz1.Scale(afactor);
- end;
- class operator TSizeF.+ (const asz1, asz2 : TSizeF): TSizeF;
- begin
- result.cx:=asz1.cx+asz2.cx;
- result.cy:=asz1.cy+asz2.cy;
- end;
- class operator TSizeF.- (const asz1, asz2 : TSizeF): TSizeF;
- begin
- result.cx:=asz1.cx-asz2.cx;
- result.cy:=asz1.cy-asz2.cy;
- end;
- class operator TSizeF. - (const asz1: TSizeF): TSizeF;
- begin
- Result.cx:=-asz1.cx;
- Result.cy:=-asz1.cy;
- end;
- class operator TSizeF. := (const apt: TPointF): TSizeF;
- begin
- Result.cx:=apt.x;
- Result.cy:=apt.y;
- end;
- class operator TSizeF. := (const asz: TSize): TSizeF;
- begin
- Result.cx := asz.cx;
- Result.cy := asz.cy;
- end;
- class operator TSizeF. := (const asz: TSizeF): TPointF;
- begin
- Result.x := asz.cx;
- Result.y := asz.cy;
- end;
- class function TSizeF.Create(const ax, ay: Single): TSizeF;
- begin
- Result.cx := ax;
- Result.cy := ay;
- end;
- class function TSizeF.Create(const asz: TSize): TSizeF;
- begin
- Result.cx := asz.cX;
- Result.cy := asz.cY;
- end;
- { TRectF }
- function TRectF.ToString(aSize,aDecimals : Byte; aUseSize : Boolean = False) : RTLString;
- var
- S : RTLString;
- begin
- if aUseSize then
- S:=Size.ToString(aSize,aDecimals)
- else
- S:=BottomRight.ToString(aSize,aDecimals);
- Result:='['+TopLeft.ToString(aSize,aDecimals)+' - '+S+']';
- end;
- function TRectF.ToString(aUseSize: Boolean = False) : RTLString;
- begin
- Result:=ToString(8,2,aUseSize);
- end;
- class operator TRectF. * (L, R: TRectF): TRectF;
- begin
- Result := TRectF.Intersect(L, R);
- end;
- class operator TRectF. + (L, R: TRectF): TRectF;
- begin
- Result := TRectF.Union(L, R);
- end;
- class operator TRectF. := (const arc: TRect): TRectF;
- begin
- Result.Left:=arc.Left;
- Result.Top:=arc.Top;
- Result.Right:=arc.Right;
- Result.Bottom:=arc.Bottom;
- end;
- class operator TRectF. <> (L, R: TRectF): Boolean;
- begin
- Result := not(L=R);
- end;
- class operator TRectF. = (L, R: TRectF): Boolean;
- begin
- Result :=
- SameValue(L.Left,R.Left) and SameValue(L.Right,R.Right) and
- SameValue(L.Top,R.Top) and SameValue(L.Bottom,R.Bottom);
- end;
- constructor TRectF.Create(ALeft, ATop, ARight, ABottom: Single);
- begin
- Left := ALeft;
- Top := ATop;
- Right := ARight;
- Bottom := ABottom;
- end;
- constructor TRectF.Create(P1, P2: TPointF; Normalize: Boolean);
- begin
- TopLeft := P1;
- BottomRight := P2;
- if Normalize then
- NormalizeRect;
- end;
- constructor TRectF.Create(Origin: TPointF);
- begin
- TopLeft := Origin;
- BottomRight := Origin;
- end;
- constructor TRectF.Create(Origin: TPointF; AWidth, AHeight: Single);
- begin
- TopLeft := Origin;
- Width := AWidth;
- Height := AHeight;
- end;
- constructor TRectF.Create(R: TRectF; Normalize: Boolean);
- begin
- Self := R;
- if Normalize then
- NormalizeRect;
- end;
- constructor TRectF.Create(R: TRect; Normalize: Boolean);
- begin
- Self := R;
- if Normalize then
- NormalizeRect;
- end;
- function TRectF.CenterPoint: TPointF;
- begin
- Result.X := (Right-Left) / 2 + Left;
- Result.Y := (Bottom-Top) / 2 + Top;
- end;
- function TRectF.Ceiling: TRectF;
- begin
- Result.BottomRight:=BottomRight.Ceiling;
- Result.TopLeft:=TopLeft.Ceiling;
- end;
- function TRectF.CenterAt(const Dest: TRectF): TRectF;
- begin
- Result:=Self;
- RectCenter(Result,Dest);
- end;
- function TRectF.Fit(const Dest: TRectF): Single;
- var
- R : TRectF;
- begin
- R:=FitInto(Dest,Result);
- Self:=R;
- end;
- function TRectF.FitInto(const Dest: TRectF; out Ratio: Single): TRectF;
- var
- dw, dh, w, h : Single;
- begin
- dw := Dest.Width;
- dh := Dest.Height;
- if (dw <= 0) or (dh <= 0) then
- begin
- Ratio := 1.0;
- exit(Self);
- end;
- w := Self.Width;
- h := Self.Height;
- if w * dh > h * dw then
- Ratio := w / dw
- else
- Ratio := h / dh;
- if Ratio = 0 then
- exit(Self);
- w := w / Ratio;
- h := h / Ratio;
- // Center the result within the Dest rectangle
- Result.Left := (Dest.Left + Dest.Right - w) * 0.5;
- Result.Right := Result.Left + w;
- Result.Top := (Dest.Top + Dest.Bottom - h) * 0.5;
- Result.Bottom := Result.Top + h;
- end;
- function TRectF.FitInto(const Dest: TRectF): TRectF;
- var
- Ratio: Single;
- begin
- Result:=FitInto(Dest,Ratio);
- end;
- function TRectF.PlaceInto(const Dest: TRectF; const AHorzAlign: THorzRectAlign = THorzRectAlign.Center; const AVertAlign: TVertRectAlign = TVertRectAlign.Center): TRectF;
- var
- R : TRectF;
- X,Y : Single;
- D : TRectF absolute dest;
- begin
- if (Height>Dest.Height) or (Width>Dest.Width) then
- R:=FitInto(Dest)
- else
- R:=Self;
- case AHorzAlign of
- THorzRectAlign.Left:
- X:=D.Left;
- THorzRectAlign.Center:
- X:=(D.Left+D.Right-R.Width)/2;
- THorzRectAlign.Right:
- X:=D.Right-R.Width;
- end;
- case AVertAlign of
- TVertRectAlign.Top:
- Y:=D.Top;
- TVertRectAlign.Center:
- Y:=(D.Top+D.Bottom-R.Height)/2;
- TVertRectAlign.Bottom:
- Y:=D.Bottom-R.Height;
- end;
- R.SetLocation(PointF(X,Y));
- Result:=R;
- end;
- function TRectF.SnapToPixel(AScale: Single; APlaceBetweenPixels: Boolean): TRectF;
- function sc (S : single) : single; inline;
- begin
- Result:=System.Trunc(S*AScale)/AScale;
- end;
- var
- R : TRectF;
- Off: Single;
- begin
- if AScale<=0 then
- AScale := 1;
- R.Top:=Sc(Top);
- R.Left:=Sc(Left);
- R.Width:=Sc(Width);
- R.Height:=Sc(Height);
- if APlaceBetweenPixels then
- begin
- Off:=1/(2*aScale);
- R.Offset(Off,Off);
- end;
- Result:=R;
- end;
- function TRectF.Contains(Pt: TPointF): Boolean;
- begin
- Result := (Left <= Pt.X) and (Pt.X < Right) and (Top <= Pt.Y) and (Pt.Y < Bottom);
- end;
- function TRectF.Contains(R: TRectF): Boolean;
- begin
- Result := (Left <= R.Left) and (R.Right <= Right) and (Top <= R.Top) and (R.Bottom <= Bottom);
- end;
- class function TRectF.Empty: TRectF;
- begin
- Result := TRectF.Create(0,0,0,0);
- end;
- function TRectF.EqualsTo(const R: TRectF; const Epsilon: Single): Boolean;
- begin
- Result:=TopLeft.EqualsTo(R.TopLeft,Epsilon);
- Result:=Result and BottomRight.EqualsTo(R.BottomRight,Epsilon);
- end;
- function TRectF.GetHeight: Single;
- begin
- result:=bottom-top;
- end;
- function TRectF.GetLocation: TPointF;
- begin
- result.x:=Left; result.y:=top;
- end;
- function TRectF.GetSize: TSizeF;
- begin
- result.cx:=width; result.cy:=height;
- end;
- function TRectF.GetWidth: Single;
- begin
- result:=right-left;
- end;
- procedure TRectF.Inflate(DX, DY: Single);
- begin
- Left:=Left-dx;
- Top:=Top-dy;
- Right:=Right+dx;
- Bottom:=Bottom+dy;
- end;
- procedure TRectF.Intersect(R: TRectF);
- begin
- Self := Intersect(Self, R);
- end;
- class function TRectF.Intersect(R1: TRectF; R2: TRectF): TRectF;
- begin
- Result := R1;
- if R2.Left > R1.Left then
- Result.Left := R2.Left;
- if R2.Top > R1.Top then
- Result.Top := R2.Top;
- if R2.Right < R1.Right then
- Result.Right := R2.Right;
- if R2.Bottom < R1.Bottom then
- Result.Bottom := R2.Bottom;
- end;
- function TRectF.IntersectsWith(R: TRectF): Boolean;
- begin
- Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom);
- end;
- function TRectF.IsEmpty: Boolean;
- begin
- Result := (CompareValue(Right,Left)<=0) or (CompareValue(Bottom,Top)<=0);
- end;
- procedure TRectF.NormalizeRect;
- var
- x: Single;
- begin
- if Top>Bottom then
- begin
- x := Top;
- Top := Bottom;
- Bottom := x;
- end;
- if Left>Right then
- begin
- x := Left;
- Left := Right;
- Right := x;
- end
- end;
- procedure TRectF.Inflate(DL, DT, DR, DB: Single);
- begin
- Left:=Left-dl;
- Top:=Top-dt;
- Right:=Right+dr;
- Bottom:=Bottom+db;
- end;
- procedure TRectF.Offset(const dx, dy: Single);
- begin
- left:=left+dx; right:=right+dx;
- bottom:=bottom+dy; top:=top+dy;
- end;
- procedure TRectF.Offset(DP: TPointF);
- begin
- left:=left+DP.x; right:=right+DP.x;
- bottom:=bottom+DP.y; top:=top+DP.y;
- end;
- function TRectF.Truncate: TRect;
- begin
- Result.BottomRight:=BottomRight.Truncate;
- Result.TopLeft:=TopLeft.Truncate;
- end;
- function TRectF.Round: TRect;
- begin
- Result.BottomRight:=BottomRight.Round;
- Result.TopLeft:=TopLeft.Round;
- end;
- procedure TRectF.SetHeight(AValue: Single);
- begin
- bottom:=top+avalue;
- end;
- procedure TRectF.SetLocation(X, Y: Single);
- begin
- Offset(X-Left, Y-Top);
- end;
- procedure TRectF.SetLocation(P: TPointF);
- begin
- SetLocation(P.X, P.Y);
- end;
- procedure TRectF.SetSize(AValue: TSizeF);
- begin
- bottom:=top+avalue.cy;
- right:=left+avalue.cx;
- end;
- procedure TRectF.SetWidth(AValue: Single);
- begin
- right:=left+avalue;
- end;
- class function TRectF.Union(const Points: array of TPointF): TRectF;
- var
- i: Integer;
- begin
- if Length(Points) > 0 then
- begin
- Result.TopLeft := Points[Low(Points)];
- Result.BottomRight := Points[Low(Points)];
- for i := Low(Points)+1 to High(Points) do
- begin
- if Points[i].X < Result.Left then Result.Left := Points[i].X;
- if Points[i].X > Result.Right then Result.Right := Points[i].X;
- if Points[i].Y < Result.Top then Result.Top := Points[i].Y;
- if Points[i].Y > Result.Bottom then Result.Bottom := Points[i].Y;
- end;
- end else
- Result := Empty;
- end;
- procedure TRectF.Union(const r: TRectF);
- begin
- left:=min(r.left,left);
- top:=min(r.top,top);
- right:=max(r.right,right);
- bottom:=max(r.bottom,bottom);
- end;
- class function TRectF.Union(R1, R2: TRectF): TRectF;
- begin
- Result:=R1;
- Result.Union(R2);
- end;
- { TPoint3D }
- function TPoint3D.ToString(aSize,aDecimals : Byte) : RTLString;
-
- var
- Sx,Sy,Sz : shortstring;
- P : integer;
- begin
- Sx:=SingleToStr(X,aSize,aDecimals);
- Sy:=SingleToStr(Y,aSize,aDecimals);
- Sz:=SingleToStr(Z,aSize,aDecimals);
- Result:='('+Sx+','+Sy+','+Sz+')';
- end;
-
- function TPoint3D.ToString : RTLString;
- begin
- Result:=ToString(8,2);
- end;
- constructor TPoint3D.Create(const ax,ay,az:single);
- begin
- x:=ax; y:=ay; z:=az;
- end;
- procedure TPoint3D.Offset(const adeltax,adeltay,adeltaz:single);
- begin
- x:=x+adeltax; y:=y+adeltay; z:=z+adeltaz;
- end;
- procedure TPoint3D.Offset(const adelta:TPoint3D);
- begin
- x:=x+adelta.x; y:=y+adelta.y; z:=z+adelta.z;
- end;
- generic class procedure TBitConverter.UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
- begin
- move(ASrcValue, ADestination[AOffset], SizeOf(T));
- end;
- generic class procedure TBitConverter.From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
- begin
- if AOffset < 0 then
- System.Error(reRangeError);
- if IsManagedType(T) then
- System.Error(reInvalidCast);
- if Length(ADestination) < (SizeOf(T) + AOffset) then
- System.Error(reRangeError);
- TBitConverter.specialize UnsafeFrom<T>(ASrcValue, ADestination, AOffset);
- end;
- generic class function TBitConverter.UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
- begin
- move(ASource[AOffset], Result, SizeOf(T));
- end;
- generic class function TBitConverter.InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
- begin
- if AOffset < 0 then
- System.Error(reRangeError);
- if IsManagedType(T) then
- System.Error(reInvalidCast);
- if Length(ASource) < (SizeOf(T) + AOffset) then
- System.Error(reRangeError);
- Result := TBitConverter.specialize UnsafeInTo<T>(ASource, AOffset);
- end;
- end.
|