types.pp 21 KB

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