types.pp 46 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826
  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. unit Types;
  13. interface
  14. {$modeswitch advancedrecords}
  15. {$modeswitch class}
  16. {$if defined(win32) or defined(win64) or defined(wince)}
  17. uses
  18. Windows;
  19. {$elseif defined(win16)}
  20. uses
  21. WinTypes;
  22. {$endif}
  23. {$if defined(win32) or defined(win64)}
  24. const
  25. RT_RCDATA = Windows.RT_RCDATA deprecated 'Use Windows.RT_RCDATA instead';
  26. {$elseif defined(win16)}
  27. const
  28. RT_RCDATA = WinTypes.RT_RCDATA deprecated 'Use WinTypes.RT_RCDATA instead';
  29. {$endif}
  30. Const
  31. Epsilon: Single = 1E-40;
  32. Epsilon2: Single = 1E-30;
  33. type
  34. TEndian = Objpas.TEndian;
  35. TDirection = (FromBeginning, FromEnd);
  36. TValueRelationship = -1..1;
  37. DWORD = LongWord;
  38. PLongint = System.PLongint;
  39. PSmallInt = System.PSmallInt;
  40. {$ifndef FPUNONE}
  41. PDouble = System.PDouble;
  42. {$endif}
  43. PByte = System.PByte;
  44. Largeint = int64;
  45. LARGE_INT = LargeInt;
  46. PLargeInt = ^LargeInt;
  47. LargeUint = qword;
  48. LARGE_UINT= LargeUInt;
  49. PLargeuInt = ^LargeuInt;
  50. TBooleanDynArray = array of Boolean;
  51. TByteDynArray = array of Byte;
  52. TClassicByteDynArray = TByteDynArray;
  53. TCardinalDynArray = array of Cardinal;
  54. TInt64DynArray = array of Int64;
  55. TIntegerDynArray = array of Integer;
  56. TLongWordDynArray = array of LongWord;
  57. TPointerDynArray = array of Pointer;
  58. TQWordDynArray = array of QWord;
  59. TShortIntDynArray = array of ShortInt;
  60. TSmallIntDynArray = array of SmallInt;
  61. TRTLStringDynArray = array of Ansistring;
  62. TAnsiStringDynArray = Array of AnsiString;
  63. TWideStringDynArray = array of WideString;
  64. TUnicodeStringDynArray = array of UnicodeString;
  65. {$if SIZEOF(CHAR)=2}
  66. TStringDynArray = Array of UnicodeString;
  67. {$ELSE}
  68. TStringDynArray = Array of AnsiString;
  69. {$ENDIF}
  70. TClassicStringDynArray = TStringDynArray;
  71. TObjectDynArray = array of TObject;
  72. TWordDynArray = array of Word;
  73. TCurrencyArray = Array of currency;
  74. {$ifndef FPUNONE}
  75. TSingleDynArray = array of Single;
  76. TDoubleDynArray = array of Double;
  77. TExtendedDynArray = array of Extended;
  78. TCompDynArray = array of Comp;
  79. {$endif}
  80. {$if defined(win32) or defined(win64) or defined(wince)}
  81. TArray4IntegerType = Windows.TArray4IntegerType;
  82. TSmallPoint = Windows.TSmallPoint;
  83. PSmallPoint = Windows.PSmallPoint;
  84. TSize = Windows.TSize;
  85. TagSize = Windows.tagSize deprecated;
  86. PSize = Windows.PSize;
  87. TPoint = Windows.TPoint;
  88. TagPoint = Windows.TagPoint deprecated;
  89. PPoint = Windows.PPoint;
  90. TRect = Windows.TRect;
  91. PRect = Windows.PRect;
  92. TSplitRectType = Windows.TSplitRectType;
  93. const
  94. srLeft = TSplitRectType.srLeft;
  95. srRight = TSplitRectType.srRight;
  96. srTop = TSplitRectType.srTop;
  97. srBottom = TSplitRectType.srBottom;
  98. type
  99. {$else}
  100. {$i typshrdh.inc}
  101. TagSize = tSize deprecated;
  102. TagPoint = TPoint deprecated;
  103. {$endif}
  104. { TPointF }
  105. PPointF = ^TPointF;
  106. TPointF =
  107. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  108. packed
  109. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  110. record
  111. x,y : Single;
  112. public
  113. function Add(const apt: TPoint): TPointF;
  114. function Add(const apt: TPointF): TPointF;
  115. function Distance(const apt : TPointF) : Single;
  116. function DotProduct(const apt : TPointF) : Single;
  117. function IsZero : Boolean;
  118. function Subtract(const apt : TPointF): TPointF;
  119. function Subtract(const apt : TPoint): TPointF;
  120. procedure SetLocation(const apt :TPointF);
  121. procedure SetLocation(const apt :TPoint);
  122. procedure SetLocation(ax,ay : Single);
  123. procedure Offset(const apt :TPointF);
  124. procedure Offset(const apt :TPoint);
  125. procedure Offset(dx,dy : Single);
  126. function EqualsTo(const apt: TPointF; const aEpsilon : Single): Boolean;
  127. function Scale (afactor:Single) : TPointF;
  128. function Ceiling : TPoint;
  129. function Truncate: TPoint;
  130. function Floor : TPoint;
  131. function Round : TPoint;
  132. function Length : Single;
  133. function Rotate(angle: single): TPointF;
  134. function Reflect(const normal: TPointF): TPointF;
  135. function MidPoint(const b: TPointF): TPointF;
  136. class function PointInCircle(const pt, center: TPointF; radius: single): Boolean; static;
  137. class function PointInCircle(const pt, center: TPointF; radius: integer): Boolean; static;
  138. class function Zero: TPointF; inline; static;
  139. function Angle(const b: TPointF): Single;
  140. function AngleCosine(const b: TPointF): single;
  141. function CrossProduct(const apt: TPointF): Single;
  142. function Normalize: TPointF;
  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 = Windows.PCLSID;
  374. TCLSID = Windows.CLSID;
  375. TFiletime = Windows.TFileTime;
  376. Filetime = Windows.FileTime;
  377. PFiletime = Windows.PFileTime;
  378. {$endif Windows}
  379. type
  380. tagSTATSTG = record
  381. pwcsName : POleStr;
  382. dwType : DWord;
  383. cbSize : Large_uint;
  384. mtime : TFileTime;
  385. ctime : TFileTime;
  386. atime : TFileTime;
  387. grfMode : DWord;
  388. grfLocksSupported : DWord;
  389. clsid : TCLSID;
  390. grfStateBits : DWord;
  391. reserved : DWord;
  392. end;
  393. TStatStg = tagSTATSTG;
  394. STATSTG = TStatStg;
  395. PStatStg = ^TStatStg;
  396. { classes depends on these interfaces, we can't use the activex unit in classes though }
  397. IClassFactory = Interface(IUnknown) ['{00000001-0000-0000-C000-000000000046}']
  398. Function CreateInstance(Const unkOuter : IUnknown;Const riid : TGUID;Out vObject) : HResult;StdCall;
  399. Function LockServer(fLock : LongBool) : HResult;StdCall;
  400. End;
  401. ISequentialStream = interface(IUnknown)
  402. ['{0c733a30-2a1c-11ce-ade5-00aa0044773d}']
  403. function Read(pv : Pointer;cb : DWORD;pcbRead : PDWORD) : HRESULT;stdcall;
  404. function Write(pv : Pointer;cb : DWORD;pcbWritten : PDWORD): HRESULT;stdcall;
  405. end;
  406. IStream = interface(ISequentialStream) ['{0000000C-0000-0000-C000-000000000046}']
  407. function Seek(dlibMove : LargeInt; dwOrigin : DWORD; out libNewPosition : LargeUInt) : HResult;stdcall;
  408. function SetSize(libNewSize : LargeUInt) : HRESULT;stdcall;
  409. function CopyTo(stm: IStream;cb : LargeUInt;out cbRead : LargeUInt; out cbWritten : LargeUInt) : HRESULT;stdcall;
  410. function Commit(grfCommitFlags : DWORD) : HRESULT;stdcall;
  411. function Revert : HRESULT;stdcall;
  412. function LockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
  413. function UnlockRegion(libOffset : LargeUInt;cb : LargeUInt; dwLockType : DWORD) : HRESULT;stdcall;
  414. Function Stat(out statstg : TStatStg;grfStatFlag : DWORD) : HRESULT;stdcall;
  415. function Clone(out stm : IStream) : HRESULT;stdcall;
  416. end;
  417. function EqualRect(const r1,r2 : TRect) : Boolean;
  418. function EqualRect(const r1,r2 : TRectF) : Boolean;
  419. function NormalizeRectF(const Pts: array of TPointF): TRectF; overload;
  420. function NormalizeRect(const ARect: TRectF): TRectF; overload;
  421. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  422. function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
  423. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  424. function Point(x,y : Integer) : TPoint; inline;
  425. function PointF(x,y: Single) : TPointF; inline;
  426. function PtInRect(const Rect : TRect; const p : TPoint) : Boolean;
  427. function PtInRect(const Rect : TRectF; const p : TPointF) : Boolean;
  428. function IntersectRect(const Rect1, Rect2: TRect): Boolean;
  429. function IntersectRect(const Rect1, Rect2: TRectF): Boolean;
  430. function IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  431. function IntersectRect(var Rect : TRectF; const R1,R2 : TRectF) : Boolean;
  432. function RectCenter(var R: TRect; const Bounds: TRect): TRect;
  433. function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
  434. function RectHeight(const Rect: TRect): Integer; inline;
  435. function RectHeight(const Rect: TRectF): Single; inline;
  436. function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  437. function UnionRect(var Rect : TRectF; const R1,R2 : TRectF) : Boolean;
  438. function UnionRect(const R1,R2 : TRect) : TRect;
  439. function UnionRect(const R1,R2 : TRectF) : TRectF;
  440. function IsRectEmpty(const Rect : TRectF) : Boolean;
  441. function IsRectEmpty(const Rect : TRect) : Boolean;
  442. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  443. function OffsetRect(var Rect : TRectF;DX : Single;DY : Single) : Boolean;
  444. procedure MultiplyRect(var R: TRectF; const DX, DY: Single);
  445. function CenterPoint(const Rect: TRect): TPoint;
  446. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  447. function InflateRect(var Rect: TRectF; dx: single; dy: Single): Boolean;
  448. function Size(AWidth, AHeight: Integer): TSize; inline;
  449. function Size(const ARect: TRect): TSize;
  450. function ScalePoint(const P: TPointF; dX, dY: Single): TPointF; overload;
  451. function ScalePoint(const P: TPoint; dX, dY: Single): TPoint; overload;
  452. function MinPoint(const P1, P2: TPointF): TPointF; overload;
  453. function MinPoint(const P1, P2: TPoint): TPoint; overload;
  454. function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Size: Integer): TRect; overload;
  455. function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Percent: Double): TRect; overload;
  456. function CenteredRect(const SourceRect: TRect; const aCenteredRect: TRect): TRect;
  457. function IntersectRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
  458. function UnionRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
  459. {$ifndef VER3_0}
  460. type
  461. TBitConverter = class
  462. generic class procedure UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static; {inline;}
  463. generic class procedure From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static;
  464. generic class function UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static; {inline;}
  465. generic class function InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static;
  466. end;
  467. {$endif}
  468. implementation
  469. Uses Math;
  470. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  471. {$i typshrd.inc}
  472. {$endif}
  473. function SmallPoint(X, Y: Integer): TSmallPoint; inline; overload;
  474. begin
  475. Result.X:=X;
  476. Result.Y:=Y;
  477. end;
  478. function SmallPoint(XY: LongWord): TSmallPoint; overload;
  479. begin
  480. Result.X:=SmallInt(XY and $0000FFFF);
  481. Result.Y:=SmallInt(XY shr 16);
  482. end;
  483. function MinPoint(const P1, P2: TPointF): TPointF; overload;
  484. begin
  485. Result:=P1;
  486. if (P2.Y<P1.Y)
  487. or ((P2.Y=P1.Y) and (P2.X<P1.X)) then
  488. Result:=P2;
  489. end;
  490. function MinPoint(const P1, P2: TPoint): TPoint; overload;
  491. begin
  492. Result:=P1;
  493. if (P2.Y<P1.Y)
  494. or ((P2.Y=P1.Y) and (P2.X<P1.X)) then
  495. Result:=P2;
  496. end;
  497. function ScalePoint(const P: TPointF; dX, dY: Single): TPointF; overload;
  498. begin
  499. Result.X:=P.X*dX;
  500. Result.Y:=P.Y*dY;
  501. end;
  502. function ScalePoint(const P: TPoint; dX, dY: Single): TPoint; overload;
  503. begin
  504. Result.X:=Round(P.X*dX);
  505. Result.Y:=Round(P.Y*dY);
  506. end;
  507. function NormalizeRectF(const Pts: array of TPointF): TRectF;
  508. var
  509. Pt: TPointF;
  510. begin
  511. Result.Left:=$FFFF;
  512. Result.Top:=$FFFF;
  513. Result.Right:=-$FFFF;
  514. Result.Bottom:=-$FFFF;
  515. for Pt in Pts do
  516. begin
  517. Result.Left:=Min(Pt.X,Result.left);
  518. Result.Top:=Min(Pt.Y,Result.Top);
  519. Result.Right:=Max(Pt.X,Result.Right);
  520. Result.Bottom:=Max(Pt.Y,Result.Bottom);
  521. end;
  522. end;
  523. function NormalizeRect(const aRect : TRectF): TRectF;
  524. begin
  525. With aRect do
  526. Result:=NormalizeRectF([PointF(Left,Top),
  527. PointF(Right,Top),
  528. PointF(Right,Bottom),
  529. PointF(Left,Bottom)]);
  530. end;
  531. function EqualRect(const r1,r2 : TRect) : Boolean;
  532. begin
  533. EqualRect:=(r1.left=r2.left) and (r1.right=r2.right) and (r1.top=r2.top) and (r1.bottom=r2.bottom);
  534. end;
  535. function EqualRect(const r1,r2 : TRectF) : Boolean;
  536. begin
  537. EqualRect:=r1.EqualsTo(r2);
  538. end;
  539. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  540. begin
  541. Rect.Left:=Left;
  542. Rect.Top:=Top;
  543. Rect.Right:=Right;
  544. Rect.Bottom:=Bottom;
  545. end;
  546. function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
  547. begin
  548. RectF.Left:=Left;
  549. RectF.Top:=Top;
  550. RectF.Right:=Right;
  551. RectF.Bottom:=Bottom;
  552. end;
  553. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  554. begin
  555. Bounds.Left:=ALeft;
  556. Bounds.Top:=ATop;
  557. Bounds.Right:=ALeft+AWidth;
  558. Bounds.Bottom:=ATop+AHeight;
  559. end;
  560. function Point(x,y : Integer) : TPoint; inline;
  561. begin
  562. Point.x:=x;
  563. Point.y:=y;
  564. end;
  565. function PointF(x,y: Single) : TPointF; inline;
  566. begin
  567. PointF.x:=x;
  568. PointF.y:=y;
  569. end;
  570. function PtInRect(const Rect : TRect;const p : TPoint) : Boolean;
  571. begin
  572. PtInRect:=(p.y>=Rect.Top) and
  573. (p.y<Rect.Bottom) and
  574. (p.x>=Rect.Left) and
  575. (p.x<Rect.Right);
  576. end;
  577. function PtInRect(const Rect : TRectF;const p : TPointF) : Boolean;
  578. begin
  579. PtInRect:=(p.y>=Rect.Top) and
  580. (p.y<Rect.Bottom) and
  581. (p.x>=Rect.Left) and
  582. (p.x<Rect.Right);
  583. end;
  584. function IntersectRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
  585. begin
  586. Result:=IntersectRect(Rect,R1,R2);
  587. end;
  588. function UnionRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
  589. begin
  590. Result:=UnionRect(Rect,R1,R2);
  591. end;
  592. function IntersectRect(const Rect1, Rect2: TRect): Boolean;
  593. begin
  594. Result:=(Rect1.Left<Rect2.Right)
  595. and (Rect1.Right>Rect2.Left)
  596. and (Rect1.Top<Rect2.Bottom)
  597. and (Rect1.Bottom>Rect2.Top);
  598. end;
  599. function IntersectRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  600. var
  601. lRect: TRect;
  602. begin
  603. lRect := R1;
  604. if R2.Left > R1.Left then
  605. lRect.Left := R2.Left;
  606. if R2.Top > R1.Top then
  607. lRect.Top := R2.Top;
  608. if R2.Right < R1.Right then
  609. lRect.Right := R2.Right;
  610. if R2.Bottom < R1.Bottom then
  611. lRect.Bottom := R2.Bottom;
  612. // The var parameter is only assigned in the end to avoid problems
  613. // when passing the same rectangle in the var and const parameters.
  614. // See http://bugs.freepascal.org/view.php?id=17722
  615. Result:=not IsRectEmpty(lRect);
  616. if Result then
  617. Rect := lRect
  618. else
  619. FillChar(Rect,SizeOf(Rect),0);
  620. end;
  621. function IntersectRect(const Rect1, Rect2: TRectF): Boolean;
  622. begin
  623. Result:=(Rect1.Left<Rect2.Right)
  624. and (Rect1.Right>Rect2.Left)
  625. and (Rect1.Top<Rect2.Bottom)
  626. and (Rect1.Bottom>Rect2.Top);
  627. end;
  628. function IntersectRect(var Rect : TRectF;const R1,R2 : TRectF) : Boolean;
  629. var
  630. lRect: TRectF;
  631. begin
  632. lRect := R1;
  633. if R2.Left > R1.Left then
  634. lRect.Left := R2.Left;
  635. if R2.Top > R1.Top then
  636. lRect.Top := R2.Top;
  637. if R2.Right < R1.Right then
  638. lRect.Right := R2.Right;
  639. if R2.Bottom < R1.Bottom then
  640. lRect.Bottom := R2.Bottom;
  641. // The var parameter is only assigned in the end to avoid problems
  642. // when passing the same rectangle in the var and const parameters.
  643. // See http://bugs.freepascal.org/view.php?id=17722
  644. Result:=not IsRectEmpty(lRect);
  645. if Result then
  646. Rect := lRect
  647. else
  648. FillChar(Rect,SizeOf(Rect),0);
  649. end;
  650. function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Size: Integer): TRect; overload;
  651. begin
  652. Result:=Rect.SplitRect(SplitType,Size);
  653. end;
  654. function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Percent: Double): TRect; overload;
  655. begin
  656. Result:=Rect.SplitRect(SplitType,Percent);
  657. end;
  658. function CenteredRect(const SourceRect: TRect; const aCenteredRect: TRect): TRect;
  659. var
  660. W,H: Integer;
  661. Center : TPoint;
  662. begin
  663. W:=aCenteredRect.Width;
  664. H:=aCenteredRect.Height;
  665. Center:=SourceRect.CenterPoint;
  666. With Center do
  667. Result:= Rect(X-(W div 2),Y-(H div 2),X+((W+1) div 2),Y+((H+1) div 2));
  668. end;
  669. function RectWidth(const Rect: TRect): Integer;
  670. begin
  671. Result:=Rect.Width;
  672. end;
  673. function RectWidth(const Rect: TRectF): Single;
  674. begin
  675. Result:=Rect.Width;
  676. end;
  677. function RectHeight(const Rect: TRect): Integer; inline;
  678. begin
  679. Result:=Rect.Height;
  680. end;
  681. function RectHeight(const Rect: TRectF): Single; inline;
  682. begin
  683. Result:=Rect.Height
  684. end;
  685. function RectCenter(var R: TRect; const Bounds: TRect): TRect;
  686. var
  687. C : TPoint;
  688. CS : TPoint;
  689. begin
  690. C:=Bounds.CenterPoint;
  691. CS:=R.CenterPoint;
  692. OffsetRect(R,C.X-CS.X,C.Y-CS.Y);
  693. Result:=R;
  694. end;
  695. function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
  696. Var
  697. C,CS : TPointF;
  698. begin
  699. C:=Bounds.CenterPoint;
  700. CS:=R.CenterPoint;
  701. OffsetRect(R,C.X-CS.X,C.Y-CS.Y);
  702. Result:=R;
  703. end;
  704. procedure MultiplyRect(var R: TRectF; const DX, DY: Single);
  705. begin
  706. R.Left:=DX*R.Left;
  707. R.Right:=DX*R.Right;
  708. R.Top:=DY*R.Top;
  709. R.Bottom:=DY*R.Bottom;
  710. end;
  711. function UnionRect(const R1,R2 : TRect) : TRect;
  712. begin
  713. Result:=Default(TRect);
  714. UnionRect(Result,R1,R2);
  715. end;
  716. function UnionRect(const R1,R2 : TRectF) : TRectF;
  717. begin
  718. Result:=Default(TRectF);
  719. UnionRect(Result,R1,R2);
  720. end;
  721. function UnionRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  722. var
  723. lRect: TRect;
  724. begin
  725. lRect:=R1;
  726. if R2.Left<R1.Left then
  727. lRect.Left:=R2.Left;
  728. if R2.Top<R1.Top then
  729. lRect.Top:=R2.Top;
  730. if R2.Right>R1.Right then
  731. lRect.Right:=R2.Right;
  732. if R2.Bottom>R1.Bottom then
  733. lRect.Bottom:=R2.Bottom;
  734. Result:=not IsRectEmpty(lRect);
  735. if Result then
  736. Rect := lRect
  737. else
  738. FillChar(Rect,SizeOf(Rect),0);
  739. end;
  740. function UnionRect(var Rect : TRectF;const R1,R2 : TRectF) : Boolean;
  741. var
  742. lRect: TRectF;
  743. begin
  744. lRect:=R1;
  745. if R2.Left<R1.Left then
  746. lRect.Left:=R2.Left;
  747. if R2.Top<R1.Top then
  748. lRect.Top:=R2.Top;
  749. if R2.Right>R1.Right then
  750. lRect.Right:=R2.Right;
  751. if R2.Bottom>R1.Bottom then
  752. lRect.Bottom:=R2.Bottom;
  753. Result:=not IsRectEmpty(lRect);
  754. if Result then
  755. Rect := lRect
  756. else
  757. FillChar(Rect,SizeOf(Rect),0);
  758. end;
  759. function IsRectEmpty(const Rect : TRect) : Boolean;
  760. begin
  761. IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
  762. end;
  763. function IsRectEmpty(const Rect : TRectF) : Boolean;
  764. begin
  765. IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
  766. end;
  767. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  768. begin
  769. Result:=assigned(@Rect);
  770. if Result then
  771. with Rect do
  772. begin
  773. inc(Left,dx);
  774. inc(Top,dy);
  775. inc(Right,dx);
  776. inc(Bottom,dy);
  777. end;
  778. end;
  779. function Avg(a, b: Longint): Longint;
  780. begin
  781. if a < b then
  782. Result := a + ((b - a) shr 1)
  783. else
  784. Result := b + ((a - b) shr 1);
  785. end;
  786. function OffsetRect(var Rect: TRectF; DX: Single; DY: Single): Boolean;
  787. begin
  788. Result:=assigned(@Rect);
  789. if Result then
  790. with Rect do
  791. begin
  792. Left:=Left+dx;
  793. Right:=Right+dx;
  794. Top:=Top+dy;
  795. Bottom:=Bottom+dy;
  796. end;
  797. end;
  798. function CenterPoint(const Rect: TRect): TPoint;
  799. begin
  800. with Rect do
  801. begin
  802. Result.X := Avg(Left, Right);
  803. Result.Y := Avg(Top, Bottom);
  804. end;
  805. end;
  806. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  807. begin
  808. Result:=assigned(@Rect);
  809. if Result then
  810. with Rect do
  811. begin
  812. dec(Left, dx);
  813. dec(Top, dy);
  814. inc(Right, dx);
  815. inc(Bottom, dy);
  816. end;
  817. end;
  818. function InflateRect(var Rect: TRectF; dx: Single; dy: Single): Boolean;
  819. begin
  820. Result:=assigned(@Rect);
  821. if Result then
  822. with Rect do
  823. begin
  824. Left:=Left-dx;
  825. Top:=Top-dy;
  826. Right:=Right+dx;
  827. Bottom:=Bottom+dy;
  828. end;
  829. end;
  830. function Size(AWidth, AHeight: Integer): TSize; inline;
  831. begin
  832. Result.cx := AWidth;
  833. Result.cy := AHeight;
  834. end;
  835. function Size(const ARect: TRect): TSize; inline;
  836. begin
  837. Result.cx := ARect.Right - ARect.Left;
  838. Result.cy := ARect.Bottom - ARect.Top;
  839. end;
  840. { TPointF}
  841. function TPointF.Add(const apt: TPoint): TPointF;
  842. begin
  843. result.x:=x+apt.x;
  844. result.y:=y+apt.y;
  845. end;
  846. function TPointF.Add(const apt: TPointF): TPointF;
  847. begin
  848. result.x:=x+apt.x;
  849. result.y:=y+apt.y;
  850. end;
  851. function TPointF.Subtract(const apt : TPointF): TPointF;
  852. begin
  853. result.x:=x-apt.x;
  854. result.y:=y-apt.y;
  855. end;
  856. function TPointF.Subtract(const apt: TPoint): TPointF;
  857. begin
  858. result.x:=x-apt.x;
  859. result.y:=y-apt.y;
  860. end;
  861. function TPointF.Distance(const apt : TPointF) : Single;
  862. begin
  863. result:=sqrt(sqr(apt.x-x)+sqr(apt.y-y));
  864. end;
  865. function TPointF.DotProduct(const apt: TPointF): Single;
  866. begin
  867. result:=x*apt.x+y*apt.y;
  868. end;
  869. function TPointF.IsZero : Boolean;
  870. begin
  871. result:=SameValue(x,0.0) and SameValue(y,0.0);
  872. end;
  873. procedure TPointF.Offset(const apt :TPointF);
  874. begin
  875. x:=x+apt.x;
  876. y:=y+apt.y;
  877. end;
  878. procedure TPointF.Offset(const apt: TPoint);
  879. begin
  880. x:=x+apt.x;
  881. y:=y+apt.y;
  882. end;
  883. procedure TPointF.Offset(dx,dy : Single);
  884. begin
  885. x:=x+dx;
  886. y:=y+dy;
  887. end;
  888. function TPointF.EqualsTo(const apt: TPointF; const aEpsilon: Single): Boolean;
  889. function Eq(a,b : single) : boolean; inline;
  890. begin
  891. result:=abs(a-b)<=aEpsilon;
  892. end;
  893. begin
  894. Result:=Eq(X,apt.X) and Eq(Y,apt.Y);
  895. end;
  896. function TPointF.Scale(afactor: Single): TPointF;
  897. begin
  898. result.x:=afactor*x;
  899. result.y:=afactor*y;
  900. end;
  901. function TPointF.Ceiling: TPoint;
  902. begin
  903. result.x:=ceil(x);
  904. result.y:=ceil(y);
  905. end;
  906. function TPointF.Truncate: TPoint;
  907. begin
  908. result.x:=trunc(x);
  909. result.y:=trunc(y);
  910. end;
  911. function TPointF.Floor: TPoint;
  912. begin
  913. result.x:=Math.floor(x);
  914. result.y:=Math.floor(y);
  915. end;
  916. function TPointF.Round: TPoint;
  917. begin
  918. result.x:=System.round(x);
  919. result.y:=System.round(y);
  920. end;
  921. function TPointF.Length: Single;
  922. begin
  923. result:=sqrt(sqr(x)+sqr(y));
  924. end;
  925. function TPointF.Rotate(angle: single): TPointF;
  926. var
  927. sina, cosa: single;
  928. begin
  929. sincos(angle, sina, cosa);
  930. result.x := x * cosa - y * sina;
  931. result.y := x * sina + y * cosa;
  932. end;
  933. function TPointF.Reflect(const normal: TPointF): TPointF;
  934. begin
  935. result := self + (-2 * normal ** self) * normal;
  936. end;
  937. function TPointF.MidPoint(const b: TPointF): TPointF;
  938. begin
  939. result.x := 0.5 * (x + b.x);
  940. result.y := 0.5 * (y + b.y);
  941. end;
  942. class function TPointF.Zero: TPointF;
  943. begin
  944. Result.X:=0;
  945. Result.Y:=0;
  946. end;
  947. class function TPointF.PointInCircle(const pt, center: TPointF; radius: single): Boolean;
  948. begin
  949. result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(radius);
  950. end;
  951. class function TPointF.PointInCircle(const pt, center: TPointF; radius: integer): Boolean;
  952. begin
  953. result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(single(radius));
  954. end;
  955. function TPointF.Angle(const b: TPointF): Single;
  956. begin
  957. result := ArcTan2(y - b.y, x - b.x);
  958. end;
  959. function TPointF.AngleCosine(const b: TPointF): single;
  960. begin
  961. result := EnsureRange((self ** b) / sqrt((sqr(x) + sqr(y)) * (sqr(b.x) + sqr(b.y))), -1, 1);
  962. end;
  963. class operator TPointF.= (const apt1, apt2 : TPointF) : Boolean;
  964. begin
  965. result:=SameValue(apt1.x,apt2.x) and SameValue(apt1.y,apt2.y);
  966. end;
  967. class operator TPointF.<> (const apt1, apt2 : TPointF): Boolean;
  968. begin
  969. result:=NOT (SameValue(apt1.x,apt2.x) and Samevalue(apt1.y,apt2.y));
  970. end;
  971. class operator TPointF. * (const apt1, apt2: TPointF): TPointF;
  972. begin
  973. result.x:=apt1.x*apt2.x;
  974. result.y:=apt1.y*apt2.y;
  975. end;
  976. class operator TPointF. * (afactor: single; const apt1: TPointF): TPointF;
  977. begin
  978. result:=apt1.Scale(afactor);
  979. end;
  980. class operator TPointF. * (const apt1: TPointF; afactor: single): TPointF;
  981. begin
  982. result:=apt1.Scale(afactor);
  983. end;
  984. class operator TPointF. ** (const apt1, apt2: TPointF): Single;
  985. begin
  986. result:=apt1.x*apt2.x + apt1.y*apt2.y;
  987. end;
  988. class operator TPointF.+ (const apt1, apt2 : TPointF): TPointF;
  989. begin
  990. result.x:=apt1.x+apt2.x;
  991. result.y:=apt1.y+apt2.y;
  992. end;
  993. class operator TPointF.- (const apt1, apt2 : TPointF): TPointF;
  994. begin
  995. result.x:=apt1.x-apt2.x;
  996. result.y:=apt1.y-apt2.y;
  997. end;
  998. class operator TPointF. - (const apt1: TPointF): TPointF;
  999. begin
  1000. Result.x:=-apt1.x;
  1001. Result.y:=-apt1.y;
  1002. end;
  1003. class operator TPointF. / (const apt1: TPointF; afactor: single): TPointF;
  1004. begin
  1005. result:=apt1.Scale(1/afactor);
  1006. end;
  1007. class operator TPointF. := (const apt: TPoint): TPointF;
  1008. begin
  1009. Result.x:=apt.x;
  1010. Result.y:=apt.y;
  1011. end;
  1012. procedure TPointF.SetLocation(const apt :TPointF);
  1013. begin
  1014. x:=apt.x; y:=apt.y;
  1015. end;
  1016. procedure TPointF.SetLocation(const apt: TPoint);
  1017. begin
  1018. x:=apt.x; y:=apt.y;
  1019. end;
  1020. procedure TPointF.SetLocation(ax,ay : Single);
  1021. begin
  1022. x:=ax; y:=ay;
  1023. end;
  1024. class function TPointF.Create(const ax, ay: Single): TPointF;
  1025. begin
  1026. Result.x := ax;
  1027. Result.y := ay;
  1028. end;
  1029. class function TPointF.Create(const apt: TPoint): TPointF;
  1030. begin
  1031. Result.x := apt.X;
  1032. Result.y := apt.Y;
  1033. end;
  1034. function TPointF.CrossProduct(const apt: TPointF): Single;
  1035. begin
  1036. Result:=X*apt.Y-Y*apt.X;
  1037. end;
  1038. function TPointF.Normalize: TPointF;
  1039. var
  1040. L: Single;
  1041. begin
  1042. L:=Sqrt(Sqr(X)+Sqr(Y));
  1043. if SameValue(L,0,Epsilon) then
  1044. Result:=Self
  1045. else
  1046. begin
  1047. Result.X:=X/L;
  1048. Result.Y:=Y/L;
  1049. end;
  1050. end;
  1051. { TSizeF }
  1052. function TSizeF.Add(const asz: TSize): TSizeF;
  1053. begin
  1054. result.cx:=cx+asz.cx;
  1055. result.cy:=cy+asz.cy;
  1056. end;
  1057. function TSizeF.Add(const asz: TSizeF): TSizeF;
  1058. begin
  1059. result.cx:=cx+asz.cx;
  1060. result.cy:=cy+asz.cy;
  1061. end;
  1062. function TSizeF.Subtract(const asz : TSizeF): TSizeF;
  1063. begin
  1064. result.cx:=cx-asz.cx;
  1065. result.cy:=cy-asz.cy;
  1066. end;
  1067. function TSizeF.SwapDimensions:TSizeF;
  1068. begin
  1069. result.cx:=cy;
  1070. result.cy:=cx;
  1071. end;
  1072. function TSizeF.Subtract(const asz: TSize): TSizeF;
  1073. begin
  1074. result.cx:=cx-asz.cx;
  1075. result.cy:=cy-asz.cy;
  1076. end;
  1077. function TSizeF.Distance(const asz : TSizeF) : Single;
  1078. begin
  1079. result:=sqrt(sqr(asz.cx-cx)+sqr(asz.cy-cy));
  1080. end;
  1081. function TSizeF.IsZero : Boolean;
  1082. begin
  1083. result:=SameValue(cx,0.0) and SameValue(cy,0.0);
  1084. end;
  1085. function TSizeF.Scale(afactor: Single): TSizeF;
  1086. begin
  1087. result.cx:=afactor*cx;
  1088. result.cy:=afactor*cy;
  1089. end;
  1090. function TSizeF.Ceiling: TSize;
  1091. begin
  1092. result.cx:=ceil(cx);
  1093. result.cy:=ceil(cy);
  1094. end;
  1095. function TSizeF.Truncate: TSize;
  1096. begin
  1097. result.cx:=trunc(cx);
  1098. result.cy:=trunc(cy);
  1099. end;
  1100. function TSizeF.Floor: TSize;
  1101. begin
  1102. result.cx:=Math.floor(cx);
  1103. result.cy:=Math.floor(cy);
  1104. end;
  1105. function TSizeF.Round: TSize;
  1106. begin
  1107. result.cx:=System.round(cx);
  1108. result.cy:=System.round(cy);
  1109. end;
  1110. function TSizeF.Length: Single;
  1111. begin //distance(self) ?
  1112. result:=sqrt(sqr(cx)+sqr(cy));
  1113. end;
  1114. class operator TSizeF.= (const asz1, asz2 : TSizeF) : Boolean;
  1115. begin
  1116. result:=SameValue(asz1.cx,asz2.cx) and SameValue(asz1.cy,asz2.cy);
  1117. end;
  1118. class operator TSizeF.<> (const asz1, asz2 : TSizeF): Boolean;
  1119. begin
  1120. result:=NOT (SameValue(asz1.cx,asz2.cx) and Samevalue(asz1.cy,asz2.cy));
  1121. end;
  1122. class operator TSizeF. * (afactor: single; const asz1: TSizeF): TSizeF;
  1123. begin
  1124. result:=asz1.Scale(afactor);
  1125. end;
  1126. class operator TSizeF. * (const asz1: TSizeF; afactor: single): TSizeF;
  1127. begin
  1128. result:=asz1.Scale(afactor);
  1129. end;
  1130. class operator TSizeF.+ (const asz1, asz2 : TSizeF): TSizeF;
  1131. begin
  1132. result.cx:=asz1.cx+asz2.cx;
  1133. result.cy:=asz1.cy+asz2.cy;
  1134. end;
  1135. class operator TSizeF.- (const asz1, asz2 : TSizeF): TSizeF;
  1136. begin
  1137. result.cx:=asz1.cx-asz2.cx;
  1138. result.cy:=asz1.cy-asz2.cy;
  1139. end;
  1140. class operator TSizeF. - (const asz1: TSizeF): TSizeF;
  1141. begin
  1142. Result.cx:=-asz1.cx;
  1143. Result.cy:=-asz1.cy;
  1144. end;
  1145. class operator TSizeF. := (const apt: TPointF): TSizeF;
  1146. begin
  1147. Result.cx:=apt.x;
  1148. Result.cy:=apt.y;
  1149. end;
  1150. class operator TSizeF. := (const asz: TSize): TSizeF;
  1151. begin
  1152. Result.cx := asz.cx;
  1153. Result.cy := asz.cy;
  1154. end;
  1155. class operator TSizeF. := (const asz: TSizeF): TPointF;
  1156. begin
  1157. Result.x := asz.cx;
  1158. Result.y := asz.cy;
  1159. end;
  1160. class function TSizeF.Create(const ax, ay: Single): TSizeF;
  1161. begin
  1162. Result.cx := ax;
  1163. Result.cy := ay;
  1164. end;
  1165. class function TSizeF.Create(const asz: TSize): TSizeF;
  1166. begin
  1167. Result.cx := asz.cX;
  1168. Result.cy := asz.cY;
  1169. end;
  1170. { TRectF }
  1171. class operator TRectF. * (L, R: TRectF): TRectF;
  1172. begin
  1173. Result := TRectF.Intersect(L, R);
  1174. end;
  1175. class operator TRectF. + (L, R: TRectF): TRectF;
  1176. begin
  1177. Result := TRectF.Union(L, R);
  1178. end;
  1179. class operator TRectF. := (const arc: TRect): TRectF;
  1180. begin
  1181. Result.Left:=arc.Left;
  1182. Result.Top:=arc.Top;
  1183. Result.Right:=arc.Right;
  1184. Result.Bottom:=arc.Bottom;
  1185. end;
  1186. class operator TRectF. <> (L, R: TRectF): Boolean;
  1187. begin
  1188. Result := not(L=R);
  1189. end;
  1190. class operator TRectF. = (L, R: TRectF): Boolean;
  1191. begin
  1192. Result :=
  1193. SameValue(L.Left,R.Left) and SameValue(L.Right,R.Right) and
  1194. SameValue(L.Top,R.Top) and SameValue(L.Bottom,R.Bottom);
  1195. end;
  1196. constructor TRectF.Create(ALeft, ATop, ARight, ABottom: Single);
  1197. begin
  1198. Left := ALeft;
  1199. Top := ATop;
  1200. Right := ARight;
  1201. Bottom := ABottom;
  1202. end;
  1203. constructor TRectF.Create(P1, P2: TPointF; Normalize: Boolean);
  1204. begin
  1205. TopLeft := P1;
  1206. BottomRight := P2;
  1207. if Normalize then
  1208. NormalizeRect;
  1209. end;
  1210. constructor TRectF.Create(Origin: TPointF);
  1211. begin
  1212. TopLeft := Origin;
  1213. BottomRight := Origin;
  1214. end;
  1215. constructor TRectF.Create(Origin: TPointF; AWidth, AHeight: Single);
  1216. begin
  1217. TopLeft := Origin;
  1218. Width := AWidth;
  1219. Height := AHeight;
  1220. end;
  1221. constructor TRectF.Create(R: TRectF; Normalize: Boolean);
  1222. begin
  1223. Self := R;
  1224. if Normalize then
  1225. NormalizeRect;
  1226. end;
  1227. constructor TRectF.Create(R: TRect; Normalize: Boolean);
  1228. begin
  1229. Self := R;
  1230. if Normalize then
  1231. NormalizeRect;
  1232. end;
  1233. function TRectF.CenterPoint: TPointF;
  1234. begin
  1235. Result.X := (Right-Left) / 2 + Left;
  1236. Result.Y := (Bottom-Top) / 2 + Top;
  1237. end;
  1238. function TRectF.Ceiling: TRectF;
  1239. begin
  1240. Result.BottomRight:=BottomRight.Ceiling;
  1241. Result.TopLeft:=TopLeft.Ceiling;
  1242. end;
  1243. function TRectF.CenterAt(const Dest: TRectF): TRectF;
  1244. begin
  1245. Result:=Self;
  1246. RectCenter(Result,Dest);
  1247. end;
  1248. function TRectF.Fit(const Dest: TRectF): Single;
  1249. var
  1250. R : TRectF;
  1251. begin
  1252. R:=FitInto(Dest,Result);
  1253. Self:=R;
  1254. end;
  1255. function TRectF.FitInto(const Dest: TRectF; out Ratio: Single): TRectF;
  1256. begin
  1257. if (Dest.Width<=0) or (Dest.Height<=0) then
  1258. begin
  1259. Ratio:=1.0;
  1260. exit(Self);
  1261. end;
  1262. Ratio:=Max(Self.Width / Dest.Width, Self.Height / Dest.Height);
  1263. if Ratio=0 then
  1264. exit(Self);
  1265. Result.Width:=Self.Width / Ratio;
  1266. Result.Height:=Self.Height / Ratio;
  1267. Result.Left:=Self.Left + (Self.Width - Result.Width) / 2;
  1268. Result.Top:=Self.Top + (Self.Height - Result.Height) / 2;
  1269. end;
  1270. function TRectF.FitInto(const Dest: TRectF): TRectF;
  1271. var
  1272. Ratio: Single;
  1273. begin
  1274. Result:=FitInto(Dest,Ratio);
  1275. end;
  1276. function TRectF.PlaceInto(const Dest: TRectF; const AHorzAlign: THorzRectAlign = THorzRectAlign.Center; const AVertAlign: TVertRectAlign = TVertRectAlign.Center): TRectF;
  1277. var
  1278. R : TRectF;
  1279. X,Y : Single;
  1280. D : TRectF absolute dest;
  1281. begin
  1282. if (Height>Dest.Height) or (Width>Dest.Width) then
  1283. R:=FitInto(Dest)
  1284. else
  1285. R:=Self;
  1286. case AHorzAlign of
  1287. THorzRectAlign.Left:
  1288. X:=D.Left;
  1289. THorzRectAlign.Center:
  1290. X:=(D.Left+D.Right-R.Width)/2;
  1291. THorzRectAlign.Right:
  1292. X:=D.Right-R.Width;
  1293. end;
  1294. case AVertAlign of
  1295. TVertRectAlign.Top:
  1296. Y:=D.Top;
  1297. TVertRectAlign.Center:
  1298. Y:=(D.Top+D.Bottom-R.Height)/2;
  1299. TVertRectAlign.Bottom:
  1300. Y:=D.Bottom-R.Height;
  1301. end;
  1302. R.SetLocation(PointF(X,Y));
  1303. Result:=R;
  1304. end;
  1305. function TRectF.SnapToPixel(AScale: Single; APlaceBetweenPixels: Boolean): TRectF;
  1306. function sc (S : single) : single; inline;
  1307. begin
  1308. Result:=System.Trunc(S*AScale)/AScale;
  1309. end;
  1310. var
  1311. R : TRectF;
  1312. Off: Single;
  1313. begin
  1314. if AScale<=0 then
  1315. AScale := 1;
  1316. R.Top:=Sc(Top);
  1317. R.Left:=Sc(Left);
  1318. R.Width:=Sc(Width);
  1319. R.Height:=Sc(Height);
  1320. if APlaceBetweenPixels then
  1321. begin
  1322. Off:=1/(2*aScale);
  1323. R.Offset(Off,Off);
  1324. end;
  1325. Result:=R;
  1326. end;
  1327. function TRectF.Contains(Pt: TPointF): Boolean;
  1328. begin
  1329. Result := (Left <= Pt.X) and (Pt.X < Right) and (Top <= Pt.Y) and (Pt.Y < Bottom);
  1330. end;
  1331. function TRectF.Contains(R: TRectF): Boolean;
  1332. begin
  1333. Result := (Left <= R.Left) and (R.Right <= Right) and (Top <= R.Top) and (R.Bottom <= Bottom);
  1334. end;
  1335. class function TRectF.Empty: TRectF;
  1336. begin
  1337. Result := TRectF.Create(0,0,0,0);
  1338. end;
  1339. function TRectF.EqualsTo(const R: TRectF; const Epsilon: Single): Boolean;
  1340. begin
  1341. Result:=TopLeft.EqualsTo(R.TopLeft,Epsilon);
  1342. Result:=Result and BottomRight.EqualsTo(R.BottomRight,Epsilon);
  1343. end;
  1344. function TRectF.GetHeight: Single;
  1345. begin
  1346. result:=bottom-top;
  1347. end;
  1348. function TRectF.GetLocation: TPointF;
  1349. begin
  1350. result.x:=Left; result.y:=top;
  1351. end;
  1352. function TRectF.GetSize: TSizeF;
  1353. begin
  1354. result.cx:=width; result.cy:=height;
  1355. end;
  1356. function TRectF.GetWidth: Single;
  1357. begin
  1358. result:=right-left;
  1359. end;
  1360. procedure TRectF.Inflate(DX, DY: Single);
  1361. begin
  1362. Left:=Left-dx;
  1363. Top:=Top-dy;
  1364. Right:=Right+dx;
  1365. Bottom:=Bottom+dy;
  1366. end;
  1367. procedure TRectF.Intersect(R: TRectF);
  1368. begin
  1369. Self := Intersect(Self, R);
  1370. end;
  1371. class function TRectF.Intersect(R1: TRectF; R2: TRectF): TRectF;
  1372. begin
  1373. Result := R1;
  1374. if R2.Left > R1.Left then
  1375. Result.Left := R2.Left;
  1376. if R2.Top > R1.Top then
  1377. Result.Top := R2.Top;
  1378. if R2.Right < R1.Right then
  1379. Result.Right := R2.Right;
  1380. if R2.Bottom < R1.Bottom then
  1381. Result.Bottom := R2.Bottom;
  1382. end;
  1383. function TRectF.IntersectsWith(R: TRectF): Boolean;
  1384. begin
  1385. Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom);
  1386. end;
  1387. function TRectF.IsEmpty: Boolean;
  1388. begin
  1389. Result := (CompareValue(Right,Left)<=0) or (CompareValue(Bottom,Top)<=0);
  1390. end;
  1391. procedure TRectF.NormalizeRect;
  1392. var
  1393. x: Single;
  1394. begin
  1395. if Top>Bottom then
  1396. begin
  1397. x := Top;
  1398. Top := Bottom;
  1399. Bottom := x;
  1400. end;
  1401. if Left>Right then
  1402. begin
  1403. x := Left;
  1404. Left := Right;
  1405. Right := x;
  1406. end
  1407. end;
  1408. procedure TRectF.Inflate(DL, DT, DR, DB: Single);
  1409. begin
  1410. Left:=Left-dl;
  1411. Top:=Top-dt;
  1412. Right:=Right+dr;
  1413. Bottom:=Bottom+db;
  1414. end;
  1415. procedure TRectF.Offset(const dx, dy: Single);
  1416. begin
  1417. left:=left+dx; right:=right+dx;
  1418. bottom:=bottom+dy; top:=top+dy;
  1419. end;
  1420. procedure TRectF.Offset(DP: TPointF);
  1421. begin
  1422. left:=left+DP.x; right:=right+DP.x;
  1423. bottom:=bottom+DP.y; top:=top+DP.y;
  1424. end;
  1425. function TRectF.Truncate: TRect;
  1426. begin
  1427. Result.BottomRight:=BottomRight.Truncate;
  1428. Result.TopLeft:=TopLeft.Truncate;
  1429. end;
  1430. function TRectF.Round: TRect;
  1431. begin
  1432. Result.BottomRight:=BottomRight.Round;
  1433. Result.TopLeft:=TopLeft.Round;
  1434. end;
  1435. procedure TRectF.SetHeight(AValue: Single);
  1436. begin
  1437. bottom:=top+avalue;
  1438. end;
  1439. procedure TRectF.SetLocation(X, Y: Single);
  1440. begin
  1441. Offset(X-Left, Y-Top);
  1442. end;
  1443. procedure TRectF.SetLocation(P: TPointF);
  1444. begin
  1445. SetLocation(P.X, P.Y);
  1446. end;
  1447. procedure TRectF.SetSize(AValue: TSizeF);
  1448. begin
  1449. bottom:=top+avalue.cy;
  1450. right:=left+avalue.cx;
  1451. end;
  1452. procedure TRectF.SetWidth(AValue: Single);
  1453. begin
  1454. right:=left+avalue;
  1455. end;
  1456. class function TRectF.Union(const Points: array of TPointF): TRectF;
  1457. var
  1458. i: Integer;
  1459. begin
  1460. if Length(Points) > 0 then
  1461. begin
  1462. Result.TopLeft := Points[Low(Points)];
  1463. Result.BottomRight := Points[Low(Points)];
  1464. for i := Low(Points)+1 to High(Points) do
  1465. begin
  1466. if Points[i].X < Result.Left then Result.Left := Points[i].X;
  1467. if Points[i].X > Result.Right then Result.Right := Points[i].X;
  1468. if Points[i].Y < Result.Top then Result.Top := Points[i].Y;
  1469. if Points[i].Y > Result.Bottom then Result.Bottom := Points[i].Y;
  1470. end;
  1471. end else
  1472. Result := Empty;
  1473. end;
  1474. procedure TRectF.Union(const r: TRectF);
  1475. begin
  1476. left:=min(r.left,left);
  1477. top:=min(r.top,top);
  1478. right:=max(r.right,right);
  1479. bottom:=max(r.bottom,bottom);
  1480. end;
  1481. class function TRectF.Union(R1, R2: TRectF): TRectF;
  1482. begin
  1483. Result:=R1;
  1484. Result.Union(R2);
  1485. end;
  1486. { TPoint3D }
  1487. constructor TPoint3D.Create(const ax,ay,az:single);
  1488. begin
  1489. x:=ax; y:=ay; z:=az;
  1490. end;
  1491. procedure TPoint3D.Offset(const adeltax,adeltay,adeltaz:single);
  1492. begin
  1493. x:=x+adeltax; y:=y+adeltay; z:=z+adeltaz;
  1494. end;
  1495. procedure TPoint3D.Offset(const adelta:TPoint3D);
  1496. begin
  1497. x:=x+adelta.x; y:=y+adelta.y; z:=z+adelta.z;
  1498. end;
  1499. {$ifndef VER3_0}
  1500. generic class procedure TBitConverter.UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  1501. begin
  1502. move(ASrcValue, ADestination[AOffset], SizeOf(T));
  1503. end;
  1504. generic class procedure TBitConverter.From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  1505. begin
  1506. if AOffset < 0 then
  1507. System.Error(reRangeError);
  1508. if IsManagedType(T) then
  1509. System.Error(reInvalidCast);
  1510. if Length(ADestination) < (SizeOf(T) + AOffset) then
  1511. System.Error(reRangeError);
  1512. TBitConverter.specialize UnsafeFrom<T>(ASrcValue, ADestination, AOffset);
  1513. end;
  1514. generic class function TBitConverter.UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  1515. begin
  1516. move(ASource[AOffset], Result, SizeOf(T));
  1517. end;
  1518. generic class function TBitConverter.InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  1519. begin
  1520. if AOffset < 0 then
  1521. System.Error(reRangeError);
  1522. if IsManagedType(T) then
  1523. System.Error(reInvalidCast);
  1524. if Length(ASource) < (SizeOf(T) + AOffset) then
  1525. System.Error(reRangeError);
  1526. Result := TBitConverter.specialize UnsafeInTo<T>(ASource, AOffset);
  1527. end;
  1528. {$endif}
  1529. end.