types.pp 50 KB

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