types.pp 21 KB

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