types.pp 39 KB

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