typshrd.inc 9.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2015 by Marco van de Voort
  4. member of the Free Pascal development team.
  5. Types that are in unit types on all platforms but also in
  6. unit Windows on win<x>
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. { TSize }
  14. {$ifdef VER3}
  15. constructor TSize.Create(ax,ay:Longint);
  16. begin
  17. cx:=ax; cy:=ay;
  18. end;
  19. constructor TSize.Create(asz :TSize);
  20. begin
  21. cx:=asz.cx; cy:=asz.cy;
  22. // vector:=TSize(asz.vector); ??
  23. end;
  24. {$endif}
  25. function TSize.IsZero : Boolean;
  26. begin
  27. result:=(cx=0) and (cy=0);
  28. end;
  29. function TSize.Distance(const asz : TSize) : Double;
  30. begin
  31. result:=sqrt(sqr(cx-asz.cx)+sqr(cy-asz.cy));
  32. end;
  33. function TSize.Add(const asz : TSize): TSize;
  34. begin
  35. result.cx:=cx+asz.cx;
  36. result.cy:=cy+asz.cy;
  37. end;
  38. function TSize.Subtract(const asz : TSize): TSize;
  39. begin
  40. result.cx:=cx-asz.cx;
  41. result.cy:=cy-asz.cy;
  42. end;
  43. class operator TSize.=(const asz1, asz2 : TSize) : Boolean;
  44. begin
  45. result:=(asz1.cx=asz2.cx) and (asz1.cy=asz2.cy);
  46. end;
  47. class operator TSize.<> (const asz1, asz2 : TSize): Boolean;
  48. begin
  49. result:=(asz1.cx<>asz2.cx) or (asz1.cy<>asz2.cy);
  50. end;
  51. class operator TSize.+(const asz1, asz2 : TSize): TSize;
  52. begin
  53. result.cx:=asz1.cx+asz2.cx;
  54. result.cy:=asz1.cy+asz2.cy;
  55. end;
  56. class operator TSize.-(const asz1, asz2 : TSize): TSize;
  57. begin
  58. result.cx:=asz1.cx-asz2.cx;
  59. result.cy:=asz1.cy-asz2.cy;
  60. end;
  61. { TPoint }
  62. {$ifdef VER3}
  63. constructor TPoint.Create(ax,ay:Longint);
  64. begin
  65. x:=ax; y:=ay;
  66. end;
  67. constructor TPoint.Create(apt :TPoint);
  68. begin
  69. x:=apt.x; y:=apt.y;
  70. end;
  71. {$endif}
  72. function TPoint.Add(const apt: TPoint): TPoint;
  73. begin
  74. result.x:=x+apt.x;
  75. result.y:=y+apt.y;
  76. end;
  77. function TPoint.Distance(const apt: TPoint): ValReal;
  78. begin
  79. result:=sqrt(sqr(ValReal(apt.x)-ValReal(x))+sqr(ValReal(apt.y)-ValReal(y))); // convert to ValReal to prevent integer overflows
  80. end;
  81. function TPoint.IsZero : Boolean;
  82. begin
  83. result:=(x=0) and (y=0);
  84. end;
  85. function TPoint.Subtract(const apt : TPoint): TPoint;
  86. begin
  87. result.x:=x-apt.x;
  88. result.y:=y-apt.y;
  89. end;
  90. class function TPoint.Zero: TPoint;
  91. begin
  92. Result.x := 0;
  93. Result.y := 0;
  94. end;
  95. procedure TPoint.SetLocation(const apt :TPoint);
  96. begin
  97. x:=apt.x; y:=apt.y;
  98. end;
  99. procedure TPoint.SetLocation(ax,ay : Longint);
  100. begin
  101. x:=ax; y:=ay;
  102. end;
  103. procedure TPoint.Offset(const apt :TPoint);
  104. begin
  105. x:=x+apt.x;
  106. y:=y+apt.y;
  107. end;
  108. class function TPoint.PointInCircle(const apt, acenter: TPoint;
  109. const aradius: Integer): Boolean;
  110. begin
  111. Result := apt.Distance(acenter) <= aradius;
  112. end;
  113. procedure TPoint.Offset(dx,dy : Longint);
  114. begin
  115. x:=x+dx;
  116. y:=y+dy;
  117. end;
  118. class operator TPoint.= (const apt1, apt2 : TPoint) : Boolean;
  119. begin
  120. result:=(apt1.x=apt2.x) and (apt1.y=apt2.y);
  121. end;
  122. class operator TPoint.<> (const apt1, apt2 : TPoint): Boolean;
  123. begin
  124. result:=(apt1.x<>apt2.x) or (apt1.y<>apt2.y);
  125. end;
  126. class operator TPoint.+ (const apt1, apt2 : TPoint): TPoint;
  127. begin
  128. result.x:=apt1.x+apt2.x;
  129. result.y:=apt1.y+apt2.y;
  130. end;
  131. class operator TPoint.- (const apt1, apt2 : TPoint): TPoint;
  132. begin
  133. result.x:=apt1.x-apt2.x;
  134. result.y:=apt1.y-apt2.y;
  135. end;
  136. // warning suppression for the next ones?
  137. class operator TPoint.:= (const aspt : TSmallPoint): TPoint;
  138. begin
  139. result.x:=aspt.x;
  140. result.y:=aspt.y;
  141. end;
  142. class operator TPoint.Explicit (const apt: TPoint): TSmallPoint;
  143. begin
  144. result.x:=apt.x;
  145. result.y:=apt.y;
  146. end;
  147. { TRect }
  148. class operator TRect. * (L, R: TRect): TRect;
  149. begin
  150. Result := TRect.Intersect(L, R);
  151. end;
  152. class operator TRect. + (L, R: TRect): TRect;
  153. begin
  154. Result := TRect.Union(L, R);
  155. end;
  156. class operator TRect. <> (L, R: TRect): Boolean;
  157. begin
  158. Result := not(L=R);
  159. end;
  160. class operator TRect. = (L, R: TRect): Boolean;
  161. begin
  162. Result :=
  163. (L.Left = R.Left) and (L.Right = R.Right) and
  164. (L.Top = R.Top) and (L.Bottom = R.Bottom);
  165. end;
  166. {$IFDEF VER3_0_0}
  167. class function TRect.Create(ALeft, ATop, ARight, ABottom: Longint): TRect;
  168. begin
  169. Result.Left := ALeft;
  170. Result.Top := ATop;
  171. Result.Right := ARight;
  172. Result.Bottom := ABottom;
  173. end;
  174. class function TRect.Create(P1, P2: TPoint; Normalize: Boolean): TRect;
  175. begin
  176. Result.TopLeft := P1;
  177. Result.BottomRight := P2;
  178. if Normalize then
  179. Result.NormalizeRect;
  180. end;
  181. class function TRect.Create(Origin: TPoint): TRect;
  182. begin
  183. Result.TopLeft := Origin;
  184. Result.BottomRight := Origin;
  185. end;
  186. class function TRect.Create(Origin: TPoint; AWidth, AHeight: Longint): TRect;
  187. begin
  188. Result.TopLeft := Origin;
  189. Result.Width := AWidth;
  190. Result.Height := AHeight;
  191. end;
  192. class function TRect.Create(R: TRect; Normalize: Boolean): TRect;
  193. begin
  194. Result := R;
  195. if Normalize then
  196. Result.NormalizeRect;
  197. end;
  198. {$ELSE}
  199. constructor TRect.Create(ALeft, ATop, ARight, ABottom: Longint);
  200. begin
  201. Left := ALeft;
  202. Top := ATop;
  203. Right := ARight;
  204. Bottom := ABottom;
  205. end;
  206. constructor TRect.Create(P1, P2: TPoint; Normalize: Boolean);
  207. begin
  208. TopLeft := P1;
  209. BottomRight := P2;
  210. if Normalize then
  211. NormalizeRect;
  212. end;
  213. constructor TRect.Create(Origin: TPoint);
  214. begin
  215. TopLeft := Origin;
  216. BottomRight := Origin;
  217. end;
  218. constructor TRect.Create(Origin: TPoint; AWidth, AHeight: Longint);
  219. begin
  220. TopLeft := Origin;
  221. Width := AWidth;
  222. Height := AHeight;
  223. end;
  224. constructor TRect.Create(R: TRect; Normalize: Boolean);
  225. begin
  226. Self := R;
  227. if Normalize then
  228. NormalizeRect;
  229. end;
  230. {$ENDIF}
  231. function TRect.CenterPoint: TPoint;
  232. begin
  233. Result.X := (Right-Left) div 2 + Left;
  234. Result.Y := (Bottom-Top) div 2 + Top;
  235. end;
  236. function TRect.Contains(Pt: TPoint): Boolean;
  237. begin
  238. Result := (Left <= Pt.X) and (Pt.X <= Right) and (Top <= Pt.Y) and (Pt.Y <= Bottom);
  239. end;
  240. function TRect.Contains(R: TRect): Boolean;
  241. begin
  242. Result := (Left <= R.Left) and (R.Right <= Right) and (Top <= R.Top) and (R.Bottom <= Bottom);
  243. end;
  244. class function TRect.Empty: TRect;
  245. begin
  246. Result := TRect.Create(0,0,0,0);
  247. end;
  248. function TRect.getHeight: Longint;
  249. begin
  250. result:=bottom-top;
  251. end;
  252. function TRect.getLocation: TPoint;
  253. begin
  254. result.x:=Left; result.y:=top;
  255. end;
  256. function TRect.getSize: TSize;
  257. begin
  258. result.cx:=width; result.cy:=height;
  259. end;
  260. function TRect.getWidth: Longint;
  261. begin
  262. result:=right-left;
  263. end;
  264. procedure TRect.Inflate(DX, DY: Longint);
  265. begin
  266. InflateRect(Self, DX, DY);
  267. end;
  268. procedure TRect.Intersect(R: TRect);
  269. begin
  270. Self := Intersect(Self, R);
  271. end;
  272. class function TRect.Intersect(R1: TRect; R2: TRect): TRect;
  273. begin
  274. IntersectRect(Result, R1, R2);
  275. end;
  276. function TRect.IntersectsWith(R: TRect): Boolean;
  277. begin
  278. Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom);
  279. end;
  280. function TRect.IsEmpty: Boolean;
  281. begin
  282. Result := (Right <= Left) or (Bottom <= Top);
  283. end;
  284. procedure TRect.NormalizeRect;
  285. var
  286. x: LongInt;
  287. begin
  288. if Top>Bottom then
  289. begin
  290. x := Top;
  291. Top := Bottom;
  292. Bottom := x;
  293. end;
  294. if Left>Right then
  295. begin
  296. x := Left;
  297. Left := Right;
  298. Right := x;
  299. end
  300. end;
  301. procedure TRect.Inflate(DL, DT, DR, DB: Longint);
  302. begin
  303. Dec(Left, DL);
  304. Dec(Top, DT);
  305. Inc(Right, DR);
  306. Inc(Bottom, DB);
  307. end;
  308. procedure TRect.Offset(DX, DY: Longint);
  309. begin
  310. OffsetRect(Self, DX, DY);
  311. end;
  312. procedure TRect.Offset(DP: TPoint);
  313. begin
  314. OffsetRect(Self, DP.X, DP.Y);
  315. end;
  316. procedure TRect.setHeight(AValue: Longint);
  317. begin
  318. bottom:=top+avalue;
  319. end;
  320. procedure TRect.SetLocation(X, Y: Longint);
  321. begin
  322. Offset(X-Left, Y-Top);
  323. end;
  324. procedure TRect.SetLocation(P: TPoint);
  325. begin
  326. SetLocation(P.X, P.Y);
  327. end;
  328. procedure TRect.setSize(AValue: TSize);
  329. begin
  330. bottom:=top+avalue.cy;
  331. right:=left+avalue.cx;
  332. end;
  333. procedure TRect.setWidth(AValue: Longint);
  334. begin
  335. right:=left+avalue;
  336. end;
  337. function TRect.SplitRect(SplitType: TSplitRectType; Percent: Double): TRect;
  338. begin
  339. Result := Self;
  340. case SplitType of
  341. srLeft: Result.Right := Left + Trunc(Percent*Width);
  342. srRight: Result.Left := Right - Trunc(Percent*Width);
  343. srTop: Result.Bottom := Top + Trunc(Percent*Height);
  344. srBottom: Result.Top := Bottom - Trunc(Percent*Height);
  345. end;
  346. end;
  347. function TRect.SplitRect(SplitType: TSplitRectType; ASize: Longint): TRect;
  348. begin
  349. Result := Self;
  350. case SplitType of
  351. srLeft: Result.Right := Left + ASize;
  352. srRight: Result.Left := Right - ASize;
  353. srTop: Result.Bottom := Top + ASize;
  354. srBottom: Result.Top := Bottom - ASize;
  355. end;
  356. end;
  357. class function TRect.Union(const Points: array of TPoint): TRect;
  358. var
  359. i: Integer;
  360. begin
  361. if Length(Points) > 0 then
  362. begin
  363. Result.TopLeft := Points[Low(Points)];
  364. Result.BottomRight := Points[Low(Points)];
  365. for i := Low(Points)+1 to High(Points) do
  366. begin
  367. if Points[i].X < Result.Left then Result.Left := Points[i].X;
  368. if Points[i].X > Result.Right then Result.Right := Points[i].X;
  369. if Points[i].Y < Result.Top then Result.Top := Points[i].Y;
  370. if Points[i].Y > Result.Bottom then Result.Bottom := Points[i].Y;
  371. end;
  372. end else
  373. Result := Empty;
  374. end;
  375. procedure TRect.Union(R: TRect);
  376. begin
  377. Self := Union(Self, R);
  378. end;
  379. class function TRect.Union(R1, R2: TRect): TRect;
  380. begin
  381. UnionRect(Result, R1, R2);
  382. end;