types.pp 35 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2002 by Florian Klaempfl,
  4. member of the Free Pascal development team.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$MODE OBJFPC}
  12. unit Types;
  13. interface
  14. {$modeswitch advancedrecords}
  15. {$modeswitch class}
  16. {$if defined(win32) or defined(win64) or defined(wince)}
  17. uses
  18. Windows;
  19. {$elseif defined(win16)}
  20. uses
  21. WinTypes;
  22. {$endif}
  23. {$if defined(win32) or defined(win64)}
  24. const
  25. RT_RCDATA = Windows.RT_RCDATA deprecated 'Use Windows.RT_RCDATA instead';
  26. {$elseif defined(win16)}
  27. const
  28. RT_RCDATA = WinTypes.RT_RCDATA deprecated 'Use WinTypes.RT_RCDATA instead';
  29. {$endif}
  30. Const
  31. Epsilon: Single = 1E-40;
  32. Epsilon2: Single = 1E-30;
  33. type
  34. TEndian = Objpas.TEndian;
  35. TDirection = (FromBeginning, FromEnd);
  36. TValueRelationship = -1..1;
  37. DWORD = LongWord;
  38. PLongint = System.PLongint;
  39. PSmallInt = System.PSmallInt;
  40. {$ifndef FPUNONE}
  41. PDouble = System.PDouble;
  42. {$endif}
  43. PByte = System.PByte;
  44. Largeint = int64;
  45. LARGE_INT = LargeInt;
  46. PLargeInt = ^LargeInt;
  47. LargeUint = qword;
  48. LARGE_UINT= LargeUInt;
  49. PLargeuInt = ^LargeuInt;
  50. TBooleanDynArray = array of Boolean;
  51. TByteDynArray = array of Byte;
  52. TCardinalDynArray = array of Cardinal;
  53. TInt64DynArray = array of Int64;
  54. TIntegerDynArray = array of Integer;
  55. TLongWordDynArray = array of LongWord;
  56. TPointerDynArray = array of Pointer;
  57. TQWordDynArray = array of QWord;
  58. TShortIntDynArray = array of ShortInt;
  59. TSmallIntDynArray = array of SmallInt;
  60. TRTLStringDynArray = array of RTLString;
  61. TAnsiStringDynArray = Array of AnsiString;
  62. TWideStringDynArray = array of WideString;
  63. TUnicodeStringDynArray = array of UnicodeString;
  64. {$if SIZEOF(CHAR)=2}
  65. TStringDynArray = Array of UnicodeString;
  66. {$ELSE}
  67. TStringDynArray = Array of AnsiString;
  68. {$ENDIF}
  69. TObjectDynArray = array of TObject;
  70. TWordDynArray = array of Word;
  71. TCurrencyArray = Array of currency;
  72. {$ifndef FPUNONE}
  73. TSingleDynArray = array of Single;
  74. TDoubleDynArray = array of Double;
  75. TExtendedDynArray = array of Extended;
  76. TCompDynArray = array of Comp;
  77. {$endif}
  78. {$if defined(win32) or defined(win64) or defined(wince)}
  79. TArray4IntegerType = Windows.TArray4IntegerType;
  80. TSmallPoint = Windows.TSmallPoint;
  81. PSmallPoint = Windows.PSmallPoint;
  82. TSize = Windows.TSize;
  83. TagSize = Windows.tagSize deprecated;
  84. PSize = Windows.PSize;
  85. TPoint = Windows.TPoint;
  86. TagPoint = Windows.TagPoint deprecated;
  87. PPoint = Windows.PPoint;
  88. TRect = Windows.TRect;
  89. PRect = Windows.PRect;
  90. TSplitRectType = Windows.TSplitRectType;
  91. const
  92. srLeft = TSplitRectType.srLeft;
  93. srRight = TSplitRectType.srRight;
  94. srTop = TSplitRectType.srTop;
  95. srBottom = TSplitRectType.srBottom;
  96. type
  97. {$else}
  98. {$i typshrdh.inc}
  99. TagSize = tSize deprecated;
  100. TagPoint = TPoint deprecated;
  101. {$endif}
  102. { TPointF }
  103. PPointF = ^TPointF;
  104. TPointF =
  105. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  106. packed
  107. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  108. record
  109. x,y : Single;
  110. public
  111. function Add(const apt: TPoint): TPointF;
  112. function Add(const apt: TPointF): TPointF;
  113. function Distance(const apt : TPointF) : Single;
  114. function DotProduct(const apt : TPointF) : Single;
  115. function IsZero : Boolean;
  116. function Subtract(const apt : TPointF): TPointF;
  117. function Subtract(const apt : TPoint): TPointF;
  118. procedure SetLocation(const apt :TPointF);
  119. procedure SetLocation(const apt :TPoint);
  120. procedure SetLocation(ax,ay : Single);
  121. procedure Offset(const apt :TPointF);
  122. procedure Offset(const apt :TPoint);
  123. procedure Offset(dx,dy : Single);
  124. function Scale (afactor:Single) : TPointF;
  125. function Ceiling : TPoint;
  126. function Truncate: TPoint;
  127. function Floor : TPoint;
  128. function Round : TPoint;
  129. function Length : Single;
  130. function Rotate(angle: single): TPointF;
  131. function Reflect(const normal: TPointF): TPointF;
  132. function MidPoint(const b: TPointF): TPointF;
  133. class function PointInCircle(const pt, center: TPointF; radius: single): Boolean; static;
  134. class function PointInCircle(const pt, center: TPointF; radius: integer): Boolean; static;
  135. function Angle(const b: TPointF): Single;
  136. function AngleCosine(const b: TPointF): single;
  137. class function Create(const ax, ay: Single): TPointF; overload; static; inline;
  138. class function Create(const apt: TPoint): TPointF; overload; static; inline;
  139. class operator = (const apt1, apt2 : TPointF) : Boolean;
  140. class operator <> (const apt1, apt2 : TPointF): Boolean;
  141. class operator + (const apt1, apt2 : TPointF): TPointF;
  142. class operator - (const apt1, apt2 : TPointF): TPointF;
  143. class operator - (const apt1 : TPointF): TPointF;
  144. class operator * (const apt1, apt2: TPointF): TPointF;
  145. class operator * (const apt1: TPointF; afactor: single): TPointF;
  146. class operator * (afactor: single; const apt1: TPointF): TPointF;
  147. class operator / (const apt1: TPointF; afactor: single): TPointF;
  148. class operator := (const apt: TPoint): TPointF;
  149. class operator ** (const apt1, apt2: TPointF): Single; // scalar product
  150. end;
  151. { TSizeF }
  152. PSizeF = ^TSizeF;
  153. TSizeF =
  154. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  155. packed
  156. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  157. record
  158. cx,cy : Single;
  159. public
  160. function Add(const asz: TSize): TSizeF;
  161. function Add(const asz: TSizeF): TSizeF;
  162. function Distance(const asz : TSizeF) : Single;
  163. function IsZero : Boolean;
  164. function Subtract(const asz : TSizeF): TSizeF;
  165. function Subtract(const asz : TSize): TSizeF;
  166. function SwapDimensions:TSizeF;
  167. function Scale (afactor:Single) : TSizeF;
  168. function Ceiling : TSize;
  169. function Truncate: TSize;
  170. function Floor : TSize;
  171. function Round : TSize;
  172. function Length : Single;
  173. class function Create(const ax, ay: Single): TSizeF; overload; static; inline;
  174. class function Create(const asz: TSize): TSizeF; overload; static; inline;
  175. class operator = (const asz1, asz2 : TSizeF) : Boolean;
  176. class operator <> (const asz1, asz2 : TSizeF): Boolean;
  177. class operator + (const asz1, asz2 : TSizeF): TSizeF;
  178. class operator - (const asz1, asz2 : TSizeF): TSizeF;
  179. class operator - (const asz1 : TSizeF): TSizeF;
  180. class operator * (const asz1: TSizeF; afactor: single): TSizeF;
  181. class operator * (afactor: single; const asz1: TSizeF): TSizeF;
  182. class operator := (const apt: TPointF): TSizeF;
  183. class operator := (const asz: TSize): TSizeF;
  184. class operator := (const asz: TSizeF): TPointF;
  185. property Width: Single read cx write cx;
  186. property Height: Single read cy write cy;
  187. end;
  188. { TRectF }
  189. PRectF = ^TRectF;
  190. TRectF =
  191. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  192. packed
  193. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  194. record
  195. private
  196. function GetLocation: TPointF;
  197. function GetSize: TSizeF;
  198. procedure SetSize(AValue: TSizeF);
  199. function GetHeight: Single; inline;
  200. function GetWidth: Single; inline;
  201. procedure SetHeight(AValue: Single);
  202. procedure SetWidth (AValue: Single);
  203. public
  204. constructor Create(Origin: TPointF); // empty rect at given origin
  205. constructor Create(Origin: TPointF; AWidth, AHeight: Single);
  206. constructor Create(ALeft, ATop, ARight, ABottom: Single);
  207. constructor Create(P1, P2: TPointF; Normalize: Boolean = False);
  208. constructor Create(R: TRectF; Normalize: Boolean = False);
  209. constructor Create(R: TRect; Normalize: Boolean = False);
  210. class operator = (L, R: TRectF): Boolean;
  211. class operator <> (L, R: TRectF): Boolean;
  212. class operator + (L, R: TRectF): TRectF; // union
  213. class operator * (L, R: TRectF): TRectF; // intersection
  214. class operator := (const arc: TRect): TRectF;
  215. class function Empty: TRectF; static;
  216. procedure NormalizeRect;
  217. function IsEmpty: Boolean;
  218. function Contains(Pt: TPointF): Boolean;
  219. function Contains(R: TRectF): Boolean;
  220. function IntersectsWith(R: TRectF): Boolean;
  221. class function Intersect(R1: TRectF; R2: TRectF): TRectF; static;
  222. procedure Intersect(R: TRectF);
  223. class function Union(R1, R2: TRectF): TRectF; static;
  224. class function Union(const Points: array of TPointF): TRectF; static;
  225. procedure SetLocation(X, Y: Single);
  226. procedure SetLocation(P: TPointF);
  227. procedure Inflate(DX, DY: Single);
  228. procedure Inflate(DL, DT, DR, DB: Single);
  229. function CenterPoint: TPointF;
  230. function FitInto(const Dest: TRectF; out Ratio: Single): TRectF; overload;
  231. function FitInto(const Dest: TRectF): TRectF; overload;
  232. procedure Union (const r: TRectF); inline;
  233. procedure Offset (const dx,dy : Single); inline;
  234. procedure Offset (DP: TPointF); inline;
  235. property Width : Single read GetWidth write SetWidth;
  236. property Height : Single read GetHeight write SetHeight;
  237. property Size : TSizeF read getSize write SetSize;
  238. property Location: TPointF read getLocation write setLocation;
  239. case Integer of
  240. 0: (Left, Top, Right, Bottom: Single);
  241. 1: (TopLeft, BottomRight: TPointF);
  242. end;
  243. TDuplicates = (dupIgnore, dupAccept, dupError);
  244. TPoint3D =
  245. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  246. packed
  247. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  248. record
  249. public
  250. Type TSingle3Array = array[0..2] of single;
  251. constructor Create(const ax,ay,az:single);
  252. procedure Offset(const adeltax,adeltay,adeltaz:single); inline;
  253. procedure Offset(const adelta:TPoint3D); inline;
  254. public
  255. case Integer of
  256. 0: (data:TSingle3Array);
  257. 1: (x,y,z : single);
  258. end;
  259. type
  260. TOleChar = WideChar;
  261. POleStr = PWideChar;
  262. PPOleStr = ^POleStr;
  263. TListCallback = procedure(data,arg:pointer) of object;
  264. TListStaticCallback = procedure(data,arg:pointer);
  265. const
  266. GUID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';
  267. STGTY_STORAGE = 1;
  268. STGTY_STREAM = 2;
  269. STGTY_LOCKBYTES = 3;
  270. STGTY_PROPERTY = 4;
  271. STREAM_SEEK_SET = 0;
  272. STREAM_SEEK_CUR = 1;
  273. STREAM_SEEK_END = 2;
  274. LOCK_WRITE = 1;
  275. LOCK_EXCLUSIVE = 2;
  276. LOCK_ONLYONCE = 4;
  277. STATFLAG_DEFAULT = 0;
  278. STATFLAG_NONAME = 1;
  279. STATFLAG_NOOPEN = 2;
  280. {$ifndef Wince}
  281. // in Wince these are in unit windows. Under 32/64 in ActiveX.
  282. // for now duplicate them. Not that bad for untyped constants.
  283. E_FAIL = HRESULT($80004005);
  284. E_INVALIDARG = HRESULT($80070057);
  285. STG_E_INVALIDFUNCTION = HRESULT($80030001);
  286. STG_E_FILENOTFOUND = HRESULT($80030002);
  287. STG_E_PATHNOTFOUND = HRESULT($80030003);
  288. STG_E_TOOMANYOPENFILES = HRESULT($80030004);
  289. STG_E_ACCESSDENIED = HRESULT($80030005);
  290. STG_E_INVALIDHANDLE = HRESULT($80030006);
  291. STG_E_INSUFFICIENTMEMORY = HRESULT($80030008);
  292. STG_E_INVALIDPOINTER = HRESULT($80030009);
  293. STG_E_NOMOREFILES = HRESULT($80030012);
  294. STG_E_DISKISWRITEPROTECTED = HRESULT($80030013);
  295. STG_E_SEEKERROR = HRESULT($80030019);
  296. STG_E_WRITEFAULT = HRESULT($8003001D);
  297. STG_E_READFAULT = HRESULT($8003001E);
  298. STG_E_SHAREVIOLATION = HRESULT($80030020);
  299. STG_E_LOCKVIOLATION = HRESULT($80030021);
  300. STG_E_FILEALREADYEXISTS = HRESULT($80030050);
  301. STG_E_INVALIDPARAMETER = HRESULT($80030057);
  302. STG_E_MEDIUMFULL = HRESULT($80030070);
  303. STG_E_PROPSETMISMATCHED = HRESULT($800300F0);
  304. STG_E_ABNORMALAPIEXIT = HRESULT($800300FA);
  305. STG_E_INVALIDHEADER = HRESULT($800300FB);
  306. STG_E_INVALIDNAME = HRESULT($800300FC);
  307. STG_E_UNKNOWN = HRESULT($800300FD);
  308. STG_E_UNIMPLEMENTEDFUNCTION = HRESULT($800300FE);
  309. STG_E_INVALIDFLAG = HRESULT($800300FF);
  310. STG_E_INUSE = HRESULT($80030100);
  311. STG_E_NOTCURRENT = HRESULT($80030101);
  312. STG_E_REVERTED = HRESULT($80030102);
  313. STG_E_CANTSAVE = HRESULT($80030103);
  314. STG_E_OLDFORMAT = HRESULT($80030104);
  315. STG_E_OLDDLL = HRESULT($80030105);
  316. STG_E_SHAREREQUIRED = HRESULT($80030106);
  317. STG_E_EXTANTMARSHALLINGS = HRESULT($80030108);
  318. STG_E_DOCFILECORRUPT = HRESULT($80030109);
  319. STG_E_BADBASEADDRESS = HRESULT($80030110);
  320. STG_E_INCOMPLETE = HRESULT($80030201);
  321. STG_E_TERMINATED = HRESULT($80030202);
  322. STG_S_CONVERTED = $00030200;
  323. STG_S_BLOCK = $00030201;
  324. STG_S_RETRYNOW = $00030202;
  325. STG_S_MONITORING = $00030203;
  326. {$endif}
  327. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  328. type
  329. PCLSID = PGUID;
  330. TCLSID = TGUID;
  331. PDWord = ^DWord;
  332. PDisplay = Pointer;
  333. PEvent = Pointer;
  334. TXrmOptionDescRec = record
  335. end;
  336. XrmOptionDescRec = TXrmOptionDescRec;
  337. PXrmOptionDescRec = ^TXrmOptionDescRec;
  338. Widget = Pointer;
  339. WidgetClass = Pointer;
  340. ArgList = Pointer;
  341. Region = Pointer;
  342. _FILETIME =
  343. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  344. packed
  345. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  346. record
  347. dwLowDateTime : DWORD;
  348. dwHighDateTime : DWORD;
  349. end;
  350. TFileTime = _FILETIME;
  351. FILETIME = _FILETIME;
  352. PFileTime = ^TFileTime;
  353. {$else}
  354. type
  355. PCLSID = Windows.PCLSID;
  356. TCLSID = Windows.CLSID;
  357. TFiletime = Windows.TFileTime;
  358. Filetime = Windows.FileTime;
  359. PFiletime = Windows.PFileTime;
  360. {$endif Windows}
  361. type
  362. tagSTATSTG = record
  363. pwcsName : POleStr;
  364. dwType : DWord;
  365. cbSize : Large_uint;
  366. mtime : TFileTime;
  367. ctime : TFileTime;
  368. atime : TFileTime;
  369. grfMode : DWord;
  370. grfLocksSupported : DWord;
  371. clsid : TCLSID;
  372. grfStateBits : DWord;
  373. reserved : DWord;
  374. end;
  375. TStatStg = tagSTATSTG;
  376. STATSTG = TStatStg;
  377. PStatStg = ^TStatStg;
  378. { classes depends on these interfaces, we can't use the activex unit in classes though }
  379. IClassFactory = Interface(IUnknown) ['{00000001-0000-0000-C000-000000000046}']
  380. Function CreateInstance(Const unkOuter : IUnknown;Const riid : TGUID;Out vObject) : HResult;StdCall;
  381. Function LockServer(fLock : LongBool) : HResult;StdCall;
  382. End;
  383. ISequentialStream = interface(IUnknown)
  384. ['{0c733a30-2a1c-11ce-ade5-00aa0044773d}']
  385. function Read(pv : Pointer;cb : DWORD;pcbRead : PDWORD) : HRESULT;stdcall;
  386. function Write(pv : Pointer;cb : DWORD;pcbWritten : PDWORD): HRESULT;stdcall;
  387. end;
  388. IStream = interface(ISequentialStream) ['{0000000C-0000-0000-C000-000000000046}']
  389. function Seek(dlibMove : LargeInt; dwOrigin : DWORD; out libNewPosition : LargeUInt) : HResult;stdcall;
  390. function SetSize(libNewSize : LargeUInt) : HRESULT;stdcall;
  391. function CopyTo(stm: IStream;cb : LargeUInt;out cbRead : LargeUInt; out cbWritten : LargeUInt) : HRESULT;stdcall;
  392. function Commit(grfCommitFlags : DWORD) : HRESULT;stdcall;
  393. function Revert : HRESULT;stdcall;
  394. function LockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
  395. function UnlockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
  396. Function Stat(out statstg : TStatStg;grfStatFlag : DWORD) : HRESULT;stdcall;
  397. function Clone(out stm : IStream) : HRESULT;stdcall;
  398. end;
  399. function EqualRect(const r1,r2 : TRect) : Boolean;
  400. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  401. function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
  402. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  403. function Point(x,y : Integer) : TPoint; inline;
  404. function PointF(x,y: Single) : TPointF; inline;
  405. function PtInRect(const Rect : TRect; const p : TPoint) : Boolean;
  406. function IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  407. function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  408. function IsRectEmpty(const Rect : TRect) : Boolean;
  409. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  410. function CenterPoint(const Rect: TRect): TPoint;
  411. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  412. function Size(AWidth, AHeight: Integer): TSize; inline;
  413. function Size(const ARect: TRect): TSize;
  414. {$ifndef VER3_0}
  415. type
  416. TBitConverter = class
  417. generic class procedure UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static; {inline;}
  418. generic class procedure From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static;
  419. generic class function UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static; {inline;}
  420. generic class function InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static;
  421. end;
  422. {$endif}
  423. implementation
  424. Uses Math;
  425. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  426. {$i typshrd.inc}
  427. {$endif}
  428. function EqualRect(const r1,r2 : TRect) : Boolean;
  429. begin
  430. EqualRect:=(r1.left=r2.left) and (r1.right=r2.right) and (r1.top=r2.top) and (r1.bottom=r2.bottom);
  431. end;
  432. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  433. begin
  434. Rect.Left:=Left;
  435. Rect.Top:=Top;
  436. Rect.Right:=Right;
  437. Rect.Bottom:=Bottom;
  438. end;
  439. function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
  440. begin
  441. RectF.Left:=Left;
  442. RectF.Top:=Top;
  443. RectF.Right:=Right;
  444. RectF.Bottom:=Bottom;
  445. end;
  446. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  447. begin
  448. Bounds.Left:=ALeft;
  449. Bounds.Top:=ATop;
  450. Bounds.Right:=ALeft+AWidth;
  451. Bounds.Bottom:=ATop+AHeight;
  452. end;
  453. function Point(x,y : Integer) : TPoint; inline;
  454. begin
  455. Point.x:=x;
  456. Point.y:=y;
  457. end;
  458. function PointF(x,y: Single) : TPointF; inline;
  459. begin
  460. PointF.x:=x;
  461. PointF.y:=y;
  462. end;
  463. function PtInRect(const Rect : TRect;const p : TPoint) : Boolean;
  464. begin
  465. PtInRect:=(p.y>=Rect.Top) and
  466. (p.y<Rect.Bottom) and
  467. (p.x>=Rect.Left) and
  468. (p.x<Rect.Right);
  469. end;
  470. function IntersectRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  471. var
  472. lRect: TRect;
  473. begin
  474. lRect := R1;
  475. if R2.Left > R1.Left then
  476. lRect.Left := R2.Left;
  477. if R2.Top > R1.Top then
  478. lRect.Top := R2.Top;
  479. if R2.Right < R1.Right then
  480. lRect.Right := R2.Right;
  481. if R2.Bottom < R1.Bottom then
  482. lRect.Bottom := R2.Bottom;
  483. // The var parameter is only assigned in the end to avoid problems
  484. // when passing the same rectangle in the var and const parameters.
  485. // See http://bugs.freepascal.org/view.php?id=17722
  486. if IsRectEmpty(lRect) then
  487. begin
  488. FillChar(Rect,SizeOf(Rect),0);
  489. IntersectRect:=false;
  490. end
  491. else
  492. begin
  493. IntersectRect:=true;
  494. Rect := lRect;
  495. end;
  496. end;
  497. function UnionRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  498. var
  499. lRect: TRect;
  500. begin
  501. lRect:=R1;
  502. if R2.Left<R1.Left then
  503. lRect.Left:=R2.Left;
  504. if R2.Top<R1.Top then
  505. lRect.Top:=R2.Top;
  506. if R2.Right>R1.Right then
  507. lRect.Right:=R2.Right;
  508. if R2.Bottom>R1.Bottom then
  509. lRect.Bottom:=R2.Bottom;
  510. if IsRectEmpty(lRect) then
  511. begin
  512. FillChar(Rect,SizeOf(Rect),0);
  513. UnionRect:=false;
  514. end
  515. else
  516. begin
  517. Rect:=lRect;
  518. UnionRect:=true;
  519. end;
  520. end;
  521. function IsRectEmpty(const Rect : TRect) : Boolean;
  522. begin
  523. IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
  524. end;
  525. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  526. begin
  527. if assigned(@Rect) then
  528. begin
  529. with Rect do
  530. begin
  531. inc(Left,dx);
  532. inc(Top,dy);
  533. inc(Right,dx);
  534. inc(Bottom,dy);
  535. end;
  536. OffsetRect:=true;
  537. end
  538. else
  539. OffsetRect:=false;
  540. end;
  541. function Avg(a, b: Longint): Longint;
  542. begin
  543. if a < b then
  544. Result := a + ((b - a) shr 1)
  545. else
  546. Result := b + ((a - b) shr 1);
  547. end;
  548. function CenterPoint(const Rect: TRect): TPoint;
  549. begin
  550. with Rect do
  551. begin
  552. Result.X := Avg(Left, Right);
  553. Result.Y := Avg(Top, Bottom);
  554. end;
  555. end;
  556. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  557. begin
  558. if Assigned(@Rect) then
  559. begin
  560. with Rect do
  561. begin
  562. dec(Left, dx);
  563. dec(Top, dy);
  564. inc(Right, dx);
  565. inc(Bottom, dy);
  566. end;
  567. Result := True;
  568. end
  569. else
  570. Result := False;
  571. end;
  572. function Size(AWidth, AHeight: Integer): TSize; inline;
  573. begin
  574. Result.cx := AWidth;
  575. Result.cy := AHeight;
  576. end;
  577. function Size(const ARect: TRect): TSize; inline;
  578. begin
  579. Result.cx := ARect.Right - ARect.Left;
  580. Result.cy := ARect.Bottom - ARect.Top;
  581. end;
  582. { TPointF}
  583. function TPointF.Add(const apt: TPoint): TPointF;
  584. begin
  585. result.x:=x+apt.x;
  586. result.y:=y+apt.y;
  587. end;
  588. function TPointF.Add(const apt: TPointF): TPointF;
  589. begin
  590. result.x:=x+apt.x;
  591. result.y:=y+apt.y;
  592. end;
  593. function TPointF.Subtract(const apt : TPointF): TPointF;
  594. begin
  595. result.x:=x-apt.x;
  596. result.y:=y-apt.y;
  597. end;
  598. function TPointF.Subtract(const apt: TPoint): TPointF;
  599. begin
  600. result.x:=x-apt.x;
  601. result.y:=y-apt.y;
  602. end;
  603. function TPointF.Distance(const apt : TPointF) : Single;
  604. begin
  605. result:=sqrt(sqr(apt.x-x)+sqr(apt.y-y));
  606. end;
  607. function TPointF.DotProduct(const apt: TPointF): Single;
  608. begin
  609. result:=x*apt.x+y*apt.y;
  610. end;
  611. function TPointF.IsZero : Boolean;
  612. begin
  613. result:=SameValue(x,0.0) and SameValue(y,0.0);
  614. end;
  615. procedure TPointF.Offset(const apt :TPointF);
  616. begin
  617. x:=x+apt.x;
  618. y:=y+apt.y;
  619. end;
  620. procedure TPointF.Offset(const apt: TPoint);
  621. begin
  622. x:=x+apt.x;
  623. y:=y+apt.y;
  624. end;
  625. procedure TPointF.Offset(dx,dy : Single);
  626. begin
  627. x:=x+dx;
  628. y:=y+dy;
  629. end;
  630. function TPointF.Scale(afactor: Single): TPointF;
  631. begin
  632. result.x:=afactor*x;
  633. result.y:=afactor*y;
  634. end;
  635. function TPointF.Ceiling: TPoint;
  636. begin
  637. result.x:=ceil(x);
  638. result.y:=ceil(y);
  639. end;
  640. function TPointF.Truncate: TPoint;
  641. begin
  642. result.x:=trunc(x);
  643. result.y:=trunc(y);
  644. end;
  645. function TPointF.Floor: TPoint;
  646. begin
  647. result.x:=Math.floor(x);
  648. result.y:=Math.floor(y);
  649. end;
  650. function TPointF.Round: TPoint;
  651. begin
  652. result.x:=System.round(x);
  653. result.y:=System.round(y);
  654. end;
  655. function TPointF.Length: Single;
  656. begin
  657. result:=sqrt(sqr(x)+sqr(y));
  658. end;
  659. function TPointF.Rotate(angle: single): TPointF;
  660. var
  661. sina, cosa: single;
  662. begin
  663. sincos(angle, sina, cosa);
  664. result.x := x * cosa - y * sina;
  665. result.y := x * sina + y * cosa;
  666. end;
  667. function TPointF.Reflect(const normal: TPointF): TPointF;
  668. begin
  669. result := self + (-2 * normal ** self) * normal;
  670. end;
  671. function TPointF.MidPoint(const b: TPointF): TPointF;
  672. begin
  673. result.x := 0.5 * (x + b.x);
  674. result.y := 0.5 * (y + b.y);
  675. end;
  676. class function TPointF.PointInCircle(const pt, center: TPointF; radius: single): Boolean;
  677. begin
  678. result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(radius);
  679. end;
  680. class function TPointF.PointInCircle(const pt, center: TPointF; radius: integer): Boolean;
  681. begin
  682. result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(single(radius));
  683. end;
  684. function TPointF.Angle(const b: TPointF): Single;
  685. begin
  686. result := ArcTan2(y - b.y, x - b.x);
  687. end;
  688. function TPointF.AngleCosine(const b: TPointF): single;
  689. begin
  690. result := EnsureRange((self ** b) / sqrt((sqr(x) + sqr(y)) * (sqr(b.x) + sqr(b.y))), -1, 1);
  691. end;
  692. class operator TPointF.= (const apt1, apt2 : TPointF) : Boolean;
  693. begin
  694. result:=SameValue(apt1.x,apt2.x) and SameValue(apt1.y,apt2.y);
  695. end;
  696. class operator TPointF.<> (const apt1, apt2 : TPointF): Boolean;
  697. begin
  698. result:=NOT (SameValue(apt1.x,apt2.x) and Samevalue(apt1.y,apt2.y));
  699. end;
  700. class operator TPointF. * (const apt1, apt2: TPointF): TPointF;
  701. begin
  702. result.x:=apt1.x*apt2.x;
  703. result.y:=apt1.y*apt2.y;
  704. end;
  705. class operator TPointF. * (afactor: single; const apt1: TPointF): TPointF;
  706. begin
  707. result:=apt1.Scale(afactor);
  708. end;
  709. class operator TPointF. * (const apt1: TPointF; afactor: single): TPointF;
  710. begin
  711. result:=apt1.Scale(afactor);
  712. end;
  713. class operator TPointF. ** (const apt1, apt2: TPointF): Single;
  714. begin
  715. result:=apt1.x*apt2.x + apt1.y*apt2.y;
  716. end;
  717. class operator TPointF.+ (const apt1, apt2 : TPointF): TPointF;
  718. begin
  719. result.x:=apt1.x+apt2.x;
  720. result.y:=apt1.y+apt2.y;
  721. end;
  722. class operator TPointF.- (const apt1, apt2 : TPointF): TPointF;
  723. begin
  724. result.x:=apt1.x-apt2.x;
  725. result.y:=apt1.y-apt2.y;
  726. end;
  727. class operator TPointF. - (const apt1: TPointF): TPointF;
  728. begin
  729. Result.x:=-apt1.x;
  730. Result.y:=-apt1.y;
  731. end;
  732. class operator TPointF. / (const apt1: TPointF; afactor: single): TPointF;
  733. begin
  734. result:=apt1.Scale(1/afactor);
  735. end;
  736. class operator TPointF. := (const apt: TPoint): TPointF;
  737. begin
  738. Result.x:=apt.x;
  739. Result.y:=apt.y;
  740. end;
  741. procedure TPointF.SetLocation(const apt :TPointF);
  742. begin
  743. x:=apt.x; y:=apt.y;
  744. end;
  745. procedure TPointF.SetLocation(const apt: TPoint);
  746. begin
  747. x:=apt.x; y:=apt.y;
  748. end;
  749. procedure TPointF.SetLocation(ax,ay : Single);
  750. begin
  751. x:=ax; y:=ay;
  752. end;
  753. class function TPointF.Create(const ax, ay: Single): TPointF;
  754. begin
  755. Result.x := ax;
  756. Result.y := ay;
  757. end;
  758. class function TPointF.Create(const apt: TPoint): TPointF;
  759. begin
  760. Result.x := apt.X;
  761. Result.y := apt.Y;
  762. end;
  763. { TSizeF }
  764. function TSizeF.Add(const asz: TSize): TSizeF;
  765. begin
  766. result.cx:=cx+asz.cx;
  767. result.cy:=cy+asz.cy;
  768. end;
  769. function TSizeF.Add(const asz: TSizeF): TSizeF;
  770. begin
  771. result.cx:=cx+asz.cx;
  772. result.cy:=cy+asz.cy;
  773. end;
  774. function TSizeF.Subtract(const asz : TSizeF): TSizeF;
  775. begin
  776. result.cx:=cx-asz.cx;
  777. result.cy:=cy-asz.cy;
  778. end;
  779. function TSizeF.SwapDimensions:TSizeF;
  780. begin
  781. result.cx:=cy;
  782. result.cy:=cx;
  783. end;
  784. function TSizeF.Subtract(const asz: TSize): TSizeF;
  785. begin
  786. result.cx:=cx-asz.cx;
  787. result.cy:=cy-asz.cy;
  788. end;
  789. function TSizeF.Distance(const asz : TSizeF) : Single;
  790. begin
  791. result:=sqrt(sqr(asz.cx-cx)+sqr(asz.cy-cy));
  792. end;
  793. function TSizeF.IsZero : Boolean;
  794. begin
  795. result:=SameValue(cx,0.0) and SameValue(cy,0.0);
  796. end;
  797. function TSizeF.Scale(afactor: Single): TSizeF;
  798. begin
  799. result.cx:=afactor*cx;
  800. result.cy:=afactor*cy;
  801. end;
  802. function TSizeF.Ceiling: TSize;
  803. begin
  804. result.cx:=ceil(cx);
  805. result.cy:=ceil(cy);
  806. end;
  807. function TSizeF.Truncate: TSize;
  808. begin
  809. result.cx:=trunc(cx);
  810. result.cy:=trunc(cy);
  811. end;
  812. function TSizeF.Floor: TSize;
  813. begin
  814. result.cx:=Math.floor(cx);
  815. result.cy:=Math.floor(cy);
  816. end;
  817. function TSizeF.Round: TSize;
  818. begin
  819. result.cx:=System.round(cx);
  820. result.cy:=System.round(cy);
  821. end;
  822. function TSizeF.Length: Single;
  823. begin //distance(self) ?
  824. result:=sqrt(sqr(cx)+sqr(cy));
  825. end;
  826. class operator TSizeF.= (const asz1, asz2 : TSizeF) : Boolean;
  827. begin
  828. result:=SameValue(asz1.cx,asz2.cx) and SameValue(asz1.cy,asz2.cy);
  829. end;
  830. class operator TSizeF.<> (const asz1, asz2 : TSizeF): Boolean;
  831. begin
  832. result:=NOT (SameValue(asz1.cx,asz2.cx) and Samevalue(asz1.cy,asz2.cy));
  833. end;
  834. class operator TSizeF. * (afactor: single; const asz1: TSizeF): TSizeF;
  835. begin
  836. result:=asz1.Scale(afactor);
  837. end;
  838. class operator TSizeF. * (const asz1: TSizeF; afactor: single): TSizeF;
  839. begin
  840. result:=asz1.Scale(afactor);
  841. end;
  842. class operator TSizeF.+ (const asz1, asz2 : TSizeF): TSizeF;
  843. begin
  844. result.cx:=asz1.cx+asz2.cx;
  845. result.cy:=asz1.cy+asz2.cy;
  846. end;
  847. class operator TSizeF.- (const asz1, asz2 : TSizeF): TSizeF;
  848. begin
  849. result.cx:=asz1.cx-asz2.cx;
  850. result.cy:=asz1.cy-asz2.cy;
  851. end;
  852. class operator TSizeF. - (const asz1: TSizeF): TSizeF;
  853. begin
  854. Result.cx:=-asz1.cx;
  855. Result.cy:=-asz1.cy;
  856. end;
  857. class operator TSizeF. := (const apt: TPointF): TSizeF;
  858. begin
  859. Result.cx:=apt.x;
  860. Result.cy:=apt.y;
  861. end;
  862. class operator TSizeF. := (const asz: TSize): TSizeF;
  863. begin
  864. Result.cx := asz.cx;
  865. Result.cy := asz.cy;
  866. end;
  867. class operator TSizeF. := (const asz: TSizeF): TPointF;
  868. begin
  869. Result.x := asz.cx;
  870. Result.y := asz.cy;
  871. end;
  872. class function TSizeF.Create(const ax, ay: Single): TSizeF;
  873. begin
  874. Result.cx := ax;
  875. Result.cy := ay;
  876. end;
  877. class function TSizeF.Create(const asz: TSize): TSizeF;
  878. begin
  879. Result.cx := asz.cX;
  880. Result.cy := asz.cY;
  881. end;
  882. { TRectF }
  883. class operator TRectF. * (L, R: TRectF): TRectF;
  884. begin
  885. Result := TRectF.Intersect(L, R);
  886. end;
  887. class operator TRectF. + (L, R: TRectF): TRectF;
  888. begin
  889. Result := TRectF.Union(L, R);
  890. end;
  891. class operator TRectF. := (const arc: TRect): TRectF;
  892. begin
  893. Result.Left:=arc.Left;
  894. Result.Top:=arc.Top;
  895. Result.Right:=arc.Right;
  896. Result.Bottom:=arc.Bottom;
  897. end;
  898. class operator TRectF. <> (L, R: TRectF): Boolean;
  899. begin
  900. Result := not(L=R);
  901. end;
  902. class operator TRectF. = (L, R: TRectF): Boolean;
  903. begin
  904. Result :=
  905. SameValue(L.Left,R.Left) and SameValue(L.Right,R.Right) and
  906. SameValue(L.Top,R.Top) and SameValue(L.Bottom,R.Bottom);
  907. end;
  908. constructor TRectF.Create(ALeft, ATop, ARight, ABottom: Single);
  909. begin
  910. Left := ALeft;
  911. Top := ATop;
  912. Right := ARight;
  913. Bottom := ABottom;
  914. end;
  915. constructor TRectF.Create(P1, P2: TPointF; Normalize: Boolean);
  916. begin
  917. TopLeft := P1;
  918. BottomRight := P2;
  919. if Normalize then
  920. NormalizeRect;
  921. end;
  922. constructor TRectF.Create(Origin: TPointF);
  923. begin
  924. TopLeft := Origin;
  925. BottomRight := Origin;
  926. end;
  927. constructor TRectF.Create(Origin: TPointF; AWidth, AHeight: Single);
  928. begin
  929. TopLeft := Origin;
  930. Width := AWidth;
  931. Height := AHeight;
  932. end;
  933. constructor TRectF.Create(R: TRectF; Normalize: Boolean);
  934. begin
  935. Self := R;
  936. if Normalize then
  937. NormalizeRect;
  938. end;
  939. constructor TRectF.Create(R: TRect; Normalize: Boolean);
  940. begin
  941. Self := R;
  942. if Normalize then
  943. NormalizeRect;
  944. end;
  945. function TRectF.CenterPoint: TPointF;
  946. begin
  947. Result.X := (Right-Left) / 2 + Left;
  948. Result.Y := (Bottom-Top) / 2 + Top;
  949. end;
  950. function TRectF.FitInto(const Dest: TRectF; out Ratio: Single): TRectF;
  951. begin
  952. if (Dest.Width<=0) or (Dest.Height<=0) then
  953. begin
  954. Ratio:=1.0;
  955. exit(Self);
  956. end;
  957. Ratio:=Max(Self.Width / Dest.Width, Self.Height / Dest.Height);
  958. if Ratio=0 then
  959. exit(Self);
  960. Result.Width:=Self.Width / Ratio;
  961. Result.Height:=Self.Height / Ratio;
  962. Result.Left:=Self.Left + (Self.Width - Result.Width) / 2;
  963. Result.Top:=Self.Top + (Self.Height - Result.Height) / 2;
  964. end;
  965. function TRectF.FitInto(const Dest: TRectF): TRectF;
  966. var
  967. Ratio: Single;
  968. begin
  969. Result:=FitInto(Dest,Ratio);
  970. end;
  971. function TRectF.Contains(Pt: TPointF): Boolean;
  972. begin
  973. Result := (Left <= Pt.X) and (Pt.X < Right) and (Top <= Pt.Y) and (Pt.Y < Bottom);
  974. end;
  975. function TRectF.Contains(R: TRectF): Boolean;
  976. begin
  977. Result := (Left <= R.Left) and (R.Right <= Right) and (Top <= R.Top) and (R.Bottom <= Bottom);
  978. end;
  979. class function TRectF.Empty: TRectF;
  980. begin
  981. Result := TRectF.Create(0,0,0,0);
  982. end;
  983. function TRectF.GetHeight: Single;
  984. begin
  985. result:=bottom-top;
  986. end;
  987. function TRectF.GetLocation: TPointF;
  988. begin
  989. result.x:=Left; result.y:=top;
  990. end;
  991. function TRectF.GetSize: TSizeF;
  992. begin
  993. result.cx:=width; result.cy:=height;
  994. end;
  995. function TRectF.GetWidth: Single;
  996. begin
  997. result:=right-left;
  998. end;
  999. procedure TRectF.Inflate(DX, DY: Single);
  1000. begin
  1001. Left:=Left-dx;
  1002. Top:=Top-dy;
  1003. Right:=Right+dx;
  1004. Bottom:=Bottom+dy;
  1005. end;
  1006. procedure TRectF.Intersect(R: TRectF);
  1007. begin
  1008. Self := Intersect(Self, R);
  1009. end;
  1010. class function TRectF.Intersect(R1: TRectF; R2: TRectF): TRectF;
  1011. begin
  1012. Result := R1;
  1013. if R2.Left > R1.Left then
  1014. Result.Left := R2.Left;
  1015. if R2.Top > R1.Top then
  1016. Result.Top := R2.Top;
  1017. if R2.Right < R1.Right then
  1018. Result.Right := R2.Right;
  1019. if R2.Bottom < R1.Bottom then
  1020. Result.Bottom := R2.Bottom;
  1021. end;
  1022. function TRectF.IntersectsWith(R: TRectF): Boolean;
  1023. begin
  1024. Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom);
  1025. end;
  1026. function TRectF.IsEmpty: Boolean;
  1027. begin
  1028. Result := (CompareValue(Right,Left)<=0) or (CompareValue(Bottom,Top)<=0);
  1029. end;
  1030. procedure TRectF.NormalizeRect;
  1031. var
  1032. x: Single;
  1033. begin
  1034. if Top>Bottom then
  1035. begin
  1036. x := Top;
  1037. Top := Bottom;
  1038. Bottom := x;
  1039. end;
  1040. if Left>Right then
  1041. begin
  1042. x := Left;
  1043. Left := Right;
  1044. Right := x;
  1045. end
  1046. end;
  1047. procedure TRectF.Inflate(DL, DT, DR, DB: Single);
  1048. begin
  1049. Left:=Left-dl;
  1050. Top:=Top-dt;
  1051. Right:=Right+dr;
  1052. Bottom:=Bottom+db;
  1053. end;
  1054. procedure TRectF.Offset(const dx, dy: Single);
  1055. begin
  1056. left:=left+dx; right:=right+dx;
  1057. bottom:=bottom+dy; top:=top+dy;
  1058. end;
  1059. procedure TRectF.Offset(DP: TPointF);
  1060. begin
  1061. left:=left+DP.x; right:=right+DP.x;
  1062. bottom:=bottom+DP.y; top:=top+DP.y;
  1063. end;
  1064. procedure TRectF.SetHeight(AValue: Single);
  1065. begin
  1066. bottom:=top+avalue;
  1067. end;
  1068. procedure TRectF.SetLocation(X, Y: Single);
  1069. begin
  1070. Offset(X-Left, Y-Top);
  1071. end;
  1072. procedure TRectF.SetLocation(P: TPointF);
  1073. begin
  1074. SetLocation(P.X, P.Y);
  1075. end;
  1076. procedure TRectF.SetSize(AValue: TSizeF);
  1077. begin
  1078. bottom:=top+avalue.cy;
  1079. right:=left+avalue.cx;
  1080. end;
  1081. procedure TRectF.SetWidth(AValue: Single);
  1082. begin
  1083. right:=left+avalue;
  1084. end;
  1085. class function TRectF.Union(const Points: array of TPointF): TRectF;
  1086. var
  1087. i: Integer;
  1088. begin
  1089. if Length(Points) > 0 then
  1090. begin
  1091. Result.TopLeft := Points[Low(Points)];
  1092. Result.BottomRight := Points[Low(Points)];
  1093. for i := Low(Points)+1 to High(Points) do
  1094. begin
  1095. if Points[i].X < Result.Left then Result.Left := Points[i].X;
  1096. if Points[i].X > Result.Right then Result.Right := Points[i].X;
  1097. if Points[i].Y < Result.Top then Result.Top := Points[i].Y;
  1098. if Points[i].Y > Result.Bottom then Result.Bottom := Points[i].Y;
  1099. end;
  1100. end else
  1101. Result := Empty;
  1102. end;
  1103. procedure TRectF.Union(const r: TRectF);
  1104. begin
  1105. left:=min(r.left,left);
  1106. top:=min(r.top,top);
  1107. right:=max(r.right,right);
  1108. bottom:=max(r.bottom,bottom);
  1109. end;
  1110. class function TRectF.Union(R1, R2: TRectF): TRectF;
  1111. begin
  1112. Result:=R1;
  1113. Result.Union(R2);
  1114. end;
  1115. { TPoint3D }
  1116. constructor TPoint3D.Create(const ax,ay,az:single);
  1117. begin
  1118. x:=ax; y:=ay; z:=az;
  1119. end;
  1120. procedure TPoint3D.Offset(const adeltax,adeltay,adeltaz:single);
  1121. begin
  1122. x:=x+adeltax; y:=y+adeltay; z:=z+adeltaz;
  1123. end;
  1124. procedure TPoint3D.Offset(const adelta:TPoint3D);
  1125. begin
  1126. x:=x+adelta.x; y:=y+adelta.y; z:=z+adelta.z;
  1127. end;
  1128. {$ifndef VER3_0}
  1129. generic class procedure TBitConverter.UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  1130. begin
  1131. move(ASrcValue, ADestination[AOffset], SizeOf(T));
  1132. end;
  1133. generic class procedure TBitConverter.From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  1134. begin
  1135. if AOffset < 0 then
  1136. System.Error(reRangeError);
  1137. if IsManagedType(T) then
  1138. System.Error(reInvalidCast);
  1139. if Length(ADestination) < (SizeOf(T) + AOffset) then
  1140. System.Error(reRangeError);
  1141. TBitConverter.specialize UnsafeFrom<T>(ASrcValue, ADestination, AOffset);
  1142. end;
  1143. generic class function TBitConverter.UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  1144. begin
  1145. move(ASource[AOffset], Result, SizeOf(T));
  1146. end;
  1147. generic class function TBitConverter.InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  1148. begin
  1149. if AOffset < 0 then
  1150. System.Error(reRangeError);
  1151. if IsManagedType(T) then
  1152. System.Error(reInvalidCast);
  1153. if Length(ASource) < (SizeOf(T) + AOffset) then
  1154. System.Error(reRangeError);
  1155. Result := TBitConverter.specialize UnsafeInTo<T>(ASource, AOffset);
  1156. end;
  1157. {$endif}
  1158. end.