types.pp 47 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840
  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. {$IFNDEF FPC_DOTTEDUNITS}
  13. unit Types;
  14. {$ENDIF FPC_DOTTEDUNITS}
  15. interface
  16. {$modeswitch advancedrecords}
  17. {$modeswitch class}
  18. {$if defined(win32) or defined(win64) or defined(wince)}
  19. uses
  20. {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows;
  21. {$elseif defined(win16)}
  22. uses
  23. {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}WinTypes;
  24. {$endif}
  25. {$if defined(win32) or defined(win64)}
  26. const
  27. RT_RCDATA = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.RT_RCDATA deprecated 'Use Windows.RT_RCDATA instead';
  28. {$elseif defined(win16)}
  29. const
  30. RT_RCDATA = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}WinTypes.RT_RCDATA deprecated 'Use WinTypes.RT_RCDATA instead';
  31. {$endif}
  32. Const
  33. Epsilon: Single = 1E-40;
  34. Epsilon2: Single = 1E-30;
  35. type
  36. TEndian = Objpas.TEndian;
  37. TDirection = (FromBeginning, FromEnd);
  38. TValueRelationship = -1..1;
  39. DWORD = LongWord;
  40. PLongint = System.PLongint;
  41. PSmallInt = System.PSmallInt;
  42. {$ifndef FPUNONE}
  43. PDouble = System.PDouble;
  44. {$endif}
  45. PByte = System.PByte;
  46. Largeint = int64;
  47. LARGE_INT = LargeInt;
  48. PLargeInt = ^LargeInt;
  49. LargeUint = qword;
  50. LARGE_UINT= LargeUInt;
  51. PLargeuInt = ^LargeuInt;
  52. TBooleanDynArray = array of Boolean;
  53. TByteDynArray = array of Byte;
  54. TClassicByteDynArray = TByteDynArray;
  55. TCardinalDynArray = array of Cardinal;
  56. TInt64DynArray = array of Int64;
  57. TIntegerDynArray = array of Integer;
  58. TLongWordDynArray = array of LongWord;
  59. TPointerDynArray = array of Pointer;
  60. TQWordDynArray = array of QWord;
  61. TShortIntDynArray = array of ShortInt;
  62. TSmallIntDynArray = array of SmallInt;
  63. TRTLStringDynArray = array of RTLString;
  64. TAnsiStringDynArray = Array of AnsiString;
  65. TWideStringDynArray = array of WideString;
  66. TUnicodeStringDynArray = array of UnicodeString;
  67. {$if SIZEOF(CHAR)=2}
  68. TStringDynArray = Array of UnicodeString;
  69. {$ELSE}
  70. TStringDynArray = Array of AnsiString;
  71. {$ENDIF}
  72. TClassicStringDynArray = TStringDynArray;
  73. TObjectDynArray = array of TObject;
  74. TWordDynArray = array of Word;
  75. TCurrencyArray = Array of currency;
  76. {$ifndef FPUNONE}
  77. TSingleDynArray = array of Single;
  78. TDoubleDynArray = array of Double;
  79. TExtendedDynArray = array of Extended;
  80. TCompDynArray = array of Comp;
  81. {$endif}
  82. {$if defined(win32) or defined(win64) or defined(wince)}
  83. TArray4IntegerType = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TArray4IntegerType;
  84. TSmallPoint = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TSmallPoint;
  85. PSmallPoint = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.PSmallPoint;
  86. TSize = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TSize;
  87. TagSize = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.tagSize deprecated;
  88. PSize = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.PSize;
  89. TPoint = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TPoint;
  90. TagPoint = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TagPoint deprecated;
  91. PPoint = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.PPoint;
  92. TRect = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TRect;
  93. PRect = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.PRect;
  94. TSplitRectType = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TSplitRectType;
  95. const
  96. srLeft = TSplitRectType.srLeft;
  97. srRight = TSplitRectType.srRight;
  98. srTop = TSplitRectType.srTop;
  99. srBottom = TSplitRectType.srBottom;
  100. type
  101. {$else}
  102. {$i typshrdh.inc}
  103. TagSize = tSize deprecated;
  104. TagPoint = TPoint deprecated;
  105. {$endif}
  106. { TPointF }
  107. PPointF = ^TPointF;
  108. TPointF =
  109. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  110. packed
  111. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  112. record
  113. x,y : Single;
  114. public
  115. function Add(const apt: TPoint): TPointF;
  116. function Add(const apt: TPointF): TPointF;
  117. function Distance(const apt : TPointF) : Single;
  118. function DotProduct(const apt : TPointF) : Single;
  119. function IsZero : Boolean;
  120. function Subtract(const apt : TPointF): TPointF;
  121. function Subtract(const apt : TPoint): TPointF;
  122. procedure SetLocation(const apt :TPointF);
  123. procedure SetLocation(const apt :TPoint);
  124. procedure SetLocation(ax,ay : Single);
  125. procedure Offset(const apt :TPointF);
  126. procedure Offset(const apt :TPoint);
  127. procedure Offset(dx,dy : Single);
  128. function EqualsTo(const apt: TPointF; const aEpsilon : Single): Boolean; overload;
  129. function EqualsTo(const apt: TPointF): Boolean; overload;
  130. function Scale (afactor:Single) : TPointF;
  131. function Ceiling : TPoint;
  132. function Truncate: TPoint;
  133. function Floor : TPoint;
  134. function Round : TPoint;
  135. function Length : Single;
  136. function Rotate(angle: single): TPointF;
  137. function Reflect(const normal: TPointF): TPointF;
  138. function MidPoint(const b: TPointF): TPointF;
  139. class function PointInCircle(const pt, center: TPointF; radius: single): Boolean; static;
  140. class function PointInCircle(const pt, center: TPointF; radius: integer): Boolean; static;
  141. class function Zero: TPointF; inline; static;
  142. function Angle(const b: TPointF): Single;
  143. function AngleCosine(const b: TPointF): single;
  144. function CrossProduct(const apt: TPointF): Single;
  145. function Normalize: TPointF;
  146. class function Create(const ax, ay: Single): TPointF; overload; static; inline;
  147. class function Create(const apt: TPoint): TPointF; overload; static; inline;
  148. class operator = (const apt1, apt2 : TPointF) : Boolean;
  149. class operator <> (const apt1, apt2 : TPointF): Boolean;
  150. class operator + (const apt1, apt2 : TPointF): TPointF;
  151. class operator - (const apt1, apt2 : TPointF): TPointF;
  152. class operator - (const apt1 : TPointF): TPointF;
  153. class operator * (const apt1, apt2: TPointF): TPointF;
  154. class operator * (const apt1: TPointF; afactor: single): TPointF;
  155. class operator * (afactor: single; const apt1: TPointF): TPointF;
  156. class operator / (const apt1: TPointF; afactor: single): TPointF;
  157. class operator := (const apt: TPoint): TPointF;
  158. class operator ** (const apt1, apt2: TPointF): Single; // scalar product
  159. end;
  160. { TSizeF }
  161. PSizeF = ^TSizeF;
  162. TSizeF =
  163. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  164. packed
  165. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  166. record
  167. cx,cy : Single;
  168. public
  169. function Add(const asz: TSize): TSizeF;
  170. function Add(const asz: TSizeF): TSizeF;
  171. function Distance(const asz : TSizeF) : Single;
  172. function IsZero : Boolean;
  173. function Subtract(const asz : TSizeF): TSizeF;
  174. function Subtract(const asz : TSize): TSizeF;
  175. function SwapDimensions:TSizeF;
  176. function Scale (afactor:Single) : TSizeF;
  177. function Ceiling : TSize;
  178. function Truncate: TSize;
  179. function Floor : TSize;
  180. function Round : TSize;
  181. function Length : Single;
  182. class function Create(const ax, ay: Single): TSizeF; overload; static; inline;
  183. class function Create(const asz: TSize): TSizeF; overload; static; inline;
  184. class operator = (const asz1, asz2 : TSizeF) : Boolean;
  185. class operator <> (const asz1, asz2 : TSizeF): Boolean;
  186. class operator + (const asz1, asz2 : TSizeF): TSizeF;
  187. class operator - (const asz1, asz2 : TSizeF): TSizeF;
  188. class operator - (const asz1 : TSizeF): TSizeF;
  189. class operator * (const asz1: TSizeF; afactor: single): TSizeF;
  190. class operator * (afactor: single; const asz1: TSizeF): TSizeF;
  191. class operator := (const apt: TPointF): TSizeF;
  192. class operator := (const asz: TSize): TSizeF;
  193. class operator := (const asz: TSizeF): TPointF;
  194. property Width: Single read cx write cx;
  195. property Height: Single read cy write cy;
  196. end;
  197. {$SCOPEDENUMS ON}
  198. TVertRectAlign = (Center, Top, Bottom);
  199. THorzRectAlign = (Center, Left, Right);
  200. {$SCOPEDENUMS OFF}
  201. { TRectF }
  202. PRectF = ^TRectF;
  203. TRectF =
  204. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  205. packed
  206. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  207. record
  208. private
  209. function GetLocation: TPointF;
  210. function GetSize: TSizeF;
  211. procedure SetSize(AValue: TSizeF);
  212. function GetHeight: Single; inline;
  213. function GetWidth: Single; inline;
  214. procedure SetHeight(AValue: Single);
  215. procedure SetWidth (AValue: Single);
  216. public
  217. constructor Create(Origin: TPointF); // empty rect at given origin
  218. constructor Create(Origin: TPointF; AWidth, AHeight: Single);
  219. constructor Create(ALeft, ATop, ARight, ABottom: Single);
  220. constructor Create(P1, P2: TPointF; Normalize: Boolean = False);
  221. constructor Create(R: TRectF; Normalize: Boolean = False);
  222. constructor Create(R: TRect; Normalize: Boolean = False);
  223. class operator = (L, R: TRectF): Boolean;
  224. class operator <> (L, R: TRectF): Boolean;
  225. class operator + (L, R: TRectF): TRectF; // union
  226. class operator * (L, R: TRectF): TRectF; // intersection
  227. class operator := (const arc: TRect): TRectF;
  228. class function Empty: TRectF; static;
  229. class function Intersect(R1: TRectF; R2: TRectF): TRectF; static;
  230. class function Union(const Points: array of TPointF): TRectF; static;
  231. class function Union(R1, R2: TRectF): TRectF; static;
  232. Function Ceiling : TRectF;
  233. function CenterAt(const Dest: TRectF): TRectF;
  234. function CenterPoint: TPointF;
  235. function Contains(Pt: TPointF): Boolean;
  236. function Contains(R: TRectF): Boolean;
  237. function EqualsTo(const R: TRectF; const Epsilon: Single = 0): Boolean;
  238. function Fit(const Dest: TRectF): Single; deprecated 'Use FitInto';
  239. function FitInto(const Dest: TRectF): TRectF; overload;
  240. function FitInto(const Dest: TRectF; out Ratio: Single): TRectF; overload;
  241. function IntersectsWith(R: TRectF): Boolean;
  242. function IsEmpty: Boolean;
  243. function PlaceInto(const Dest: TRectF; const AHorzAlign: THorzRectAlign = THorzRectAlign.Center; const AVertAlign: TVertRectAlign = TVertRectAlign.Center): TRectF;
  244. function Round: TRect;
  245. function SnapToPixel(AScale: Single; APlaceBetweenPixels: Boolean = True): TRectF;
  246. function Truncate: TRect;
  247. procedure Inflate(DL, DT, DR, DB: Single);
  248. procedure Inflate(DX, DY: Single);
  249. procedure Intersect(R: TRectF);
  250. procedure NormalizeRect;
  251. procedure Offset (const dx,dy : Single); inline;
  252. procedure Offset (DP: TPointF); inline;
  253. procedure SetLocation(P: TPointF);
  254. procedure SetLocation(X, Y: Single);
  255. procedure Union (const r: TRectF); inline;
  256. property Width : Single read GetWidth write SetWidth;
  257. property Height : Single read GetHeight write SetHeight;
  258. property Size : TSizeF read getSize write SetSize;
  259. property Location: TPointF read getLocation write setLocation;
  260. case Integer of
  261. 0: (Left, Top, Right, Bottom: Single);
  262. 1: (TopLeft, BottomRight: TPointF);
  263. end;
  264. TDuplicates = (dupIgnore, dupAccept, dupError);
  265. TPoint3D =
  266. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  267. packed
  268. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  269. record
  270. public
  271. Type TSingle3Array = array[0..2] of single;
  272. constructor Create(const ax,ay,az:single);
  273. procedure Offset(const adeltax,adeltay,adeltaz:single); inline;
  274. procedure Offset(const adelta:TPoint3D); inline;
  275. public
  276. case Integer of
  277. 0: (data:TSingle3Array);
  278. 1: (x,y,z : single);
  279. end;
  280. type
  281. TOleChar = WideChar;
  282. POleStr = PWideChar;
  283. PPOleStr = ^POleStr;
  284. TListCallback = procedure(data,arg:pointer) of object;
  285. TListStaticCallback = procedure(data,arg:pointer);
  286. const
  287. GUID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';
  288. STGTY_STORAGE = 1;
  289. STGTY_STREAM = 2;
  290. STGTY_LOCKBYTES = 3;
  291. STGTY_PROPERTY = 4;
  292. STREAM_SEEK_SET = 0;
  293. STREAM_SEEK_CUR = 1;
  294. STREAM_SEEK_END = 2;
  295. LOCK_WRITE = 1;
  296. LOCK_EXCLUSIVE = 2;
  297. LOCK_ONLYONCE = 4;
  298. STATFLAG_DEFAULT = 0;
  299. STATFLAG_NONAME = 1;
  300. STATFLAG_NOOPEN = 2;
  301. {$ifndef Wince}
  302. // in Wince these are in unit windows. Under 32/64 in ActiveX.
  303. // for now duplicate them. Not that bad for untyped constants.
  304. E_FAIL = HRESULT($80004005);
  305. E_INVALIDARG = HRESULT($80070057);
  306. STG_E_INVALIDFUNCTION = HRESULT($80030001);
  307. STG_E_FILENOTFOUND = HRESULT($80030002);
  308. STG_E_PATHNOTFOUND = HRESULT($80030003);
  309. STG_E_TOOMANYOPENFILES = HRESULT($80030004);
  310. STG_E_ACCESSDENIED = HRESULT($80030005);
  311. STG_E_INVALIDHANDLE = HRESULT($80030006);
  312. STG_E_INSUFFICIENTMEMORY = HRESULT($80030008);
  313. STG_E_INVALIDPOINTER = HRESULT($80030009);
  314. STG_E_NOMOREFILES = HRESULT($80030012);
  315. STG_E_DISKISWRITEPROTECTED = HRESULT($80030013);
  316. STG_E_SEEKERROR = HRESULT($80030019);
  317. STG_E_WRITEFAULT = HRESULT($8003001D);
  318. STG_E_READFAULT = HRESULT($8003001E);
  319. STG_E_SHAREVIOLATION = HRESULT($80030020);
  320. STG_E_LOCKVIOLATION = HRESULT($80030021);
  321. STG_E_FILEALREADYEXISTS = HRESULT($80030050);
  322. STG_E_INVALIDPARAMETER = HRESULT($80030057);
  323. STG_E_MEDIUMFULL = HRESULT($80030070);
  324. STG_E_PROPSETMISMATCHED = HRESULT($800300F0);
  325. STG_E_ABNORMALAPIEXIT = HRESULT($800300FA);
  326. STG_E_INVALIDHEADER = HRESULT($800300FB);
  327. STG_E_INVALIDNAME = HRESULT($800300FC);
  328. STG_E_UNKNOWN = HRESULT($800300FD);
  329. STG_E_UNIMPLEMENTEDFUNCTION = HRESULT($800300FE);
  330. STG_E_INVALIDFLAG = HRESULT($800300FF);
  331. STG_E_INUSE = HRESULT($80030100);
  332. STG_E_NOTCURRENT = HRESULT($80030101);
  333. STG_E_REVERTED = HRESULT($80030102);
  334. STG_E_CANTSAVE = HRESULT($80030103);
  335. STG_E_OLDFORMAT = HRESULT($80030104);
  336. STG_E_OLDDLL = HRESULT($80030105);
  337. STG_E_SHAREREQUIRED = HRESULT($80030106);
  338. STG_E_EXTANTMARSHALLINGS = HRESULT($80030108);
  339. STG_E_DOCFILECORRUPT = HRESULT($80030109);
  340. STG_E_BADBASEADDRESS = HRESULT($80030110);
  341. STG_E_INCOMPLETE = HRESULT($80030201);
  342. STG_E_TERMINATED = HRESULT($80030202);
  343. STG_S_CONVERTED = $00030200;
  344. STG_S_BLOCK = $00030201;
  345. STG_S_RETRYNOW = $00030202;
  346. STG_S_MONITORING = $00030203;
  347. {$endif}
  348. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  349. type
  350. PCLSID = PGUID;
  351. TCLSID = TGUID;
  352. PDWord = ^DWord;
  353. PDisplay = Pointer;
  354. PEvent = Pointer;
  355. TXrmOptionDescRec = record
  356. end;
  357. XrmOptionDescRec = TXrmOptionDescRec;
  358. PXrmOptionDescRec = ^TXrmOptionDescRec;
  359. Widget = Pointer;
  360. WidgetClass = Pointer;
  361. ArgList = Pointer;
  362. Region = Pointer;
  363. _FILETIME =
  364. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  365. packed
  366. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  367. record
  368. dwLowDateTime : DWORD;
  369. dwHighDateTime : DWORD;
  370. end;
  371. TFileTime = _FILETIME;
  372. FILETIME = _FILETIME;
  373. PFileTime = ^TFileTime;
  374. {$else}
  375. type
  376. PCLSID = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.PCLSID;
  377. TCLSID = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.CLSID;
  378. TFiletime = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.TFileTime;
  379. Filetime = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.FileTime;
  380. PFiletime = {$IFDEF FPC_DOTTEDUNITS}WinApi.{$ENDIF}Windows.PFileTime;
  381. {$endif Windows}
  382. type
  383. tagSTATSTG = record
  384. pwcsName : POleStr;
  385. dwType : DWord;
  386. cbSize : Large_uint;
  387. mtime : TFileTime;
  388. ctime : TFileTime;
  389. atime : TFileTime;
  390. grfMode : DWord;
  391. grfLocksSupported : DWord;
  392. clsid : TCLSID;
  393. grfStateBits : DWord;
  394. reserved : DWord;
  395. end;
  396. TStatStg = tagSTATSTG;
  397. STATSTG = TStatStg;
  398. PStatStg = ^TStatStg;
  399. { classes depends on these interfaces, we can't use the activex unit in classes though }
  400. IClassFactory = Interface(IUnknown) ['{00000001-0000-0000-C000-000000000046}']
  401. Function CreateInstance(Const unkOuter : IUnknown;Const riid : TGUID;Out vObject) : HResult;StdCall;
  402. Function LockServer(fLock : LongBool) : HResult;StdCall;
  403. End;
  404. ISequentialStream = interface(IUnknown)
  405. ['{0c733a30-2a1c-11ce-ade5-00aa0044773d}']
  406. function Read(pv : Pointer;cb : DWORD;pcbRead : PDWORD) : HRESULT;stdcall;
  407. function Write(pv : Pointer;cb : DWORD;pcbWritten : PDWORD): HRESULT;stdcall;
  408. end;
  409. IStream = interface(ISequentialStream) ['{0000000C-0000-0000-C000-000000000046}']
  410. function Seek(dlibMove : LargeInt; dwOrigin : DWORD; out libNewPosition : LargeUInt) : HResult;stdcall;
  411. function SetSize(libNewSize : LargeUInt) : HRESULT;stdcall;
  412. function CopyTo(stm: IStream;cb : LargeUInt;out cbRead : LargeUInt; out cbWritten : LargeUInt) : HRESULT;stdcall;
  413. function Commit(grfCommitFlags : DWORD) : HRESULT;stdcall;
  414. function Revert : HRESULT;stdcall;
  415. function LockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
  416. function UnlockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
  417. Function Stat(out statstg : TStatStg;grfStatFlag : DWORD) : HRESULT;stdcall;
  418. function Clone(out stm : IStream) : HRESULT;stdcall;
  419. end;
  420. function EqualRect(const r1,r2 : TRect) : Boolean;
  421. function EqualRect(const r1,r2 : TRectF) : Boolean;
  422. function NormalizeRectF(const Pts: array of TPointF): TRectF; overload;
  423. function NormalizeRect(const ARect: TRectF): TRectF; overload;
  424. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  425. function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
  426. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  427. function Point(x,y : Integer) : TPoint; inline;
  428. function PointF(x,y: Single) : TPointF; inline;
  429. function PtInRect(const Rect : TRect; const p : TPoint) : Boolean;
  430. function PtInRect(const Rect : TRectF; const p : TPointF) : Boolean;
  431. function IntersectRect(const Rect1, Rect2: TRect): Boolean;
  432. function IntersectRect(const Rect1, Rect2: TRectF): Boolean;
  433. function IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  434. function IntersectRect(var Rect : TRectF; const R1,R2 : TRectF) : Boolean;
  435. function RectCenter(var R: TRect; const Bounds: TRect): TRect;
  436. function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
  437. function RectHeight(const Rect: TRect): Integer; inline;
  438. function RectHeight(const Rect: TRectF): Single; inline;
  439. function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  440. function UnionRect(var Rect : TRectF; const R1,R2 : TRectF) : Boolean;
  441. function UnionRect(const R1,R2 : TRect) : TRect;
  442. function UnionRect(const R1,R2 : TRectF) : TRectF;
  443. function IsRectEmpty(const Rect : TRectF) : Boolean;
  444. function IsRectEmpty(const Rect : TRect) : Boolean;
  445. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  446. function OffsetRect(var Rect : TRectF;DX : Single;DY : Single) : Boolean;
  447. procedure MultiplyRect(var R: TRectF; const DX, DY: Single);
  448. function CenterPoint(const Rect: TRect): TPoint;
  449. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  450. function InflateRect(var Rect: TRectF; dx: single; dy: Single): Boolean;
  451. function Size(AWidth, AHeight: Integer): TSize; inline;
  452. function Size(const ARect: TRect): TSize;
  453. function ScalePoint(const P: TPointF; dX, dY: Single): TPointF; overload;
  454. function ScalePoint(const P: TPoint; dX, dY: Single): TPoint; overload;
  455. function MinPoint(const P1, P2: TPointF): TPointF; overload;
  456. function MinPoint(const P1, P2: TPoint): TPoint; overload;
  457. function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Size: Integer): TRect; overload;
  458. function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Percent: Double): TRect; overload;
  459. function CenteredRect(const SourceRect: TRect; const aCenteredRect: TRect): TRect;
  460. function IntersectRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
  461. function UnionRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
  462. {$ifndef VER3_0}
  463. type
  464. TBitConverter = class
  465. generic class procedure UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static; {inline;}
  466. generic class procedure From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static;
  467. generic class function UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static; {inline;}
  468. generic class function InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static;
  469. end;
  470. {$endif}
  471. implementation
  472. {$IFDEF FPC_DOTTEDUNITS}
  473. Uses System.Math;
  474. {$ELSE FPC_DOTTEDUNITS}
  475. Uses Math;
  476. {$ENDIF FPC_DOTTEDUNITS}
  477. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  478. {$i typshrd.inc}
  479. {$endif}
  480. function SmallPoint(X, Y: Integer): TSmallPoint; inline; overload;
  481. begin
  482. Result.X:=X;
  483. Result.Y:=Y;
  484. end;
  485. function SmallPoint(XY: LongWord): TSmallPoint; overload;
  486. begin
  487. Result.X:=SmallInt(XY and $0000FFFF);
  488. Result.Y:=SmallInt(XY shr 16);
  489. end;
  490. function MinPoint(const P1, P2: TPointF): TPointF; overload;
  491. begin
  492. Result:=P1;
  493. if (P2.Y<P1.Y)
  494. or ((P2.Y=P1.Y) and (P2.X<P1.X)) then
  495. Result:=P2;
  496. end;
  497. function MinPoint(const P1, P2: TPoint): TPoint; overload;
  498. begin
  499. Result:=P1;
  500. if (P2.Y<P1.Y)
  501. or ((P2.Y=P1.Y) and (P2.X<P1.X)) then
  502. Result:=P2;
  503. end;
  504. function ScalePoint(const P: TPointF; dX, dY: Single): TPointF; overload;
  505. begin
  506. Result.X:=P.X*dX;
  507. Result.Y:=P.Y*dY;
  508. end;
  509. function ScalePoint(const P: TPoint; dX, dY: Single): TPoint; overload;
  510. begin
  511. Result.X:=Round(P.X*dX);
  512. Result.Y:=Round(P.Y*dY);
  513. end;
  514. function NormalizeRectF(const Pts: array of TPointF): TRectF;
  515. var
  516. Pt: TPointF;
  517. begin
  518. Result.Left:=$FFFF;
  519. Result.Top:=$FFFF;
  520. Result.Right:=-$FFFF;
  521. Result.Bottom:=-$FFFF;
  522. for Pt in Pts do
  523. begin
  524. Result.Left:=Min(Pt.X,Result.left);
  525. Result.Top:=Min(Pt.Y,Result.Top);
  526. Result.Right:=Max(Pt.X,Result.Right);
  527. Result.Bottom:=Max(Pt.Y,Result.Bottom);
  528. end;
  529. end;
  530. function NormalizeRect(const aRect : TRectF): TRectF;
  531. begin
  532. With aRect do
  533. Result:=NormalizeRectF([PointF(Left,Top),
  534. PointF(Right,Top),
  535. PointF(Right,Bottom),
  536. PointF(Left,Bottom)]);
  537. end;
  538. function EqualRect(const r1,r2 : TRect) : Boolean;
  539. begin
  540. EqualRect:=(r1.left=r2.left) and (r1.right=r2.right) and (r1.top=r2.top) and (r1.bottom=r2.bottom);
  541. end;
  542. function EqualRect(const r1,r2 : TRectF) : Boolean;
  543. begin
  544. EqualRect:=r1.EqualsTo(r2);
  545. end;
  546. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  547. begin
  548. Rect.Left:=Left;
  549. Rect.Top:=Top;
  550. Rect.Right:=Right;
  551. Rect.Bottom:=Bottom;
  552. end;
  553. function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
  554. begin
  555. RectF.Left:=Left;
  556. RectF.Top:=Top;
  557. RectF.Right:=Right;
  558. RectF.Bottom:=Bottom;
  559. end;
  560. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  561. begin
  562. Bounds.Left:=ALeft;
  563. Bounds.Top:=ATop;
  564. Bounds.Right:=ALeft+AWidth;
  565. Bounds.Bottom:=ATop+AHeight;
  566. end;
  567. function Point(x,y : Integer) : TPoint; inline;
  568. begin
  569. Point.x:=x;
  570. Point.y:=y;
  571. end;
  572. function PointF(x,y: Single) : TPointF; inline;
  573. begin
  574. PointF.x:=x;
  575. PointF.y:=y;
  576. end;
  577. function PtInRect(const Rect : TRect;const p : TPoint) : Boolean;
  578. begin
  579. PtInRect:=(p.y>=Rect.Top) and
  580. (p.y<Rect.Bottom) and
  581. (p.x>=Rect.Left) and
  582. (p.x<Rect.Right);
  583. end;
  584. function PtInRect(const Rect : TRectF;const p : TPointF) : Boolean;
  585. begin
  586. PtInRect:=(p.y>=Rect.Top) and
  587. (p.y<Rect.Bottom) and
  588. (p.x>=Rect.Left) and
  589. (p.x<Rect.Right);
  590. end;
  591. function IntersectRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
  592. begin
  593. Result:=IntersectRect(Rect,R1,R2);
  594. end;
  595. function UnionRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
  596. begin
  597. Result:=UnionRect(Rect,R1,R2);
  598. end;
  599. function IntersectRect(const Rect1, Rect2: TRect): Boolean;
  600. begin
  601. Result:=(Rect1.Left<Rect2.Right)
  602. and (Rect1.Right>Rect2.Left)
  603. and (Rect1.Top<Rect2.Bottom)
  604. and (Rect1.Bottom>Rect2.Top);
  605. end;
  606. function IntersectRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  607. var
  608. lRect: TRect;
  609. begin
  610. lRect := R1;
  611. if R2.Left > R1.Left then
  612. lRect.Left := R2.Left;
  613. if R2.Top > R1.Top then
  614. lRect.Top := R2.Top;
  615. if R2.Right < R1.Right then
  616. lRect.Right := R2.Right;
  617. if R2.Bottom < R1.Bottom then
  618. lRect.Bottom := R2.Bottom;
  619. // The var parameter is only assigned in the end to avoid problems
  620. // when passing the same rectangle in the var and const parameters.
  621. // See http://bugs.freepascal.org/view.php?id=17722
  622. Result:=not IsRectEmpty(lRect);
  623. if Result then
  624. Rect := lRect
  625. else
  626. FillChar(Rect,SizeOf(Rect),0);
  627. end;
  628. function IntersectRect(const Rect1, Rect2: TRectF): Boolean;
  629. begin
  630. Result:=(Rect1.Left<Rect2.Right)
  631. and (Rect1.Right>Rect2.Left)
  632. and (Rect1.Top<Rect2.Bottom)
  633. and (Rect1.Bottom>Rect2.Top);
  634. end;
  635. function IntersectRect(var Rect : TRectF;const R1,R2 : TRectF) : Boolean;
  636. var
  637. lRect: TRectF;
  638. begin
  639. lRect := R1;
  640. if R2.Left > R1.Left then
  641. lRect.Left := R2.Left;
  642. if R2.Top > R1.Top then
  643. lRect.Top := R2.Top;
  644. if R2.Right < R1.Right then
  645. lRect.Right := R2.Right;
  646. if R2.Bottom < R1.Bottom then
  647. lRect.Bottom := R2.Bottom;
  648. // The var parameter is only assigned in the end to avoid problems
  649. // when passing the same rectangle in the var and const parameters.
  650. // See http://bugs.freepascal.org/view.php?id=17722
  651. Result:=not IsRectEmpty(lRect);
  652. if Result then
  653. Rect := lRect
  654. else
  655. FillChar(Rect,SizeOf(Rect),0);
  656. end;
  657. function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Size: Integer): TRect; overload;
  658. begin
  659. Result:=Rect.SplitRect(SplitType,Size);
  660. end;
  661. function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Percent: Double): TRect; overload;
  662. begin
  663. Result:=Rect.SplitRect(SplitType,Percent);
  664. end;
  665. function CenteredRect(const SourceRect: TRect; const aCenteredRect: TRect): TRect;
  666. var
  667. W,H: Integer;
  668. Center : TPoint;
  669. begin
  670. W:=aCenteredRect.Width;
  671. H:=aCenteredRect.Height;
  672. Center:=SourceRect.CenterPoint;
  673. With Center do
  674. Result:= Rect(X-(W div 2),Y-(H div 2),X+((W+1) div 2),Y+((H+1) div 2));
  675. end;
  676. function RectWidth(const Rect: TRect): Integer;
  677. begin
  678. Result:=Rect.Width;
  679. end;
  680. function RectWidth(const Rect: TRectF): Single;
  681. begin
  682. Result:=Rect.Width;
  683. end;
  684. function RectHeight(const Rect: TRect): Integer; inline;
  685. begin
  686. Result:=Rect.Height;
  687. end;
  688. function RectHeight(const Rect: TRectF): Single; inline;
  689. begin
  690. Result:=Rect.Height
  691. end;
  692. function RectCenter(var R: TRect; const Bounds: TRect): TRect;
  693. var
  694. C : TPoint;
  695. CS : TPoint;
  696. begin
  697. C:=Bounds.CenterPoint;
  698. CS:=R.CenterPoint;
  699. OffsetRect(R,C.X-CS.X,C.Y-CS.Y);
  700. Result:=R;
  701. end;
  702. function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
  703. Var
  704. C,CS : TPointF;
  705. begin
  706. C:=Bounds.CenterPoint;
  707. CS:=R.CenterPoint;
  708. OffsetRect(R,C.X-CS.X,C.Y-CS.Y);
  709. Result:=R;
  710. end;
  711. procedure MultiplyRect(var R: TRectF; const DX, DY: Single);
  712. begin
  713. R.Left:=DX*R.Left;
  714. R.Right:=DX*R.Right;
  715. R.Top:=DY*R.Top;
  716. R.Bottom:=DY*R.Bottom;
  717. end;
  718. function UnionRect(const R1,R2 : TRect) : TRect;
  719. begin
  720. Result:=Default(TRect);
  721. UnionRect(Result,R1,R2);
  722. end;
  723. function UnionRect(const R1,R2 : TRectF) : TRectF;
  724. begin
  725. Result:=Default(TRectF);
  726. UnionRect(Result,R1,R2);
  727. end;
  728. function UnionRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  729. var
  730. lRect: TRect;
  731. begin
  732. lRect:=R1;
  733. if R2.Left<R1.Left then
  734. lRect.Left:=R2.Left;
  735. if R2.Top<R1.Top then
  736. lRect.Top:=R2.Top;
  737. if R2.Right>R1.Right then
  738. lRect.Right:=R2.Right;
  739. if R2.Bottom>R1.Bottom then
  740. lRect.Bottom:=R2.Bottom;
  741. Result:=not IsRectEmpty(lRect);
  742. if Result then
  743. Rect := lRect
  744. else
  745. FillChar(Rect,SizeOf(Rect),0);
  746. end;
  747. function UnionRect(var Rect : TRectF;const R1,R2 : TRectF) : Boolean;
  748. var
  749. lRect: TRectF;
  750. begin
  751. lRect:=R1;
  752. if R2.Left<R1.Left then
  753. lRect.Left:=R2.Left;
  754. if R2.Top<R1.Top then
  755. lRect.Top:=R2.Top;
  756. if R2.Right>R1.Right then
  757. lRect.Right:=R2.Right;
  758. if R2.Bottom>R1.Bottom then
  759. lRect.Bottom:=R2.Bottom;
  760. Result:=not IsRectEmpty(lRect);
  761. if Result then
  762. Rect := lRect
  763. else
  764. FillChar(Rect,SizeOf(Rect),0);
  765. end;
  766. function IsRectEmpty(const Rect : TRect) : Boolean;
  767. begin
  768. IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
  769. end;
  770. function IsRectEmpty(const Rect : TRectF) : Boolean;
  771. begin
  772. IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
  773. end;
  774. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  775. begin
  776. Result:=assigned(@Rect);
  777. if Result then
  778. with Rect do
  779. begin
  780. inc(Left,dx);
  781. inc(Top,dy);
  782. inc(Right,dx);
  783. inc(Bottom,dy);
  784. end;
  785. end;
  786. function Avg(a, b: Longint): Longint;
  787. begin
  788. if a < b then
  789. Result := a + ((b - a) shr 1)
  790. else
  791. Result := b + ((a - b) shr 1);
  792. end;
  793. function OffsetRect(var Rect: TRectF; DX: Single; DY: Single): Boolean;
  794. begin
  795. Result:=assigned(@Rect);
  796. if Result then
  797. with Rect do
  798. begin
  799. Left:=Left+dx;
  800. Right:=Right+dx;
  801. Top:=Top+dy;
  802. Bottom:=Bottom+dy;
  803. end;
  804. end;
  805. function CenterPoint(const Rect: TRect): TPoint;
  806. begin
  807. with Rect do
  808. begin
  809. Result.X := Avg(Left, Right);
  810. Result.Y := Avg(Top, Bottom);
  811. end;
  812. end;
  813. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  814. begin
  815. Result:=assigned(@Rect);
  816. if Result then
  817. with Rect do
  818. begin
  819. dec(Left, dx);
  820. dec(Top, dy);
  821. inc(Right, dx);
  822. inc(Bottom, dy);
  823. end;
  824. end;
  825. function InflateRect(var Rect: TRectF; dx: Single; dy: Single): Boolean;
  826. begin
  827. Result:=assigned(@Rect);
  828. if Result then
  829. with Rect do
  830. begin
  831. Left:=Left-dx;
  832. Top:=Top-dy;
  833. Right:=Right+dx;
  834. Bottom:=Bottom+dy;
  835. end;
  836. end;
  837. function Size(AWidth, AHeight: Integer): TSize; inline;
  838. begin
  839. Result.cx := AWidth;
  840. Result.cy := AHeight;
  841. end;
  842. function Size(const ARect: TRect): TSize; inline;
  843. begin
  844. Result.cx := ARect.Right - ARect.Left;
  845. Result.cy := ARect.Bottom - ARect.Top;
  846. end;
  847. { TPointF}
  848. function TPointF.Add(const apt: TPoint): TPointF;
  849. begin
  850. result.x:=x+apt.x;
  851. result.y:=y+apt.y;
  852. end;
  853. function TPointF.Add(const apt: TPointF): TPointF;
  854. begin
  855. result.x:=x+apt.x;
  856. result.y:=y+apt.y;
  857. end;
  858. function TPointF.Subtract(const apt : TPointF): TPointF;
  859. begin
  860. result.x:=x-apt.x;
  861. result.y:=y-apt.y;
  862. end;
  863. function TPointF.Subtract(const apt: TPoint): TPointF;
  864. begin
  865. result.x:=x-apt.x;
  866. result.y:=y-apt.y;
  867. end;
  868. function TPointF.Distance(const apt : TPointF) : Single;
  869. begin
  870. result:=sqrt(sqr(apt.x-x)+sqr(apt.y-y));
  871. end;
  872. function TPointF.DotProduct(const apt: TPointF): Single;
  873. begin
  874. result:=x*apt.x+y*apt.y;
  875. end;
  876. function TPointF.IsZero : Boolean;
  877. begin
  878. result:=SameValue(x,0.0) and SameValue(y,0.0);
  879. end;
  880. procedure TPointF.Offset(const apt :TPointF);
  881. begin
  882. x:=x+apt.x;
  883. y:=y+apt.y;
  884. end;
  885. procedure TPointF.Offset(const apt: TPoint);
  886. begin
  887. x:=x+apt.x;
  888. y:=y+apt.y;
  889. end;
  890. procedure TPointF.Offset(dx,dy : Single);
  891. begin
  892. x:=x+dx;
  893. y:=y+dy;
  894. end;
  895. function TPointF.EqualsTo(const apt: TPointF): Boolean;
  896. begin
  897. Result:=EqualsTo(apt,0);
  898. end;
  899. function TPointF.EqualsTo(const apt: TPointF; const aEpsilon: Single): Boolean;
  900. function Eq(a,b : single) : boolean; inline;
  901. begin
  902. result:=abs(a-b)<=aEpsilon;
  903. end;
  904. begin
  905. Result:=Eq(X,apt.X) and Eq(Y,apt.Y);
  906. end;
  907. function TPointF.Scale(afactor: Single): TPointF;
  908. begin
  909. result.x:=afactor*x;
  910. result.y:=afactor*y;
  911. end;
  912. function TPointF.Ceiling: TPoint;
  913. begin
  914. result.x:=ceil(x);
  915. result.y:=ceil(y);
  916. end;
  917. function TPointF.Truncate: TPoint;
  918. begin
  919. result.x:=trunc(x);
  920. result.y:=trunc(y);
  921. end;
  922. function TPointF.Floor: TPoint;
  923. begin
  924. result.x:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(x);
  925. result.y:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(y);
  926. end;
  927. function TPointF.Round: TPoint;
  928. begin
  929. result.x:=System.round(x);
  930. result.y:=System.round(y);
  931. end;
  932. function TPointF.Length: Single;
  933. begin
  934. result:=sqrt(sqr(x)+sqr(y));
  935. end;
  936. function TPointF.Rotate(angle: single): TPointF;
  937. var
  938. sina, cosa: single;
  939. begin
  940. sincos(angle, sina, cosa);
  941. result.x := x * cosa - y * sina;
  942. result.y := x * sina + y * cosa;
  943. end;
  944. function TPointF.Reflect(const normal: TPointF): TPointF;
  945. begin
  946. result := self + (-2 * normal ** self) * normal;
  947. end;
  948. function TPointF.MidPoint(const b: TPointF): TPointF;
  949. begin
  950. result.x := 0.5 * (x + b.x);
  951. result.y := 0.5 * (y + b.y);
  952. end;
  953. class function TPointF.Zero: TPointF;
  954. begin
  955. Result.X:=0;
  956. Result.Y:=0;
  957. end;
  958. class function TPointF.PointInCircle(const pt, center: TPointF; radius: single): Boolean;
  959. begin
  960. result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(radius);
  961. end;
  962. class function TPointF.PointInCircle(const pt, center: TPointF; radius: integer): Boolean;
  963. begin
  964. result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(single(radius));
  965. end;
  966. function TPointF.Angle(const b: TPointF): Single;
  967. begin
  968. result := ArcTan2(y - b.y, x - b.x);
  969. end;
  970. function TPointF.AngleCosine(const b: TPointF): single;
  971. begin
  972. result := EnsureRange((self ** b) / sqrt((sqr(x) + sqr(y)) * (sqr(b.x) + sqr(b.y))), -1, 1);
  973. end;
  974. class operator TPointF.= (const apt1, apt2 : TPointF) : Boolean;
  975. begin
  976. result:=SameValue(apt1.x,apt2.x) and SameValue(apt1.y,apt2.y);
  977. end;
  978. class operator TPointF.<> (const apt1, apt2 : TPointF): Boolean;
  979. begin
  980. result:=NOT (SameValue(apt1.x,apt2.x) and Samevalue(apt1.y,apt2.y));
  981. end;
  982. class operator TPointF. * (const apt1, apt2: TPointF): TPointF;
  983. begin
  984. result.x:=apt1.x*apt2.x;
  985. result.y:=apt1.y*apt2.y;
  986. end;
  987. class operator TPointF. * (afactor: single; const apt1: TPointF): TPointF;
  988. begin
  989. result:=apt1.Scale(afactor);
  990. end;
  991. class operator TPointF. * (const apt1: TPointF; afactor: single): TPointF;
  992. begin
  993. result:=apt1.Scale(afactor);
  994. end;
  995. class operator TPointF. ** (const apt1, apt2: TPointF): Single;
  996. begin
  997. result:=apt1.x*apt2.x + apt1.y*apt2.y;
  998. end;
  999. class operator TPointF.+ (const apt1, apt2 : TPointF): TPointF;
  1000. begin
  1001. result.x:=apt1.x+apt2.x;
  1002. result.y:=apt1.y+apt2.y;
  1003. end;
  1004. class operator TPointF.- (const apt1, apt2 : TPointF): TPointF;
  1005. begin
  1006. result.x:=apt1.x-apt2.x;
  1007. result.y:=apt1.y-apt2.y;
  1008. end;
  1009. class operator TPointF. - (const apt1: TPointF): TPointF;
  1010. begin
  1011. Result.x:=-apt1.x;
  1012. Result.y:=-apt1.y;
  1013. end;
  1014. class operator TPointF. / (const apt1: TPointF; afactor: single): TPointF;
  1015. begin
  1016. result:=apt1.Scale(1/afactor);
  1017. end;
  1018. class operator TPointF. := (const apt: TPoint): TPointF;
  1019. begin
  1020. Result.x:=apt.x;
  1021. Result.y:=apt.y;
  1022. end;
  1023. procedure TPointF.SetLocation(const apt :TPointF);
  1024. begin
  1025. x:=apt.x; y:=apt.y;
  1026. end;
  1027. procedure TPointF.SetLocation(const apt: TPoint);
  1028. begin
  1029. x:=apt.x; y:=apt.y;
  1030. end;
  1031. procedure TPointF.SetLocation(ax,ay : Single);
  1032. begin
  1033. x:=ax; y:=ay;
  1034. end;
  1035. class function TPointF.Create(const ax, ay: Single): TPointF;
  1036. begin
  1037. Result.x := ax;
  1038. Result.y := ay;
  1039. end;
  1040. class function TPointF.Create(const apt: TPoint): TPointF;
  1041. begin
  1042. Result.x := apt.X;
  1043. Result.y := apt.Y;
  1044. end;
  1045. function TPointF.CrossProduct(const apt: TPointF): Single;
  1046. begin
  1047. Result:=X*apt.Y-Y*apt.X;
  1048. end;
  1049. function TPointF.Normalize: TPointF;
  1050. var
  1051. L: Single;
  1052. begin
  1053. L:=Sqrt(Sqr(X)+Sqr(Y));
  1054. if SameValue(L,0,Epsilon) then
  1055. Result:=Self
  1056. else
  1057. begin
  1058. Result.X:=X/L;
  1059. Result.Y:=Y/L;
  1060. end;
  1061. end;
  1062. { TSizeF }
  1063. function TSizeF.Add(const asz: TSize): TSizeF;
  1064. begin
  1065. result.cx:=cx+asz.cx;
  1066. result.cy:=cy+asz.cy;
  1067. end;
  1068. function TSizeF.Add(const asz: TSizeF): TSizeF;
  1069. begin
  1070. result.cx:=cx+asz.cx;
  1071. result.cy:=cy+asz.cy;
  1072. end;
  1073. function TSizeF.Subtract(const asz : TSizeF): TSizeF;
  1074. begin
  1075. result.cx:=cx-asz.cx;
  1076. result.cy:=cy-asz.cy;
  1077. end;
  1078. function TSizeF.SwapDimensions:TSizeF;
  1079. begin
  1080. result.cx:=cy;
  1081. result.cy:=cx;
  1082. end;
  1083. function TSizeF.Subtract(const asz: TSize): TSizeF;
  1084. begin
  1085. result.cx:=cx-asz.cx;
  1086. result.cy:=cy-asz.cy;
  1087. end;
  1088. function TSizeF.Distance(const asz : TSizeF) : Single;
  1089. begin
  1090. result:=sqrt(sqr(asz.cx-cx)+sqr(asz.cy-cy));
  1091. end;
  1092. function TSizeF.IsZero : Boolean;
  1093. begin
  1094. result:=SameValue(cx,0.0) and SameValue(cy,0.0);
  1095. end;
  1096. function TSizeF.Scale(afactor: Single): TSizeF;
  1097. begin
  1098. result.cx:=afactor*cx;
  1099. result.cy:=afactor*cy;
  1100. end;
  1101. function TSizeF.Ceiling: TSize;
  1102. begin
  1103. result.cx:=ceil(cx);
  1104. result.cy:=ceil(cy);
  1105. end;
  1106. function TSizeF.Truncate: TSize;
  1107. begin
  1108. result.cx:=trunc(cx);
  1109. result.cy:=trunc(cy);
  1110. end;
  1111. function TSizeF.Floor: TSize;
  1112. begin
  1113. result.cx:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(cx);
  1114. result.cy:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(cy);
  1115. end;
  1116. function TSizeF.Round: TSize;
  1117. begin
  1118. result.cx:=System.round(cx);
  1119. result.cy:=System.round(cy);
  1120. end;
  1121. function TSizeF.Length: Single;
  1122. begin //distance(self) ?
  1123. result:=sqrt(sqr(cx)+sqr(cy));
  1124. end;
  1125. class operator TSizeF.= (const asz1, asz2 : TSizeF) : Boolean;
  1126. begin
  1127. result:=SameValue(asz1.cx,asz2.cx) and SameValue(asz1.cy,asz2.cy);
  1128. end;
  1129. class operator TSizeF.<> (const asz1, asz2 : TSizeF): Boolean;
  1130. begin
  1131. result:=NOT (SameValue(asz1.cx,asz2.cx) and Samevalue(asz1.cy,asz2.cy));
  1132. end;
  1133. class operator TSizeF. * (afactor: single; const asz1: TSizeF): TSizeF;
  1134. begin
  1135. result:=asz1.Scale(afactor);
  1136. end;
  1137. class operator TSizeF. * (const asz1: TSizeF; afactor: single): TSizeF;
  1138. begin
  1139. result:=asz1.Scale(afactor);
  1140. end;
  1141. class operator TSizeF.+ (const asz1, asz2 : TSizeF): TSizeF;
  1142. begin
  1143. result.cx:=asz1.cx+asz2.cx;
  1144. result.cy:=asz1.cy+asz2.cy;
  1145. end;
  1146. class operator TSizeF.- (const asz1, asz2 : TSizeF): TSizeF;
  1147. begin
  1148. result.cx:=asz1.cx-asz2.cx;
  1149. result.cy:=asz1.cy-asz2.cy;
  1150. end;
  1151. class operator TSizeF. - (const asz1: TSizeF): TSizeF;
  1152. begin
  1153. Result.cx:=-asz1.cx;
  1154. Result.cy:=-asz1.cy;
  1155. end;
  1156. class operator TSizeF. := (const apt: TPointF): TSizeF;
  1157. begin
  1158. Result.cx:=apt.x;
  1159. Result.cy:=apt.y;
  1160. end;
  1161. class operator TSizeF. := (const asz: TSize): TSizeF;
  1162. begin
  1163. Result.cx := asz.cx;
  1164. Result.cy := asz.cy;
  1165. end;
  1166. class operator TSizeF. := (const asz: TSizeF): TPointF;
  1167. begin
  1168. Result.x := asz.cx;
  1169. Result.y := asz.cy;
  1170. end;
  1171. class function TSizeF.Create(const ax, ay: Single): TSizeF;
  1172. begin
  1173. Result.cx := ax;
  1174. Result.cy := ay;
  1175. end;
  1176. class function TSizeF.Create(const asz: TSize): TSizeF;
  1177. begin
  1178. Result.cx := asz.cX;
  1179. Result.cy := asz.cY;
  1180. end;
  1181. { TRectF }
  1182. class operator TRectF. * (L, R: TRectF): TRectF;
  1183. begin
  1184. Result := TRectF.Intersect(L, R);
  1185. end;
  1186. class operator TRectF. + (L, R: TRectF): TRectF;
  1187. begin
  1188. Result := TRectF.Union(L, R);
  1189. end;
  1190. class operator TRectF. := (const arc: TRect): TRectF;
  1191. begin
  1192. Result.Left:=arc.Left;
  1193. Result.Top:=arc.Top;
  1194. Result.Right:=arc.Right;
  1195. Result.Bottom:=arc.Bottom;
  1196. end;
  1197. class operator TRectF. <> (L, R: TRectF): Boolean;
  1198. begin
  1199. Result := not(L=R);
  1200. end;
  1201. class operator TRectF. = (L, R: TRectF): Boolean;
  1202. begin
  1203. Result :=
  1204. SameValue(L.Left,R.Left) and SameValue(L.Right,R.Right) and
  1205. SameValue(L.Top,R.Top) and SameValue(L.Bottom,R.Bottom);
  1206. end;
  1207. constructor TRectF.Create(ALeft, ATop, ARight, ABottom: Single);
  1208. begin
  1209. Left := ALeft;
  1210. Top := ATop;
  1211. Right := ARight;
  1212. Bottom := ABottom;
  1213. end;
  1214. constructor TRectF.Create(P1, P2: TPointF; Normalize: Boolean);
  1215. begin
  1216. TopLeft := P1;
  1217. BottomRight := P2;
  1218. if Normalize then
  1219. NormalizeRect;
  1220. end;
  1221. constructor TRectF.Create(Origin: TPointF);
  1222. begin
  1223. TopLeft := Origin;
  1224. BottomRight := Origin;
  1225. end;
  1226. constructor TRectF.Create(Origin: TPointF; AWidth, AHeight: Single);
  1227. begin
  1228. TopLeft := Origin;
  1229. Width := AWidth;
  1230. Height := AHeight;
  1231. end;
  1232. constructor TRectF.Create(R: TRectF; Normalize: Boolean);
  1233. begin
  1234. Self := R;
  1235. if Normalize then
  1236. NormalizeRect;
  1237. end;
  1238. constructor TRectF.Create(R: TRect; Normalize: Boolean);
  1239. begin
  1240. Self := R;
  1241. if Normalize then
  1242. NormalizeRect;
  1243. end;
  1244. function TRectF.CenterPoint: TPointF;
  1245. begin
  1246. Result.X := (Right-Left) / 2 + Left;
  1247. Result.Y := (Bottom-Top) / 2 + Top;
  1248. end;
  1249. function TRectF.Ceiling: TRectF;
  1250. begin
  1251. Result.BottomRight:=BottomRight.Ceiling;
  1252. Result.TopLeft:=TopLeft.Ceiling;
  1253. end;
  1254. function TRectF.CenterAt(const Dest: TRectF): TRectF;
  1255. begin
  1256. Result:=Self;
  1257. RectCenter(Result,Dest);
  1258. end;
  1259. function TRectF.Fit(const Dest: TRectF): Single;
  1260. var
  1261. R : TRectF;
  1262. begin
  1263. R:=FitInto(Dest,Result);
  1264. Self:=R;
  1265. end;
  1266. function TRectF.FitInto(const Dest: TRectF; out Ratio: Single): TRectF;
  1267. begin
  1268. if (Dest.Width<=0) or (Dest.Height<=0) then
  1269. begin
  1270. Ratio:=1.0;
  1271. exit(Self);
  1272. end;
  1273. Ratio:=Max(Self.Width / Dest.Width, Self.Height / Dest.Height);
  1274. if Ratio=0 then
  1275. exit(Self);
  1276. Result.Width:=Self.Width / Ratio;
  1277. Result.Height:=Self.Height / Ratio;
  1278. Result.Left:=Self.Left + (Self.Width - Result.Width) / 2;
  1279. Result.Top:=Self.Top + (Self.Height - Result.Height) / 2;
  1280. end;
  1281. function TRectF.FitInto(const Dest: TRectF): TRectF;
  1282. var
  1283. Ratio: Single;
  1284. begin
  1285. Result:=FitInto(Dest,Ratio);
  1286. end;
  1287. function TRectF.PlaceInto(const Dest: TRectF; const AHorzAlign: THorzRectAlign = THorzRectAlign.Center; const AVertAlign: TVertRectAlign = TVertRectAlign.Center): TRectF;
  1288. var
  1289. R : TRectF;
  1290. X,Y : Single;
  1291. D : TRectF absolute dest;
  1292. begin
  1293. if (Height>Dest.Height) or (Width>Dest.Width) then
  1294. R:=FitInto(Dest)
  1295. else
  1296. R:=Self;
  1297. case AHorzAlign of
  1298. THorzRectAlign.Left:
  1299. X:=D.Left;
  1300. THorzRectAlign.Center:
  1301. X:=(D.Left+D.Right-R.Width)/2;
  1302. THorzRectAlign.Right:
  1303. X:=D.Right-R.Width;
  1304. end;
  1305. case AVertAlign of
  1306. TVertRectAlign.Top:
  1307. Y:=D.Top;
  1308. TVertRectAlign.Center:
  1309. Y:=(D.Top+D.Bottom-R.Height)/2;
  1310. TVertRectAlign.Bottom:
  1311. Y:=D.Bottom-R.Height;
  1312. end;
  1313. R.SetLocation(PointF(X,Y));
  1314. Result:=R;
  1315. end;
  1316. function TRectF.SnapToPixel(AScale: Single; APlaceBetweenPixels: Boolean): TRectF;
  1317. function sc (S : single) : single; inline;
  1318. begin
  1319. Result:=System.Trunc(S*AScale)/AScale;
  1320. end;
  1321. var
  1322. R : TRectF;
  1323. Off: Single;
  1324. begin
  1325. if AScale<=0 then
  1326. AScale := 1;
  1327. R.Top:=Sc(Top);
  1328. R.Left:=Sc(Left);
  1329. R.Width:=Sc(Width);
  1330. R.Height:=Sc(Height);
  1331. if APlaceBetweenPixels then
  1332. begin
  1333. Off:=1/(2*aScale);
  1334. R.Offset(Off,Off);
  1335. end;
  1336. Result:=R;
  1337. end;
  1338. function TRectF.Contains(Pt: TPointF): Boolean;
  1339. begin
  1340. Result := (Left <= Pt.X) and (Pt.X < Right) and (Top <= Pt.Y) and (Pt.Y < Bottom);
  1341. end;
  1342. function TRectF.Contains(R: TRectF): Boolean;
  1343. begin
  1344. Result := (Left <= R.Left) and (R.Right <= Right) and (Top <= R.Top) and (R.Bottom <= Bottom);
  1345. end;
  1346. class function TRectF.Empty: TRectF;
  1347. begin
  1348. Result := TRectF.Create(0,0,0,0);
  1349. end;
  1350. function TRectF.EqualsTo(const R: TRectF; const Epsilon: Single): Boolean;
  1351. begin
  1352. Result:=TopLeft.EqualsTo(R.TopLeft,Epsilon);
  1353. Result:=Result and BottomRight.EqualsTo(R.BottomRight,Epsilon);
  1354. end;
  1355. function TRectF.GetHeight: Single;
  1356. begin
  1357. result:=bottom-top;
  1358. end;
  1359. function TRectF.GetLocation: TPointF;
  1360. begin
  1361. result.x:=Left; result.y:=top;
  1362. end;
  1363. function TRectF.GetSize: TSizeF;
  1364. begin
  1365. result.cx:=width; result.cy:=height;
  1366. end;
  1367. function TRectF.GetWidth: Single;
  1368. begin
  1369. result:=right-left;
  1370. end;
  1371. procedure TRectF.Inflate(DX, DY: Single);
  1372. begin
  1373. Left:=Left-dx;
  1374. Top:=Top-dy;
  1375. Right:=Right+dx;
  1376. Bottom:=Bottom+dy;
  1377. end;
  1378. procedure TRectF.Intersect(R: TRectF);
  1379. begin
  1380. Self := Intersect(Self, R);
  1381. end;
  1382. class function TRectF.Intersect(R1: TRectF; R2: TRectF): TRectF;
  1383. begin
  1384. Result := R1;
  1385. if R2.Left > R1.Left then
  1386. Result.Left := R2.Left;
  1387. if R2.Top > R1.Top then
  1388. Result.Top := R2.Top;
  1389. if R2.Right < R1.Right then
  1390. Result.Right := R2.Right;
  1391. if R2.Bottom < R1.Bottom then
  1392. Result.Bottom := R2.Bottom;
  1393. end;
  1394. function TRectF.IntersectsWith(R: TRectF): Boolean;
  1395. begin
  1396. Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom);
  1397. end;
  1398. function TRectF.IsEmpty: Boolean;
  1399. begin
  1400. Result := (CompareValue(Right,Left)<=0) or (CompareValue(Bottom,Top)<=0);
  1401. end;
  1402. procedure TRectF.NormalizeRect;
  1403. var
  1404. x: Single;
  1405. begin
  1406. if Top>Bottom then
  1407. begin
  1408. x := Top;
  1409. Top := Bottom;
  1410. Bottom := x;
  1411. end;
  1412. if Left>Right then
  1413. begin
  1414. x := Left;
  1415. Left := Right;
  1416. Right := x;
  1417. end
  1418. end;
  1419. procedure TRectF.Inflate(DL, DT, DR, DB: Single);
  1420. begin
  1421. Left:=Left-dl;
  1422. Top:=Top-dt;
  1423. Right:=Right+dr;
  1424. Bottom:=Bottom+db;
  1425. end;
  1426. procedure TRectF.Offset(const dx, dy: Single);
  1427. begin
  1428. left:=left+dx; right:=right+dx;
  1429. bottom:=bottom+dy; top:=top+dy;
  1430. end;
  1431. procedure TRectF.Offset(DP: TPointF);
  1432. begin
  1433. left:=left+DP.x; right:=right+DP.x;
  1434. bottom:=bottom+DP.y; top:=top+DP.y;
  1435. end;
  1436. function TRectF.Truncate: TRect;
  1437. begin
  1438. Result.BottomRight:=BottomRight.Truncate;
  1439. Result.TopLeft:=TopLeft.Truncate;
  1440. end;
  1441. function TRectF.Round: TRect;
  1442. begin
  1443. Result.BottomRight:=BottomRight.Round;
  1444. Result.TopLeft:=TopLeft.Round;
  1445. end;
  1446. procedure TRectF.SetHeight(AValue: Single);
  1447. begin
  1448. bottom:=top+avalue;
  1449. end;
  1450. procedure TRectF.SetLocation(X, Y: Single);
  1451. begin
  1452. Offset(X-Left, Y-Top);
  1453. end;
  1454. procedure TRectF.SetLocation(P: TPointF);
  1455. begin
  1456. SetLocation(P.X, P.Y);
  1457. end;
  1458. procedure TRectF.SetSize(AValue: TSizeF);
  1459. begin
  1460. bottom:=top+avalue.cy;
  1461. right:=left+avalue.cx;
  1462. end;
  1463. procedure TRectF.SetWidth(AValue: Single);
  1464. begin
  1465. right:=left+avalue;
  1466. end;
  1467. class function TRectF.Union(const Points: array of TPointF): TRectF;
  1468. var
  1469. i: Integer;
  1470. begin
  1471. if Length(Points) > 0 then
  1472. begin
  1473. Result.TopLeft := Points[Low(Points)];
  1474. Result.BottomRight := Points[Low(Points)];
  1475. for i := Low(Points)+1 to High(Points) do
  1476. begin
  1477. if Points[i].X < Result.Left then Result.Left := Points[i].X;
  1478. if Points[i].X > Result.Right then Result.Right := Points[i].X;
  1479. if Points[i].Y < Result.Top then Result.Top := Points[i].Y;
  1480. if Points[i].Y > Result.Bottom then Result.Bottom := Points[i].Y;
  1481. end;
  1482. end else
  1483. Result := Empty;
  1484. end;
  1485. procedure TRectF.Union(const r: TRectF);
  1486. begin
  1487. left:=min(r.left,left);
  1488. top:=min(r.top,top);
  1489. right:=max(r.right,right);
  1490. bottom:=max(r.bottom,bottom);
  1491. end;
  1492. class function TRectF.Union(R1, R2: TRectF): TRectF;
  1493. begin
  1494. Result:=R1;
  1495. Result.Union(R2);
  1496. end;
  1497. { TPoint3D }
  1498. constructor TPoint3D.Create(const ax,ay,az:single);
  1499. begin
  1500. x:=ax; y:=ay; z:=az;
  1501. end;
  1502. procedure TPoint3D.Offset(const adeltax,adeltay,adeltaz:single);
  1503. begin
  1504. x:=x+adeltax; y:=y+adeltay; z:=z+adeltaz;
  1505. end;
  1506. procedure TPoint3D.Offset(const adelta:TPoint3D);
  1507. begin
  1508. x:=x+adelta.x; y:=y+adelta.y; z:=z+adelta.z;
  1509. end;
  1510. {$ifndef VER3_0}
  1511. generic class procedure TBitConverter.UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  1512. begin
  1513. move(ASrcValue, ADestination[AOffset], SizeOf(T));
  1514. end;
  1515. generic class procedure TBitConverter.From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  1516. begin
  1517. if AOffset < 0 then
  1518. System.Error(reRangeError);
  1519. if IsManagedType(T) then
  1520. System.Error(reInvalidCast);
  1521. if Length(ADestination) < (SizeOf(T) + AOffset) then
  1522. System.Error(reRangeError);
  1523. TBitConverter.specialize UnsafeFrom<T>(ASrcValue, ADestination, AOffset);
  1524. end;
  1525. generic class function TBitConverter.UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  1526. begin
  1527. move(ASource[AOffset], Result, SizeOf(T));
  1528. end;
  1529. generic class function TBitConverter.InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  1530. begin
  1531. if AOffset < 0 then
  1532. System.Error(reRangeError);
  1533. if IsManagedType(T) then
  1534. System.Error(reInvalidCast);
  1535. if Length(ASource) < (SizeOf(T) + AOffset) then
  1536. System.Error(reRangeError);
  1537. Result := TBitConverter.specialize UnsafeInTo<T>(ASource, AOffset);
  1538. end;
  1539. {$endif}
  1540. end.