types.pp 39 KB

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