types.pp 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748
  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. type
  152. TOleChar = WideChar;
  153. POleStr = PWideChar;
  154. PPOleStr = ^POleStr;
  155. TListCallback = procedure(data,arg:pointer) of object;
  156. TListStaticCallback = procedure(data,arg:pointer);
  157. const
  158. GUID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';
  159. STGTY_STORAGE = 1;
  160. STGTY_STREAM = 2;
  161. STGTY_LOCKBYTES = 3;
  162. STGTY_PROPERTY = 4;
  163. STREAM_SEEK_SET = 0;
  164. STREAM_SEEK_CUR = 1;
  165. STREAM_SEEK_END = 2;
  166. LOCK_WRITE = 1;
  167. LOCK_EXCLUSIVE = 2;
  168. LOCK_ONLYONCE = 4;
  169. STATFLAG_DEFAULT = 0;
  170. STATFLAG_NONAME = 1;
  171. STATFLAG_NOOPEN = 2;
  172. {$ifndef Wince}
  173. // in Wince these are in unit windows. Under 32/64 in ActiveX.
  174. // for now duplicate them. Not that bad for untyped constants.
  175. E_FAIL = HRESULT($80004005);
  176. E_INVALIDARG = HRESULT($80070057);
  177. STG_E_INVALIDFUNCTION = HRESULT($80030001);
  178. STG_E_FILENOTFOUND = HRESULT($80030002);
  179. STG_E_PATHNOTFOUND = HRESULT($80030003);
  180. STG_E_TOOMANYOPENFILES = HRESULT($80030004);
  181. STG_E_ACCESSDENIED = HRESULT($80030005);
  182. STG_E_INVALIDHANDLE = HRESULT($80030006);
  183. STG_E_INSUFFICIENTMEMORY = HRESULT($80030008);
  184. STG_E_INVALIDPOINTER = HRESULT($80030009);
  185. STG_E_NOMOREFILES = HRESULT($80030012);
  186. STG_E_DISKISWRITEPROTECTED = HRESULT($80030013);
  187. STG_E_SEEKERROR = HRESULT($80030019);
  188. STG_E_WRITEFAULT = HRESULT($8003001D);
  189. STG_E_READFAULT = HRESULT($8003001E);
  190. STG_E_SHAREVIOLATION = HRESULT($80030020);
  191. STG_E_LOCKVIOLATION = HRESULT($80030021);
  192. STG_E_FILEALREADYEXISTS = HRESULT($80030050);
  193. STG_E_INVALIDPARAMETER = HRESULT($80030057);
  194. STG_E_MEDIUMFULL = HRESULT($80030070);
  195. STG_E_PROPSETMISMATCHED = HRESULT($800300F0);
  196. STG_E_ABNORMALAPIEXIT = HRESULT($800300FA);
  197. STG_E_INVALIDHEADER = HRESULT($800300FB);
  198. STG_E_INVALIDNAME = HRESULT($800300FC);
  199. STG_E_UNKNOWN = HRESULT($800300FD);
  200. STG_E_UNIMPLEMENTEDFUNCTION = HRESULT($800300FE);
  201. STG_E_INVALIDFLAG = HRESULT($800300FF);
  202. STG_E_INUSE = HRESULT($80030100);
  203. STG_E_NOTCURRENT = HRESULT($80030101);
  204. STG_E_REVERTED = HRESULT($80030102);
  205. STG_E_CANTSAVE = HRESULT($80030103);
  206. STG_E_OLDFORMAT = HRESULT($80030104);
  207. STG_E_OLDDLL = HRESULT($80030105);
  208. STG_E_SHAREREQUIRED = HRESULT($80030106);
  209. STG_E_EXTANTMARSHALLINGS = HRESULT($80030108);
  210. STG_E_DOCFILECORRUPT = HRESULT($80030109);
  211. STG_E_BADBASEADDRESS = HRESULT($80030110);
  212. STG_E_INCOMPLETE = HRESULT($80030201);
  213. STG_E_TERMINATED = HRESULT($80030202);
  214. STG_S_CONVERTED = $00030200;
  215. STG_S_BLOCK = $00030201;
  216. STG_S_RETRYNOW = $00030202;
  217. STG_S_MONITORING = $00030203;
  218. {$endif}
  219. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  220. type
  221. PCLSID = PGUID;
  222. TCLSID = TGUID;
  223. PDWord = ^DWord;
  224. PDisplay = Pointer;
  225. PEvent = Pointer;
  226. TXrmOptionDescRec = record
  227. end;
  228. XrmOptionDescRec = TXrmOptionDescRec;
  229. PXrmOptionDescRec = ^TXrmOptionDescRec;
  230. Widget = Pointer;
  231. WidgetClass = Pointer;
  232. ArgList = Pointer;
  233. Region = Pointer;
  234. _FILETIME =
  235. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  236. packed
  237. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  238. record
  239. dwLowDateTime : DWORD;
  240. dwHighDateTime : DWORD;
  241. end;
  242. TFileTime = _FILETIME;
  243. FILETIME = _FILETIME;
  244. PFileTime = ^TFileTime;
  245. {$else}
  246. type
  247. PCLSID = Windows.PCLSID;
  248. TCLSID = Windows.CLSID;
  249. TFiletime = Windows.TFileTime;
  250. Filetime = Windows.FileTime;
  251. PFiletime = Windows.PFileTime;
  252. {$endif Windows}
  253. type
  254. tagSTATSTG = record
  255. pwcsName : POleStr;
  256. dwType : DWord;
  257. cbSize : Large_uint;
  258. mtime : TFileTime;
  259. ctime : TFileTime;
  260. atime : TFileTime;
  261. grfMode : DWord;
  262. grfLocksSupported : DWord;
  263. clsid : TCLSID;
  264. grfStateBits : DWord;
  265. reserved : DWord;
  266. end;
  267. TStatStg = tagSTATSTG;
  268. STATSTG = TStatStg;
  269. PStatStg = ^TStatStg;
  270. { classes depends on these interfaces, we can't use the activex unit in classes though }
  271. IClassFactory = Interface(IUnknown) ['{00000001-0000-0000-C000-000000000046}']
  272. Function CreateInstance(Const unkOuter : IUnknown;Const riid : TGUID;Out vObject) : HResult;StdCall;
  273. Function LockServer(fLock : LongBool) : HResult;StdCall;
  274. End;
  275. ISequentialStream = interface(IUnknown)
  276. ['{0c733a30-2a1c-11ce-ade5-00aa0044773d}']
  277. function Read(pv : Pointer;cb : DWORD;pcbRead : PDWORD) : HRESULT;stdcall;
  278. function Write(pv : Pointer;cb : DWORD;pcbWritten : PDWORD): HRESULT;stdcall;
  279. end;
  280. IStream = interface(ISequentialStream) ['{0000000C-0000-0000-C000-000000000046}']
  281. function Seek(dlibMove : LargeInt; dwOrigin : DWORD; out libNewPosition : LargeUInt) : HResult;stdcall;
  282. function SetSize(libNewSize : LargeUInt) : HRESULT;stdcall;
  283. function CopyTo(stm: IStream;cb : LargeUInt;out cbRead : LargeUInt; out cbWritten : LargeUInt) : HRESULT;stdcall;
  284. function Commit(grfCommitFlags : DWORD) : HRESULT;stdcall;
  285. function Revert : HRESULT;stdcall;
  286. function LockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
  287. function UnlockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
  288. Function Stat(out statstg : TStatStg;grfStatFlag : DWORD) : HRESULT;stdcall;
  289. function Clone(out stm : IStream) : HRESULT;stdcall;
  290. end;
  291. function EqualRect(const r1,r2 : TRect) : Boolean;
  292. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  293. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  294. function Point(x,y : Integer) : TPoint; inline;
  295. function PtInRect(const Rect : TRect; const p : TPoint) : Boolean;
  296. function IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  297. function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  298. function IsRectEmpty(const Rect : TRect) : Boolean;
  299. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  300. function CenterPoint(const Rect: TRect): TPoint;
  301. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  302. function Size(AWidth, AHeight: Integer): TSize; inline;
  303. function Size(const ARect: TRect): TSize;
  304. {$ifndef VER3_0}
  305. type
  306. TBitConverter = class
  307. generic class procedure UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static; {inline;}
  308. generic class procedure From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static;
  309. generic class function UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static; {inline;}
  310. generic class function InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static;
  311. end;
  312. {$endif}
  313. implementation
  314. Uses Math;
  315. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  316. {$i typshrd.inc}
  317. {$endif}
  318. function EqualRect(const r1,r2 : TRect) : Boolean;
  319. begin
  320. EqualRect:=(r1.left=r2.left) and (r1.right=r2.right) and (r1.top=r2.top) and (r1.bottom=r2.bottom);
  321. end;
  322. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  323. begin
  324. Rect.Left:=Left;
  325. Rect.Top:=Top;
  326. Rect.Right:=Right;
  327. Rect.Bottom:=Bottom;
  328. end;
  329. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  330. begin
  331. Bounds.Left:=ALeft;
  332. Bounds.Top:=ATop;
  333. Bounds.Right:=ALeft+AWidth;
  334. Bounds.Bottom:=ATop+AHeight;
  335. end;
  336. function Point(x,y : Integer) : TPoint; inline;
  337. begin
  338. Point.x:=x;
  339. Point.y:=y;
  340. end;
  341. function PtInRect(const Rect : TRect;const p : TPoint) : Boolean;
  342. begin
  343. PtInRect:=(p.y>=Rect.Top) and
  344. (p.y<Rect.Bottom) and
  345. (p.x>=Rect.Left) and
  346. (p.x<Rect.Right);
  347. end;
  348. function IntersectRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  349. var
  350. lRect: TRect;
  351. begin
  352. lRect := R1;
  353. if R2.Left > R1.Left then
  354. lRect.Left := R2.Left;
  355. if R2.Top > R1.Top then
  356. lRect.Top := R2.Top;
  357. if R2.Right < R1.Right then
  358. lRect.Right := R2.Right;
  359. if R2.Bottom < R1.Bottom then
  360. lRect.Bottom := R2.Bottom;
  361. // The var parameter is only assigned in the end to avoid problems
  362. // when passing the same rectangle in the var and const parameters.
  363. // See http://bugs.freepascal.org/view.php?id=17722
  364. Result:=not IsRectEmpty(lRect);
  365. if Result then
  366. Rect := lRect
  367. else
  368. FillChar(Rect,SizeOf(Rect),0);
  369. end;
  370. function UnionRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  371. var
  372. lRect: TRect;
  373. begin
  374. lRect:=R1;
  375. if R2.Left<R1.Left then
  376. lRect.Left:=R2.Left;
  377. if R2.Top<R1.Top then
  378. lRect.Top:=R2.Top;
  379. if R2.Right>R1.Right then
  380. lRect.Right:=R2.Right;
  381. if R2.Bottom>R1.Bottom then
  382. lRect.Bottom:=R2.Bottom;
  383. Result:=not IsRectEmpty(lRect);
  384. if Result then
  385. Rect := lRect
  386. else
  387. FillChar(Rect,SizeOf(Rect),0);
  388. end;
  389. function IsRectEmpty(const Rect : TRect) : Boolean;
  390. begin
  391. IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
  392. end;
  393. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  394. begin
  395. Result:=assigned(@Rect);
  396. if Result then
  397. with Rect do
  398. begin
  399. inc(Left,dx);
  400. inc(Top,dy);
  401. inc(Right,dx);
  402. inc(Bottom,dy);
  403. end;
  404. end;
  405. function Avg(a, b: Longint): Longint;
  406. begin
  407. if a < b then
  408. Result := a + ((b - a) shr 1)
  409. else
  410. Result := b + ((a - b) shr 1);
  411. end;
  412. function CenterPoint(const Rect: TRect): TPoint;
  413. begin
  414. with Rect do
  415. begin
  416. Result.X := Avg(Left, Right);
  417. Result.Y := Avg(Top, Bottom);
  418. end;
  419. end;
  420. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  421. begin
  422. Result:=assigned(@Rect);
  423. if Result then
  424. with Rect do
  425. begin
  426. dec(Left, dx);
  427. dec(Top, dy);
  428. inc(Right, dx);
  429. inc(Bottom, dy);
  430. end;
  431. end;
  432. function Size(AWidth, AHeight: Integer): TSize; inline;
  433. begin
  434. Result.cx := AWidth;
  435. Result.cy := AHeight;
  436. end;
  437. function Size(const ARect: TRect): TSize; inline;
  438. begin
  439. Result.cx := ARect.Right - ARect.Left;
  440. Result.cy := ARect.Bottom - ARect.Top;
  441. end;
  442. { TPointF}
  443. function TPointF.Add(const apt: TPoint): TPointF;
  444. begin
  445. result.x:=x+apt.x;
  446. result.y:=y+apt.y;
  447. end;
  448. function TPointF.Add(const apt: TPointF): TPointF;
  449. begin
  450. result.x:=x+apt.x;
  451. result.y:=y+apt.y;
  452. end;
  453. function TPointF.Subtract(const apt : TPointF): TPointF;
  454. begin
  455. result.x:=x-apt.x;
  456. result.y:=y-apt.y;
  457. end;
  458. function TPointF.Subtract(const apt: TPoint): TPointF;
  459. begin
  460. result.x:=x-apt.x;
  461. result.y:=y-apt.y;
  462. end;
  463. function TPointF.Distance(const apt : TPointF) : Single;
  464. begin
  465. result:=sqrt(sqr(apt.x-x)+sqr(apt.y-y));
  466. end;
  467. function TPointF.DotProduct(const apt: TPointF): Single;
  468. begin
  469. result:=x*apt.x+y*apt.y;
  470. end;
  471. function TPointF.IsZero : Boolean;
  472. begin
  473. result:=SameValue(x,0.0) and SameValue(y,0.0);
  474. end;
  475. procedure TPointF.Offset(const apt :TPointF);
  476. begin
  477. x:=x+apt.x;
  478. y:=y+apt.y;
  479. end;
  480. procedure TPointF.Offset(const apt: TPoint);
  481. begin
  482. x:=x+apt.x;
  483. y:=y+apt.y;
  484. end;
  485. procedure TPointF.Offset(dx,dy : Single);
  486. begin
  487. x:=x+dx;
  488. y:=y+dy;
  489. end;
  490. function TPointF.Scale(afactor: Single): TPointF;
  491. begin
  492. result.x:=afactor*x;
  493. result.y:=afactor*y;
  494. end;
  495. function TPointF.Ceiling: TPoint;
  496. begin
  497. result.x:=ceil(x);
  498. result.y:=ceil(y);
  499. end;
  500. function TPointF.Truncate: TPoint;
  501. begin
  502. result.x:=trunc(x);
  503. result.y:=trunc(y);
  504. end;
  505. function TPointF.Floor: TPoint;
  506. begin
  507. result.x:=Math.floor(x);
  508. result.y:=Math.floor(y);
  509. end;
  510. function TPointF.Round: TPoint;
  511. begin
  512. result.x:=System.round(x);
  513. result.y:=System.round(y);
  514. end;
  515. function TPointF.Length: Single;
  516. begin //distance(self) ?
  517. result:=sqrt(sqr(x)+sqr(y));
  518. end;
  519. class operator TPointF.= (const apt1, apt2 : TPointF) : Boolean;
  520. begin
  521. result:=SameValue(apt1.x,apt2.x) and SameValue(apt1.y,apt2.y);
  522. end;
  523. class operator TPointF.<> (const apt1, apt2 : TPointF): Boolean;
  524. begin
  525. result:=NOT (SameValue(apt1.x,apt2.x) and Samevalue(apt1.y,apt2.y));
  526. end;
  527. class operator TPointF. * (const apt1, apt2: TPointF): Single;
  528. begin
  529. result:=apt1.x*apt2.x + apt1.y*apt2.y;
  530. end;
  531. class operator TPointF. * (afactor: single; const apt1: TPointF): TPointF;
  532. begin
  533. result:=apt1.Scale(afactor);
  534. end;
  535. class operator TPointF. * (const apt1: TPointF; afactor: single): TPointF;
  536. begin
  537. result:=apt1.Scale(afactor);
  538. end;
  539. class operator TPointF.+ (const apt1, apt2 : TPointF): TPointF;
  540. begin
  541. result.x:=apt1.x+apt2.x;
  542. result.y:=apt1.y+apt2.y;
  543. end;
  544. class operator TPointF.- (const apt1, apt2 : TPointF): TPointF;
  545. begin
  546. result.x:=apt1.x-apt2.x;
  547. result.y:=apt1.y-apt2.y;
  548. end;
  549. class operator TPointF. - (const apt1: TPointF): TPointF;
  550. begin
  551. Result.x:=-apt1.x;
  552. Result.y:=-apt1.y;
  553. end;
  554. procedure TPointF.SetLocation(const apt :TPointF);
  555. begin
  556. x:=apt.x; y:=apt.y;
  557. end;
  558. procedure TPointF.SetLocation(const apt: TPoint);
  559. begin
  560. x:=apt.x; y:=apt.y;
  561. end;
  562. procedure TPointF.SetLocation(ax,ay : Single);
  563. begin
  564. x:=ax; y:=ay;
  565. end;
  566. class function TPointF.Create(const ax, ay: Single): TPointF;
  567. begin
  568. Result.x := ax;
  569. Result.y := ay;
  570. end;
  571. class function TPointF.Create(const apt: TPoint): TPointF;
  572. begin
  573. Result.x := apt.X;
  574. Result.y := apt.Y;
  575. end;
  576. { TRectF }
  577. function TRectF.GetHeight: Single;
  578. begin
  579. result:=bottom-top;
  580. end;
  581. function TRectF.GetWidth: Single;
  582. begin
  583. result:=right-left;
  584. end;
  585. procedure TRectF.SetHeight(AValue: Single);
  586. begin
  587. bottom:=top+avalue;
  588. end;
  589. procedure TRectF.SetWidth(AValue: Single);
  590. begin
  591. right:=left+avalue;
  592. end;
  593. function TRectF.Union(const r: TRectF): TRectF;
  594. begin
  595. result.left:=min(r.left,left);
  596. result.top:=min(r.top,top);
  597. result.right:=max(r.right,right);
  598. result.bottom:=max(r.bottom,bottom);
  599. end;
  600. procedure TRectF.Offset(const dx, dy: Single);
  601. begin
  602. left:=left+dx; right:=right+dx;
  603. bottom:=bottom+dy; top:=top+dy;
  604. end;
  605. {$ifndef VER3_0}
  606. generic class procedure TBitConverter.UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  607. begin
  608. move(ASrcValue, ADestination[AOffset], SizeOf(T));
  609. end;
  610. generic class procedure TBitConverter.From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  611. begin
  612. if AOffset < 0 then
  613. System.Error(reRangeError);
  614. if IsManagedType(T) then
  615. System.Error(reInvalidCast);
  616. if Length(ADestination) < (SizeOf(T) + AOffset) then
  617. System.Error(reRangeError);
  618. TBitConverter.specialize UnsafeFrom<T>(ASrcValue, ADestination, AOffset);
  619. end;
  620. generic class function TBitConverter.UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  621. begin
  622. move(ASource[AOffset], Result, SizeOf(T));
  623. end;
  624. generic class function TBitConverter.InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  625. begin
  626. if AOffset < 0 then
  627. System.Error(reRangeError);
  628. if IsManagedType(T) then
  629. System.Error(reInvalidCast);
  630. if Length(ASource) < (SizeOf(T) + AOffset) then
  631. System.Error(reRangeError);
  632. Result := TBitConverter.specialize UnsafeInTo<T>(ASource, AOffset);
  633. end;
  634. {$endif}
  635. end.