types.pp 47 KB

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