types.pp 46 KB

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