types.pp 40 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532
  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 Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  419. function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
  420. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  421. function Point(x,y : Integer) : TPoint; inline;
  422. function PointF(x,y: Single) : TPointF; inline;
  423. function PtInRect(const Rect : TRect; const p : TPoint) : Boolean;
  424. function IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  425. function RectCenter(var R: TRect; const Bounds: TRect): TRect;
  426. function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
  427. function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  428. function IsRectEmpty(const Rect : TRect) : Boolean;
  429. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  430. function OffsetRect(var Rect : TRectF;DX : Single;DY : Single) : Boolean;
  431. function CenterPoint(const Rect: TRect): TPoint;
  432. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  433. function Size(AWidth, AHeight: Integer): TSize; inline;
  434. function Size(const ARect: TRect): TSize;
  435. {$ifndef VER3_0}
  436. type
  437. TBitConverter = class
  438. generic class procedure UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static; {inline;}
  439. generic class procedure From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static;
  440. generic class function UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static; {inline;}
  441. generic class function InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static;
  442. end;
  443. {$endif}
  444. implementation
  445. {$IFDEF FPC_DOTTEDUNITS}
  446. Uses System.Math;
  447. {$ELSE FPC_DOTTEDUNITS}
  448. Uses Math;
  449. {$ENDIF FPC_DOTTEDUNITS}
  450. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  451. {$i typshrd.inc}
  452. {$endif}
  453. function EqualRect(const r1,r2 : TRect) : Boolean;
  454. begin
  455. EqualRect:=(r1.left=r2.left) and (r1.right=r2.right) and (r1.top=r2.top) and (r1.bottom=r2.bottom);
  456. end;
  457. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  458. begin
  459. Rect.Left:=Left;
  460. Rect.Top:=Top;
  461. Rect.Right:=Right;
  462. Rect.Bottom:=Bottom;
  463. end;
  464. function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
  465. begin
  466. RectF.Left:=Left;
  467. RectF.Top:=Top;
  468. RectF.Right:=Right;
  469. RectF.Bottom:=Bottom;
  470. end;
  471. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  472. begin
  473. Bounds.Left:=ALeft;
  474. Bounds.Top:=ATop;
  475. Bounds.Right:=ALeft+AWidth;
  476. Bounds.Bottom:=ATop+AHeight;
  477. end;
  478. function Point(x,y : Integer) : TPoint; inline;
  479. begin
  480. Point.x:=x;
  481. Point.y:=y;
  482. end;
  483. function PointF(x,y: Single) : TPointF; inline;
  484. begin
  485. PointF.x:=x;
  486. PointF.y:=y;
  487. end;
  488. function PtInRect(const Rect : TRect;const p : TPoint) : Boolean;
  489. begin
  490. PtInRect:=(p.y>=Rect.Top) and
  491. (p.y<Rect.Bottom) and
  492. (p.x>=Rect.Left) and
  493. (p.x<Rect.Right);
  494. end;
  495. function IntersectRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  496. var
  497. lRect: TRect;
  498. begin
  499. lRect := R1;
  500. if R2.Left > R1.Left then
  501. lRect.Left := R2.Left;
  502. if R2.Top > R1.Top then
  503. lRect.Top := R2.Top;
  504. if R2.Right < R1.Right then
  505. lRect.Right := R2.Right;
  506. if R2.Bottom < R1.Bottom then
  507. lRect.Bottom := R2.Bottom;
  508. // The var parameter is only assigned in the end to avoid problems
  509. // when passing the same rectangle in the var and const parameters.
  510. // See http://bugs.freepascal.org/view.php?id=17722
  511. Result:=not IsRectEmpty(lRect);
  512. if Result then
  513. Rect := lRect
  514. else
  515. FillChar(Rect,SizeOf(Rect),0);
  516. end;
  517. function RectCenter(var R: TRect; const Bounds: TRect): TRect;
  518. var
  519. C : TPoint;
  520. CS : TPoint;
  521. begin
  522. C:=Bounds.CenterPoint;
  523. CS:=R.CenterPoint;
  524. OffsetRect(R,C.X-CS.X,C.Y-CS.Y);
  525. Result:=R;
  526. end;
  527. function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
  528. Var
  529. C,CS : TPointF;
  530. begin
  531. C:=Bounds.CenterPoint;
  532. CS:=R.CenterPoint;
  533. OffsetRect(R,C.X-CS.X,C.Y-CS.Y);
  534. Result:=R;
  535. end;
  536. function UnionRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  537. var
  538. lRect: TRect;
  539. begin
  540. lRect:=R1;
  541. if R2.Left<R1.Left then
  542. lRect.Left:=R2.Left;
  543. if R2.Top<R1.Top then
  544. lRect.Top:=R2.Top;
  545. if R2.Right>R1.Right then
  546. lRect.Right:=R2.Right;
  547. if R2.Bottom>R1.Bottom then
  548. lRect.Bottom:=R2.Bottom;
  549. Result:=not IsRectEmpty(lRect);
  550. if Result then
  551. Rect := lRect
  552. else
  553. FillChar(Rect,SizeOf(Rect),0);
  554. end;
  555. function IsRectEmpty(const Rect : TRect) : Boolean;
  556. begin
  557. IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
  558. end;
  559. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  560. begin
  561. Result:=assigned(@Rect);
  562. if Result then
  563. with Rect do
  564. begin
  565. inc(Left,dx);
  566. inc(Top,dy);
  567. inc(Right,dx);
  568. inc(Bottom,dy);
  569. end;
  570. end;
  571. function Avg(a, b: Longint): Longint;
  572. begin
  573. if a < b then
  574. Result := a + ((b - a) shr 1)
  575. else
  576. Result := b + ((a - b) shr 1);
  577. end;
  578. function OffsetRect(var Rect: TRectF; DX: Single; DY: Single): Boolean;
  579. begin
  580. Result:=assigned(@Rect);
  581. if Result then
  582. with Rect do
  583. begin
  584. Left:=Left+dx;
  585. Right:=Right+dx;
  586. Top:=Top+dy;
  587. Bottom:=Bottom+dy;
  588. end;
  589. end;
  590. function CenterPoint(const Rect: TRect): TPoint;
  591. begin
  592. with Rect do
  593. begin
  594. Result.X := Avg(Left, Right);
  595. Result.Y := Avg(Top, Bottom);
  596. end;
  597. end;
  598. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  599. begin
  600. Result:=assigned(@Rect);
  601. if Result then
  602. with Rect do
  603. begin
  604. dec(Left, dx);
  605. dec(Top, dy);
  606. inc(Right, dx);
  607. inc(Bottom, dy);
  608. end;
  609. end;
  610. function Size(AWidth, AHeight: Integer): TSize; inline;
  611. begin
  612. Result.cx := AWidth;
  613. Result.cy := AHeight;
  614. end;
  615. function Size(const ARect: TRect): TSize; inline;
  616. begin
  617. Result.cx := ARect.Right - ARect.Left;
  618. Result.cy := ARect.Bottom - ARect.Top;
  619. end;
  620. { TPointF}
  621. function TPointF.Add(const apt: TPoint): TPointF;
  622. begin
  623. result.x:=x+apt.x;
  624. result.y:=y+apt.y;
  625. end;
  626. function TPointF.Add(const apt: TPointF): TPointF;
  627. begin
  628. result.x:=x+apt.x;
  629. result.y:=y+apt.y;
  630. end;
  631. function TPointF.Subtract(const apt : TPointF): TPointF;
  632. begin
  633. result.x:=x-apt.x;
  634. result.y:=y-apt.y;
  635. end;
  636. function TPointF.Subtract(const apt: TPoint): TPointF;
  637. begin
  638. result.x:=x-apt.x;
  639. result.y:=y-apt.y;
  640. end;
  641. function TPointF.Distance(const apt : TPointF) : Single;
  642. begin
  643. result:=sqrt(sqr(apt.x-x)+sqr(apt.y-y));
  644. end;
  645. function TPointF.DotProduct(const apt: TPointF): Single;
  646. begin
  647. result:=x*apt.x+y*apt.y;
  648. end;
  649. function TPointF.IsZero : Boolean;
  650. begin
  651. result:=SameValue(x,0.0) and SameValue(y,0.0);
  652. end;
  653. procedure TPointF.Offset(const apt :TPointF);
  654. begin
  655. x:=x+apt.x;
  656. y:=y+apt.y;
  657. end;
  658. procedure TPointF.Offset(const apt: TPoint);
  659. begin
  660. x:=x+apt.x;
  661. y:=y+apt.y;
  662. end;
  663. procedure TPointF.Offset(dx,dy : Single);
  664. begin
  665. x:=x+dx;
  666. y:=y+dy;
  667. end;
  668. function TPointF.EqualsTo(const apt: TPointF; const aEpsilon: Single): Boolean;
  669. function Eq(a,b : single) : boolean; inline;
  670. begin
  671. result:=abs(a-b)<=aEpsilon;
  672. end;
  673. begin
  674. Result:=Eq(X,apt.X) and Eq(Y,apt.Y);
  675. end;
  676. function TPointF.Scale(afactor: Single): TPointF;
  677. begin
  678. result.x:=afactor*x;
  679. result.y:=afactor*y;
  680. end;
  681. function TPointF.Ceiling: TPoint;
  682. begin
  683. result.x:=ceil(x);
  684. result.y:=ceil(y);
  685. end;
  686. function TPointF.Truncate: TPoint;
  687. begin
  688. result.x:=trunc(x);
  689. result.y:=trunc(y);
  690. end;
  691. function TPointF.Floor: TPoint;
  692. begin
  693. result.x:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(x);
  694. result.y:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(y);
  695. end;
  696. function TPointF.Round: TPoint;
  697. begin
  698. result.x:=System.round(x);
  699. result.y:=System.round(y);
  700. end;
  701. function TPointF.Length: Single;
  702. begin
  703. result:=sqrt(sqr(x)+sqr(y));
  704. end;
  705. function TPointF.Rotate(angle: single): TPointF;
  706. var
  707. sina, cosa: single;
  708. begin
  709. sincos(angle, sina, cosa);
  710. result.x := x * cosa - y * sina;
  711. result.y := x * sina + y * cosa;
  712. end;
  713. function TPointF.Reflect(const normal: TPointF): TPointF;
  714. begin
  715. result := self + (-2 * normal ** self) * normal;
  716. end;
  717. function TPointF.MidPoint(const b: TPointF): TPointF;
  718. begin
  719. result.x := 0.5 * (x + b.x);
  720. result.y := 0.5 * (y + b.y);
  721. end;
  722. class function TPointF.Zero: TPointF;
  723. begin
  724. Result.X:=0;
  725. Result.Y:=0;
  726. end;
  727. class function TPointF.PointInCircle(const pt, center: TPointF; radius: single): Boolean;
  728. begin
  729. result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(radius);
  730. end;
  731. class function TPointF.PointInCircle(const pt, center: TPointF; radius: integer): Boolean;
  732. begin
  733. result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(single(radius));
  734. end;
  735. function TPointF.Angle(const b: TPointF): Single;
  736. begin
  737. result := ArcTan2(y - b.y, x - b.x);
  738. end;
  739. function TPointF.AngleCosine(const b: TPointF): single;
  740. begin
  741. result := EnsureRange((self ** b) / sqrt((sqr(x) + sqr(y)) * (sqr(b.x) + sqr(b.y))), -1, 1);
  742. end;
  743. class operator TPointF.= (const apt1, apt2 : TPointF) : Boolean;
  744. begin
  745. result:=SameValue(apt1.x,apt2.x) and SameValue(apt1.y,apt2.y);
  746. end;
  747. class operator TPointF.<> (const apt1, apt2 : TPointF): Boolean;
  748. begin
  749. result:=NOT (SameValue(apt1.x,apt2.x) and Samevalue(apt1.y,apt2.y));
  750. end;
  751. class operator TPointF. * (const apt1, apt2: TPointF): TPointF;
  752. begin
  753. result.x:=apt1.x*apt2.x;
  754. result.y:=apt1.y*apt2.y;
  755. end;
  756. class operator TPointF. * (afactor: single; const apt1: TPointF): TPointF;
  757. begin
  758. result:=apt1.Scale(afactor);
  759. end;
  760. class operator TPointF. * (const apt1: TPointF; afactor: single): TPointF;
  761. begin
  762. result:=apt1.Scale(afactor);
  763. end;
  764. class operator TPointF. ** (const apt1, apt2: TPointF): Single;
  765. begin
  766. result:=apt1.x*apt2.x + apt1.y*apt2.y;
  767. end;
  768. class operator TPointF.+ (const apt1, apt2 : TPointF): TPointF;
  769. begin
  770. result.x:=apt1.x+apt2.x;
  771. result.y:=apt1.y+apt2.y;
  772. end;
  773. class operator TPointF.- (const apt1, apt2 : TPointF): TPointF;
  774. begin
  775. result.x:=apt1.x-apt2.x;
  776. result.y:=apt1.y-apt2.y;
  777. end;
  778. class operator TPointF. - (const apt1: TPointF): TPointF;
  779. begin
  780. Result.x:=-apt1.x;
  781. Result.y:=-apt1.y;
  782. end;
  783. class operator TPointF. / (const apt1: TPointF; afactor: single): TPointF;
  784. begin
  785. result:=apt1.Scale(1/afactor);
  786. end;
  787. class operator TPointF. := (const apt: TPoint): TPointF;
  788. begin
  789. Result.x:=apt.x;
  790. Result.y:=apt.y;
  791. end;
  792. procedure TPointF.SetLocation(const apt :TPointF);
  793. begin
  794. x:=apt.x; y:=apt.y;
  795. end;
  796. procedure TPointF.SetLocation(const apt: TPoint);
  797. begin
  798. x:=apt.x; y:=apt.y;
  799. end;
  800. procedure TPointF.SetLocation(ax,ay : Single);
  801. begin
  802. x:=ax; y:=ay;
  803. end;
  804. class function TPointF.Create(const ax, ay: Single): TPointF;
  805. begin
  806. Result.x := ax;
  807. Result.y := ay;
  808. end;
  809. class function TPointF.Create(const apt: TPoint): TPointF;
  810. begin
  811. Result.x := apt.X;
  812. Result.y := apt.Y;
  813. end;
  814. { TSizeF }
  815. function TSizeF.Add(const asz: TSize): TSizeF;
  816. begin
  817. result.cx:=cx+asz.cx;
  818. result.cy:=cy+asz.cy;
  819. end;
  820. function TSizeF.Add(const asz: TSizeF): TSizeF;
  821. begin
  822. result.cx:=cx+asz.cx;
  823. result.cy:=cy+asz.cy;
  824. end;
  825. function TSizeF.Subtract(const asz : TSizeF): TSizeF;
  826. begin
  827. result.cx:=cx-asz.cx;
  828. result.cy:=cy-asz.cy;
  829. end;
  830. function TSizeF.SwapDimensions:TSizeF;
  831. begin
  832. result.cx:=cy;
  833. result.cy:=cx;
  834. end;
  835. function TSizeF.Subtract(const asz: TSize): TSizeF;
  836. begin
  837. result.cx:=cx-asz.cx;
  838. result.cy:=cy-asz.cy;
  839. end;
  840. function TSizeF.Distance(const asz : TSizeF) : Single;
  841. begin
  842. result:=sqrt(sqr(asz.cx-cx)+sqr(asz.cy-cy));
  843. end;
  844. function TSizeF.IsZero : Boolean;
  845. begin
  846. result:=SameValue(cx,0.0) and SameValue(cy,0.0);
  847. end;
  848. function TSizeF.Scale(afactor: Single): TSizeF;
  849. begin
  850. result.cx:=afactor*cx;
  851. result.cy:=afactor*cy;
  852. end;
  853. function TSizeF.Ceiling: TSize;
  854. begin
  855. result.cx:=ceil(cx);
  856. result.cy:=ceil(cy);
  857. end;
  858. function TSizeF.Truncate: TSize;
  859. begin
  860. result.cx:=trunc(cx);
  861. result.cy:=trunc(cy);
  862. end;
  863. function TSizeF.Floor: TSize;
  864. begin
  865. result.cx:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(cx);
  866. result.cy:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(cy);
  867. end;
  868. function TSizeF.Round: TSize;
  869. begin
  870. result.cx:=System.round(cx);
  871. result.cy:=System.round(cy);
  872. end;
  873. function TSizeF.Length: Single;
  874. begin //distance(self) ?
  875. result:=sqrt(sqr(cx)+sqr(cy));
  876. end;
  877. class operator TSizeF.= (const asz1, asz2 : TSizeF) : Boolean;
  878. begin
  879. result:=SameValue(asz1.cx,asz2.cx) and SameValue(asz1.cy,asz2.cy);
  880. end;
  881. class operator TSizeF.<> (const asz1, asz2 : TSizeF): Boolean;
  882. begin
  883. result:=NOT (SameValue(asz1.cx,asz2.cx) and Samevalue(asz1.cy,asz2.cy));
  884. end;
  885. class operator TSizeF. * (afactor: single; const asz1: TSizeF): TSizeF;
  886. begin
  887. result:=asz1.Scale(afactor);
  888. end;
  889. class operator TSizeF. * (const asz1: TSizeF; afactor: single): TSizeF;
  890. begin
  891. result:=asz1.Scale(afactor);
  892. end;
  893. class operator TSizeF.+ (const asz1, asz2 : TSizeF): TSizeF;
  894. begin
  895. result.cx:=asz1.cx+asz2.cx;
  896. result.cy:=asz1.cy+asz2.cy;
  897. end;
  898. class operator TSizeF.- (const asz1, asz2 : TSizeF): TSizeF;
  899. begin
  900. result.cx:=asz1.cx-asz2.cx;
  901. result.cy:=asz1.cy-asz2.cy;
  902. end;
  903. class operator TSizeF. - (const asz1: TSizeF): TSizeF;
  904. begin
  905. Result.cx:=-asz1.cx;
  906. Result.cy:=-asz1.cy;
  907. end;
  908. class operator TSizeF. := (const apt: TPointF): TSizeF;
  909. begin
  910. Result.cx:=apt.x;
  911. Result.cy:=apt.y;
  912. end;
  913. class operator TSizeF. := (const asz: TSize): TSizeF;
  914. begin
  915. Result.cx := asz.cx;
  916. Result.cy := asz.cy;
  917. end;
  918. class operator TSizeF. := (const asz: TSizeF): TPointF;
  919. begin
  920. Result.x := asz.cx;
  921. Result.y := asz.cy;
  922. end;
  923. class function TSizeF.Create(const ax, ay: Single): TSizeF;
  924. begin
  925. Result.cx := ax;
  926. Result.cy := ay;
  927. end;
  928. class function TSizeF.Create(const asz: TSize): TSizeF;
  929. begin
  930. Result.cx := asz.cX;
  931. Result.cy := asz.cY;
  932. end;
  933. { TRectF }
  934. class operator TRectF. * (L, R: TRectF): TRectF;
  935. begin
  936. Result := TRectF.Intersect(L, R);
  937. end;
  938. class operator TRectF. + (L, R: TRectF): TRectF;
  939. begin
  940. Result := TRectF.Union(L, R);
  941. end;
  942. class operator TRectF. := (const arc: TRect): TRectF;
  943. begin
  944. Result.Left:=arc.Left;
  945. Result.Top:=arc.Top;
  946. Result.Right:=arc.Right;
  947. Result.Bottom:=arc.Bottom;
  948. end;
  949. class operator TRectF. <> (L, R: TRectF): Boolean;
  950. begin
  951. Result := not(L=R);
  952. end;
  953. class operator TRectF. = (L, R: TRectF): Boolean;
  954. begin
  955. Result :=
  956. SameValue(L.Left,R.Left) and SameValue(L.Right,R.Right) and
  957. SameValue(L.Top,R.Top) and SameValue(L.Bottom,R.Bottom);
  958. end;
  959. constructor TRectF.Create(ALeft, ATop, ARight, ABottom: Single);
  960. begin
  961. Left := ALeft;
  962. Top := ATop;
  963. Right := ARight;
  964. Bottom := ABottom;
  965. end;
  966. constructor TRectF.Create(P1, P2: TPointF; Normalize: Boolean);
  967. begin
  968. TopLeft := P1;
  969. BottomRight := P2;
  970. if Normalize then
  971. NormalizeRect;
  972. end;
  973. constructor TRectF.Create(Origin: TPointF);
  974. begin
  975. TopLeft := Origin;
  976. BottomRight := Origin;
  977. end;
  978. constructor TRectF.Create(Origin: TPointF; AWidth, AHeight: Single);
  979. begin
  980. TopLeft := Origin;
  981. Width := AWidth;
  982. Height := AHeight;
  983. end;
  984. constructor TRectF.Create(R: TRectF; Normalize: Boolean);
  985. begin
  986. Self := R;
  987. if Normalize then
  988. NormalizeRect;
  989. end;
  990. constructor TRectF.Create(R: TRect; Normalize: Boolean);
  991. begin
  992. Self := R;
  993. if Normalize then
  994. NormalizeRect;
  995. end;
  996. function TRectF.CenterPoint: TPointF;
  997. begin
  998. Result.X := (Right-Left) / 2 + Left;
  999. Result.Y := (Bottom-Top) / 2 + Top;
  1000. end;
  1001. function TRectF.Ceiling: TRectF;
  1002. begin
  1003. Result.BottomRight:=BottomRight.Ceiling;
  1004. Result.TopLeft:=TopLeft.Ceiling;
  1005. end;
  1006. function TRectF.CenterAt(const Dest: TRectF): TRectF;
  1007. begin
  1008. Result:=Self;
  1009. RectCenter(Result,Dest);
  1010. end;
  1011. function TRectF.Fit(const Dest: TRectF): Single;
  1012. var
  1013. R : TRectF;
  1014. begin
  1015. R:=FitInto(Dest,Result);
  1016. Self:=R;
  1017. end;
  1018. function TRectF.FitInto(const Dest: TRectF; out Ratio: Single): TRectF;
  1019. begin
  1020. if (Dest.Width<=0) or (Dest.Height<=0) then
  1021. begin
  1022. Ratio:=1.0;
  1023. exit(Self);
  1024. end;
  1025. Ratio:=Max(Self.Width / Dest.Width, Self.Height / Dest.Height);
  1026. if Ratio=0 then
  1027. exit(Self);
  1028. Result.Width:=Self.Width / Ratio;
  1029. Result.Height:=Self.Height / Ratio;
  1030. Result.Left:=Self.Left + (Self.Width - Result.Width) / 2;
  1031. Result.Top:=Self.Top + (Self.Height - Result.Height) / 2;
  1032. end;
  1033. function TRectF.FitInto(const Dest: TRectF): TRectF;
  1034. var
  1035. Ratio: Single;
  1036. begin
  1037. Result:=FitInto(Dest,Ratio);
  1038. end;
  1039. function TRectF.PlaceInto(const Dest: TRectF; const AHorzAlign: THorzRectAlign = THorzRectAlign.Center; const AVertAlign: TVertRectAlign = TVertRectAlign.Center): TRectF;
  1040. var
  1041. R : TRectF;
  1042. X,Y : Single;
  1043. D : TRectF absolute dest;
  1044. begin
  1045. if (Height>Dest.Height) or (Width>Dest.Width) then
  1046. R:=FitInto(Dest)
  1047. else
  1048. R:=Self;
  1049. case AHorzAlign of
  1050. THorzRectAlign.Left:
  1051. X:=D.Left;
  1052. THorzRectAlign.Center:
  1053. X:=(D.Left+D.Right-R.Width)/2;
  1054. THorzRectAlign.Right:
  1055. X:=D.Right-R.Width;
  1056. end;
  1057. case AVertAlign of
  1058. TVertRectAlign.Top:
  1059. Y:=D.Top;
  1060. TVertRectAlign.Center:
  1061. Y:=(D.Top+D.Bottom-R.Height)/2;
  1062. TVertRectAlign.Bottom:
  1063. Y:=D.Bottom-R.Height;
  1064. end;
  1065. R.SetLocation(PointF(X,Y));
  1066. Result:=R;
  1067. end;
  1068. function TRectF.SnapToPixel(AScale: Single; APlaceBetweenPixels: Boolean): TRectF;
  1069. function sc (S : single) : single; inline;
  1070. begin
  1071. Result:=System.Trunc(S*AScale)/AScale;
  1072. end;
  1073. var
  1074. R : TRectF;
  1075. Off: Single;
  1076. begin
  1077. if AScale<=0 then
  1078. AScale := 1;
  1079. R.Top:=Sc(Top);
  1080. R.Left:=Sc(Left);
  1081. R.Width:=Sc(Width);
  1082. R.Height:=Sc(Height);
  1083. if APlaceBetweenPixels then
  1084. begin
  1085. Off:=1/(2*aScale);
  1086. R.Offset(Off,Off);
  1087. end;
  1088. Result:=R;
  1089. end;
  1090. function TRectF.Contains(Pt: TPointF): Boolean;
  1091. begin
  1092. Result := (Left <= Pt.X) and (Pt.X < Right) and (Top <= Pt.Y) and (Pt.Y < Bottom);
  1093. end;
  1094. function TRectF.Contains(R: TRectF): Boolean;
  1095. begin
  1096. Result := (Left <= R.Left) and (R.Right <= Right) and (Top <= R.Top) and (R.Bottom <= Bottom);
  1097. end;
  1098. class function TRectF.Empty: TRectF;
  1099. begin
  1100. Result := TRectF.Create(0,0,0,0);
  1101. end;
  1102. function TRectF.EqualsTo(const R: TRectF; const Epsilon: Single): Boolean;
  1103. begin
  1104. Result:=TopLeft.EqualsTo(R.TopLeft,Epsilon);
  1105. Result:=Result and BottomRight.EqualsTo(R.BottomRight,Epsilon);
  1106. end;
  1107. function TRectF.GetHeight: Single;
  1108. begin
  1109. result:=bottom-top;
  1110. end;
  1111. function TRectF.GetLocation: TPointF;
  1112. begin
  1113. result.x:=Left; result.y:=top;
  1114. end;
  1115. function TRectF.GetSize: TSizeF;
  1116. begin
  1117. result.cx:=width; result.cy:=height;
  1118. end;
  1119. function TRectF.GetWidth: Single;
  1120. begin
  1121. result:=right-left;
  1122. end;
  1123. procedure TRectF.Inflate(DX, DY: Single);
  1124. begin
  1125. Left:=Left-dx;
  1126. Top:=Top-dy;
  1127. Right:=Right+dx;
  1128. Bottom:=Bottom+dy;
  1129. end;
  1130. procedure TRectF.Intersect(R: TRectF);
  1131. begin
  1132. Self := Intersect(Self, R);
  1133. end;
  1134. class function TRectF.Intersect(R1: TRectF; R2: TRectF): TRectF;
  1135. begin
  1136. Result := R1;
  1137. if R2.Left > R1.Left then
  1138. Result.Left := R2.Left;
  1139. if R2.Top > R1.Top then
  1140. Result.Top := R2.Top;
  1141. if R2.Right < R1.Right then
  1142. Result.Right := R2.Right;
  1143. if R2.Bottom < R1.Bottom then
  1144. Result.Bottom := R2.Bottom;
  1145. end;
  1146. function TRectF.IntersectsWith(R: TRectF): Boolean;
  1147. begin
  1148. Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom);
  1149. end;
  1150. function TRectF.IsEmpty: Boolean;
  1151. begin
  1152. Result := (CompareValue(Right,Left)<=0) or (CompareValue(Bottom,Top)<=0);
  1153. end;
  1154. procedure TRectF.NormalizeRect;
  1155. var
  1156. x: Single;
  1157. begin
  1158. if Top>Bottom then
  1159. begin
  1160. x := Top;
  1161. Top := Bottom;
  1162. Bottom := x;
  1163. end;
  1164. if Left>Right then
  1165. begin
  1166. x := Left;
  1167. Left := Right;
  1168. Right := x;
  1169. end
  1170. end;
  1171. procedure TRectF.Inflate(DL, DT, DR, DB: Single);
  1172. begin
  1173. Left:=Left-dl;
  1174. Top:=Top-dt;
  1175. Right:=Right+dr;
  1176. Bottom:=Bottom+db;
  1177. end;
  1178. procedure TRectF.Offset(const dx, dy: Single);
  1179. begin
  1180. left:=left+dx; right:=right+dx;
  1181. bottom:=bottom+dy; top:=top+dy;
  1182. end;
  1183. procedure TRectF.Offset(DP: TPointF);
  1184. begin
  1185. left:=left+DP.x; right:=right+DP.x;
  1186. bottom:=bottom+DP.y; top:=top+DP.y;
  1187. end;
  1188. function TRectF.Truncate: TRect;
  1189. begin
  1190. Result.BottomRight:=BottomRight.Truncate;
  1191. Result.TopLeft:=TopLeft.Truncate;
  1192. end;
  1193. function TRectF.Round: TRect;
  1194. begin
  1195. Result.BottomRight:=BottomRight.Round;
  1196. Result.TopLeft:=TopLeft.Round;
  1197. end;
  1198. procedure TRectF.SetHeight(AValue: Single);
  1199. begin
  1200. bottom:=top+avalue;
  1201. end;
  1202. procedure TRectF.SetLocation(X, Y: Single);
  1203. begin
  1204. Offset(X-Left, Y-Top);
  1205. end;
  1206. procedure TRectF.SetLocation(P: TPointF);
  1207. begin
  1208. SetLocation(P.X, P.Y);
  1209. end;
  1210. procedure TRectF.SetSize(AValue: TSizeF);
  1211. begin
  1212. bottom:=top+avalue.cy;
  1213. right:=left+avalue.cx;
  1214. end;
  1215. procedure TRectF.SetWidth(AValue: Single);
  1216. begin
  1217. right:=left+avalue;
  1218. end;
  1219. class function TRectF.Union(const Points: array of TPointF): TRectF;
  1220. var
  1221. i: Integer;
  1222. begin
  1223. if Length(Points) > 0 then
  1224. begin
  1225. Result.TopLeft := Points[Low(Points)];
  1226. Result.BottomRight := Points[Low(Points)];
  1227. for i := Low(Points)+1 to High(Points) do
  1228. begin
  1229. if Points[i].X < Result.Left then Result.Left := Points[i].X;
  1230. if Points[i].X > Result.Right then Result.Right := Points[i].X;
  1231. if Points[i].Y < Result.Top then Result.Top := Points[i].Y;
  1232. if Points[i].Y > Result.Bottom then Result.Bottom := Points[i].Y;
  1233. end;
  1234. end else
  1235. Result := Empty;
  1236. end;
  1237. procedure TRectF.Union(const r: TRectF);
  1238. begin
  1239. left:=min(r.left,left);
  1240. top:=min(r.top,top);
  1241. right:=max(r.right,right);
  1242. bottom:=max(r.bottom,bottom);
  1243. end;
  1244. class function TRectF.Union(R1, R2: TRectF): TRectF;
  1245. begin
  1246. Result:=R1;
  1247. Result.Union(R2);
  1248. end;
  1249. { TPoint3D }
  1250. constructor TPoint3D.Create(const ax,ay,az:single);
  1251. begin
  1252. x:=ax; y:=ay; z:=az;
  1253. end;
  1254. procedure TPoint3D.Offset(const adeltax,adeltay,adeltaz:single);
  1255. begin
  1256. x:=x+adeltax; y:=y+adeltay; z:=z+adeltaz;
  1257. end;
  1258. procedure TPoint3D.Offset(const adelta:TPoint3D);
  1259. begin
  1260. x:=x+adelta.x; y:=y+adelta.y; z:=z+adelta.z;
  1261. end;
  1262. {$ifndef VER3_0}
  1263. generic class procedure TBitConverter.UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  1264. begin
  1265. move(ASrcValue, ADestination[AOffset], SizeOf(T));
  1266. end;
  1267. generic class procedure TBitConverter.From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  1268. begin
  1269. if AOffset < 0 then
  1270. System.Error(reRangeError);
  1271. if IsManagedType(T) then
  1272. System.Error(reInvalidCast);
  1273. if Length(ADestination) < (SizeOf(T) + AOffset) then
  1274. System.Error(reRangeError);
  1275. TBitConverter.specialize UnsafeFrom<T>(ASrcValue, ADestination, AOffset);
  1276. end;
  1277. generic class function TBitConverter.UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  1278. begin
  1279. move(ASource[AOffset], Result, SizeOf(T));
  1280. end;
  1281. generic class function TBitConverter.InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  1282. begin
  1283. if AOffset < 0 then
  1284. System.Error(reRangeError);
  1285. if IsManagedType(T) then
  1286. System.Error(reInvalidCast);
  1287. if Length(ASource) < (SizeOf(T) + AOffset) then
  1288. System.Error(reRangeError);
  1289. Result := TBitConverter.specialize UnsafeInTo<T>(ASource, AOffset);
  1290. end;
  1291. {$endif}
  1292. end.