123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326 |
- {
- 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}
- unit Types;
- interface
- {$modeswitch advancedrecords}
- {$modeswitch class}
- {$if defined(win32) or defined(win64) or defined(wince)}
- uses
- Windows;
- {$elseif defined(win16)}
- uses
- WinTypes;
- {$endif}
- {$if defined(win32) or defined(win64)}
- const
- RT_RCDATA = Windows.RT_RCDATA deprecated 'Use Windows.RT_RCDATA instead';
- {$elseif defined(win16)}
- const
- RT_RCDATA = WinTypes.RT_RCDATA deprecated 'Use WinTypes.RT_RCDATA instead';
- {$endif}
- type
- TEndian = Objpas.TEndian;
- TDirection = (FromBeginning, FromEnd);
- TValueRelationship = -1..1;
-
- 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;
- TBooleanDynArray = array of Boolean;
- TByteDynArray = array of Byte;
- 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;
- TStringDynArray = array of AnsiString;
- TObjectDynArray = array of TObject;
- TWideStringDynArray = array of WideString;
- 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 = Windows.TArray4IntegerType;
- TSmallPoint = Windows.TSmallPoint;
- PSmallPoint = Windows.PSmallPoint;
- TSize = Windows.TSize;
- TagSize = Windows.tagSize deprecated;
- PSize = Windows.PSize;
- TPoint = Windows.TPoint;
- TagPoint = Windows.TagPoint deprecated;
- PPoint = Windows.PPoint;
- TRect = Windows.TRect;
- PRect = Windows.PRect;
- TSplitRectType = 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 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;
- function Angle(const b: TPointF): Single;
- function AngleCosine(const b: TPointF): single;
- 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;
- 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;
- { 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;
- procedure NormalizeRect;
- function IsEmpty: Boolean;
- function Contains(Pt: TPointF): Boolean;
- function Contains(R: TRectF): Boolean;
- function IntersectsWith(R: TRectF): Boolean;
- class function Intersect(R1: TRectF; R2: TRectF): TRectF; static;
- procedure Intersect(R: TRectF);
- class function Union(R1, R2: TRectF): TRectF; static;
- class function Union(const Points: array of TPointF): TRectF; static;
- procedure SetLocation(X, Y: Single);
- procedure SetLocation(P: TPointF);
- procedure Inflate(DX, DY: Single);
- procedure Inflate(DL, DT, DR, DB: Single);
- function CenterPoint: TPointF;
- procedure Union (const r: TRectF); inline;
- procedure Offset (const dx,dy : Single); inline;
- procedure Offset (DP: TPointF); 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;
- 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 = Windows.PCLSID;
- TCLSID = Windows.CLSID;
- TFiletime = Windows.TFileTime;
- Filetime = Windows.FileTime;
- PFiletime = 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 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 IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
- function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
- function IsRectEmpty(const Rect : TRect) : Boolean;
- function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
- function CenterPoint(const Rect: TRect): TPoint;
- function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
- function Size(AWidth, AHeight: Integer): TSize; inline;
- function Size(const ARect: TRect): TSize;
- {$ifndef VER3_0}
- 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;
- {$endif}
- implementation
- Uses Math;
- {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
- {$i typshrd.inc}
- {$endif}
- 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 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 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
- if IsRectEmpty(lRect) then
- begin
- FillChar(Rect,SizeOf(Rect),0);
- IntersectRect:=false;
- end
- else
- begin
- IntersectRect:=true;
- Rect := lRect;
- end;
- end;
- function UnionRect(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;
- if IsRectEmpty(lRect) then
- begin
- FillChar(Rect,SizeOf(Rect),0);
- UnionRect:=false;
- end
- else
- begin
- Rect:=lRect;
- UnionRect:=true;
- end;
- end;
- function IsRectEmpty(const Rect : TRect) : Boolean;
- begin
- IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
- end;
- function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
- begin
- if assigned(@Rect) then
- begin
- with Rect do
- begin
- inc(Left,dx);
- inc(Top,dy);
- inc(Right,dx);
- inc(Bottom,dy);
- end;
- OffsetRect:=true;
- end
- else
- OffsetRect:=false;
- 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 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
- if Assigned(@Rect) then
- begin
- with Rect do
- begin
- dec(Left, dx);
- dec(Top, dy);
- inc(Right, dx);
- inc(Bottom, dy);
- end;
- Result := True;
- end
- else
- Result := False;
- 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;
- { TPointF}
- 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.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:=Math.floor(x);
- result.y:=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.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;
- { TSizeF }
- 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:=Math.floor(cx);
- result.cy:=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 }
- 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.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.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;
- 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 }
- 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;
- {$ifndef VER3_0}
- 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;
- {$endif}
- end.
|