types.pp 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765
  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 : Longint);
  110. procedure Offset(const apt :TPointF);
  111. procedure Offset(const apt :TPoint);
  112. procedure Offset(dx,dy : Longint);
  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. if IsRectEmpty(lRect) then
  365. begin
  366. FillChar(Rect,SizeOf(Rect),0);
  367. IntersectRect:=false;
  368. end
  369. else
  370. begin
  371. IntersectRect:=true;
  372. Rect := lRect;
  373. end;
  374. end;
  375. function UnionRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  376. var
  377. lRect: TRect;
  378. begin
  379. lRect:=R1;
  380. if R2.Left<R1.Left then
  381. lRect.Left:=R2.Left;
  382. if R2.Top<R1.Top then
  383. lRect.Top:=R2.Top;
  384. if R2.Right>R1.Right then
  385. lRect.Right:=R2.Right;
  386. if R2.Bottom>R1.Bottom then
  387. lRect.Bottom:=R2.Bottom;
  388. if IsRectEmpty(lRect) then
  389. begin
  390. FillChar(Rect,SizeOf(Rect),0);
  391. UnionRect:=false;
  392. end
  393. else
  394. begin
  395. Rect:=lRect;
  396. UnionRect:=true;
  397. end;
  398. end;
  399. function IsRectEmpty(const Rect : TRect) : Boolean;
  400. begin
  401. IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
  402. end;
  403. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  404. begin
  405. if assigned(@Rect) then
  406. begin
  407. with Rect do
  408. begin
  409. inc(Left,dx);
  410. inc(Top,dy);
  411. inc(Right,dx);
  412. inc(Bottom,dy);
  413. end;
  414. OffsetRect:=true;
  415. end
  416. else
  417. OffsetRect:=false;
  418. end;
  419. function Avg(a, b: Longint): Longint;
  420. begin
  421. if a < b then
  422. Result := a + ((b - a) shr 1)
  423. else
  424. Result := b + ((a - b) shr 1);
  425. end;
  426. function CenterPoint(const Rect: TRect): TPoint;
  427. begin
  428. with Rect do
  429. begin
  430. Result.X := Avg(Left, Right);
  431. Result.Y := Avg(Top, Bottom);
  432. end;
  433. end;
  434. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  435. begin
  436. if Assigned(@Rect) then
  437. begin
  438. with Rect do
  439. begin
  440. dec(Left, dx);
  441. dec(Top, dy);
  442. inc(Right, dx);
  443. inc(Bottom, dy);
  444. end;
  445. Result := True;
  446. end
  447. else
  448. Result := False;
  449. end;
  450. function Size(AWidth, AHeight: Integer): TSize; inline;
  451. begin
  452. Result.cx := AWidth;
  453. Result.cy := AHeight;
  454. end;
  455. function Size(const ARect: TRect): TSize; inline;
  456. begin
  457. Result.cx := ARect.Right - ARect.Left;
  458. Result.cy := ARect.Bottom - ARect.Top;
  459. end;
  460. { TPointF}
  461. function TPointF.Add(const apt: TPoint): TPointF;
  462. begin
  463. result.x:=x+apt.x;
  464. result.y:=y+apt.y;
  465. end;
  466. function TPointF.Add(const apt: TPointF): TPointF;
  467. begin
  468. result.x:=x+apt.x;
  469. result.y:=y+apt.y;
  470. end;
  471. function TPointF.Subtract(const apt : TPointF): TPointF;
  472. begin
  473. result.x:=x-apt.x;
  474. result.y:=y-apt.y;
  475. end;
  476. function TPointF.Subtract(const apt: TPoint): TPointF;
  477. begin
  478. result.x:=x-apt.x;
  479. result.y:=y-apt.y;
  480. end;
  481. function TPointF.Distance(const apt : TPointF) : Single;
  482. begin
  483. result:=sqrt(sqr(apt.x-x)+sqr(apt.y-y));
  484. end;
  485. function TPointF.DotProduct(const apt: TPointF): Single;
  486. begin
  487. result:=x*apt.x+y*apt.y;
  488. end;
  489. function TPointF.IsZero : Boolean;
  490. begin
  491. result:=SameValue(x,0.0) and SameValue(y,0.0);
  492. end;
  493. procedure TPointF.Offset(const apt :TPointF);
  494. begin
  495. x:=x+apt.x;
  496. y:=y+apt.y;
  497. end;
  498. procedure TPointF.Offset(const apt: TPoint);
  499. begin
  500. x:=x+apt.x;
  501. y:=y+apt.y;
  502. end;
  503. procedure TPointF.Offset(dx,dy : Longint);
  504. begin
  505. x:=x+dx;
  506. y:=y+dy;
  507. end;
  508. function TPointF.Scale(afactor: Single): TPointF;
  509. begin
  510. result.x:=afactor*x;
  511. result.y:=afactor*y;
  512. end;
  513. function TPointF.Ceiling: TPoint;
  514. begin
  515. result.x:=ceil(x);
  516. result.y:=ceil(y);
  517. end;
  518. function TPointF.Truncate: TPoint;
  519. begin
  520. result.x:=trunc(x);
  521. result.y:=trunc(y);
  522. end;
  523. function TPointF.Floor: TPoint;
  524. begin
  525. result.x:=Math.floor(x);
  526. result.y:=Math.floor(y);
  527. end;
  528. function TPointF.Round: TPoint;
  529. begin
  530. result.x:=System.round(x);
  531. result.y:=System.round(y);
  532. end;
  533. function TPointF.Length: Single;
  534. begin //distance(self) ?
  535. result:=sqrt(sqr(x)+sqr(y));
  536. end;
  537. class operator TPointF.= (const apt1, apt2 : TPointF) : Boolean;
  538. begin
  539. result:=SameValue(apt1.x,apt2.x) and SameValue(apt1.y,apt2.y);
  540. end;
  541. class operator TPointF.<> (const apt1, apt2 : TPointF): Boolean;
  542. begin
  543. result:=NOT (SameValue(apt1.x,apt2.x) and Samevalue(apt1.y,apt2.y));
  544. end;
  545. class operator TPointF. * (const apt1, apt2: TPointF): Single;
  546. begin
  547. result:=apt1.x*apt2.x + apt1.y*apt2.y;
  548. end;
  549. class operator TPointF. * (afactor: single; const apt1: TPointF): TPointF;
  550. begin
  551. result:=apt1.Scale(afactor);
  552. end;
  553. class operator TPointF. * (const apt1: TPointF; afactor: single): TPointF;
  554. begin
  555. result:=apt1.Scale(afactor);
  556. end;
  557. class operator TPointF.+ (const apt1, apt2 : TPointF): TPointF;
  558. begin
  559. result.x:=apt1.x+apt2.x;
  560. result.y:=apt1.y+apt2.y;
  561. end;
  562. class operator TPointF.- (const apt1, apt2 : TPointF): TPointF;
  563. begin
  564. result.x:=apt1.x-apt2.x;
  565. result.y:=apt1.y-apt2.y;
  566. end;
  567. class operator TPointF. - (const apt1: TPointF): TPointF;
  568. begin
  569. Result.x:=-apt1.x;
  570. Result.y:=-apt1.y;
  571. end;
  572. procedure TPointF.SetLocation(const apt :TPointF);
  573. begin
  574. x:=apt.x; y:=apt.y;
  575. end;
  576. procedure TPointF.SetLocation(const apt: TPoint);
  577. begin
  578. x:=apt.x; y:=apt.y;
  579. end;
  580. procedure TPointF.SetLocation(ax,ay : Longint);
  581. begin
  582. x:=ax; y:=ay;
  583. end;
  584. class function TPointF.Create(const ax, ay: Single): TPointF;
  585. begin
  586. Result.x := ax;
  587. Result.y := ay;
  588. end;
  589. class function TPointF.Create(const apt: TPoint): TPointF;
  590. begin
  591. Result.x := apt.X;
  592. Result.y := apt.Y;
  593. end;
  594. { TRectF }
  595. function TRectF.GetHeight: Single;
  596. begin
  597. result:=bottom-top;
  598. end;
  599. function TRectF.GetWidth: Single;
  600. begin
  601. result:=right-left;
  602. end;
  603. procedure TRectF.SetHeight(AValue: Single);
  604. begin
  605. bottom:=top+avalue;
  606. end;
  607. procedure TRectF.SetWidth(AValue: Single);
  608. begin
  609. right:=left+avalue;
  610. end;
  611. function TRectF.Union(const r: TRectF): TRectF;
  612. begin
  613. result.left:=min(r.left,left);
  614. result.top:=min(r.top,top);
  615. result.right:=min(r.right,right);
  616. result.bottom:=min(r.bottom,bottom);
  617. end;
  618. procedure TRectF.Offset(const dx, dy: Single);
  619. begin
  620. left:=left+dx; right:=right+dx;
  621. bottom:=bottom+dy; top:=top+dy;
  622. end;
  623. {$ifndef VER3_0}
  624. generic class procedure TBitConverter.UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  625. begin
  626. move(ASrcValue, ADestination[AOffset], SizeOf(T));
  627. end;
  628. generic class procedure TBitConverter.From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  629. begin
  630. if AOffset < 0 then
  631. System.Error(reRangeError);
  632. if IsManagedType(T) then
  633. System.Error(reInvalidCast);
  634. if Length(ADestination) < (SizeOf(T) + AOffset) then
  635. System.Error(reRangeError);
  636. TBitConverter.specialize UnsafeFrom<T>(ASrcValue, ADestination, AOffset);
  637. end;
  638. generic class function TBitConverter.UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  639. begin
  640. move(ASource[AOffset], Result, SizeOf(T));
  641. end;
  642. generic class function TBitConverter.InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  643. begin
  644. if AOffset < 0 then
  645. System.Error(reRangeError);
  646. if IsManagedType(T) then
  647. System.Error(reInvalidCast);
  648. if Length(ASource) < (SizeOf(T) + AOffset) then
  649. System.Error(reRangeError);
  650. Result := TBitConverter.specialize UnsafeInTo<T>(ASource, AOffset);
  651. end;
  652. {$endif}
  653. end.