types.pp 47 KB

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