types.pp 50 KB

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