types.pp 53 KB

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