12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532 |
- {
- 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;
- 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;
- 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;
- 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;
- 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;
- {$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);
- 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;
- 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 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 RectCenter(var R: TRect; const Bounds: TRect): TRect;
- function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
- 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 OffsetRect(var Rect : TRectF;DX : Single;DY : Single) : 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
- {$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 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
- Result:=not IsRectEmpty(lRect);
- if Result then
- Rect := lRect
- else
- FillChar(Rect,SizeOf(Rect),0);
- 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;
- 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;
- 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 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 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.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;
- { 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:={$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 }
- 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;
- begin
- if (Dest.Width<=0) or (Dest.Height<=0) then
- begin
- Ratio:=1.0;
- exit(Self);
- end;
- Ratio:=Max(Self.Width / Dest.Width, Self.Height / Dest.Height);
- if Ratio=0 then
- exit(Self);
- Result.Width:=Self.Width / Ratio;
- Result.Height:=Self.Height / Ratio;
- Result.Left:=Self.Left + (Self.Width - Result.Width) / 2;
- Result.Top:=Self.Top + (Self.Height - Result.Height) / 2;
- 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 }
- 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.
|