types.pp 33 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319
  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. PPointF = ^TPointF;
  94. TPointF =
  95. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  96. packed
  97. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  98. record
  99. x,y : Single;
  100. public
  101. function Add(const apt: TPoint): TPointF;
  102. function Add(const apt: TPointF): TPointF;
  103. function Distance(const apt : TPointF) : Single;
  104. function DotProduct(const apt : TPointF) : Single;
  105. function IsZero : Boolean;
  106. function Subtract(const apt : TPointF): TPointF;
  107. function Subtract(const apt : TPoint): TPointF;
  108. procedure SetLocation(const apt :TPointF);
  109. procedure SetLocation(const apt :TPoint);
  110. procedure SetLocation(ax,ay : Longint);
  111. procedure Offset(const apt :TPointF);
  112. procedure Offset(const apt :TPoint);
  113. procedure Offset(dx,dy : Longint);
  114. function Scale (afactor:Single) : TPointF;
  115. function Ceiling : TPoint;
  116. function Truncate: TPoint;
  117. function Floor : TPoint;
  118. function Round : TPoint;
  119. function Length : Single;
  120. function Rotate(angle: single): TPointF;
  121. function Reflect(const normal: TPointF): TPointF;
  122. function MidPoint(const b: TPointF): TPointF;
  123. class function PointInCircle(const pt, center: TPointF; radius: single): Boolean; static;
  124. class function PointInCircle(const pt, center: TPointF; radius: integer): Boolean; static;
  125. function Angle(const b: TPointF): Single;
  126. function AngleCosine(const b: TPointF): single;
  127. class function Create(const ax, ay: Single): TPointF; overload; static; inline;
  128. class function Create(const apt: TPoint): TPointF; overload; static; inline;
  129. class operator = (const apt1, apt2 : TPointF) : Boolean;
  130. class operator <> (const apt1, apt2 : TPointF): Boolean;
  131. class operator + (const apt1, apt2 : TPointF): TPointF;
  132. class operator - (const apt1, apt2 : TPointF): TPointF;
  133. class operator - (const apt1 : TPointF): TPointF;
  134. class operator * (const apt1, apt2: TPointF): TPointF;
  135. class operator * (const apt1: TPointF; afactor: single): TPointF;
  136. class operator * (afactor: single; const apt1: TPointF): TPointF;
  137. class operator / (const apt1: TPointF; afactor: single): TPointF;
  138. class operator := (const apt: TPoint): TPointF;
  139. class operator ** (const apt1, apt2: TPointF): Single; // scalar product
  140. end;
  141. { TSizeF }
  142. PSizeF = ^TSizeF;
  143. TSizeF =
  144. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  145. packed
  146. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  147. record
  148. cx,cy : Single;
  149. public
  150. function Add(const asz: TSize): TSizeF;
  151. function Add(const asz: TSizeF): TSizeF;
  152. function Distance(const asz : TSizeF) : Single;
  153. function IsZero : Boolean;
  154. function Subtract(const asz : TSizeF): TSizeF;
  155. function Subtract(const asz : TSize): TSizeF;
  156. function Scale (afactor:Single) : TSizeF;
  157. function Ceiling : TSize;
  158. function Truncate: TSize;
  159. function Floor : TSize;
  160. function Round : TSize;
  161. function Length : Single;
  162. class function Create(const ax, ay: Single): TSizeF; overload; static; inline;
  163. class function Create(const asz: TSize): TSizeF; overload; static; inline;
  164. class operator = (const asz1, asz2 : TSizeF) : Boolean;
  165. class operator <> (const asz1, asz2 : TSizeF): Boolean;
  166. class operator + (const asz1, asz2 : TSizeF): TSizeF;
  167. class operator - (const asz1, asz2 : TSizeF): TSizeF;
  168. class operator - (const asz1 : TSizeF): TSizeF;
  169. class operator * (const asz1: TSizeF; afactor: single): TSizeF;
  170. class operator * (afactor: single; const asz1: TSizeF): TSizeF;
  171. class operator := (const apt: TPointF): TSizeF;
  172. class operator := (const asz: TSize): TSizeF;
  173. class operator := (const asz: TSizeF): TPointF;
  174. property Width: Single read cx write cx;
  175. property Height: Single read cy write cy;
  176. end;
  177. { TRectF }
  178. PRectF = ^TRectF;
  179. TRectF =
  180. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  181. packed
  182. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  183. record
  184. private
  185. function GetLocation: TPointF;
  186. function GetSize: TSizeF;
  187. procedure SetSize(AValue: TSizeF);
  188. function GetHeight: Single; inline;
  189. function GetWidth: Single; inline;
  190. procedure SetHeight(AValue: Single);
  191. procedure SetWidth (AValue: Single);
  192. public
  193. constructor Create(Origin: TPointF); // empty rect at given origin
  194. constructor Create(Origin: TPointF; AWidth, AHeight: Single);
  195. constructor Create(ALeft, ATop, ARight, ABottom: Single);
  196. constructor Create(P1, P2: TPointF; Normalize: Boolean = False);
  197. constructor Create(R: TRectF; Normalize: Boolean = False);
  198. constructor Create(R: TRect; Normalize: Boolean = False);
  199. class operator = (L, R: TRectF): Boolean;
  200. class operator <> (L, R: TRectF): Boolean;
  201. class operator + (L, R: TRectF): TRectF; // union
  202. class operator * (L, R: TRectF): TRectF; // intersection
  203. class operator := (const arc: TRect): TRectF;
  204. class function Empty: TRectF; static;
  205. procedure NormalizeRect;
  206. function IsEmpty: Boolean;
  207. function Contains(Pt: TPointF): Boolean;
  208. function Contains(R: TRectF): Boolean;
  209. function IntersectsWith(R: TRectF): Boolean;
  210. class function Intersect(R1: TRectF; R2: TRectF): TRectF; static;
  211. procedure Intersect(R: TRectF);
  212. class function Union(R1, R2: TRectF): TRectF; static;
  213. class function Union(const Points: array of TPointF): TRectF; static;
  214. procedure SetLocation(X, Y: Single);
  215. procedure SetLocation(P: TPointF);
  216. procedure Inflate(DX, DY: Single);
  217. procedure Inflate(DL, DT, DR, DB: Single);
  218. function CenterPoint: TPointF;
  219. procedure Union (const r: TRectF); inline;
  220. procedure Offset (const dx,dy : Single); inline;
  221. procedure Offset (DP: TPointF); inline;
  222. property Width : Single read GetWidth write SetWidth;
  223. property Height : Single read GetHeight write SetHeight;
  224. property Size : TSizeF read getSize write SetSize;
  225. property Location: TPointF read getLocation write setLocation;
  226. case Integer of
  227. 0: (Left, Top, Right, Bottom: Single);
  228. 1: (TopLeft, BottomRight: TPointF);
  229. end;
  230. TDuplicates = (dupIgnore, dupAccept, dupError);
  231. TPoint3D =
  232. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  233. packed
  234. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  235. record
  236. public
  237. Type TSingle3Array = array[0..2] of single;
  238. constructor Create(const ax,ay,az:single);
  239. procedure Offset(const adeltax,adeltay,adeltaz:single); inline;
  240. procedure Offset(const adelta:TPoint3D); inline;
  241. public
  242. case Integer of
  243. 0: (data:TSingle3Array);
  244. 1: (x,y,z : single);
  245. end;
  246. type
  247. TOleChar = WideChar;
  248. POleStr = PWideChar;
  249. PPOleStr = ^POleStr;
  250. TListCallback = procedure(data,arg:pointer) of object;
  251. TListStaticCallback = procedure(data,arg:pointer);
  252. const
  253. GUID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';
  254. STGTY_STORAGE = 1;
  255. STGTY_STREAM = 2;
  256. STGTY_LOCKBYTES = 3;
  257. STGTY_PROPERTY = 4;
  258. STREAM_SEEK_SET = 0;
  259. STREAM_SEEK_CUR = 1;
  260. STREAM_SEEK_END = 2;
  261. LOCK_WRITE = 1;
  262. LOCK_EXCLUSIVE = 2;
  263. LOCK_ONLYONCE = 4;
  264. STATFLAG_DEFAULT = 0;
  265. STATFLAG_NONAME = 1;
  266. STATFLAG_NOOPEN = 2;
  267. {$ifndef Wince}
  268. // in Wince these are in unit windows. Under 32/64 in ActiveX.
  269. // for now duplicate them. Not that bad for untyped constants.
  270. E_FAIL = HRESULT($80004005);
  271. E_INVALIDARG = HRESULT($80070057);
  272. STG_E_INVALIDFUNCTION = HRESULT($80030001);
  273. STG_E_FILENOTFOUND = HRESULT($80030002);
  274. STG_E_PATHNOTFOUND = HRESULT($80030003);
  275. STG_E_TOOMANYOPENFILES = HRESULT($80030004);
  276. STG_E_ACCESSDENIED = HRESULT($80030005);
  277. STG_E_INVALIDHANDLE = HRESULT($80030006);
  278. STG_E_INSUFFICIENTMEMORY = HRESULT($80030008);
  279. STG_E_INVALIDPOINTER = HRESULT($80030009);
  280. STG_E_NOMOREFILES = HRESULT($80030012);
  281. STG_E_DISKISWRITEPROTECTED = HRESULT($80030013);
  282. STG_E_SEEKERROR = HRESULT($80030019);
  283. STG_E_WRITEFAULT = HRESULT($8003001D);
  284. STG_E_READFAULT = HRESULT($8003001E);
  285. STG_E_SHAREVIOLATION = HRESULT($80030020);
  286. STG_E_LOCKVIOLATION = HRESULT($80030021);
  287. STG_E_FILEALREADYEXISTS = HRESULT($80030050);
  288. STG_E_INVALIDPARAMETER = HRESULT($80030057);
  289. STG_E_MEDIUMFULL = HRESULT($80030070);
  290. STG_E_PROPSETMISMATCHED = HRESULT($800300F0);
  291. STG_E_ABNORMALAPIEXIT = HRESULT($800300FA);
  292. STG_E_INVALIDHEADER = HRESULT($800300FB);
  293. STG_E_INVALIDNAME = HRESULT($800300FC);
  294. STG_E_UNKNOWN = HRESULT($800300FD);
  295. STG_E_UNIMPLEMENTEDFUNCTION = HRESULT($800300FE);
  296. STG_E_INVALIDFLAG = HRESULT($800300FF);
  297. STG_E_INUSE = HRESULT($80030100);
  298. STG_E_NOTCURRENT = HRESULT($80030101);
  299. STG_E_REVERTED = HRESULT($80030102);
  300. STG_E_CANTSAVE = HRESULT($80030103);
  301. STG_E_OLDFORMAT = HRESULT($80030104);
  302. STG_E_OLDDLL = HRESULT($80030105);
  303. STG_E_SHAREREQUIRED = HRESULT($80030106);
  304. STG_E_EXTANTMARSHALLINGS = HRESULT($80030108);
  305. STG_E_DOCFILECORRUPT = HRESULT($80030109);
  306. STG_E_BADBASEADDRESS = HRESULT($80030110);
  307. STG_E_INCOMPLETE = HRESULT($80030201);
  308. STG_E_TERMINATED = HRESULT($80030202);
  309. STG_S_CONVERTED = $00030200;
  310. STG_S_BLOCK = $00030201;
  311. STG_S_RETRYNOW = $00030202;
  312. STG_S_MONITORING = $00030203;
  313. {$endif}
  314. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  315. type
  316. PCLSID = PGUID;
  317. TCLSID = TGUID;
  318. PDWord = ^DWord;
  319. PDisplay = Pointer;
  320. PEvent = Pointer;
  321. TXrmOptionDescRec = record
  322. end;
  323. XrmOptionDescRec = TXrmOptionDescRec;
  324. PXrmOptionDescRec = ^TXrmOptionDescRec;
  325. Widget = Pointer;
  326. WidgetClass = Pointer;
  327. ArgList = Pointer;
  328. Region = Pointer;
  329. _FILETIME =
  330. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  331. packed
  332. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  333. record
  334. dwLowDateTime : DWORD;
  335. dwHighDateTime : DWORD;
  336. end;
  337. TFileTime = _FILETIME;
  338. FILETIME = _FILETIME;
  339. PFileTime = ^TFileTime;
  340. {$else}
  341. type
  342. PCLSID = Windows.PCLSID;
  343. TCLSID = Windows.CLSID;
  344. TFiletime = Windows.TFileTime;
  345. Filetime = Windows.FileTime;
  346. PFiletime = Windows.PFileTime;
  347. {$endif Windows}
  348. type
  349. tagSTATSTG = record
  350. pwcsName : POleStr;
  351. dwType : DWord;
  352. cbSize : Large_uint;
  353. mtime : TFileTime;
  354. ctime : TFileTime;
  355. atime : TFileTime;
  356. grfMode : DWord;
  357. grfLocksSupported : DWord;
  358. clsid : TCLSID;
  359. grfStateBits : DWord;
  360. reserved : DWord;
  361. end;
  362. TStatStg = tagSTATSTG;
  363. STATSTG = TStatStg;
  364. PStatStg = ^TStatStg;
  365. { classes depends on these interfaces, we can't use the activex unit in classes though }
  366. IClassFactory = Interface(IUnknown) ['{00000001-0000-0000-C000-000000000046}']
  367. Function CreateInstance(Const unkOuter : IUnknown;Const riid : TGUID;Out vObject) : HResult;StdCall;
  368. Function LockServer(fLock : LongBool) : HResult;StdCall;
  369. End;
  370. ISequentialStream = interface(IUnknown)
  371. ['{0c733a30-2a1c-11ce-ade5-00aa0044773d}']
  372. function Read(pv : Pointer;cb : DWORD;pcbRead : PDWORD) : HRESULT;stdcall;
  373. function Write(pv : Pointer;cb : DWORD;pcbWritten : PDWORD): HRESULT;stdcall;
  374. end;
  375. IStream = interface(ISequentialStream) ['{0000000C-0000-0000-C000-000000000046}']
  376. function Seek(dlibMove : LargeInt; dwOrigin : DWORD; out libNewPosition : LargeUInt) : HResult;stdcall;
  377. function SetSize(libNewSize : LargeUInt) : HRESULT;stdcall;
  378. function CopyTo(stm: IStream;cb : LargeUInt;out cbRead : LargeUInt; out cbWritten : LargeUInt) : HRESULT;stdcall;
  379. function Commit(grfCommitFlags : DWORD) : HRESULT;stdcall;
  380. function Revert : HRESULT;stdcall;
  381. function LockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
  382. function UnlockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
  383. Function Stat(out statstg : TStatStg;grfStatFlag : DWORD) : HRESULT;stdcall;
  384. function Clone(out stm : IStream) : HRESULT;stdcall;
  385. end;
  386. function EqualRect(const r1,r2 : TRect) : Boolean;
  387. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  388. function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
  389. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  390. function Point(x,y : Integer) : TPoint; inline;
  391. function PointF(x,y: Single) : TPointF; inline;
  392. function PtInRect(const Rect : TRect; const p : TPoint) : Boolean;
  393. function IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  394. function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  395. function IsRectEmpty(const Rect : TRect) : Boolean;
  396. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  397. function CenterPoint(const Rect: TRect): TPoint;
  398. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  399. function Size(AWidth, AHeight: Integer): TSize; inline;
  400. function Size(const ARect: TRect): TSize;
  401. {$ifndef VER3_0}
  402. type
  403. TBitConverter = class
  404. generic class procedure UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static; {inline;}
  405. generic class procedure From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static;
  406. generic class function UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static; {inline;}
  407. generic class function InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static;
  408. end;
  409. {$endif}
  410. implementation
  411. Uses Math;
  412. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  413. {$i typshrd.inc}
  414. {$endif}
  415. function EqualRect(const r1,r2 : TRect) : Boolean;
  416. begin
  417. EqualRect:=(r1.left=r2.left) and (r1.right=r2.right) and (r1.top=r2.top) and (r1.bottom=r2.bottom);
  418. end;
  419. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  420. begin
  421. Rect.Left:=Left;
  422. Rect.Top:=Top;
  423. Rect.Right:=Right;
  424. Rect.Bottom:=Bottom;
  425. end;
  426. function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
  427. begin
  428. RectF.Left:=Left;
  429. RectF.Top:=Top;
  430. RectF.Right:=Right;
  431. RectF.Bottom:=Bottom;
  432. end;
  433. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  434. begin
  435. Bounds.Left:=ALeft;
  436. Bounds.Top:=ATop;
  437. Bounds.Right:=ALeft+AWidth;
  438. Bounds.Bottom:=ATop+AHeight;
  439. end;
  440. function Point(x,y : Integer) : TPoint; inline;
  441. begin
  442. Point.x:=x;
  443. Point.y:=y;
  444. end;
  445. function PointF(x,y: Single) : TPointF; inline;
  446. begin
  447. PointF.x:=x;
  448. PointF.y:=y;
  449. end;
  450. function PtInRect(const Rect : TRect;const p : TPoint) : Boolean;
  451. begin
  452. PtInRect:=(p.y>=Rect.Top) and
  453. (p.y<Rect.Bottom) and
  454. (p.x>=Rect.Left) and
  455. (p.x<Rect.Right);
  456. end;
  457. function IntersectRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  458. var
  459. lRect: TRect;
  460. begin
  461. lRect := R1;
  462. if R2.Left > R1.Left then
  463. lRect.Left := R2.Left;
  464. if R2.Top > R1.Top then
  465. lRect.Top := R2.Top;
  466. if R2.Right < R1.Right then
  467. lRect.Right := R2.Right;
  468. if R2.Bottom < R1.Bottom then
  469. lRect.Bottom := R2.Bottom;
  470. // The var parameter is only assigned in the end to avoid problems
  471. // when passing the same rectangle in the var and const parameters.
  472. // See http://bugs.freepascal.org/view.php?id=17722
  473. if IsRectEmpty(lRect) then
  474. begin
  475. FillChar(Rect,SizeOf(Rect),0);
  476. IntersectRect:=false;
  477. end
  478. else
  479. begin
  480. IntersectRect:=true;
  481. Rect := lRect;
  482. end;
  483. end;
  484. function UnionRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  485. var
  486. lRect: TRect;
  487. begin
  488. lRect:=R1;
  489. if R2.Left<R1.Left then
  490. lRect.Left:=R2.Left;
  491. if R2.Top<R1.Top then
  492. lRect.Top:=R2.Top;
  493. if R2.Right>R1.Right then
  494. lRect.Right:=R2.Right;
  495. if R2.Bottom>R1.Bottom then
  496. lRect.Bottom:=R2.Bottom;
  497. if IsRectEmpty(lRect) then
  498. begin
  499. FillChar(Rect,SizeOf(Rect),0);
  500. UnionRect:=false;
  501. end
  502. else
  503. begin
  504. Rect:=lRect;
  505. UnionRect:=true;
  506. end;
  507. end;
  508. function IsRectEmpty(const Rect : TRect) : Boolean;
  509. begin
  510. IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
  511. end;
  512. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  513. begin
  514. if assigned(@Rect) then
  515. begin
  516. with Rect do
  517. begin
  518. inc(Left,dx);
  519. inc(Top,dy);
  520. inc(Right,dx);
  521. inc(Bottom,dy);
  522. end;
  523. OffsetRect:=true;
  524. end
  525. else
  526. OffsetRect:=false;
  527. end;
  528. function Avg(a, b: Longint): Longint;
  529. begin
  530. if a < b then
  531. Result := a + ((b - a) shr 1)
  532. else
  533. Result := b + ((a - b) shr 1);
  534. end;
  535. function CenterPoint(const Rect: TRect): TPoint;
  536. begin
  537. with Rect do
  538. begin
  539. Result.X := Avg(Left, Right);
  540. Result.Y := Avg(Top, Bottom);
  541. end;
  542. end;
  543. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  544. begin
  545. if Assigned(@Rect) then
  546. begin
  547. with Rect do
  548. begin
  549. dec(Left, dx);
  550. dec(Top, dy);
  551. inc(Right, dx);
  552. inc(Bottom, dy);
  553. end;
  554. Result := True;
  555. end
  556. else
  557. Result := False;
  558. end;
  559. function Size(AWidth, AHeight: Integer): TSize; inline;
  560. begin
  561. Result.cx := AWidth;
  562. Result.cy := AHeight;
  563. end;
  564. function Size(const ARect: TRect): TSize; inline;
  565. begin
  566. Result.cx := ARect.Right - ARect.Left;
  567. Result.cy := ARect.Bottom - ARect.Top;
  568. end;
  569. { TPointF}
  570. function TPointF.Add(const apt: TPoint): TPointF;
  571. begin
  572. result.x:=x+apt.x;
  573. result.y:=y+apt.y;
  574. end;
  575. function TPointF.Add(const apt: TPointF): TPointF;
  576. begin
  577. result.x:=x+apt.x;
  578. result.y:=y+apt.y;
  579. end;
  580. function TPointF.Subtract(const apt : TPointF): TPointF;
  581. begin
  582. result.x:=x-apt.x;
  583. result.y:=y-apt.y;
  584. end;
  585. function TPointF.Subtract(const apt: TPoint): TPointF;
  586. begin
  587. result.x:=x-apt.x;
  588. result.y:=y-apt.y;
  589. end;
  590. function TPointF.Distance(const apt : TPointF) : Single;
  591. begin
  592. result:=sqrt(sqr(apt.x-x)+sqr(apt.y-y));
  593. end;
  594. function TPointF.DotProduct(const apt: TPointF): Single;
  595. begin
  596. result:=x*apt.x+y*apt.y;
  597. end;
  598. function TPointF.IsZero : Boolean;
  599. begin
  600. result:=SameValue(x,0.0) and SameValue(y,0.0);
  601. end;
  602. procedure TPointF.Offset(const apt :TPointF);
  603. begin
  604. x:=x+apt.x;
  605. y:=y+apt.y;
  606. end;
  607. procedure TPointF.Offset(const apt: TPoint);
  608. begin
  609. x:=x+apt.x;
  610. y:=y+apt.y;
  611. end;
  612. procedure TPointF.Offset(dx,dy : Longint);
  613. begin
  614. x:=x+dx;
  615. y:=y+dy;
  616. end;
  617. function TPointF.Scale(afactor: Single): TPointF;
  618. begin
  619. result.x:=afactor*x;
  620. result.y:=afactor*y;
  621. end;
  622. function TPointF.Ceiling: TPoint;
  623. begin
  624. result.x:=ceil(x);
  625. result.y:=ceil(y);
  626. end;
  627. function TPointF.Truncate: TPoint;
  628. begin
  629. result.x:=trunc(x);
  630. result.y:=trunc(y);
  631. end;
  632. function TPointF.Floor: TPoint;
  633. begin
  634. result.x:=Math.floor(x);
  635. result.y:=Math.floor(y);
  636. end;
  637. function TPointF.Round: TPoint;
  638. begin
  639. result.x:=System.round(x);
  640. result.y:=System.round(y);
  641. end;
  642. function TPointF.Length: Single;
  643. begin
  644. result:=sqrt(sqr(x)+sqr(y));
  645. end;
  646. function TPointF.Rotate(angle: single): TPointF;
  647. var
  648. sina, cosa: single;
  649. begin
  650. sincos(angle, sina, cosa);
  651. result.x := x * cosa - y * sina;
  652. result.y := x * sina + y * cosa;
  653. end;
  654. function TPointF.Reflect(const normal: TPointF): TPointF;
  655. begin
  656. result := self + (-2 * normal ** self) * normal;
  657. end;
  658. function TPointF.MidPoint(const b: TPointF): TPointF;
  659. begin
  660. result.x := 0.5 * (x + b.x);
  661. result.y := 0.5 * (y + b.y);
  662. end;
  663. class function TPointF.PointInCircle(const pt, center: TPointF; radius: single): Boolean;
  664. begin
  665. result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(radius);
  666. end;
  667. class function TPointF.PointInCircle(const pt, center: TPointF; radius: integer): Boolean;
  668. begin
  669. result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(single(radius));
  670. end;
  671. function TPointF.Angle(const b: TPointF): Single;
  672. begin
  673. result := ArcTan2(y - b.y, x - b.x);
  674. end;
  675. function TPointF.AngleCosine(const b: TPointF): single;
  676. begin
  677. result := EnsureRange((self ** b) / sqrt((sqr(x) + sqr(y)) * (sqr(b.x) + sqr(b.y))), -1, 1);
  678. end;
  679. class operator TPointF.= (const apt1, apt2 : TPointF) : Boolean;
  680. begin
  681. result:=SameValue(apt1.x,apt2.x) and SameValue(apt1.y,apt2.y);
  682. end;
  683. class operator TPointF.<> (const apt1, apt2 : TPointF): Boolean;
  684. begin
  685. result:=NOT (SameValue(apt1.x,apt2.x) and Samevalue(apt1.y,apt2.y));
  686. end;
  687. class operator TPointF. * (const apt1, apt2: TPointF): TPointF;
  688. begin
  689. result.x:=apt1.x*apt2.x;
  690. result.y:=apt1.y*apt2.y;
  691. end;
  692. class operator TPointF. * (afactor: single; const apt1: TPointF): TPointF;
  693. begin
  694. result:=apt1.Scale(afactor);
  695. end;
  696. class operator TPointF. * (const apt1: TPointF; afactor: single): TPointF;
  697. begin
  698. result:=apt1.Scale(afactor);
  699. end;
  700. class operator TPointF. ** (const apt1, apt2: TPointF): Single;
  701. begin
  702. result:=apt1.x*apt2.x + apt1.y*apt2.y;
  703. end;
  704. class operator TPointF.+ (const apt1, apt2 : TPointF): TPointF;
  705. begin
  706. result.x:=apt1.x+apt2.x;
  707. result.y:=apt1.y+apt2.y;
  708. end;
  709. class operator TPointF.- (const apt1, apt2 : TPointF): TPointF;
  710. begin
  711. result.x:=apt1.x-apt2.x;
  712. result.y:=apt1.y-apt2.y;
  713. end;
  714. class operator TPointF. - (const apt1: TPointF): TPointF;
  715. begin
  716. Result.x:=-apt1.x;
  717. Result.y:=-apt1.y;
  718. end;
  719. class operator TPointF. / (const apt1: TPointF; afactor: single): TPointF;
  720. begin
  721. result:=apt1.Scale(1/afactor);
  722. end;
  723. class operator TPointF. := (const apt: TPoint): TPointF;
  724. begin
  725. Result.x:=apt.x;
  726. Result.y:=apt.y;
  727. end;
  728. procedure TPointF.SetLocation(const apt :TPointF);
  729. begin
  730. x:=apt.x; y:=apt.y;
  731. end;
  732. procedure TPointF.SetLocation(const apt: TPoint);
  733. begin
  734. x:=apt.x; y:=apt.y;
  735. end;
  736. procedure TPointF.SetLocation(ax,ay : Longint);
  737. begin
  738. x:=ax; y:=ay;
  739. end;
  740. class function TPointF.Create(const ax, ay: Single): TPointF;
  741. begin
  742. Result.x := ax;
  743. Result.y := ay;
  744. end;
  745. class function TPointF.Create(const apt: TPoint): TPointF;
  746. begin
  747. Result.x := apt.X;
  748. Result.y := apt.Y;
  749. end;
  750. { TSizeF }
  751. function TSizeF.Add(const asz: TSize): TSizeF;
  752. begin
  753. result.cx:=cx+asz.cx;
  754. result.cy:=cy+asz.cy;
  755. end;
  756. function TSizeF.Add(const asz: TSizeF): TSizeF;
  757. begin
  758. result.cx:=cx+asz.cx;
  759. result.cy:=cy+asz.cy;
  760. end;
  761. function TSizeF.Subtract(const asz : TSizeF): TSizeF;
  762. begin
  763. result.cx:=cx-asz.cx;
  764. result.cy:=cy-asz.cy;
  765. end;
  766. function TSizeF.Subtract(const asz: TSize): TSizeF;
  767. begin
  768. result.cx:=cx-asz.cx;
  769. result.cy:=cy-asz.cy;
  770. end;
  771. function TSizeF.Distance(const asz : TSizeF) : Single;
  772. begin
  773. result:=sqrt(sqr(asz.cx-cx)+sqr(asz.cy-cy));
  774. end;
  775. function TSizeF.IsZero : Boolean;
  776. begin
  777. result:=SameValue(cx,0.0) and SameValue(cy,0.0);
  778. end;
  779. function TSizeF.Scale(afactor: Single): TSizeF;
  780. begin
  781. result.cx:=afactor*cx;
  782. result.cy:=afactor*cy;
  783. end;
  784. function TSizeF.Ceiling: TSize;
  785. begin
  786. result.cx:=ceil(cx);
  787. result.cy:=ceil(cy);
  788. end;
  789. function TSizeF.Truncate: TSize;
  790. begin
  791. result.cx:=trunc(cx);
  792. result.cy:=trunc(cy);
  793. end;
  794. function TSizeF.Floor: TSize;
  795. begin
  796. result.cx:=Math.floor(cx);
  797. result.cy:=Math.floor(cy);
  798. end;
  799. function TSizeF.Round: TSize;
  800. begin
  801. result.cx:=System.round(cx);
  802. result.cy:=System.round(cy);
  803. end;
  804. function TSizeF.Length: Single;
  805. begin //distance(self) ?
  806. result:=sqrt(sqr(cx)+sqr(cy));
  807. end;
  808. class operator TSizeF.= (const asz1, asz2 : TSizeF) : Boolean;
  809. begin
  810. result:=SameValue(asz1.cx,asz2.cx) and SameValue(asz1.cy,asz2.cy);
  811. end;
  812. class operator TSizeF.<> (const asz1, asz2 : TSizeF): Boolean;
  813. begin
  814. result:=NOT (SameValue(asz1.cx,asz2.cx) and Samevalue(asz1.cy,asz2.cy));
  815. end;
  816. class operator TSizeF. * (afactor: single; const asz1: TSizeF): TSizeF;
  817. begin
  818. result:=asz1.Scale(afactor);
  819. end;
  820. class operator TSizeF. * (const asz1: TSizeF; afactor: single): TSizeF;
  821. begin
  822. result:=asz1.Scale(afactor);
  823. end;
  824. class operator TSizeF.+ (const asz1, asz2 : TSizeF): TSizeF;
  825. begin
  826. result.cx:=asz1.cx+asz2.cx;
  827. result.cy:=asz1.cy+asz2.cy;
  828. end;
  829. class operator TSizeF.- (const asz1, asz2 : TSizeF): TSizeF;
  830. begin
  831. result.cx:=asz1.cx-asz2.cx;
  832. result.cy:=asz1.cy-asz2.cy;
  833. end;
  834. class operator TSizeF. - (const asz1: TSizeF): TSizeF;
  835. begin
  836. Result.cx:=-asz1.cx;
  837. Result.cy:=-asz1.cy;
  838. end;
  839. class operator TSizeF. := (const apt: TPointF): TSizeF;
  840. begin
  841. Result.cx:=apt.x;
  842. Result.cy:=apt.y;
  843. end;
  844. class operator TSizeF. := (const asz: TSize): TSizeF;
  845. begin
  846. Result.cx := asz.cx;
  847. Result.cy := asz.cy;
  848. end;
  849. class operator TSizeF. := (const asz: TSizeF): TPointF;
  850. begin
  851. Result.x := asz.cx;
  852. Result.y := asz.cy;
  853. end;
  854. class function TSizeF.Create(const ax, ay: Single): TSizeF;
  855. begin
  856. Result.cx := ax;
  857. Result.cy := ay;
  858. end;
  859. class function TSizeF.Create(const asz: TSize): TSizeF;
  860. begin
  861. Result.cx := asz.cX;
  862. Result.cy := asz.cY;
  863. end;
  864. { TRectF }
  865. class operator TRectF. * (L, R: TRectF): TRectF;
  866. begin
  867. Result := TRectF.Intersect(L, R);
  868. end;
  869. class operator TRectF. + (L, R: TRectF): TRectF;
  870. begin
  871. Result := TRectF.Union(L, R);
  872. end;
  873. class operator TRectF. := (const arc: TRect): TRectF;
  874. begin
  875. Result.Left:=arc.Left;
  876. Result.Top:=arc.Top;
  877. Result.Right:=arc.Right;
  878. Result.Bottom:=arc.Bottom;
  879. end;
  880. class operator TRectF. <> (L, R: TRectF): Boolean;
  881. begin
  882. Result := not(L=R);
  883. end;
  884. class operator TRectF. = (L, R: TRectF): Boolean;
  885. begin
  886. Result :=
  887. SameValue(L.Left,R.Left) and SameValue(L.Right,R.Right) and
  888. SameValue(L.Top,R.Top) and SameValue(L.Bottom,R.Bottom);
  889. end;
  890. constructor TRectF.Create(ALeft, ATop, ARight, ABottom: Single);
  891. begin
  892. Left := ALeft;
  893. Top := ATop;
  894. Right := ARight;
  895. Bottom := ABottom;
  896. end;
  897. constructor TRectF.Create(P1, P2: TPointF; Normalize: Boolean);
  898. begin
  899. TopLeft := P1;
  900. BottomRight := P2;
  901. if Normalize then
  902. NormalizeRect;
  903. end;
  904. constructor TRectF.Create(Origin: TPointF);
  905. begin
  906. TopLeft := Origin;
  907. BottomRight := Origin;
  908. end;
  909. constructor TRectF.Create(Origin: TPointF; AWidth, AHeight: Single);
  910. begin
  911. TopLeft := Origin;
  912. Width := AWidth;
  913. Height := AHeight;
  914. end;
  915. constructor TRectF.Create(R: TRectF; Normalize: Boolean);
  916. begin
  917. Self := R;
  918. if Normalize then
  919. NormalizeRect;
  920. end;
  921. constructor TRectF.Create(R: TRect; Normalize: Boolean);
  922. begin
  923. Self := R;
  924. if Normalize then
  925. NormalizeRect;
  926. end;
  927. function TRectF.CenterPoint: TPointF;
  928. begin
  929. Result.X := (Right-Left) / 2 + Left;
  930. Result.Y := (Bottom-Top) / 2 + Top;
  931. end;
  932. function TRectF.Contains(Pt: TPointF): Boolean;
  933. begin
  934. Result := (Left <= Pt.X) and (Pt.X < Right) and (Top <= Pt.Y) and (Pt.Y < Bottom);
  935. end;
  936. function TRectF.Contains(R: TRectF): Boolean;
  937. begin
  938. Result := (Left <= R.Left) and (R.Right <= Right) and (Top <= R.Top) and (R.Bottom <= Bottom);
  939. end;
  940. class function TRectF.Empty: TRectF;
  941. begin
  942. Result := TRectF.Create(0,0,0,0);
  943. end;
  944. function TRectF.GetHeight: Single;
  945. begin
  946. result:=bottom-top;
  947. end;
  948. function TRectF.GetLocation: TPointF;
  949. begin
  950. result.x:=Left; result.y:=top;
  951. end;
  952. function TRectF.GetSize: TSizeF;
  953. begin
  954. result.cx:=width; result.cy:=height;
  955. end;
  956. function TRectF.GetWidth: Single;
  957. begin
  958. result:=right-left;
  959. end;
  960. procedure TRectF.Inflate(DX, DY: Single);
  961. begin
  962. Left:=Left-dx;
  963. Top:=Top-dy;
  964. Right:=Right+dx;
  965. Bottom:=Bottom+dy;
  966. end;
  967. procedure TRectF.Intersect(R: TRectF);
  968. begin
  969. Self := Intersect(Self, R);
  970. end;
  971. class function TRectF.Intersect(R1: TRectF; R2: TRectF): TRectF;
  972. begin
  973. Result := R1;
  974. if R2.Left > R1.Left then
  975. Result.Left := R2.Left;
  976. if R2.Top > R1.Top then
  977. Result.Top := R2.Top;
  978. if R2.Right < R1.Right then
  979. Result.Right := R2.Right;
  980. if R2.Bottom < R1.Bottom then
  981. Result.Bottom := R2.Bottom;
  982. end;
  983. function TRectF.IntersectsWith(R: TRectF): Boolean;
  984. begin
  985. Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom);
  986. end;
  987. function TRectF.IsEmpty: Boolean;
  988. begin
  989. Result := (CompareValue(Right,Left)<=0) or (CompareValue(Bottom,Top)<=0);
  990. end;
  991. procedure TRectF.NormalizeRect;
  992. var
  993. x: Single;
  994. begin
  995. if Top>Bottom then
  996. begin
  997. x := Top;
  998. Top := Bottom;
  999. Bottom := x;
  1000. end;
  1001. if Left>Right then
  1002. begin
  1003. x := Left;
  1004. Left := Right;
  1005. Right := x;
  1006. end
  1007. end;
  1008. procedure TRectF.Inflate(DL, DT, DR, DB: Single);
  1009. begin
  1010. Left:=Left-dl;
  1011. Top:=Top-dt;
  1012. Right:=Right+dr;
  1013. Bottom:=Bottom+db;
  1014. end;
  1015. procedure TRectF.Offset(const dx, dy: Single);
  1016. begin
  1017. left:=left+dx; right:=right+dx;
  1018. bottom:=bottom+dy; top:=top+dy;
  1019. end;
  1020. procedure TRectF.Offset(DP: TPointF);
  1021. begin
  1022. left:=left+DP.x; right:=right+DP.x;
  1023. bottom:=bottom+DP.y; top:=top+DP.y;
  1024. end;
  1025. procedure TRectF.SetHeight(AValue: Single);
  1026. begin
  1027. bottom:=top+avalue;
  1028. end;
  1029. procedure TRectF.SetLocation(X, Y: Single);
  1030. begin
  1031. Offset(X-Left, Y-Top);
  1032. end;
  1033. procedure TRectF.SetLocation(P: TPointF);
  1034. begin
  1035. SetLocation(P.X, P.Y);
  1036. end;
  1037. procedure TRectF.SetSize(AValue: TSizeF);
  1038. begin
  1039. bottom:=top+avalue.cy;
  1040. right:=left+avalue.cx;
  1041. end;
  1042. procedure TRectF.SetWidth(AValue: Single);
  1043. begin
  1044. right:=left+avalue;
  1045. end;
  1046. class function TRectF.Union(const Points: array of TPointF): TRectF;
  1047. var
  1048. i: Integer;
  1049. begin
  1050. if Length(Points) > 0 then
  1051. begin
  1052. Result.TopLeft := Points[Low(Points)];
  1053. Result.BottomRight := Points[Low(Points)];
  1054. for i := Low(Points)+1 to High(Points) do
  1055. begin
  1056. if Points[i].X < Result.Left then Result.Left := Points[i].X;
  1057. if Points[i].X > Result.Right then Result.Right := Points[i].X;
  1058. if Points[i].Y < Result.Top then Result.Top := Points[i].Y;
  1059. if Points[i].Y > Result.Bottom then Result.Bottom := Points[i].Y;
  1060. end;
  1061. end else
  1062. Result := Empty;
  1063. end;
  1064. procedure TRectF.Union(const r: TRectF);
  1065. begin
  1066. left:=min(r.left,left);
  1067. top:=min(r.top,top);
  1068. right:=max(r.right,right);
  1069. bottom:=max(r.bottom,bottom);
  1070. end;
  1071. class function TRectF.Union(R1, R2: TRectF): TRectF;
  1072. begin
  1073. Result:=R1;
  1074. Result.Union(R2);
  1075. end;
  1076. { TPoint3D }
  1077. constructor TPoint3D.Create(const ax,ay,az:single);
  1078. begin
  1079. x:=ax; y:=ay; z:=az;
  1080. end;
  1081. procedure TPoint3D.Offset(const adeltax,adeltay,adeltaz:single);
  1082. begin
  1083. x:=x+adeltax; y:=y+adeltay; z:=z+adeltaz;
  1084. end;
  1085. procedure TPoint3D.Offset(const adelta:TPoint3D);
  1086. begin
  1087. x:=x+adelta.x; y:=y+adelta.y; z:=z+adelta.z;
  1088. end;
  1089. {$ifndef VER3_0}
  1090. generic class procedure TBitConverter.UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  1091. begin
  1092. move(ASrcValue, ADestination[AOffset], SizeOf(T));
  1093. end;
  1094. generic class procedure TBitConverter.From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  1095. begin
  1096. if AOffset < 0 then
  1097. System.Error(reRangeError);
  1098. if IsManagedType(T) then
  1099. System.Error(reInvalidCast);
  1100. if Length(ADestination) < (SizeOf(T) + AOffset) then
  1101. System.Error(reRangeError);
  1102. TBitConverter.specialize UnsafeFrom<T>(ASrcValue, ADestination, AOffset);
  1103. end;
  1104. generic class function TBitConverter.UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  1105. begin
  1106. move(ASource[AOffset], Result, SizeOf(T));
  1107. end;
  1108. generic class function TBitConverter.InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  1109. begin
  1110. if AOffset < 0 then
  1111. System.Error(reRangeError);
  1112. if IsManagedType(T) then
  1113. System.Error(reInvalidCast);
  1114. if Length(ASource) < (SizeOf(T) + AOffset) then
  1115. System.Error(reRangeError);
  1116. Result := TBitConverter.specialize UnsafeInTo<T>(ASource, AOffset);
  1117. end;
  1118. {$endif}
  1119. end.