types.pp 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783
  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. type
  31. TEndian = Objpas.TEndian;
  32. TDirection = (FromBeginning, FromEnd);
  33. TValueRelationship = -1..1;
  34. DWORD = LongWord;
  35. PLongint = System.PLongint;
  36. PSmallInt = System.PSmallInt;
  37. {$ifndef FPUNONE}
  38. PDouble = System.PDouble;
  39. {$endif}
  40. PByte = System.PByte;
  41. Largeint = int64;
  42. LARGE_INT = LargeInt;
  43. PLargeInt = ^LargeInt;
  44. LargeUint = qword;
  45. LARGE_UINT= LargeUInt;
  46. PLargeuInt = ^LargeuInt;
  47. TBooleanDynArray = array of Boolean;
  48. TByteDynArray = array of Byte;
  49. TCardinalDynArray = array of Cardinal;
  50. TInt64DynArray = array of Int64;
  51. TIntegerDynArray = array of Integer;
  52. TLongWordDynArray = array of LongWord;
  53. TPointerDynArray = array of Pointer;
  54. TQWordDynArray = array of QWord;
  55. TShortIntDynArray = array of ShortInt;
  56. TSmallIntDynArray = array of SmallInt;
  57. TStringDynArray = array of AnsiString;
  58. TObjectDynArray = array of TObject;
  59. TWideStringDynArray = array of WideString;
  60. TWordDynArray = array of Word;
  61. TCurrencyArray = Array of currency;
  62. {$ifndef FPUNONE}
  63. TSingleDynArray = array of Single;
  64. TDoubleDynArray = array of Double;
  65. TExtendedDynArray = array of Extended;
  66. TCompDynArray = array of Comp;
  67. {$endif}
  68. {$if defined(win32) or defined(win64) or defined(wince)}
  69. TArray4IntegerType = Windows.TArray4IntegerType;
  70. TSmallPoint = Windows.TSmallPoint;
  71. PSmallPoint = Windows.PSmallPoint;
  72. TSize = Windows.TSize;
  73. TagSize = Windows.tagSize deprecated;
  74. PSize = Windows.PSize;
  75. TPoint = Windows.TPoint;
  76. TagPoint = Windows.TagPoint deprecated;
  77. PPoint = Windows.PPoint;
  78. TRect = Windows.TRect;
  79. PRect = Windows.PRect;
  80. TSplitRectType = Windows.TSplitRectType;
  81. const
  82. srLeft = TSplitRectType.srLeft;
  83. srRight = TSplitRectType.srRight;
  84. srTop = TSplitRectType.srTop;
  85. srBottom = TSplitRectType.srBottom;
  86. type
  87. {$else}
  88. {$i typshrdh.inc}
  89. TagSize = tSize deprecated;
  90. TagPoint = TPoint deprecated;
  91. {$endif}
  92. { TPointF }
  93. TPointF =
  94. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  95. packed
  96. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  97. record
  98. x,y : Single;
  99. public
  100. function Add(const apt: TPoint): TPointF;
  101. function Add(const apt: TPointF): TPointF;
  102. function Distance(const apt : TPointF) : Single;
  103. function DotProduct(const apt : TPointF) : Single;
  104. function IsZero : Boolean;
  105. function Subtract(const apt : TPointF): TPointF;
  106. function Subtract(const apt : TPoint): TPointF;
  107. procedure SetLocation(const apt :TPointF);
  108. procedure SetLocation(const apt :TPoint);
  109. procedure SetLocation(ax,ay : Single);
  110. procedure Offset(const apt :TPointF);
  111. procedure Offset(const apt :TPoint);
  112. procedure Offset(dx,dy : Single);
  113. function Scale (afactor:Single) : TPointF;
  114. function Ceiling : TPoint;
  115. function Truncate: TPoint;
  116. function Floor : TPoint;
  117. function Round : TPoint;
  118. function Length : Single;
  119. class function Create(const ax, ay: Single): TPointF; overload; static; inline;
  120. class function Create(const apt: TPoint): TPointF; overload; static; inline;
  121. class operator = (const apt1, apt2 : TPointF) : Boolean;
  122. class operator <> (const apt1, apt2 : TPointF): Boolean;
  123. class operator + (const apt1, apt2 : TPointF): TPointF;
  124. class operator - (const apt1, apt2 : TPointF): TPointF;
  125. class operator - (const apt1 : TPointF): TPointF;
  126. class operator * (const apt1, apt2: TPointF): Single; // scalar product
  127. class operator * (const apt1: TPointF; afactor: single): TPointF;
  128. class operator * (afactor: single; const apt1: TPointF): TPointF;
  129. end;
  130. { TRectF }
  131. TRectF =
  132. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  133. packed
  134. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  135. record
  136. private
  137. function GetHeight: Single; inline;
  138. function GetWidth: Single; inline;
  139. procedure SetHeight(AValue: Single);
  140. procedure SetWidth (AValue: Single);
  141. public
  142. function Union (const r: TRectF):TRectF; inline;
  143. procedure Offset (const dx,dy : Single); inline;
  144. property Width : Single read GetWidth write SetWidth;
  145. property Height : Single read GetHeight write SetHeight;
  146. case Integer of
  147. 0: (Left, Top, Right, Bottom: Single);
  148. 1: (TopLeft, BottomRight: TPointF);
  149. end;
  150. TDuplicates = (dupIgnore, dupAccept, dupError);
  151. TPoint3D =
  152. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  153. packed
  154. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  155. record
  156. public
  157. Type TSingle3Array = array[0..2] of single;
  158. constructor Create(const ax,ay,az:single);
  159. procedure Offset(const adeltax,adeltay,adeltaz:single); inline;
  160. procedure Offset(const adelta:TPoint3D); inline;
  161. public
  162. case Integer of
  163. 0: (data:TSingle3Array);
  164. 1: (x,y,z : single);
  165. end;
  166. type
  167. TOleChar = WideChar;
  168. POleStr = PWideChar;
  169. PPOleStr = ^POleStr;
  170. TListCallback = procedure(data,arg:pointer) of object;
  171. TListStaticCallback = procedure(data,arg:pointer);
  172. const
  173. GUID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';
  174. STGTY_STORAGE = 1;
  175. STGTY_STREAM = 2;
  176. STGTY_LOCKBYTES = 3;
  177. STGTY_PROPERTY = 4;
  178. STREAM_SEEK_SET = 0;
  179. STREAM_SEEK_CUR = 1;
  180. STREAM_SEEK_END = 2;
  181. LOCK_WRITE = 1;
  182. LOCK_EXCLUSIVE = 2;
  183. LOCK_ONLYONCE = 4;
  184. STATFLAG_DEFAULT = 0;
  185. STATFLAG_NONAME = 1;
  186. STATFLAG_NOOPEN = 2;
  187. {$ifndef Wince}
  188. // in Wince these are in unit windows. Under 32/64 in ActiveX.
  189. // for now duplicate them. Not that bad for untyped constants.
  190. E_FAIL = HRESULT($80004005);
  191. E_INVALIDARG = HRESULT($80070057);
  192. STG_E_INVALIDFUNCTION = HRESULT($80030001);
  193. STG_E_FILENOTFOUND = HRESULT($80030002);
  194. STG_E_PATHNOTFOUND = HRESULT($80030003);
  195. STG_E_TOOMANYOPENFILES = HRESULT($80030004);
  196. STG_E_ACCESSDENIED = HRESULT($80030005);
  197. STG_E_INVALIDHANDLE = HRESULT($80030006);
  198. STG_E_INSUFFICIENTMEMORY = HRESULT($80030008);
  199. STG_E_INVALIDPOINTER = HRESULT($80030009);
  200. STG_E_NOMOREFILES = HRESULT($80030012);
  201. STG_E_DISKISWRITEPROTECTED = HRESULT($80030013);
  202. STG_E_SEEKERROR = HRESULT($80030019);
  203. STG_E_WRITEFAULT = HRESULT($8003001D);
  204. STG_E_READFAULT = HRESULT($8003001E);
  205. STG_E_SHAREVIOLATION = HRESULT($80030020);
  206. STG_E_LOCKVIOLATION = HRESULT($80030021);
  207. STG_E_FILEALREADYEXISTS = HRESULT($80030050);
  208. STG_E_INVALIDPARAMETER = HRESULT($80030057);
  209. STG_E_MEDIUMFULL = HRESULT($80030070);
  210. STG_E_PROPSETMISMATCHED = HRESULT($800300F0);
  211. STG_E_ABNORMALAPIEXIT = HRESULT($800300FA);
  212. STG_E_INVALIDHEADER = HRESULT($800300FB);
  213. STG_E_INVALIDNAME = HRESULT($800300FC);
  214. STG_E_UNKNOWN = HRESULT($800300FD);
  215. STG_E_UNIMPLEMENTEDFUNCTION = HRESULT($800300FE);
  216. STG_E_INVALIDFLAG = HRESULT($800300FF);
  217. STG_E_INUSE = HRESULT($80030100);
  218. STG_E_NOTCURRENT = HRESULT($80030101);
  219. STG_E_REVERTED = HRESULT($80030102);
  220. STG_E_CANTSAVE = HRESULT($80030103);
  221. STG_E_OLDFORMAT = HRESULT($80030104);
  222. STG_E_OLDDLL = HRESULT($80030105);
  223. STG_E_SHAREREQUIRED = HRESULT($80030106);
  224. STG_E_EXTANTMARSHALLINGS = HRESULT($80030108);
  225. STG_E_DOCFILECORRUPT = HRESULT($80030109);
  226. STG_E_BADBASEADDRESS = HRESULT($80030110);
  227. STG_E_INCOMPLETE = HRESULT($80030201);
  228. STG_E_TERMINATED = HRESULT($80030202);
  229. STG_S_CONVERTED = $00030200;
  230. STG_S_BLOCK = $00030201;
  231. STG_S_RETRYNOW = $00030202;
  232. STG_S_MONITORING = $00030203;
  233. {$endif}
  234. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  235. type
  236. PCLSID = PGUID;
  237. TCLSID = TGUID;
  238. PDWord = ^DWord;
  239. PDisplay = Pointer;
  240. PEvent = Pointer;
  241. TXrmOptionDescRec = record
  242. end;
  243. XrmOptionDescRec = TXrmOptionDescRec;
  244. PXrmOptionDescRec = ^TXrmOptionDescRec;
  245. Widget = Pointer;
  246. WidgetClass = Pointer;
  247. ArgList = Pointer;
  248. Region = Pointer;
  249. _FILETIME =
  250. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  251. packed
  252. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  253. record
  254. dwLowDateTime : DWORD;
  255. dwHighDateTime : DWORD;
  256. end;
  257. TFileTime = _FILETIME;
  258. FILETIME = _FILETIME;
  259. PFileTime = ^TFileTime;
  260. {$else}
  261. type
  262. PCLSID = Windows.PCLSID;
  263. TCLSID = Windows.CLSID;
  264. TFiletime = Windows.TFileTime;
  265. Filetime = Windows.FileTime;
  266. PFiletime = Windows.PFileTime;
  267. {$endif Windows}
  268. type
  269. tagSTATSTG = record
  270. pwcsName : POleStr;
  271. dwType : DWord;
  272. cbSize : Large_uint;
  273. mtime : TFileTime;
  274. ctime : TFileTime;
  275. atime : TFileTime;
  276. grfMode : DWord;
  277. grfLocksSupported : DWord;
  278. clsid : TCLSID;
  279. grfStateBits : DWord;
  280. reserved : DWord;
  281. end;
  282. TStatStg = tagSTATSTG;
  283. STATSTG = TStatStg;
  284. PStatStg = ^TStatStg;
  285. { classes depends on these interfaces, we can't use the activex unit in classes though }
  286. IClassFactory = Interface(IUnknown) ['{00000001-0000-0000-C000-000000000046}']
  287. Function CreateInstance(Const unkOuter : IUnknown;Const riid : TGUID;Out vObject) : HResult;StdCall;
  288. Function LockServer(fLock : LongBool) : HResult;StdCall;
  289. End;
  290. ISequentialStream = interface(IUnknown)
  291. ['{0c733a30-2a1c-11ce-ade5-00aa0044773d}']
  292. function Read(pv : Pointer;cb : DWORD;pcbRead : PDWORD) : HRESULT;stdcall;
  293. function Write(pv : Pointer;cb : DWORD;pcbWritten : PDWORD): HRESULT;stdcall;
  294. end;
  295. IStream = interface(ISequentialStream) ['{0000000C-0000-0000-C000-000000000046}']
  296. function Seek(dlibMove : LargeInt; dwOrigin : DWORD; out libNewPosition : LargeUInt) : HResult;stdcall;
  297. function SetSize(libNewSize : LargeUInt) : HRESULT;stdcall;
  298. function CopyTo(stm: IStream;cb : LargeUInt;out cbRead : LargeUInt; out cbWritten : LargeUInt) : HRESULT;stdcall;
  299. function Commit(grfCommitFlags : DWORD) : HRESULT;stdcall;
  300. function Revert : HRESULT;stdcall;
  301. function LockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
  302. function UnlockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
  303. Function Stat(out statstg : TStatStg;grfStatFlag : DWORD) : HRESULT;stdcall;
  304. function Clone(out stm : IStream) : HRESULT;stdcall;
  305. end;
  306. function EqualRect(const r1,r2 : TRect) : Boolean;
  307. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  308. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  309. function Point(x,y : Integer) : TPoint; inline;
  310. function PtInRect(const Rect : TRect; const p : TPoint) : Boolean;
  311. function IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  312. function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  313. function IsRectEmpty(const Rect : TRect) : Boolean;
  314. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  315. function CenterPoint(const Rect: TRect): TPoint;
  316. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  317. function Size(AWidth, AHeight: Integer): TSize; inline;
  318. function Size(const ARect: TRect): TSize;
  319. {$ifndef VER3_0}
  320. type
  321. TBitConverter = class
  322. generic class procedure UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static; {inline;}
  323. generic class procedure From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static;
  324. generic class function UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static; {inline;}
  325. generic class function InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static;
  326. end;
  327. {$endif}
  328. implementation
  329. Uses Math;
  330. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  331. {$i typshrd.inc}
  332. {$endif}
  333. function EqualRect(const r1,r2 : TRect) : Boolean;
  334. begin
  335. EqualRect:=(r1.left=r2.left) and (r1.right=r2.right) and (r1.top=r2.top) and (r1.bottom=r2.bottom);
  336. end;
  337. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  338. begin
  339. Rect.Left:=Left;
  340. Rect.Top:=Top;
  341. Rect.Right:=Right;
  342. Rect.Bottom:=Bottom;
  343. end;
  344. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  345. begin
  346. Bounds.Left:=ALeft;
  347. Bounds.Top:=ATop;
  348. Bounds.Right:=ALeft+AWidth;
  349. Bounds.Bottom:=ATop+AHeight;
  350. end;
  351. function Point(x,y : Integer) : TPoint; inline;
  352. begin
  353. Point.x:=x;
  354. Point.y:=y;
  355. end;
  356. function PtInRect(const Rect : TRect;const p : TPoint) : Boolean;
  357. begin
  358. PtInRect:=(p.y>=Rect.Top) and
  359. (p.y<Rect.Bottom) and
  360. (p.x>=Rect.Left) and
  361. (p.x<Rect.Right);
  362. end;
  363. function IntersectRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  364. var
  365. lRect: TRect;
  366. begin
  367. lRect := R1;
  368. if R2.Left > R1.Left then
  369. lRect.Left := R2.Left;
  370. if R2.Top > R1.Top then
  371. lRect.Top := R2.Top;
  372. if R2.Right < R1.Right then
  373. lRect.Right := R2.Right;
  374. if R2.Bottom < R1.Bottom then
  375. lRect.Bottom := R2.Bottom;
  376. // The var parameter is only assigned in the end to avoid problems
  377. // when passing the same rectangle in the var and const parameters.
  378. // See http://bugs.freepascal.org/view.php?id=17722
  379. Result:=not IsRectEmpty(lRect);
  380. if Result then
  381. Rect := lRect
  382. else
  383. FillChar(Rect,SizeOf(Rect),0);
  384. end;
  385. function UnionRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  386. var
  387. lRect: TRect;
  388. begin
  389. lRect:=R1;
  390. if R2.Left<R1.Left then
  391. lRect.Left:=R2.Left;
  392. if R2.Top<R1.Top then
  393. lRect.Top:=R2.Top;
  394. if R2.Right>R1.Right then
  395. lRect.Right:=R2.Right;
  396. if R2.Bottom>R1.Bottom then
  397. lRect.Bottom:=R2.Bottom;
  398. Result:=not IsRectEmpty(lRect);
  399. if Result then
  400. Rect := lRect
  401. else
  402. FillChar(Rect,SizeOf(Rect),0);
  403. end;
  404. function IsRectEmpty(const Rect : TRect) : Boolean;
  405. begin
  406. IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
  407. end;
  408. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  409. begin
  410. Result:=assigned(@Rect);
  411. if Result then
  412. with Rect do
  413. begin
  414. inc(Left,dx);
  415. inc(Top,dy);
  416. inc(Right,dx);
  417. inc(Bottom,dy);
  418. end;
  419. end;
  420. function Avg(a, b: Longint): Longint;
  421. begin
  422. if a < b then
  423. Result := a + ((b - a) shr 1)
  424. else
  425. Result := b + ((a - b) shr 1);
  426. end;
  427. function CenterPoint(const Rect: TRect): TPoint;
  428. begin
  429. with Rect do
  430. begin
  431. Result.X := Avg(Left, Right);
  432. Result.Y := Avg(Top, Bottom);
  433. end;
  434. end;
  435. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  436. begin
  437. Result:=assigned(@Rect);
  438. if Result then
  439. with Rect do
  440. begin
  441. dec(Left, dx);
  442. dec(Top, dy);
  443. inc(Right, dx);
  444. inc(Bottom, dy);
  445. end;
  446. end;
  447. function Size(AWidth, AHeight: Integer): TSize; inline;
  448. begin
  449. Result.cx := AWidth;
  450. Result.cy := AHeight;
  451. end;
  452. function Size(const ARect: TRect): TSize; inline;
  453. begin
  454. Result.cx := ARect.Right - ARect.Left;
  455. Result.cy := ARect.Bottom - ARect.Top;
  456. end;
  457. { TPointF}
  458. function TPointF.Add(const apt: TPoint): TPointF;
  459. begin
  460. result.x:=x+apt.x;
  461. result.y:=y+apt.y;
  462. end;
  463. function TPointF.Add(const apt: TPointF): TPointF;
  464. begin
  465. result.x:=x+apt.x;
  466. result.y:=y+apt.y;
  467. end;
  468. function TPointF.Subtract(const apt : TPointF): TPointF;
  469. begin
  470. result.x:=x-apt.x;
  471. result.y:=y-apt.y;
  472. end;
  473. function TPointF.Subtract(const apt: TPoint): TPointF;
  474. begin
  475. result.x:=x-apt.x;
  476. result.y:=y-apt.y;
  477. end;
  478. function TPointF.Distance(const apt : TPointF) : Single;
  479. begin
  480. result:=sqrt(sqr(apt.x-x)+sqr(apt.y-y));
  481. end;
  482. function TPointF.DotProduct(const apt: TPointF): Single;
  483. begin
  484. result:=x*apt.x+y*apt.y;
  485. end;
  486. function TPointF.IsZero : Boolean;
  487. begin
  488. result:=SameValue(x,0.0) and SameValue(y,0.0);
  489. end;
  490. procedure TPointF.Offset(const apt :TPointF);
  491. begin
  492. x:=x+apt.x;
  493. y:=y+apt.y;
  494. end;
  495. procedure TPointF.Offset(const apt: TPoint);
  496. begin
  497. x:=x+apt.x;
  498. y:=y+apt.y;
  499. end;
  500. procedure TPointF.Offset(dx,dy : Single);
  501. begin
  502. x:=x+dx;
  503. y:=y+dy;
  504. end;
  505. function TPointF.Scale(afactor: Single): TPointF;
  506. begin
  507. result.x:=afactor*x;
  508. result.y:=afactor*y;
  509. end;
  510. function TPointF.Ceiling: TPoint;
  511. begin
  512. result.x:=ceil(x);
  513. result.y:=ceil(y);
  514. end;
  515. function TPointF.Truncate: TPoint;
  516. begin
  517. result.x:=trunc(x);
  518. result.y:=trunc(y);
  519. end;
  520. function TPointF.Floor: TPoint;
  521. begin
  522. result.x:=Math.floor(x);
  523. result.y:=Math.floor(y);
  524. end;
  525. function TPointF.Round: TPoint;
  526. begin
  527. result.x:=System.round(x);
  528. result.y:=System.round(y);
  529. end;
  530. function TPointF.Length: Single;
  531. begin //distance(self) ?
  532. result:=sqrt(sqr(x)+sqr(y));
  533. end;
  534. class operator TPointF.= (const apt1, apt2 : TPointF) : Boolean;
  535. begin
  536. result:=SameValue(apt1.x,apt2.x) and SameValue(apt1.y,apt2.y);
  537. end;
  538. class operator TPointF.<> (const apt1, apt2 : TPointF): Boolean;
  539. begin
  540. result:=NOT (SameValue(apt1.x,apt2.x) and Samevalue(apt1.y,apt2.y));
  541. end;
  542. class operator TPointF. * (const apt1, apt2: TPointF): Single;
  543. begin
  544. result:=apt1.x*apt2.x + apt1.y*apt2.y;
  545. end;
  546. class operator TPointF. * (afactor: single; const apt1: TPointF): TPointF;
  547. begin
  548. result:=apt1.Scale(afactor);
  549. end;
  550. class operator TPointF. * (const apt1: TPointF; afactor: single): TPointF;
  551. begin
  552. result:=apt1.Scale(afactor);
  553. end;
  554. class operator TPointF.+ (const apt1, apt2 : TPointF): TPointF;
  555. begin
  556. result.x:=apt1.x+apt2.x;
  557. result.y:=apt1.y+apt2.y;
  558. end;
  559. class operator TPointF.- (const apt1, apt2 : TPointF): TPointF;
  560. begin
  561. result.x:=apt1.x-apt2.x;
  562. result.y:=apt1.y-apt2.y;
  563. end;
  564. class operator TPointF. - (const apt1: TPointF): TPointF;
  565. begin
  566. Result.x:=-apt1.x;
  567. Result.y:=-apt1.y;
  568. end;
  569. procedure TPointF.SetLocation(const apt :TPointF);
  570. begin
  571. x:=apt.x; y:=apt.y;
  572. end;
  573. procedure TPointF.SetLocation(const apt: TPoint);
  574. begin
  575. x:=apt.x; y:=apt.y;
  576. end;
  577. procedure TPointF.SetLocation(ax,ay : Single);
  578. begin
  579. x:=ax; y:=ay;
  580. end;
  581. class function TPointF.Create(const ax, ay: Single): TPointF;
  582. begin
  583. Result.x := ax;
  584. Result.y := ay;
  585. end;
  586. class function TPointF.Create(const apt: TPoint): TPointF;
  587. begin
  588. Result.x := apt.X;
  589. Result.y := apt.Y;
  590. end;
  591. { TRectF }
  592. function TRectF.GetHeight: Single;
  593. begin
  594. result:=bottom-top;
  595. end;
  596. function TRectF.GetWidth: Single;
  597. begin
  598. result:=right-left;
  599. end;
  600. procedure TRectF.SetHeight(AValue: Single);
  601. begin
  602. bottom:=top+avalue;
  603. end;
  604. procedure TRectF.SetWidth(AValue: Single);
  605. begin
  606. right:=left+avalue;
  607. end;
  608. function TRectF.Union(const r: TRectF): TRectF;
  609. begin
  610. result.left:=min(r.left,left);
  611. result.top:=min(r.top,top);
  612. result.right:=max(r.right,right);
  613. result.bottom:=max(r.bottom,bottom);
  614. end;
  615. procedure TRectF.Offset(const dx, dy: Single);
  616. begin
  617. left:=left+dx; right:=right+dx;
  618. bottom:=bottom+dy; top:=top+dy;
  619. end;
  620. { TPoint3D }
  621. constructor TPoint3D.Create(const ax,ay,az:single);
  622. begin
  623. x:=ax; y:=ay; z:=az;
  624. end;
  625. procedure TPoint3D.Offset(const adeltax,adeltay,adeltaz:single);
  626. begin
  627. x:=x+adeltax; y:=y+adeltay; z:=z+adeltaz;
  628. end;
  629. procedure TPoint3D.Offset(const adelta:TPoint3D);
  630. begin
  631. x:=x+adelta.x; y:=y+adelta.y; z:=z+adelta.z;
  632. end;
  633. {$ifndef VER3_0}
  634. generic class procedure TBitConverter.UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  635. begin
  636. move(ASrcValue, ADestination[AOffset], SizeOf(T));
  637. end;
  638. generic class procedure TBitConverter.From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  639. begin
  640. if AOffset < 0 then
  641. System.Error(reRangeError);
  642. if IsManagedType(T) then
  643. System.Error(reInvalidCast);
  644. if Length(ADestination) < (SizeOf(T) + AOffset) then
  645. System.Error(reRangeError);
  646. TBitConverter.specialize UnsafeFrom<T>(ASrcValue, ADestination, AOffset);
  647. end;
  648. generic class function TBitConverter.UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  649. begin
  650. move(ASource[AOffset], Result, SizeOf(T));
  651. end;
  652. generic class function TBitConverter.InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  653. begin
  654. if AOffset < 0 then
  655. System.Error(reRangeError);
  656. if IsManagedType(T) then
  657. System.Error(reInvalidCast);
  658. if Length(ASource) < (SizeOf(T) + AOffset) then
  659. System.Error(reRangeError);
  660. Result := TBitConverter.specialize UnsafeInTo<T>(ASource, AOffset);
  661. end;
  662. {$endif}
  663. end.