types.pp 52 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055
  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. function EqualRect(const r1,r2 : TRect) : Boolean;
  456. function EqualRect(const r1,r2 : TRectF) : Boolean;
  457. function NormalizeRectF(const Pts: array of TPointF): TRectF; overload;
  458. function NormalizeRect(const ARect: TRectF): TRectF; overload;
  459. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  460. function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
  461. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  462. function Point(x,y : Integer) : TPoint; inline;
  463. function PointF(x,y: Single) : TPointF; inline;
  464. function PtInRect(const Rect : TRect; const p : TPoint) : Boolean;
  465. function PtInRect(const Rect : TRectF; const p : TPointF) : Boolean;
  466. function IntersectRect(const Rect1, Rect2: TRect): Boolean;
  467. function IntersectRect(const Rect1, Rect2: TRectF): Boolean;
  468. function IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  469. function IntersectRect(var Rect : TRectF; const R1,R2 : TRectF) : Boolean;
  470. function RectCenter(var R: TRect; const Bounds: TRect): TRect;
  471. function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
  472. function RectHeight(const Rect: TRect): Integer; inline;
  473. function RectHeight(const Rect: TRectF): Single; inline;
  474. function RectWidth(const Rect: TRect): Integer; inline;
  475. function RectWidth(const Rect: TRectF): Single; inline;
  476. function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
  477. function UnionRect(var Rect : TRectF; const R1,R2 : TRectF) : Boolean;
  478. function UnionRect(const R1,R2 : TRect) : TRect;
  479. function UnionRect(const R1,R2 : TRectF) : TRectF;
  480. function IsRectEmpty(const Rect : TRectF) : Boolean;
  481. function IsRectEmpty(const Rect : TRect) : Boolean;
  482. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  483. function OffsetRect(var Rect : TRectF;DX : Single;DY : Single) : Boolean;
  484. procedure MultiplyRect(var R: TRectF; const DX, DY: Single);
  485. function CenterPoint(const Rect: TRect): TPoint;
  486. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  487. function InflateRect(var Rect: TRectF; dx: single; dy: Single): Boolean;
  488. function Size(AWidth, AHeight: Integer): TSize; inline;
  489. function Size(const ARect: TRect): TSize; inline;
  490. function ScalePoint(const P: TPointF; dX, dY: Single): TPointF; overload;
  491. function ScalePoint(const P: TPoint; dX, dY: Single): TPoint; overload;
  492. function MinPoint(const P1, P2: TPointF): TPointF; overload;
  493. function MinPoint(const P1, P2: TPoint): TPoint; overload;
  494. function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Size: Integer): TRect; overload;
  495. function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Percent: Double): TRect; overload;
  496. function CenteredRect(const SourceRect: TRect; const aCenteredRect: TRect): TRect;
  497. function IntersectRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
  498. function UnionRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
  499. type
  500. TBitConverter = class
  501. generic class procedure UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static; {inline;}
  502. generic class procedure From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static;
  503. generic class function UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static; {inline;}
  504. generic class function InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static;
  505. end;
  506. Const
  507. cPI: Single = 3.141592654;
  508. cPIdiv180: Single = 0.017453292;
  509. cPIdiv2: Single = 1.570796326;
  510. cPIdiv4: Single = 0.785398163;
  511. implementation
  512. {$IFDEF FPC_DOTTEDUNITS}
  513. Uses System.Math;
  514. {$ELSE FPC_DOTTEDUNITS}
  515. Uses Math;
  516. {$ENDIF FPC_DOTTEDUNITS}
  517. {$if (not defined(win32)) and (not defined(win64)) and (not defined(wince))}
  518. {$i typshrd.inc}
  519. {$endif}
  520. function SmallPoint(X, Y: Integer): TSmallPoint; inline; overload;
  521. begin
  522. Result.X:=X;
  523. Result.Y:=Y;
  524. end;
  525. function SmallPoint(XY: LongWord): TSmallPoint; overload;
  526. begin
  527. Result.X:=SmallInt(XY and $0000FFFF);
  528. Result.Y:=SmallInt(XY shr 16);
  529. end;
  530. function MinPoint(const P1, P2: TPointF): TPointF; overload;
  531. begin
  532. Result:=P1;
  533. if (P2.Y<P1.Y)
  534. or ((P2.Y=P1.Y) and (P2.X<P1.X)) then
  535. Result:=P2;
  536. end;
  537. function MinPoint(const P1, P2: TPoint): TPoint; overload;
  538. begin
  539. Result:=P1;
  540. if (P2.Y<P1.Y)
  541. or ((P2.Y=P1.Y) and (P2.X<P1.X)) then
  542. Result:=P2;
  543. end;
  544. function ScalePoint(const P: TPointF; dX, dY: Single): TPointF; overload;
  545. begin
  546. Result.X:=P.X*dX;
  547. Result.Y:=P.Y*dY;
  548. end;
  549. function ScalePoint(const P: TPoint; dX, dY: Single): TPoint; overload;
  550. begin
  551. Result.X:=Round(P.X*dX);
  552. Result.Y:=Round(P.Y*dY);
  553. end;
  554. function NormalizeRectF(const Pts: array of TPointF): TRectF;
  555. var
  556. Pt: TPointF;
  557. begin
  558. Result.Left:=$FFFF;
  559. Result.Top:=$FFFF;
  560. Result.Right:=-$FFFF;
  561. Result.Bottom:=-$FFFF;
  562. for Pt in Pts do
  563. begin
  564. Result.Left:=Min(Pt.X,Result.left);
  565. Result.Top:=Min(Pt.Y,Result.Top);
  566. Result.Right:=Max(Pt.X,Result.Right);
  567. Result.Bottom:=Max(Pt.Y,Result.Bottom);
  568. end;
  569. end;
  570. function NormalizeRect(const aRect : TRectF): TRectF;
  571. begin
  572. With aRect do
  573. Result:=NormalizeRectF([PointF(Left,Top),
  574. PointF(Right,Top),
  575. PointF(Right,Bottom),
  576. PointF(Left,Bottom)]);
  577. end;
  578. function EqualRect(const r1,r2 : TRect) : Boolean;
  579. begin
  580. EqualRect:=(r1.left=r2.left) and (r1.right=r2.right) and (r1.top=r2.top) and (r1.bottom=r2.bottom);
  581. end;
  582. function EqualRect(const r1,r2 : TRectF) : Boolean;
  583. begin
  584. EqualRect:=r1.EqualsTo(r2);
  585. end;
  586. function Rect(Left,Top,Right,Bottom : Integer) : TRect; inline;
  587. begin
  588. Rect.Left:=Left;
  589. Rect.Top:=Top;
  590. Rect.Right:=Right;
  591. Rect.Bottom:=Bottom;
  592. end;
  593. function RectF(Left,Top,Right,Bottom : Single) : TRectF; inline;
  594. begin
  595. RectF.Left:=Left;
  596. RectF.Top:=Top;
  597. RectF.Right:=Right;
  598. RectF.Bottom:=Bottom;
  599. end;
  600. function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect; inline;
  601. begin
  602. Bounds.Left:=ALeft;
  603. Bounds.Top:=ATop;
  604. Bounds.Right:=ALeft+AWidth;
  605. Bounds.Bottom:=ATop+AHeight;
  606. end;
  607. function Point(x,y : Integer) : TPoint; inline;
  608. begin
  609. Point.x:=x;
  610. Point.y:=y;
  611. end;
  612. function PointF(x,y: Single) : TPointF; inline;
  613. begin
  614. PointF.x:=x;
  615. PointF.y:=y;
  616. end;
  617. function PtInRect(const Rect : TRect;const p : TPoint) : Boolean;
  618. begin
  619. PtInRect:=(p.y>=Rect.Top) and
  620. (p.y<Rect.Bottom) and
  621. (p.x>=Rect.Left) and
  622. (p.x<Rect.Right);
  623. end;
  624. function PtInRect(const Rect : TRectF;const p : TPointF) : Boolean;
  625. begin
  626. PtInRect:=(p.y>=Rect.Top) and
  627. (p.y<Rect.Bottom) and
  628. (p.x>=Rect.Left) and
  629. (p.x<Rect.Right);
  630. end;
  631. function IntersectRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
  632. begin
  633. Result:=IntersectRect(Rect,R1,R2);
  634. end;
  635. function UnionRectF(out Rect: TRectF; const R1, R2: TRectF): Boolean;
  636. begin
  637. Result:=UnionRect(Rect,R1,R2);
  638. end;
  639. function IntersectRect(const Rect1, Rect2: TRect): Boolean;
  640. begin
  641. Result:=(Rect1.Left<Rect2.Right)
  642. and (Rect1.Right>Rect2.Left)
  643. and (Rect1.Top<Rect2.Bottom)
  644. and (Rect1.Bottom>Rect2.Top);
  645. end;
  646. function IntersectRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  647. var
  648. lRect: TRect;
  649. begin
  650. lRect := R1;
  651. if R2.Left > R1.Left then
  652. lRect.Left := R2.Left;
  653. if R2.Top > R1.Top then
  654. lRect.Top := R2.Top;
  655. if R2.Right < R1.Right then
  656. lRect.Right := R2.Right;
  657. if R2.Bottom < R1.Bottom then
  658. lRect.Bottom := R2.Bottom;
  659. // The var parameter is only assigned in the end to avoid problems
  660. // when passing the same rectangle in the var and const parameters.
  661. // See http://bugs.freepascal.org/view.php?id=17722
  662. Result:=not IsRectEmpty(lRect);
  663. if Result then
  664. Rect := lRect
  665. else
  666. FillChar(Rect,SizeOf(Rect),0);
  667. end;
  668. function IntersectRect(const Rect1, Rect2: TRectF): Boolean;
  669. begin
  670. Result:=(Rect1.Left<Rect2.Right)
  671. and (Rect1.Right>Rect2.Left)
  672. and (Rect1.Top<Rect2.Bottom)
  673. and (Rect1.Bottom>Rect2.Top);
  674. end;
  675. function IntersectRect(var Rect : TRectF;const R1,R2 : TRectF) : Boolean;
  676. var
  677. lRect: TRectF;
  678. begin
  679. lRect := R1;
  680. if R2.Left > R1.Left then
  681. lRect.Left := R2.Left;
  682. if R2.Top > R1.Top then
  683. lRect.Top := R2.Top;
  684. if R2.Right < R1.Right then
  685. lRect.Right := R2.Right;
  686. if R2.Bottom < R1.Bottom then
  687. lRect.Bottom := R2.Bottom;
  688. // The var parameter is only assigned in the end to avoid problems
  689. // when passing the same rectangle in the var and const parameters.
  690. // See http://bugs.freepascal.org/view.php?id=17722
  691. Result:=not IsRectEmpty(lRect);
  692. if Result then
  693. Rect := lRect
  694. else
  695. FillChar(Rect,SizeOf(Rect),0);
  696. end;
  697. function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Size: Integer): TRect; overload;
  698. begin
  699. Result:=Rect.SplitRect(SplitType,Size);
  700. end;
  701. function SplitRect(const Rect: TRect; SplitType: TSplitRectType; Percent: Double): TRect; overload;
  702. begin
  703. Result:=Rect.SplitRect(SplitType,Percent);
  704. end;
  705. function CenteredRect(const SourceRect: TRect; const aCenteredRect: TRect): TRect;
  706. var
  707. W,H: Integer;
  708. Center : TPoint;
  709. begin
  710. W:=aCenteredRect.Width;
  711. H:=aCenteredRect.Height;
  712. Center:=SourceRect.CenterPoint;
  713. With Center do
  714. Result:= Rect(X-(W div 2),Y-(H div 2),X+((W+1) div 2),Y+((H+1) div 2));
  715. end;
  716. function RectWidth(const Rect: TRect): Integer;
  717. begin
  718. Result:=Rect.Width;
  719. end;
  720. function RectWidth(const Rect: TRectF): Single;
  721. begin
  722. Result:=Rect.Width;
  723. end;
  724. function RectHeight(const Rect: TRect): Integer; inline;
  725. begin
  726. Result:=Rect.Height;
  727. end;
  728. function RectHeight(const Rect: TRectF): Single; inline;
  729. begin
  730. Result:=Rect.Height
  731. end;
  732. function RectCenter(var R: TRect; const Bounds: TRect): TRect;
  733. var
  734. C : TPoint;
  735. CS : TPoint;
  736. begin
  737. C:=Bounds.CenterPoint;
  738. CS:=R.CenterPoint;
  739. OffsetRect(R,C.X-CS.X,C.Y-CS.Y);
  740. Result:=R;
  741. end;
  742. function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
  743. Var
  744. C,CS : TPointF;
  745. begin
  746. C:=Bounds.CenterPoint;
  747. CS:=R.CenterPoint;
  748. OffsetRect(R,C.X-CS.X,C.Y-CS.Y);
  749. Result:=R;
  750. end;
  751. procedure MultiplyRect(var R: TRectF; const DX, DY: Single);
  752. begin
  753. R.Left:=DX*R.Left;
  754. R.Right:=DX*R.Right;
  755. R.Top:=DY*R.Top;
  756. R.Bottom:=DY*R.Bottom;
  757. end;
  758. function UnionRect(const R1,R2 : TRect) : TRect;
  759. begin
  760. Result:=Default(TRect);
  761. UnionRect(Result,R1,R2);
  762. end;
  763. function UnionRect(const R1,R2 : TRectF) : TRectF;
  764. begin
  765. Result:=Default(TRectF);
  766. UnionRect(Result,R1,R2);
  767. end;
  768. function UnionRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
  769. var
  770. lRect: TRect;
  771. begin
  772. if IsRectEmpty(R1) then
  773. lRect:=R2
  774. else if IsRectEmpty(R2) then
  775. lRect:=R1
  776. else
  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. end;
  788. Result:=not IsRectEmpty(lRect);
  789. if Result then
  790. Rect:=lRect
  791. else
  792. FillChar(Rect,SizeOf(Rect),0);
  793. end;
  794. function UnionRect(var Rect : TRectF;const R1,R2 : TRectF) : Boolean;
  795. var
  796. lRect: TRectF;
  797. begin
  798. lRect:=R1;
  799. if R2.Left<R1.Left then
  800. lRect.Left:=R2.Left;
  801. if R2.Top<R1.Top then
  802. lRect.Top:=R2.Top;
  803. if R2.Right>R1.Right then
  804. lRect.Right:=R2.Right;
  805. if R2.Bottom>R1.Bottom then
  806. lRect.Bottom:=R2.Bottom;
  807. Result:=not IsRectEmpty(lRect);
  808. if Result then
  809. Rect := lRect
  810. else
  811. FillChar(Rect,SizeOf(Rect),0);
  812. end;
  813. function IsRectEmpty(const Rect : TRect) : Boolean;
  814. begin
  815. IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
  816. end;
  817. function IsRectEmpty(const Rect : TRectF) : Boolean;
  818. begin
  819. IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
  820. end;
  821. function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
  822. begin
  823. Result:=assigned(@Rect);
  824. if Result then
  825. with Rect do
  826. begin
  827. inc(Left,dx);
  828. inc(Top,dy);
  829. inc(Right,dx);
  830. inc(Bottom,dy);
  831. end;
  832. end;
  833. function Avg(a, b: Longint): Longint;
  834. begin
  835. if a < b then
  836. Result := a + ((b - a) shr 1)
  837. else
  838. Result := b + ((a - b) shr 1);
  839. end;
  840. function OffsetRect(var Rect: TRectF; DX: Single; DY: Single): Boolean;
  841. begin
  842. Result:=assigned(@Rect);
  843. if Result then
  844. with Rect do
  845. begin
  846. Left:=Left+dx;
  847. Right:=Right+dx;
  848. Top:=Top+dy;
  849. Bottom:=Bottom+dy;
  850. end;
  851. end;
  852. function CenterPoint(const Rect: TRect): TPoint;
  853. begin
  854. with Rect do
  855. begin
  856. Result.X := Avg(Left, Right);
  857. Result.Y := Avg(Top, Bottom);
  858. end;
  859. end;
  860. function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
  861. begin
  862. Result:=assigned(@Rect);
  863. if Result then
  864. with Rect do
  865. begin
  866. dec(Left, dx);
  867. dec(Top, dy);
  868. inc(Right, dx);
  869. inc(Bottom, dy);
  870. end;
  871. end;
  872. function InflateRect(var Rect: TRectF; dx: Single; dy: Single): Boolean;
  873. begin
  874. Result:=assigned(@Rect);
  875. if Result then
  876. with Rect do
  877. begin
  878. Left:=Left-dx;
  879. Top:=Top-dy;
  880. Right:=Right+dx;
  881. Bottom:=Bottom+dy;
  882. end;
  883. end;
  884. function Size(AWidth, AHeight: Integer): TSize; inline;
  885. begin
  886. Result.cx := AWidth;
  887. Result.cy := AHeight;
  888. end;
  889. function Size(const ARect: TRect): TSize; inline;
  890. begin
  891. Result.cx := ARect.Right - ARect.Left;
  892. Result.cy := ARect.Bottom - ARect.Top;
  893. end;
  894. Function SingleToStr(aValue : Single; aSize,aDecimals : Byte) : ShortString; inline;
  895. var
  896. S : ShortString;
  897. Len,P : Byte;
  898. begin
  899. Str(aValue:aSize:aDecimals,S);
  900. Len:=Length(S);
  901. P:=1;
  902. While (P<=Len) and (S[P]=' ') do
  903. Inc(P);
  904. if P>1 then
  905. Delete(S,1,P-1);
  906. Result:=S;
  907. end;
  908. { TNullPtr }
  909. class operator TNullPtr.:=(None: TNullPtr): Pointer;
  910. begin
  911. Result := nil;
  912. end;
  913. class operator TNullPtr.:=(None: TNullPtr): TObject;
  914. begin
  915. Result := nil;
  916. end;
  917. class operator TNullPtr.=(LHS: TNullPtr; RHS: Pointer): Boolean;
  918. begin
  919. Result := not Assigned(RHS);
  920. end;
  921. class operator TNullPtr.=(LHS: TNullPtr; RHS: TObject): Boolean;
  922. begin
  923. Result := not Assigned(RHS);
  924. end;
  925. class operator TNullPtr.=(LHS: Pointer; RHS: TNullPtr): Boolean;
  926. begin
  927. Result := not Assigned(LHS);
  928. end;
  929. class operator TNullPtr.=(LHS: TObject; RHS: TNullPtr): Boolean;
  930. begin
  931. Result := not Assigned(LHS);
  932. end;
  933. class operator TNullPtr.<>(LHS: TNullPtr; RHS: Pointer): Boolean;
  934. begin
  935. Result := Assigned(RHS);
  936. end;
  937. class operator TNullPtr.<>(LHS: TNullPtr; RHS: TObject): Boolean;
  938. begin
  939. Result := Assigned(RHS);
  940. end;
  941. class operator TNullPtr.<>(LHS: Pointer; RHS: TNullPtr): Boolean;
  942. begin
  943. Result := Assigned(LHS);
  944. end;
  945. class operator TNullPtr.<>(LHS: TObject; RHS: TNullPtr): Boolean;
  946. begin
  947. Result := Assigned(LHS);
  948. end;
  949. { TPointF}
  950. function TPointF.ToString : RTLString;
  951. begin
  952. Result:=ToString(8,2);
  953. end;
  954. function TPointF.ToString(aSize,aDecimals : Byte) : RTLString;
  955. var
  956. Sx,Sy : shortstring;
  957. begin
  958. Sx:=SingleToStr(X,aSize,aDecimals);
  959. Sy:=SingleToStr(Y,aSize,aDecimals);
  960. Result:='('+Sx+','+Sy+')';
  961. end;
  962. function TPointF.Add(const apt: TPoint): TPointF;
  963. begin
  964. result.x:=x+apt.x;
  965. result.y:=y+apt.y;
  966. end;
  967. function TPointF.Add(const apt: TPointF): TPointF;
  968. begin
  969. result.x:=x+apt.x;
  970. result.y:=y+apt.y;
  971. end;
  972. function TPointF.Subtract(const apt : TPointF): TPointF;
  973. begin
  974. result.x:=x-apt.x;
  975. result.y:=y-apt.y;
  976. end;
  977. function TPointF.Subtract(const apt: TPoint): TPointF;
  978. begin
  979. result.x:=x-apt.x;
  980. result.y:=y-apt.y;
  981. end;
  982. function TPointF.Distance(const apt : TPointF) : Single;
  983. begin
  984. result:=sqrt(sqr(apt.x-x)+sqr(apt.y-y));
  985. end;
  986. function TPointF.DotProduct(const apt: TPointF): Single;
  987. begin
  988. result:=x*apt.x+y*apt.y;
  989. end;
  990. function TPointF.IsZero : Boolean;
  991. begin
  992. result:=SameValue(x,0.0) and SameValue(y,0.0);
  993. end;
  994. procedure TPointF.Offset(const apt :TPointF);
  995. begin
  996. x:=x+apt.x;
  997. y:=y+apt.y;
  998. end;
  999. procedure TPointF.Offset(const apt: TPoint);
  1000. begin
  1001. x:=x+apt.x;
  1002. y:=y+apt.y;
  1003. end;
  1004. procedure TPointF.Offset(dx,dy : Single);
  1005. begin
  1006. x:=x+dx;
  1007. y:=y+dy;
  1008. end;
  1009. function TPointF.EqualsTo(const apt: TPointF): Boolean;
  1010. begin
  1011. Result:=EqualsTo(apt,0);
  1012. end;
  1013. function TPointF.EqualsTo(const apt: TPointF; const aEpsilon: Single): Boolean;
  1014. function Eq(a,b : single) : boolean; inline;
  1015. begin
  1016. result:=abs(a-b)<=aEpsilon;
  1017. end;
  1018. begin
  1019. Result:=Eq(X,apt.X) and Eq(Y,apt.Y);
  1020. end;
  1021. function TPointF.Scale(afactor: Single): TPointF;
  1022. begin
  1023. result.x:=afactor*x;
  1024. result.y:=afactor*y;
  1025. end;
  1026. function TPointF.Ceiling: TPoint;
  1027. begin
  1028. result.x:=ceil(x);
  1029. result.y:=ceil(y);
  1030. end;
  1031. function TPointF.Truncate: TPoint;
  1032. begin
  1033. result.x:=trunc(x);
  1034. result.y:=trunc(y);
  1035. end;
  1036. function TPointF.Floor: TPoint;
  1037. begin
  1038. result.x:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(x);
  1039. result.y:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(y);
  1040. end;
  1041. function TPointF.Round: TPoint;
  1042. begin
  1043. result.x:=System.round(x);
  1044. result.y:=System.round(y);
  1045. end;
  1046. function TPointF.Length: Single;
  1047. begin
  1048. result:=sqrt(sqr(x)+sqr(y));
  1049. end;
  1050. function TPointF.Rotate(angle: single): TPointF;
  1051. var
  1052. sina, cosa: single;
  1053. begin
  1054. sincos(angle, sina, cosa);
  1055. result.x := x * cosa - y * sina;
  1056. result.y := x * sina + y * cosa;
  1057. end;
  1058. function TPointF.Reflect(const normal: TPointF): TPointF;
  1059. begin
  1060. result := self + (-2 * normal ** self) * normal;
  1061. end;
  1062. function TPointF.MidPoint(const b: TPointF): TPointF;
  1063. begin
  1064. result.x := 0.5 * (x + b.x);
  1065. result.y := 0.5 * (y + b.y);
  1066. end;
  1067. class function TPointF.Zero: TPointF;
  1068. begin
  1069. Result.X:=0;
  1070. Result.Y:=0;
  1071. end;
  1072. class function TPointF.PointInCircle(const pt, center: TPointF; radius: single): Boolean;
  1073. begin
  1074. result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(radius);
  1075. end;
  1076. class function TPointF.PointInCircle(const pt, center: TPointF; radius: integer): Boolean;
  1077. begin
  1078. result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(single(radius));
  1079. end;
  1080. function TPointF.Angle(const b: TPointF): Single;
  1081. begin
  1082. result := ArcTan2(y - b.y, x - b.x);
  1083. end;
  1084. function TPointF.AngleCosine(const b: TPointF): single;
  1085. begin
  1086. result := EnsureRange((self ** b) / sqrt((sqr(x) + sqr(y)) * (sqr(b.x) + sqr(b.y))), -1, 1);
  1087. end;
  1088. class operator TPointF.= (const apt1, apt2 : TPointF) : Boolean;
  1089. begin
  1090. result:=SameValue(apt1.x,apt2.x) and SameValue(apt1.y,apt2.y);
  1091. end;
  1092. class operator TPointF.<> (const apt1, apt2 : TPointF): Boolean;
  1093. begin
  1094. result:=NOT (SameValue(apt1.x,apt2.x) and Samevalue(apt1.y,apt2.y));
  1095. end;
  1096. class operator TPointF. * (const apt1, apt2: TPointF): TPointF;
  1097. begin
  1098. result.x:=apt1.x*apt2.x;
  1099. result.y:=apt1.y*apt2.y;
  1100. end;
  1101. class operator TPointF. * (afactor: single; const apt1: TPointF): TPointF;
  1102. begin
  1103. result:=apt1.Scale(afactor);
  1104. end;
  1105. class operator TPointF. * (const apt1: TPointF; afactor: single): TPointF;
  1106. begin
  1107. result:=apt1.Scale(afactor);
  1108. end;
  1109. class operator TPointF. ** (const apt1, apt2: TPointF): Single;
  1110. begin
  1111. result:=apt1.x*apt2.x + apt1.y*apt2.y;
  1112. end;
  1113. class operator TPointF.+ (const apt1, apt2 : TPointF): TPointF;
  1114. begin
  1115. result.x:=apt1.x+apt2.x;
  1116. result.y:=apt1.y+apt2.y;
  1117. end;
  1118. class operator TPointF.- (const apt1, apt2 : TPointF): TPointF;
  1119. begin
  1120. result.x:=apt1.x-apt2.x;
  1121. result.y:=apt1.y-apt2.y;
  1122. end;
  1123. class operator TPointF. - (const apt1: TPointF): TPointF;
  1124. begin
  1125. Result.x:=-apt1.x;
  1126. Result.y:=-apt1.y;
  1127. end;
  1128. class operator TPointF. / (const apt1: TPointF; afactor: single): TPointF;
  1129. begin
  1130. result:=apt1.Scale(1/afactor);
  1131. end;
  1132. class operator TPointF. := (const apt: TPoint): TPointF;
  1133. begin
  1134. Result.x:=apt.x;
  1135. Result.y:=apt.y;
  1136. end;
  1137. procedure TPointF.SetLocation(const apt :TPointF);
  1138. begin
  1139. x:=apt.x; y:=apt.y;
  1140. end;
  1141. procedure TPointF.SetLocation(const apt: TPoint);
  1142. begin
  1143. x:=apt.x; y:=apt.y;
  1144. end;
  1145. procedure TPointF.SetLocation(ax,ay : Single);
  1146. begin
  1147. x:=ax; y:=ay;
  1148. end;
  1149. class function TPointF.Create(const ax, ay: Single): TPointF;
  1150. begin
  1151. Result.x := ax;
  1152. Result.y := ay;
  1153. end;
  1154. class function TPointF.Create(const apt: TPoint): TPointF;
  1155. begin
  1156. Result.x := apt.X;
  1157. Result.y := apt.Y;
  1158. end;
  1159. function TPointF.CrossProduct(const apt: TPointF): Single;
  1160. begin
  1161. Result:=X*apt.Y-Y*apt.X;
  1162. end;
  1163. function TPointF.Normalize: TPointF;
  1164. var
  1165. L: Single;
  1166. begin
  1167. L:=Sqrt(Sqr(X)+Sqr(Y));
  1168. if SameValue(L,0,Epsilon) then
  1169. Result:=Self
  1170. else
  1171. begin
  1172. Result.X:=X/L;
  1173. Result.Y:=Y/L;
  1174. end;
  1175. end;
  1176. { TSizeF }
  1177. function TSizeF.ToString(aSize,aDecimals : Byte) : RTLString;
  1178. var
  1179. Sx,Sy : shortstring;
  1180. begin
  1181. Sx:=SingleToStr(cx,aSize,aDecimals);
  1182. Sy:=SingleToStr(cy,aSize,aDecimals);
  1183. Result:='('+Sx+'x'+Sy+')';
  1184. end;
  1185. function TSizeF.ToString : RTLString;
  1186. begin
  1187. Result:=ToString(8,2);
  1188. end;
  1189. function TSizeF.Add(const asz: TSize): TSizeF;
  1190. begin
  1191. result.cx:=cx+asz.cx;
  1192. result.cy:=cy+asz.cy;
  1193. end;
  1194. function TSizeF.Add(const asz: TSizeF): TSizeF;
  1195. begin
  1196. result.cx:=cx+asz.cx;
  1197. result.cy:=cy+asz.cy;
  1198. end;
  1199. function TSizeF.Subtract(const asz : TSizeF): TSizeF;
  1200. begin
  1201. result.cx:=cx-asz.cx;
  1202. result.cy:=cy-asz.cy;
  1203. end;
  1204. function TSizeF.SwapDimensions:TSizeF;
  1205. begin
  1206. result.cx:=cy;
  1207. result.cy:=cx;
  1208. end;
  1209. function TSizeF.Subtract(const asz: TSize): TSizeF;
  1210. begin
  1211. result.cx:=cx-asz.cx;
  1212. result.cy:=cy-asz.cy;
  1213. end;
  1214. function TSizeF.Distance(const asz : TSizeF) : Single;
  1215. begin
  1216. result:=sqrt(sqr(asz.cx-cx)+sqr(asz.cy-cy));
  1217. end;
  1218. function TSizeF.IsZero : Boolean;
  1219. begin
  1220. result:=SameValue(cx,0.0) and SameValue(cy,0.0);
  1221. end;
  1222. function TSizeF.Scale(afactor: Single): TSizeF;
  1223. begin
  1224. result.cx:=afactor*cx;
  1225. result.cy:=afactor*cy;
  1226. end;
  1227. function TSizeF.Ceiling: TSize;
  1228. begin
  1229. result.cx:=ceil(cx);
  1230. result.cy:=ceil(cy);
  1231. end;
  1232. function TSizeF.Truncate: TSize;
  1233. begin
  1234. result.cx:=trunc(cx);
  1235. result.cy:=trunc(cy);
  1236. end;
  1237. function TSizeF.Floor: TSize;
  1238. begin
  1239. result.cx:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(cx);
  1240. result.cy:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Math.floor(cy);
  1241. end;
  1242. function TSizeF.Round: TSize;
  1243. begin
  1244. result.cx:=System.round(cx);
  1245. result.cy:=System.round(cy);
  1246. end;
  1247. function TSizeF.Length: Single;
  1248. begin //distance(self) ?
  1249. result:=sqrt(sqr(cx)+sqr(cy));
  1250. end;
  1251. class operator TSizeF.= (const asz1, asz2 : TSizeF) : Boolean;
  1252. begin
  1253. result:=SameValue(asz1.cx,asz2.cx) and SameValue(asz1.cy,asz2.cy);
  1254. end;
  1255. class operator TSizeF.<> (const asz1, asz2 : TSizeF): Boolean;
  1256. begin
  1257. result:=NOT (SameValue(asz1.cx,asz2.cx) and Samevalue(asz1.cy,asz2.cy));
  1258. end;
  1259. class operator TSizeF. * (afactor: single; const asz1: TSizeF): TSizeF;
  1260. begin
  1261. result:=asz1.Scale(afactor);
  1262. end;
  1263. class operator TSizeF. * (const asz1: TSizeF; afactor: single): TSizeF;
  1264. begin
  1265. result:=asz1.Scale(afactor);
  1266. end;
  1267. class operator TSizeF.+ (const asz1, asz2 : TSizeF): TSizeF;
  1268. begin
  1269. result.cx:=asz1.cx+asz2.cx;
  1270. result.cy:=asz1.cy+asz2.cy;
  1271. end;
  1272. class operator TSizeF.- (const asz1, asz2 : TSizeF): TSizeF;
  1273. begin
  1274. result.cx:=asz1.cx-asz2.cx;
  1275. result.cy:=asz1.cy-asz2.cy;
  1276. end;
  1277. class operator TSizeF. - (const asz1: TSizeF): TSizeF;
  1278. begin
  1279. Result.cx:=-asz1.cx;
  1280. Result.cy:=-asz1.cy;
  1281. end;
  1282. class operator TSizeF. := (const apt: TPointF): TSizeF;
  1283. begin
  1284. Result.cx:=apt.x;
  1285. Result.cy:=apt.y;
  1286. end;
  1287. class operator TSizeF. := (const asz: TSize): TSizeF;
  1288. begin
  1289. Result.cx := asz.cx;
  1290. Result.cy := asz.cy;
  1291. end;
  1292. class operator TSizeF. := (const asz: TSizeF): TPointF;
  1293. begin
  1294. Result.x := asz.cx;
  1295. Result.y := asz.cy;
  1296. end;
  1297. class function TSizeF.Create(const ax, ay: Single): TSizeF;
  1298. begin
  1299. Result.cx := ax;
  1300. Result.cy := ay;
  1301. end;
  1302. class function TSizeF.Create(const asz: TSize): TSizeF;
  1303. begin
  1304. Result.cx := asz.cX;
  1305. Result.cy := asz.cY;
  1306. end;
  1307. { TRectF }
  1308. function TRectF.ToString(aSize,aDecimals : Byte; aUseSize : Boolean = False) : RTLString;
  1309. var
  1310. S : RTLString;
  1311. begin
  1312. if aUseSize then
  1313. S:=Size.ToString(aSize,aDecimals)
  1314. else
  1315. S:=BottomRight.ToString(aSize,aDecimals);
  1316. Result:='['+TopLeft.ToString(aSize,aDecimals)+' - '+S+']';
  1317. end;
  1318. function TRectF.ToString(aUseSize: Boolean = False) : RTLString;
  1319. begin
  1320. Result:=ToString(8,2,aUseSize);
  1321. end;
  1322. class operator TRectF. * (L, R: TRectF): TRectF;
  1323. begin
  1324. Result := TRectF.Intersect(L, R);
  1325. end;
  1326. class operator TRectF. + (L, R: TRectF): TRectF;
  1327. begin
  1328. Result := TRectF.Union(L, R);
  1329. end;
  1330. class operator TRectF. := (const arc: TRect): TRectF;
  1331. begin
  1332. Result.Left:=arc.Left;
  1333. Result.Top:=arc.Top;
  1334. Result.Right:=arc.Right;
  1335. Result.Bottom:=arc.Bottom;
  1336. end;
  1337. class operator TRectF. <> (L, R: TRectF): Boolean;
  1338. begin
  1339. Result := not(L=R);
  1340. end;
  1341. class operator TRectF. = (L, R: TRectF): Boolean;
  1342. begin
  1343. Result :=
  1344. SameValue(L.Left,R.Left) and SameValue(L.Right,R.Right) and
  1345. SameValue(L.Top,R.Top) and SameValue(L.Bottom,R.Bottom);
  1346. end;
  1347. constructor TRectF.Create(ALeft, ATop, ARight, ABottom: Single);
  1348. begin
  1349. Left := ALeft;
  1350. Top := ATop;
  1351. Right := ARight;
  1352. Bottom := ABottom;
  1353. end;
  1354. constructor TRectF.Create(P1, P2: TPointF; Normalize: Boolean);
  1355. begin
  1356. TopLeft := P1;
  1357. BottomRight := P2;
  1358. if Normalize then
  1359. NormalizeRect;
  1360. end;
  1361. constructor TRectF.Create(Origin: TPointF);
  1362. begin
  1363. TopLeft := Origin;
  1364. BottomRight := Origin;
  1365. end;
  1366. constructor TRectF.Create(Origin: TPointF; AWidth, AHeight: Single);
  1367. begin
  1368. TopLeft := Origin;
  1369. Width := AWidth;
  1370. Height := AHeight;
  1371. end;
  1372. constructor TRectF.Create(R: TRectF; Normalize: Boolean);
  1373. begin
  1374. Self := R;
  1375. if Normalize then
  1376. NormalizeRect;
  1377. end;
  1378. constructor TRectF.Create(R: TRect; Normalize: Boolean);
  1379. begin
  1380. Self := R;
  1381. if Normalize then
  1382. NormalizeRect;
  1383. end;
  1384. function TRectF.CenterPoint: TPointF;
  1385. begin
  1386. Result.X := (Right-Left) / 2 + Left;
  1387. Result.Y := (Bottom-Top) / 2 + Top;
  1388. end;
  1389. function TRectF.Ceiling: TRectF;
  1390. begin
  1391. Result.BottomRight:=BottomRight.Ceiling;
  1392. Result.TopLeft:=TopLeft.Ceiling;
  1393. end;
  1394. function TRectF.CenterAt(const Dest: TRectF): TRectF;
  1395. begin
  1396. Result:=Self;
  1397. RectCenter(Result,Dest);
  1398. end;
  1399. function TRectF.Fit(const Dest: TRectF): Single;
  1400. var
  1401. R : TRectF;
  1402. begin
  1403. R:=FitInto(Dest,Result);
  1404. Self:=R;
  1405. end;
  1406. function TRectF.FitInto(const Dest: TRectF; out Ratio: Single): TRectF;
  1407. var
  1408. dw, dh, w, h : Single;
  1409. begin
  1410. dw := Dest.Width;
  1411. dh := Dest.Height;
  1412. if (dw <= 0) or (dh <= 0) then
  1413. begin
  1414. Ratio := 1.0;
  1415. exit(Self);
  1416. end;
  1417. w := Self.Width;
  1418. h := Self.Height;
  1419. if w * dh > h * dw then
  1420. Ratio := w / dw
  1421. else
  1422. Ratio := h / dh;
  1423. if Ratio = 0 then
  1424. exit(Self);
  1425. w := w / Ratio;
  1426. h := h / Ratio;
  1427. // Center the result within the Dest rectangle
  1428. Result.Left := (Dest.Left + Dest.Right - w) * 0.5;
  1429. Result.Right := Result.Left + w;
  1430. Result.Top := (Dest.Top + Dest.Bottom - h) * 0.5;
  1431. Result.Bottom := Result.Top + h;
  1432. end;
  1433. function TRectF.FitInto(const Dest: TRectF): TRectF;
  1434. var
  1435. Ratio: Single;
  1436. begin
  1437. Result:=FitInto(Dest,Ratio);
  1438. end;
  1439. function TRectF.PlaceInto(const Dest: TRectF; const AHorzAlign: THorzRectAlign = THorzRectAlign.Center; const AVertAlign: TVertRectAlign = TVertRectAlign.Center): TRectF;
  1440. var
  1441. R : TRectF;
  1442. X,Y : Single;
  1443. D : TRectF absolute dest;
  1444. begin
  1445. if (Height>Dest.Height) or (Width>Dest.Width) then
  1446. R:=FitInto(Dest)
  1447. else
  1448. R:=Self;
  1449. case AHorzAlign of
  1450. THorzRectAlign.Left:
  1451. X:=D.Left;
  1452. THorzRectAlign.Center:
  1453. X:=(D.Left+D.Right-R.Width)/2;
  1454. THorzRectAlign.Right:
  1455. X:=D.Right-R.Width;
  1456. end;
  1457. case AVertAlign of
  1458. TVertRectAlign.Top:
  1459. Y:=D.Top;
  1460. TVertRectAlign.Center:
  1461. Y:=(D.Top+D.Bottom-R.Height)/2;
  1462. TVertRectAlign.Bottom:
  1463. Y:=D.Bottom-R.Height;
  1464. end;
  1465. R.SetLocation(PointF(X,Y));
  1466. Result:=R;
  1467. end;
  1468. function TRectF.SnapToPixel(AScale: Single; APlaceBetweenPixels: Boolean): TRectF;
  1469. function sc (S : single) : single; inline;
  1470. begin
  1471. Result:=System.Trunc(S*AScale)/AScale;
  1472. end;
  1473. var
  1474. R : TRectF;
  1475. Off: Single;
  1476. begin
  1477. if AScale<=0 then
  1478. AScale := 1;
  1479. R.Top:=Sc(Top);
  1480. R.Left:=Sc(Left);
  1481. R.Width:=Sc(Width);
  1482. R.Height:=Sc(Height);
  1483. if APlaceBetweenPixels then
  1484. begin
  1485. Off:=1/(2*aScale);
  1486. R.Offset(Off,Off);
  1487. end;
  1488. Result:=R;
  1489. end;
  1490. function TRectF.Contains(Pt: TPointF): Boolean;
  1491. begin
  1492. Result := (Left <= Pt.X) and (Pt.X < Right) and (Top <= Pt.Y) and (Pt.Y < Bottom);
  1493. end;
  1494. function TRectF.Contains(R: TRectF): Boolean;
  1495. begin
  1496. Result := (Left <= R.Left) and (R.Right <= Right) and (Top <= R.Top) and (R.Bottom <= Bottom);
  1497. end;
  1498. class function TRectF.Empty: TRectF;
  1499. begin
  1500. Result := TRectF.Create(0,0,0,0);
  1501. end;
  1502. function TRectF.EqualsTo(const R: TRectF; const Epsilon: Single): Boolean;
  1503. begin
  1504. Result:=TopLeft.EqualsTo(R.TopLeft,Epsilon);
  1505. Result:=Result and BottomRight.EqualsTo(R.BottomRight,Epsilon);
  1506. end;
  1507. function TRectF.GetHeight: Single;
  1508. begin
  1509. result:=bottom-top;
  1510. end;
  1511. function TRectF.GetLocation: TPointF;
  1512. begin
  1513. result.x:=Left; result.y:=top;
  1514. end;
  1515. function TRectF.GetSize: TSizeF;
  1516. begin
  1517. result.cx:=width; result.cy:=height;
  1518. end;
  1519. function TRectF.GetWidth: Single;
  1520. begin
  1521. result:=right-left;
  1522. end;
  1523. procedure TRectF.Inflate(DX, DY: Single);
  1524. begin
  1525. Left:=Left-dx;
  1526. Top:=Top-dy;
  1527. Right:=Right+dx;
  1528. Bottom:=Bottom+dy;
  1529. end;
  1530. procedure TRectF.Intersect(R: TRectF);
  1531. begin
  1532. Self := Intersect(Self, R);
  1533. end;
  1534. class function TRectF.Intersect(R1: TRectF; R2: TRectF): TRectF;
  1535. begin
  1536. Result := R1;
  1537. if R2.Left > R1.Left then
  1538. Result.Left := R2.Left;
  1539. if R2.Top > R1.Top then
  1540. Result.Top := R2.Top;
  1541. if R2.Right < R1.Right then
  1542. Result.Right := R2.Right;
  1543. if R2.Bottom < R1.Bottom then
  1544. Result.Bottom := R2.Bottom;
  1545. end;
  1546. function TRectF.IntersectsWith(R: TRectF): Boolean;
  1547. begin
  1548. Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom);
  1549. end;
  1550. function TRectF.IsEmpty: Boolean;
  1551. begin
  1552. Result := (CompareValue(Right,Left)<=0) or (CompareValue(Bottom,Top)<=0);
  1553. end;
  1554. procedure TRectF.NormalizeRect;
  1555. var
  1556. x: Single;
  1557. begin
  1558. if Top>Bottom then
  1559. begin
  1560. x := Top;
  1561. Top := Bottom;
  1562. Bottom := x;
  1563. end;
  1564. if Left>Right then
  1565. begin
  1566. x := Left;
  1567. Left := Right;
  1568. Right := x;
  1569. end
  1570. end;
  1571. procedure TRectF.Inflate(DL, DT, DR, DB: Single);
  1572. begin
  1573. Left:=Left-dl;
  1574. Top:=Top-dt;
  1575. Right:=Right+dr;
  1576. Bottom:=Bottom+db;
  1577. end;
  1578. procedure TRectF.Offset(const dx, dy: Single);
  1579. begin
  1580. left:=left+dx; right:=right+dx;
  1581. bottom:=bottom+dy; top:=top+dy;
  1582. end;
  1583. procedure TRectF.Offset(DP: TPointF);
  1584. begin
  1585. left:=left+DP.x; right:=right+DP.x;
  1586. bottom:=bottom+DP.y; top:=top+DP.y;
  1587. end;
  1588. function TRectF.Truncate: TRect;
  1589. begin
  1590. Result.BottomRight:=BottomRight.Truncate;
  1591. Result.TopLeft:=TopLeft.Truncate;
  1592. end;
  1593. function TRectF.Round: TRect;
  1594. begin
  1595. Result.BottomRight:=BottomRight.Round;
  1596. Result.TopLeft:=TopLeft.Round;
  1597. end;
  1598. procedure TRectF.SetHeight(AValue: Single);
  1599. begin
  1600. bottom:=top+avalue;
  1601. end;
  1602. procedure TRectF.SetLocation(X, Y: Single);
  1603. begin
  1604. Offset(X-Left, Y-Top);
  1605. end;
  1606. procedure TRectF.SetLocation(P: TPointF);
  1607. begin
  1608. SetLocation(P.X, P.Y);
  1609. end;
  1610. procedure TRectF.SetSize(AValue: TSizeF);
  1611. begin
  1612. bottom:=top+avalue.cy;
  1613. right:=left+avalue.cx;
  1614. end;
  1615. procedure TRectF.SetWidth(AValue: Single);
  1616. begin
  1617. right:=left+avalue;
  1618. end;
  1619. class function TRectF.Union(const Points: array of TPointF): TRectF;
  1620. var
  1621. i: Integer;
  1622. begin
  1623. if Length(Points) > 0 then
  1624. begin
  1625. Result.TopLeft := Points[Low(Points)];
  1626. Result.BottomRight := Points[Low(Points)];
  1627. for i := Low(Points)+1 to High(Points) do
  1628. begin
  1629. if Points[i].X < Result.Left then Result.Left := Points[i].X;
  1630. if Points[i].X > Result.Right then Result.Right := Points[i].X;
  1631. if Points[i].Y < Result.Top then Result.Top := Points[i].Y;
  1632. if Points[i].Y > Result.Bottom then Result.Bottom := Points[i].Y;
  1633. end;
  1634. end else
  1635. Result := Empty;
  1636. end;
  1637. procedure TRectF.Union(const r: TRectF);
  1638. begin
  1639. left:=min(r.left,left);
  1640. top:=min(r.top,top);
  1641. right:=max(r.right,right);
  1642. bottom:=max(r.bottom,bottom);
  1643. end;
  1644. class function TRectF.Union(R1, R2: TRectF): TRectF;
  1645. begin
  1646. Result:=R1;
  1647. Result.Union(R2);
  1648. end;
  1649. { TPoint3D }
  1650. function TPoint3D.ToString(aSize,aDecimals : Byte) : RTLString;
  1651. var
  1652. Sx,Sy,Sz : shortstring;
  1653. P : integer;
  1654. begin
  1655. Sx:=SingleToStr(X,aSize,aDecimals);
  1656. Sy:=SingleToStr(Y,aSize,aDecimals);
  1657. Sz:=SingleToStr(Z,aSize,aDecimals);
  1658. Result:='('+Sx+','+Sy+','+Sz+')';
  1659. end;
  1660. function TPoint3D.ToString : RTLString;
  1661. begin
  1662. Result:=ToString(8,2);
  1663. end;
  1664. constructor TPoint3D.Create(const ax,ay,az:single);
  1665. begin
  1666. x:=ax; y:=ay; z:=az;
  1667. end;
  1668. procedure TPoint3D.Offset(const adeltax,adeltay,adeltaz:single);
  1669. begin
  1670. x:=x+adeltax; y:=y+adeltay; z:=z+adeltaz;
  1671. end;
  1672. procedure TPoint3D.Offset(const adelta:TPoint3D);
  1673. begin
  1674. x:=x+adelta.x; y:=y+adelta.y; z:=z+adelta.z;
  1675. end;
  1676. generic class procedure TBitConverter.UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  1677. begin
  1678. move(ASrcValue, ADestination[AOffset], SizeOf(T));
  1679. end;
  1680. generic class procedure TBitConverter.From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
  1681. begin
  1682. if AOffset < 0 then
  1683. System.Error(reRangeError);
  1684. if IsManagedType(T) then
  1685. System.Error(reInvalidCast);
  1686. if Length(ADestination) < (SizeOf(T) + AOffset) then
  1687. System.Error(reRangeError);
  1688. TBitConverter.specialize UnsafeFrom<T>(ASrcValue, ADestination, AOffset);
  1689. end;
  1690. generic class function TBitConverter.UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  1691. begin
  1692. move(ASource[AOffset], Result, SizeOf(T));
  1693. end;
  1694. generic class function TBitConverter.InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
  1695. begin
  1696. if AOffset < 0 then
  1697. System.Error(reRangeError);
  1698. if IsManagedType(T) then
  1699. System.Error(reInvalidCast);
  1700. if Length(ASource) < (SizeOf(T) + AOffset) then
  1701. System.Error(reRangeError);
  1702. Result := TBitConverter.specialize UnsafeInTo<T>(ASource, AOffset);
  1703. end;
  1704. end.