types.pp 47 KB

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