types.pp 53 KB

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