API tools faq
paste
Janilabo

Point Commands [20.07.2013]

Janilabo
Jul 17th, 2013
84
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 97.10 KB | None | 0 0
raw download clone embed print report
  1. [SIZE="0"][url=http://villavu.com/forum/showthread.php?t=82205]String Handling Commands[/url] |[/SIZE] [SIZE="5"][COLOR="red"]Point Commands[/COLOR][/SIZE] [SIZE="0"]| [url=http://villavu.com/forum/showthread.php?t=104649]Box Commands[/url] | [url=http://villavu.com/forum/showthread.php?t=104689]Integer Commands[/url][/SIZE]
  2.  
  3. Time for some point-related commands! :p
  4.  
  5. Added small examples for all commands, just to show how they work (due to missing those code comments), although most of the functions/procedures are pretty much self-explanatory...
  6. Also most (if not all) will have small explanations included aswell.
  7.  
  8. [b]List of [color=blue]Functions[/color] & [color=blue]Procedures[/color]:[/b]
  9.  
  10. [code][u]### / Date Added / Command Name[/u]
  11.  
  12. 000 / 07-14-2013 / PtSetConstraints()
  13. 001 / 07-14-2013 / Angle()
  14. 002 / 07-14-2013 / Distance2()
  15. 003 / 07-14-2013 / OffsetPointEx()
  16. 004 / 07-14-2013 / GetOffsetFromPoints()
  17. 005 / 07-14-2013 / GetPointWithOffset()
  18. 006 / 07-14-2013 / PointSteps()
  19. 007 / 07-14-2013 / GetPointByStep()
  20. 008 / 07-14-2013 / GetTPALine()
  21. 009 / 07-18-2013 / InEllipse()
  22. 010 / 07-18-2013 / InCircle()
  23. 011 / 07-14-2013 / TPAClone()
  24. 012 / 07-14-2013 / TPACopy()
  25. 013 / 07-14-2013 / TPACopyEx()
  26. 014 / 07-14-2013 / TPAAppend()
  27. 015 / 07-14-2013 / TPAAdd()
  28. 016 / 07-14-2013 / TPAInsert()
  29. 017 / 07-14-2013 / TPAPlant()
  30. 018 / 07-14-2013 / TPADelete()
  31. 019 / 07-14-2013 / TPARemove()
  32. 020 / 07-14-2013 / TPAGet()
  33. 021 / 07-14-2013 / TPAPickEx()
  34. 022 / 07-14-2013 / TPAMove()
  35. 023 / 07-14-2013 / TPAReplace()
  36. 024 / 07-14-2013 / TPAReplaceEx()
  37. 025 / 07-14-2013 / TPACreate()
  38. 026 / 07-14-2013 / TPACreateEx()
  39. 027 / 07-14-2013 / TPABuild()
  40. 028 / 07-18-2013 / TPAFromEllipseEx()
  41. 029 / 07-18-2013 / TPAFromCircleEx()
  42. 030 / 07-14-2013 / TPAFill()
  43. 031 / 07-14-2013 / TPAFillEx()
  44. 032 / 07-14-2013 / TPAFillIDs()
  45. 033 / 07-14-2013 / TPAFillIDsEx()
  46. 034 / 07-14-2013 / TPAXValues()
  47. 035 / 07-14-2013 / TPAYValues()
  48. 036 / 07-19-2013 / TPASwapValues()
  49. 037 / 07-14-2013 / TPADensity()
  50. 038 / 07-17-2013 / TPACenter()
  51. 039 / 07-14-2013 / TPAExtractEveryX()
  52. 040 / 07-14-2013 / TPAExtractEveryXEx()
  53. 041 / 07-14-2013 / TPAFilterEveryX()
  54. 042 / 07-14-2013 / TPAFilterEveryXEx()
  55. 043 / 07-15-2013 / TPAExtractBoxes()
  56. 044 / 07-15-2013 / TPAFilterBoxes()
  57. 045 / 07-15-2013 / TPAExtractPoints()
  58. 046 / 07-15-2013 / TPAFilterPoints()
  59. 047 / 07-17-2013 / TPAExtractNearbyPoints()
  60. 048 / 07-17-2013 / TPAExtractNearbyPointsEx()
  61. 049 / 07-17-2013 / TPAFilterNearbyPoints()
  62. 050 / 07-17-2013 / TPAFilterNearbyPointsEx()
  63. 051 / 07-14-2013 / TPASetConstraints()
  64. 052 / 07-19-2013 / TPAUnusedBoxPixels()
  65. 053 / 07-19-2013 / TPAUsedBoxPixells()
  66. 054 / 07-14-2013 / TPAReverse()
  67. 055 / 07-15-2013 / TPAInvert()
  68. 056 / 07-19-2013 / TPAEdge()
  69. 057 / 07-17-2013 / TPARotate()
  70. 058 / 07-19-2013 / TPAOffset()
  71. 059 / 07-19-2013 / TPAOffsetEx()
  72. 060 / 07-14-2013 / TPAUnique()
  73. 061 / 07-20-2013 / TPAUnique2()
  74. 062 / 07-14-2013 / TPAUniqueIDs()
  75. 063 / 07-14-2013 / TPAGrid()
  76. 064 / 07-14-2013 / TPARow()
  77. 065 / 07-14-2013 / TPAColumn()
  78. 066 / 07-14-2013 / TPACombine()
  79. 067 / 07-14-2013 / TPAContains()
  80. 068 / 07-17-2013 / TPAContainsEx()
  81. 069 / 07-17-2013 / TPAContainsTPA()
  82. 070 / 07-14-2013 / TPAPos()
  83. 071 / 07-14-2013 / TPAEmpty()
  84. 072 / 07-15-2013 / TPABounds()
  85. 073 / 07-15-2013 / TPAMean()
  86. 074 / 07-17-2013 / TPASplitEx()
  87. 075 / 07-17-2013 / TPAGroupEx()
  88. 076 / 07-14-2013 / TPAToParts() [*]
  89. 077 / 07-14-2013 / ATPAMerge()
  90. 078 / 07-15-2013 / ATPAEmpty()
  91. 079 / 07-15-2013 / ATPASize()
  92. 080 / 07-15-2013 / ATPAClean()
  93. 081 / 07-17-2013 / ATPABounds()
  94. 082 / 07-17-2013 / ATPAAllBounds()
  95.  
  96. [i]* = Amount of custom types required.[/i][/code]
  97.  
  98. [spoiler="PtSetConstraints"]
  99. [simba]{==============================================================================]
  100. Explanation: Sets point (pt) inside area, if its not inside it.
  101. Returns true if constraints were set to pt.
  102. [==============================================================================}
  103. function PtSetConstraints(var pt: TPoint; area: TBox): Boolean;
  104. var
  105. tmp: TPoint;
  106. begin
  107. if ((area.X1 <= area.X2) and (area.Y1 <= area.Y2)) then
  108. begin
  109. tmp := TPoint(pt);
  110. if (pt.X < area.X1) then
  111. pt.X := Integer(area.X1)
  112. else
  113. if (pt.X > area.X2) then
  114. pt.X := Integer(area.X2);
  115. if (pt.Y < area.Y1) then
  116. pt.Y := Integer(area.Y1)
  117. else
  118. if (pt.Y > area.Y2) then
  119. pt.Y := Integer(area.Y2);
  120. Result := ((pt.X <> tmp.X) or (pt.Y <> tmp.Y));
  121. end else
  122. Result := False;
  123. end;
  124.  
  125. var
  126. pt: TPoint;
  127.  
  128. begin
  129. pt := Point(99, 100);
  130. if PtSetConstraints(pt, IntToBox(10, 10, 99, 99)) then
  131. WriteLn(ToStr(pt));
  132. end.[/simba]
  133. [/spoiler]
  134. [spoiler="Angle"]
  135. [simba]{==============================================================================]
  136. Explanation: Calculates the angle of pt1 and pt2 coordinates.
  137. NOTE: Result is based on COMPASS degrees: http://www.blackknightassociation.com/Images/acirclueis360degrees.jpg
  138. [==============================================================================}
  139. function Angle(pt1, pt2: TPoint): Extended;
  140. begin
  141. Result := ((ArcTan2((pt2.Y - pt1.Y), (pt2.X - pt1.X)) * (180.0 / Pi)) + 90.0);
  142. if (Result < 0.0) then
  143. Result := (Result + 360.0);
  144. end;
  145.  
  146. begin
  147. WriteLn(Angle(Point(15, 10), Point(24, 4)));
  148. end.[/simba]
  149. [/spoiler]
  150. [spoiler="Distance2"]
  151. [simba]{==============================================================================]
  152. Explanation: Returns the exact distance from pt1 to pt2.
  153. [==============================================================================}
  154. function Distance2(pt1, pt2: TPoint): Extended;
  155. begin
  156. if ((pt1.X <> pt2.X) or (pt1.Y <> pt2.Y)) then
  157. Result := Sqrt(Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y))
  158. else
  159. Result := 0.0;
  160. end;
  161.  
  162. begin
  163. WriteLn(Distance2(Point(15, 10), Point(24, 4)));
  164. end.[/simba]
  165. [/spoiler]
  166. [spoiler="OffsetPointEx"]
  167. [simba]{==============================================================================]
  168. Explanation: Offsets pt with radius & angle (degrees).
  169. NOTE: Angle is based on COMPASS degrees: http://www.blackknightassociation.com/Images/acirclueis360degrees.jpg
  170. [==============================================================================}
  171. procedure OffsetPointEx(var pt: TPoint; radius, angle: Extended);
  172. begin
  173. pt := Point(Round(radius * Sin(angle * (Pi / 180)) + pt.X), Round(-radius * Cos(angle * (Pi / 180)) + pt.Y));
  174. end;
  175.  
  176. var
  177. pt: TPoint;
  178.  
  179. begin
  180. pt := Point(15, 10);
  181. OffsetPointEx(pt, 10.8166538263919, 56.3099324740202);
  182. WriteLn(pt);
  183. end.[/simba]
  184. [/spoiler]
  185. [spoiler="GetOffsetFromPoints"]
  186. [simba]{==============================================================================]
  187. Explanation: Stores the offset from pt1 to pt2 to radius and angle (degrees).
  188. NOTE: Angle is based on COMPASS degrees: http://www.blackknightassociation.com/Images/acirclueis360degrees.jpg
  189. [==============================================================================}
  190. procedure GetOffsetFromPoints(pt1, pt2: TPoint; var radius, angle: Extended);
  191. var
  192. X, Y: Integer;
  193. begin
  194. X := (pt2.X - pt1.X);
  195. Y := (pt2.Y - pt1.Y);
  196. radius := Sqrt(Pow(X, 2) + Pow(Y, 2));
  197. angle := ((ArcTan2(Y, X) * (180 / Pi)) + 90.0);
  198. if (angle < 0.0) then
  199. angle := (angle + 360.0);
  200. end;
  201.  
  202. var
  203. r, a: Extended;
  204.  
  205. begin
  206. GetOffsetFromPoints(Point(15, 10), Point(24, 4), r, a);
  207. WriteLn('Radius: ' + FloatToStr(r) + ', Angle: ' + FloatToStr(a));
  208. end.[/simba]
  209. [/spoiler]
  210. [spoiler="GetPointWithOffset"]
  211. [simba]{==============================================================================]
  212. Explanation: Returns the point with radius and angle offset from startPt.
  213. NOTE: Angle is based on COMPASS degrees: http://www.blackknightassociation.com/Images/acirclueis360degrees.jpg
  214. [==============================================================================}
  215. function GetPointWithOffset(startPt: TPoint; radius, angle: Extended): TPoint;
  216. begin
  217. Result := Point(Round(radius * Sin(angle * (Pi / 180)) + startPt.X), Round(-radius * Cos(angle * (Pi / 180)) + startPt.Y));
  218. end;
  219.  
  220. begin
  221. WriteLn(GetPointWithOffset(Point(15, 10), 10.8166538263919, 56.3099324740202));
  222. end.[/simba]
  223. [/spoiler]
  224. [spoiler="PointSteps"]
  225. [simba]{==============================================================================]
  226. Explanation: Returns the amount of point steps there is fromPt => toPt.
  227. [==============================================================================}
  228. function PointSteps(fromPt, toPt: TPoint): Integer;
  229. begin
  230. if ((fromPt.X <> toPt.X) or (fromPt.Y <> toPt.Y)) then
  231. Result := Max((Max(fromPt.X, toPt.X) - Min(fromPt.X, toPt.X)), (Max(fromPt.Y, toPt.Y) - Min(fromPt.Y, toPt.Y)))
  232. else
  233. Result := 0;
  234. end;
  235.  
  236. var
  237. a, b: TPoint;
  238.  
  239. begin
  240. a := Point(15, 10);
  241. b := Point(24, 4);
  242. WriteLn('Count of steps from ' + ToStr(a) + ' to ' + ToStr(b) + ': ' + ToStr(PointSteps(a, b)));
  243. end.[/simba]
  244. [/spoiler]
  245. [spoiler="GetPointByStep"]
  246. [simba]{==============================================================================]
  247. Explanation: Returns the point with step fromPt => toPt.
  248. [==============================================================================}
  249. function GetPointByStep(fromPt, toPt: TPoint; step: Integer): TPoint;
  250. var
  251. e: Extended;
  252. p: TPoint;
  253. begin
  254. if not (((fromPt.X = toPt.X) and (fromPt.Y = toPt.Y)) or (step < 0) or (step > Max((Max(fromPt.X, toPt.X) - Min(fromPt.X, toPt.X)), (Max(fromPt.Y, toPt.Y) - Min(fromPt.Y, toPt.Y))))) then
  255. begin
  256. e := (step / MaxE(Round(Abs(fromPt.X - toPt.X)), Round(Abs(fromPt.Y - toPt.Y))));
  257. Result.X := (fromPt.X + Round((toPt.X - fromPt.X) * e));
  258. Result.Y := (fromPt.Y + Round((toPt.Y - fromPt.Y) * e));
  259. end else
  260. Result := p;
  261. end;
  262.  
  263. var
  264. pt1, pt2: TPoint;
  265. step: Integer;
  266.  
  267. begin
  268. ClearDebug;
  269. pt1 := Point(15, 10);
  270. pt2 := Point(24, 4);
  271. for step := 0 to 9 do
  272. WriteLn(GetPointByStep(pt1, pt2, step));
  273. end.[/simba]
  274. [/spoiler]
  275. [spoiler="GetTPALine"]
  276. [simba]{==============================================================================]
  277. Explanation: Returns the line of points fromPt => toPt.
  278. [==============================================================================}
  279. function GetTPALine(fromPt, toPt: TPoint): TPointArray;
  280. var
  281. i, h: integer;
  282. begin
  283. if ((fromPt.X <> toPt.X) or (fromPt.Y <> toPt.Y)) then
  284. begin
  285. h := Max(Round(Abs(fromPt.X - toPt.X)), Round(Abs(fromPt.Y - toPt.Y)));
  286. SetLength(Result, (h + 1));
  287. for i := 0 to h do
  288. Result[i] := Point((fromPt.X + Round((toPt.X - fromPt.X) * (Extended(i) / h))), (fromPt.Y + Round((toPt.Y - fromPt.Y) * (Extended(i) / h))));
  289. end else
  290. Result := [fromPt];
  291. end;
  292.  
  293. var
  294. pt1, pt2: TPoint;
  295. TPA: TPointArray;
  296. h, i: Integer;
  297.  
  298. begin
  299. ClearDebug;
  300. pt1 := Point(15, 10);
  301. pt2 := Point(24, 4);
  302. WriteLn('GetTPALine:');
  303. TPA := GetTPALine(pt1, pt2);
  304. h := High(TPA);
  305. for i := 0 to h do
  306. WriteLn('TPA[' + IntToStr(i) + ']: ' + IntToStr(TPA[i].X) + ', ' + IntToStr(TPA[i].Y));
  307. SetLength(TPA, 0);
  308. end.[/simba]
  309. [/spoiler]
  310. [spoiler="InEllipse"]
  311. [simba]{==============================================================================]
  312. Explanation: Returns true if pt is inside the given ellipse,
  313. defined by the center point and radius.
  314. [==============================================================================}
  315. function InEllipse(pt, center: TPoint; XRadius, YRadius: Extended): Boolean;
  316. begin
  317. Result := (Sqr((pt.X - center.X) / XRadius) + Sqr((pt.Y - center.Y) / YRadius) <= 1);
  318. end;
  319.  
  320. var
  321. x: Integer;
  322.  
  323. begin
  324. ClearDebug;
  325. for x := 20 to 26 do
  326. if InEllipse(Point(x, 20), Point(30, 20), 7, 12) then
  327. WriteLn('Point(' + IntToStr(x) + ', 20) is inside ellipse!')
  328. else
  329. WriteLn('Point(' + IntToStr(x) + ', 20) is not inside ellipse...')
  330. end.[/simba]
  331. [/spoiler]
  332. [spoiler="InCircle"]
  333. [simba]{==============================================================================]
  334. Explanation: Returns true if pt is inside the given circle,
  335. defined by the center point and radius.
  336. [==============================================================================}
  337. function InCircle(pt, center: TPoint; radius: Extended): Boolean;
  338. begin
  339. Result := (Sqr((pt.X - center.X) / radius) + Sqr((pt.Y - center.Y) / radius) <= 1);
  340. end;
  341.  
  342. var
  343. x: Integer;
  344.  
  345. begin
  346. ClearDebug;
  347. for x := 20 to 26 do
  348. if InCircle(Point(x, 20), Point(30, 20), 7) then
  349. WriteLn('Point(' + IntToStr(x) + ', 20) is inside circle!')
  350. else
  351. WriteLn('Point(' + IntToStr(x) + ', 20) is not inside circle...')
  352. end.[/simba]
  353. [/spoiler]
  354. [spoiler="TPAClone"]
  355. [simba]{==============================================================================]
  356. Explanation: Returns copy ("clone") of TPA safely
  357. [==============================================================================}
  358. function TPAClone(TPA: TPointArray): TPointArray;
  359. var
  360. i, l: Integer;
  361. begin
  362. l := Length(TPA);
  363. SetLength(Result, l);
  364. for i := 0 to (l - 1) do
  365. Result[i] := TPoint(TPA[i]);
  366. end;
  367.  
  368. var
  369. TPA: TPointArray;
  370. i: Integer;
  371.  
  372. begin
  373. ClearDebug;
  374. TPA := [Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)];
  375. WriteLn(TPAClone(TPA));
  376. end.[/simba]
  377. [/spoiler]
  378. [spoiler="TPACopy"]
  379. [simba]{==============================================================================]
  380. Explanation: Version of Copy() function for TPointArrays.
  381. [==============================================================================}
  382. function TPACopy(TPA: TPointArray; startIndex, count: Integer): TPointArray;
  383. var
  384. i, l, t: Integer;
  385. begin
  386. l := Length(TPA);
  387. if (startIndex < 0) then
  388. startIndex := 0;
  389. if ((l >= startIndex) and (count > 0)) then
  390. begin
  391. t := (l - startIndex);
  392. if (count > t) then
  393. count := t;
  394. SetLength(Result, count);
  395. for i := startIndex to ((startIndex + count) - 1) do
  396. Result[(i - startIndex)] := TPoint(TPA[i]);
  397. end else
  398. SetLength(Result, 0);
  399. end;
  400.  
  401. var
  402. TPA: TPointArray;
  403.  
  404. begin
  405. TPA := [Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)];
  406. WriteLn(ToStr(TPACopy(TPA, 1, 3)));
  407. end.[/simba]
  408. [/spoiler]
  409. [spoiler="TPACopyEx"]
  410. [simba]{==============================================================================]
  411. Explanation: Copies TPA from pos1 to pos2. Reverse copies with pos1>pos2 (flexible!).
  412. [==============================================================================}
  413. function TPACopyEx(TPA: TPointArray; pos1, pos2: Integer): TPointArray;
  414. var
  415. i, l: Integer;
  416. begin
  417. l := Length(TPA);
  418. if (l > 0) then
  419. begin
  420. if (pos1 < 0) then
  421. pos1 := 0;
  422. if (pos1 > (l - 1)) then
  423. pos1 := (l - 1);
  424. if (pos2 < 0) then
  425. pos2 := 0;
  426. if (pos2 > (l - 1)) then
  427. pos2 := (l - 1);
  428. if (pos1 <> pos2) then
  429. begin
  430. {$IFNDEF Lape}
  431. SetLength(Result, (iAbs(pos1 - pos2) + 1));
  432. {$ELSE}
  433. SetLength(Result, Integer(Abs(pos1 - pos2) + 1));
  434. {$ENDIF}
  435. if (pos1 < pos2) then
  436. begin
  437. for i := pos1 to pos2 do
  438. Result[(i - pos1)] := TPoint(TPA[i]);
  439. end else
  440. for i := pos1 downto pos2 do
  441. Result[(pos1 - i)] := TPoint(TPA[i]);
  442. end else
  443. Result := [TPoint(TPA[pos1])];
  444. end else
  445. SetLength(Result, 0);
  446. end;
  447.  
  448. var
  449. TPA: TPointArray;
  450.  
  451. begin
  452. ClearDebug;
  453. TPA := [Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)];
  454. WriteLn(ToStr(TPACopyEx(TPA, 1, 3)));
  455. WriteLn(ToStr(TPACopyEx(TPA, 3, 1)));
  456. end.[/simba]
  457. [/spoiler]
  458. [spoiler="TPAAppend"]
  459. [simba]{==============================================================================]
  460. Explanation: Appends TPA with x.
  461. [==============================================================================}
  462. procedure TPAAppend(var TPA: TPointArray; x: TPoint);
  463. var
  464. aL: Integer;
  465. begin
  466. aL := (Length(TPA) + 1);
  467. SetLength(TPA, aL);
  468. TPA[(aL - 1)] := TPoint(x);
  469. end;
  470.  
  471. var
  472. TPA: TPointArray;
  473.  
  474. begin
  475. ClearDebug;
  476. TPA := [Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7)];
  477. TPAAppend(TPA, Point(8, 9));
  478. WriteLn(ToStr(TPA));
  479. end.[/simba]
  480. [/spoiler]
  481. [spoiler="TPAAdd"]
  482. [simba]{==============================================================================]
  483. Explanation: Adds all addTPA items to TPA. Returns the highest index in the end.
  484. [==============================================================================}
  485. function TPAAdd(var TPA: TPointArray; addTPA: TPointArray): Integer;
  486. var
  487. h, l, i: Integer;
  488. begin
  489. h := High(addTPA);
  490. if (h > -1) then
  491. begin
  492. l := Length(TPA);
  493. SetLength(TPA, (l + (h + 1)));
  494. for i := 0 to h do
  495. TPA[(i + l)] := TPoint(addTPA[i]);
  496. end;
  497. Result := High(TPA);
  498. end;
  499.  
  500. var
  501. TPA: TPointArray;
  502.  
  503. begin
  504. ClearDebug;
  505. TPA := [Point(0, 1), Point(2, 3)];
  506. TPAAdd(TPA, [Point(4, 5), Point(6, 7), Point(8, 9)]);
  507. WriteLn(ToStr(TPA));
  508. end.[/simba]
  509. [/spoiler]
  510. [spoiler="TPAInsert"]
  511. [simba]{==============================================================================]
  512. Explanation: Inserts pt to index position in TPA.
  513. [==============================================================================}
  514. procedure TPAInsert(var TPA: TPointArray; index: Integer; pt: TPoint);
  515. var
  516. i, l: Integer;
  517. begin
  518. l := Length(TPA);
  519. SetLength(TPA, (l + 1));
  520. if (index < 0) then
  521. index := 0;
  522. if (index > l) then
  523. index := l;
  524. if (l > index) then
  525. for i := (l - 1) downto index do
  526. TPA[(i + 1)] := TPoint(TPA[i]);
  527. TPA[index] := TPoint(pt);
  528. end;
  529.  
  530. var
  531. TPA: TPointArray;
  532.  
  533. begin
  534. ClearDebug;
  535. TPA := [Point(0, 1), Point(2, 3), Point(6, 7), Point(8, 9)];
  536. TPAInsert(TPA, 2, Point(4, 5));
  537. WriteLn(ToStr(TPA));
  538. end.[/simba]
  539. [/spoiler]
  540. [spoiler="TPAPlant"]
  541. [simba]{==============================================================================]
  542. Explanation: Plants/places pts to index position in TPA.
  543. Like TPAInsert(), with an exception that this inserts array of points.
  544. Returns the highest index from TPA in the end.
  545. [==============================================================================}
  546. function TPAPlant(var TPA: TPointArray; index: Integer; pts: TPointArray): Integer;
  547. var
  548. i, l, h: Integer;
  549. begin
  550. h := High(pts);
  551. if (h > -1) then
  552. begin
  553. l := Length(TPA);
  554. SetLength(TPA, (l + (h + 1)));
  555. if (index < 0) then
  556. index := 0;
  557. if (index > l) then
  558. index := l;
  559. for i := (l + (h + 1) - 1) downto (index + (h + 1)) do
  560. TPA[i] := TPA[(i - (h + 1))];
  561. for i := 0 to h do
  562. TPA[(i + index)] := TPoint(pts[i]);
  563. end;
  564. Result := High(TPA);
  565. end;
  566.  
  567. var
  568. TPA: TPointArray;
  569.  
  570. begin
  571. TPA := [Point(0, 1), Point(8, 9)];
  572. TPAPlant(TPA, 1, [Point(2, 3), Point(4, 5), Point(6, 7)]);
  573. WriteLn(ToStr(TPA));
  574. end.[/simba]
  575. [/spoiler]
  576. [spoiler="TPADelete"]
  577. [simba]{==============================================================================]
  578. Explanation: Deletes a point from TPA, x = index. Returns true with success.
  579. [==============================================================================}
  580. function TPADelete(var TPA: TPointArray; x: Integer): Boolean;
  581. var
  582. i, h: Integer;
  583. begin
  584. h := High(TPA);
  585. Result := ((x <= h) and (x > -1));
  586. if not Result then
  587. Exit;
  588. for i := x to (h - 1) do
  589. TPA[i] := TPA[(i + 1)];
  590. SetLength(TPA, h);
  591. end;
  592.  
  593. var
  594. TPA: TPointArray;
  595.  
  596. begin
  597. TPA := [Point(0, 1), Point(2, 3), Point(1000, 1000), Point(4, 5), Point(6, 7), Point(8, 9)];
  598. if TPADelete(TPA, 2) then
  599. WriteLn(ToStr(TPA));
  600. end.[/simba]
  601. [/spoiler]
  602. [spoiler="TPARemove"]
  603. [simba]{==============================================================================]
  604. Explanation: Removes points from TPA, x = array of indexes.
  605. NOTE: RECURSIVE/DYNAMIC! Pay attention to IDs.. In most cases you'll need to use reversed order.
  606. Also, being dynamic means that this doesn't pay attention to duplicate indexes in x,
  607. so this will delete any of those duplicate IDs then multiple times, when it is possible!
  608. [==============================================================================}
  609. procedure TPARemove(var TPA: TPointArray; x: TIntegerArray);
  610. var
  611. i, i2, h, h2: Integer;
  612. begin
  613. h := High(TPA);
  614. h2 := High(x);
  615. if ((h < 0) or (h2 < 0)) then
  616. Exit;
  617. for i2 := 0 to h2 do
  618. if ((x[i2] <= h) and (x[i2] > -1)) then
  619. begin
  620. for i := x[i2] to (h - 1) do
  621. TPA[i] := TPA[(i + 1)];
  622. Dec(h);
  623. end;
  624. SetLength(TPA, (h + 1));
  625. end;
  626.  
  627. var
  628. TPA: TPointArray;
  629.  
  630. begin
  631. ClearDebug;
  632. TPA := [Point(6, 9), Point(0, 1), Point(6, 9), Point(2, 3), Point(4, 5), Point(6, 9), Point(6, 9), Point(6, 7), Point(6, 9), Point(8, 9)];
  633. TPARemove(TPA, [0, 2, 5, 6, 8]);
  634. WriteLn(ToStr(TPA) + ' [Without reversed order]');
  635. SetLength(TPA, 0);
  636. TPA := [Point(6, 9), Point(0, 1), Point(6, 9), Point(2, 3), Point(4, 5), Point(6, 9), Point(6, 9), Point(6, 7), Point(6, 9), Point(8, 9)];
  637. TPARemove(TPA, [8, 6, 5, 2, 0]);
  638. WriteLn(ToStr(TPA) + ' [With reversed order]');
  639. SetLength(TPA, 0);
  640. end.[/simba]
  641. [/spoiler]
  642. [spoiler="TPAGet"]
  643. [simba]{==============================================================================]
  644. Explanation: Returns array of items from TPA by IDs. Ignores invalid ID's.
  645. [==============================================================================}
  646. function TPAGet(TPA: TPointArray; IDs: TIntegerArray): TPointArray;
  647. var
  648. i, h, h2, r: Integer;
  649. begin
  650. h := High(TPA);
  651. h2 := High(IDs);
  652. if ((h2 > -1) and (h > -1)) then
  653. begin
  654. SetLength(Result, (h2 + 1));
  655. for i := 0 to h2 do
  656. if ((IDs[i] <= h) and (IDs[i] > -1)) then
  657. begin
  658. Result[r] := TPoint(TPA[IDs[i]]);
  659. Inc(r);
  660. end;
  661. end;
  662. SetLength(Result, r);
  663. end;
  664.  
  665. var
  666. TPA: TPointArray;
  667. i: Integer;
  668.  
  669. begin
  670. ClearDebug;
  671. TPA := [Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)];
  672. WriteLn(TPAGet(TPA, [-999, 0, 2, 4, 3, 1, 0, -999]));
  673. end.[/simba]
  674. [/spoiler]
  675. [spoiler="TPAPickEx"]
  676. [simba]{==============================================================================]
  677. Explanation: Returns points (by pick_IDs) from TPA and then deletes em.
  678. NOTE: Ignores invalid indexes. DYNAMIC (so place indexes in reversed order to get em correctly)!
  679. [==============================================================================}
  680. function TPAPickEx(var TPA: TPointArray; pick_IDs: TIntegerArray): TPointArray;
  681. var
  682. h, h2, t, i, r: Integer;
  683. begin
  684. h2 := High(TPA);
  685. h := High(pick_IDs);
  686. if ((h2 > -1) and (h > -1)) then
  687. begin
  688. SetLength(Result, (h2 + 1));
  689. for i := 0 to h do
  690. if ((pick_IDs[i] <= h2) and (pick_IDs[i] > -1)) then
  691. begin
  692. Result[r] := TPoint(TPA[pick_IDs[i]]);
  693. Inc(r);
  694. for t := pick_IDs[i] to (h2 - 1) do
  695. TPA[t] := TPA[(t + 1)];
  696. SetLength(TPA, h2);
  697. Dec(h2);
  698. if (h2 < 0) then
  699. Break;
  700. end;
  701. SetLength(Result, r);
  702. end else
  703. SetLength(Result, 0);
  704. end;
  705.  
  706. var
  707. TPA, TPA2: TPointArray;
  708.  
  709. begin
  710. ClearDebug;
  711. TPAFromBoxWrap(IntToBox(0, 0, 2, 2), TPA);
  712. WriteLn('TPA (Before picking): ' + ToStr(TPA));
  713. TPA2 := TPAPickEx(TPA, [8, 6, 4, 2, 0]);
  714. WriteLn('TPA (After picking): ' + ToStr(TPA));
  715. WriteLn('TPA2 (Picked points): ' + ToStr(TPA2));
  716. SetLength(TPA, 0);
  717. SetLength(TPA2, 0);
  718. end.[/simba]
  719. [/spoiler]
  720. [spoiler="TPAMove"]
  721. [simba]{==============================================================================]
  722. Explanation: Moves oldIndex to newIndex in TPA. Returns true, if movement was succesfully done!
  723. [==============================================================================}
  724. function TPAMove(var TPA: TPointArray; oldIndex, newIndex: Integer): Boolean;
  725. var
  726. h, i: Integer;
  727. begin
  728. h := High(TPA);
  729. Result := ((h > 0) and (oldIndex <> newIndex) and InRange(oldIndex, 0, h) and InRange(newIndex, 0, h));
  730. if Result then
  731. if (oldIndex > newIndex) then
  732. begin
  733. for i := oldIndex downto (newIndex + 1) do
  734. Swap(TPA[i], TPA[(i - 1)]);
  735. end else
  736. for i := oldIndex to (newIndex - 1) do
  737. Swap(TPA[i], TPA[(i + 1)]);
  738. end;
  739.  
  740. var
  741. TPA: TPointArray;
  742.  
  743. begin
  744. ClearDebug;
  745. TPA := [Point(0, 1), Point(6, 7), Point(2, 3), Point(4, 5), Point(8, 9)];
  746. TPAMove(TPA, 1, 3);
  747. WriteLn(ToStr(TPA));
  748. end.[/simba]
  749. [/spoiler]
  750. [spoiler="TPAReplace"]
  751. [simba]{==============================================================================]
  752. Explanation: Replaces all oldPoint's in TPA with newPoint.
  753. [==============================================================================}
  754. procedure TPAReplace(var TPA: TPointArray; oldPoint, newPoint: TPoint);
  755. var
  756. h, i: Integer;
  757. begin
  758. if ((oldPoint.X <> newPoint.X) and (oldPoint.Y <> newPoint.Y)) then
  759. begin
  760. h := High(TPA);
  761. for i := 0 to h do
  762. if ((TPA[i].X = oldPoint.X) and (TPA[i].Y = oldPoint.Y)) then
  763. TPA[i] := TPoint(newPoint);
  764. end;
  765. end;
  766.  
  767. var
  768. TPA: TPointArray;
  769.  
  770. begin
  771. SetLength(TPA, 10);
  772. TPA[0] := Point(0, 1);
  773. TPA[1] := Point(1, 0);
  774. TPA[2] := Point(1, 1);
  775. TPAReplace(TPA, Point(0, 0), Point(9, 9));
  776. WriteLn(ToStr(TPA));
  777. end.[/simba]
  778. [/spoiler]
  779. [spoiler="TPAReplaceEx"]
  780. [simba]{==============================================================================]
  781. Explanation: Replaces all oldPoints' in TPA with newPoint.
  782. [==============================================================================}
  783. procedure TPAReplaceEx(var TPA: TPointArray; oldPoints: TPointArray; newPoint: TPoint);
  784. var
  785. a, b, x, y: Integer;
  786. begin
  787. y := High(oldPoints);
  788. if (y > -1) then
  789. begin
  790. b := High(TPA);
  791. for a := 0 to b do
  792. for x := 0 to y do
  793. if ((TPA[a].X = oldPoints[x].X) and (TPA[a].Y = oldPoints[x].Y)) then
  794. begin
  795. TPA[a] := TPoint(newPoint);
  796. Break;
  797. end;
  798. end;
  799. end;
  800.  
  801. var
  802. TPA: TPointArray;
  803.  
  804. begin
  805. SetLength(TPA, 10);
  806. TPA[0] := Point(1, 1);
  807. TPA[2] := Point(1, 1);
  808. TPA[4] := Point(2, 2);
  809. TPA[5] := Point(2, 2);
  810. TPAReplaceEx(TPA, [Point(0, 0), Point(1, 1)], Point(9, 9));
  811. WriteLn(ToStr(TPA));
  812. end.[/simba]
  813. [/spoiler]
  814. [spoiler="TPACreate"]
  815. [simba]{==============================================================================]
  816. Explanation: Creates TPA with pt (for every index) where size is length of the array.
  817. [==============================================================================}
  818. function TPACreate(pt: TPoint; size: Integer): TPointArray;
  819. var
  820. i: Integer;
  821. begin
  822. if (size > 0) then
  823. begin
  824. SetLength(Result, size);
  825. for i := 0 to (size - 1) do
  826. Result[i] := TPoint(pt);
  827. end else
  828. SetLength(Result, 0);
  829. end;
  830.  
  831. var
  832. TPA: TPointArray;
  833.  
  834. begin
  835. TPA := TPACreate(Point(6, 9), 5);
  836. WriteLn(ToStr(TPA));
  837. end.[/simba]
  838. [/spoiler]
  839. [spoiler="TPACreateEx"]
  840. [simba]{==============================================================================]
  841. Explanation: Creates TPA with pts (for every index) where size is length of the array.
  842. [==============================================================================}
  843. function TPACreateEx(pts: TPointArray; size: Integer): TPointArray;
  844. var
  845. x, y: Integer;
  846. begin
  847. if (size > 0) then
  848. begin
  849. y := Length(pts);
  850. if (y = 0) then
  851. SetLength(Result, 0);
  852. SetLength(Result, size);
  853. if (y > 0) then
  854. for x := 0 to (size - 1) do
  855. Result[x] := TPoint(pts[(x mod y)]);
  856. end else
  857. SetLength(Result, 0);
  858. end;
  859.  
  860. var
  861. TPA: TPointArray;
  862.  
  863. begin
  864. TPA := TPACreateEx([Point(1, 2), Point(3, 4), Point(5, 6)], 10);
  865. WriteLn(ToStr(TPA));
  866. end.[/simba]
  867. [/spoiler]
  868. [spoiler="TPABuild"]
  869. [simba]{==============================================================================]
  870. Explanation: Returns a TPA with xArr and yArr.
  871. If lengths of arrays aren't equal, then this function will use the one with smaller length.
  872. [==============================================================================}
  873. function TPABuild(xArr, yArr: TIntegerArray): TPointArray;
  874. var
  875. i, h: Integer;
  876. begin
  877. h := Min(High(xArr), High(yArr));
  878. SetLength(Result, (h + 1));
  879. for i := 0 to h do
  880. Result[i] := Point(xArr[i], yArr[i]);
  881. end;
  882.  
  883. var
  884. TPA: TPointArray;
  885.  
  886. begin
  887. TPA := TPABuild([10, 15, 20], [5, 10, 15]);
  888. WriteLn(ToStr(TPA));
  889. end.[/simba]
  890. [/spoiler]
  891. [spoiler="TPAFromEllipseEx"]
  892. [simba]{==============================================================================]
  893. Explanation: Generates a TPA containing all coordinates within the given ellipse,
  894. defined by the center point and radius. Coordinates are stored row-by-row.
  895. [==============================================================================}
  896. function TPAFromEllipseEx(center: TPoint; XRadius, YRadius: Extended): TPointArray;
  897. var
  898. r, x, y, rx, ry: Integer;
  899. b: TBox;
  900. begin
  901. if ((XRadius > 0) and (YRadius > 0)) then
  902. begin
  903. rx := Round(XRadius);
  904. ry := Round(YRadius);
  905. b := IntToBox((center.X - rx), (center.Y - ry), (center.X + rx), (center.Y + ry));
  906. SetLength(Result, Integer(((b.X2 - b.X1) + 1) * ((b.Y2 - b.Y1) + 1)));
  907. for y := b.Y1 to b.Y2 do
  908. for x := b.X1 to b.X2 do
  909. if (Sqr((x - center.X) / XRadius) + Sqr((y - center.Y) / YRadius) <= 1) then
  910. begin
  911. Result[r] := Point(x, y);
  912. Inc(r);
  913. end;
  914. end;
  915. SetLength(Result, r);
  916. end;
  917.  
  918. procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
  919. var
  920. a, b, w, h: Integer;
  921. begin
  922. b := High(TPA);
  923. if (b > -1) then
  924. begin
  925. try
  926. GetBitmapSize(bmp, w, h);
  927. except
  928. Exit;
  929. end;
  930. for a := 0 to b do
  931. if ((TPA[a].X > -1) and (TPA[a].Y > -1) and (TPA[a].X < w) and (TPA[a].Y < h)) then
  932. FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  933. end;
  934. end;
  935.  
  936. var
  937. bmp: Integer;
  938.  
  939. begin
  940. bmp := CreateBitmap(500, 500);
  941. SetPixels(bmp, TPAFromEllipseEx(Point(50, 50), 25.5, 20), 255);
  942. SetPixels(bmp, TPAFromEllipseEx(Point(250, 250), 50.5, 50.5), 16711680);
  943. SetPixels(bmp, TPAFromEllipseEx(Point(100, 250), 20.5, 10.5), 32768);
  944. SetPixels(bmp, TPAFromEllipseEx(Point(350, 100), 40.55, 15.444), 65535);
  945. SetPixels(bmp, TPAFromEllipseEx(Point(450, 350), 15, 45), 16777215);
  946. SetPixels(bmp, TPAFromEllipseEx(Point(60, 400), 35, 45), 8421504);
  947. SetPixels(bmp, TPAFromEllipseEx(Point(270, 420), 30, 30), 8388736);
  948. DisplayDebugImgWindow(500, 500);
  949. DrawBitmapDebugImg(bmp);
  950. FreeBitmap(bmp);
  951. end.[/simba]
  952. [/spoiler]
  953. [spoiler="TPAFromCircleEx"]
  954. [simba]{==============================================================================]
  955. Explanation: Generates a TPA containing all coordinates within the given circle,
  956. defined by the center point and radius. Coordinates are stored row-by-row.
  957. [==============================================================================}
  958. function TPAFromCircleEx(center: TPoint; radius: Extended): TPointArray;
  959. var
  960. r, x, y, v: Integer;
  961. b: TBox;
  962. begin
  963. if (radius > 0) then
  964. begin
  965. v := Round(radius);
  966. b := IntToBox((center.X - v), (center.Y - v), (center.X + v), (center.Y + v));
  967. SetLength(Result, Integer(((b.X2 - b.X1) + 1) * ((b.Y2 - b.Y1) + 1)));
  968. for y := b.Y1 to b.Y2 do
  969. for x := b.X1 to b.X2 do
  970. if (Sqr((x - center.X) / radius) + Sqr((y - center.Y) / radius) <= 1) then
  971. begin
  972. Result[r] := Point(x, y);
  973. Inc(r);
  974. end;
  975. end;
  976. SetLength(Result, r);
  977. end;
  978.  
  979. procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
  980. var
  981. a, b, w, h: Integer;
  982. begin
  983. b := High(TPA);
  984. if (b > -1) then
  985. begin
  986. try
  987. GetBitmapSize(bmp, w, h);
  988. except
  989. Exit;
  990. end;
  991. for a := 0 to b do
  992. if ((TPA[a].X > -1) and (TPA[a].Y > -1) and (TPA[a].X < w) and (TPA[a].Y < h)) then
  993. FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  994. end;
  995. end;
  996.  
  997. var
  998. bmp: Integer;
  999.  
  1000. begin
  1001. bmp := CreateBitmap(500, 500);
  1002. SetPixels(bmp, TPAFromCircleEx(Point(50, 50), 25.5), 255);
  1003. SetPixels(bmp, TPAFromCircleEx(Point(250, 250), 50.5), 16711680);
  1004. SetPixels(bmp, TPAFromCircleEx(Point(100, 250), 20.5), 32768);
  1005. SetPixels(bmp, TPAFromCircleEx(Point(350, 100), 30.444), 65535);
  1006. SetPixels(bmp, TPAFromCircleEx(Point(450, 350), 45), 16777215);
  1007. SetPixels(bmp, TPAFromCircleEx(Point(60, 400), 18.12), 8421504);
  1008. SetPixels(bmp, TPAFromCircleEx(Point(270, 420), 30.9), 8388736);
  1009. DisplayDebugImgWindow(500, 500);
  1010. DrawBitmapDebugImg(bmp);
  1011. FreeBitmap(bmp);
  1012. end.[/simba]
  1013. [/spoiler]
  1014. [spoiler="TPAFill"]
  1015. [simba]{==============================================================================]
  1016. Explanation: Fills whole TPA with pt.
  1017. [==============================================================================}
  1018. procedure TPAFill(var TPA: TPointArray; pt: TPoint);
  1019. var
  1020. h, i: Integer;
  1021. begin
  1022. h := High(TPA);
  1023. for i := 0 to h do
  1024. TPA[i] := TPoint(pt);
  1025. end;
  1026.  
  1027. var
  1028. TPA: TPointArray;
  1029.  
  1030. begin
  1031. SetLength(TPA, 10);
  1032. TPAFill(TPA, Point(6, 9));
  1033. WriteLn(ToStr(TPA));
  1034. end.[/simba]
  1035. [/spoiler]
  1036. [spoiler="TPAFillEx"]
  1037. [simba]{==============================================================================]
  1038. Explanation: Fills whole TPA with x.
  1039. [==============================================================================}
  1040. procedure TPAFillEx(var TPA: TPointArray; x: TPointArray);
  1041. var
  1042. i, h, l: Integer;
  1043. begin
  1044. h := High(TPA);
  1045. l := Length(x);
  1046. for i := 0 to h do
  1047. TPA[i] := TPoint(x[(i mod l)]);
  1048. end;
  1049.  
  1050. var
  1051. TPA: TPointArray;
  1052.  
  1053. begin
  1054. SetLength(TPA, 13);
  1055. TPAFillEx(TPA, [Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)]);
  1056. WriteLn(ToStr(TPA));
  1057. end.[/simba]
  1058. [/spoiler]
  1059. [spoiler="TPAFillIDs"]
  1060. [simba]{==============================================================================]
  1061. Explanation: Fills TPA indexes (IDs) with pt.
  1062. [==============================================================================}
  1063. procedure TPAFillIDs(var TPA: TPointArray; IDs: TIntegerArray; pt: TPoint);
  1064. var
  1065. h, l, i: Integer;
  1066. begin
  1067. l := Length(TPA);
  1068. h := High(IDs);
  1069. if ((l > 0) and (h > -1)) then
  1070. for i := 0 to h do
  1071. if ((IDs[i] < l) and (IDs[i] > -1)) then
  1072. TPA[IDs[i]] := TPoint(pt);
  1073. end;
  1074.  
  1075. var
  1076. TPA: TPointArray;
  1077.  
  1078. begin
  1079. SetLength(TPA, 13);
  1080. TPAFillIDs(TPA, [0, 1, 2, 6, 10, 11, 12], Point(6, 9));
  1081. WriteLn(ToStr(TPA));
  1082. end.[/simba]
  1083. [/spoiler]
  1084. [spoiler="TPAFillIDsEx"]
  1085. [simba]{==============================================================================]
  1086. Explanation: Fills TPA indexes (IDs) with pts.
  1087. [==============================================================================}
  1088. procedure TPAFillIDsEx(var TPA: TPointArray; IDs: TIntegerArray; pts: TPointArray);
  1089. var
  1090. h, l, i, m, r: Integer;
  1091. begin
  1092. l := Length(TPA);
  1093. h := High(IDs);
  1094. m := Length(pts);
  1095. if ((l > 0) and (h > -1) and (m > 0)) then
  1096. for i := 0 to h do
  1097. if ((IDs[i] < l) and (IDs[i] > -1)) then
  1098. begin
  1099. TPA[IDs[i]] := TPoint(pts[(r mod m)]);
  1100. Inc(r);
  1101. end;
  1102. end;
  1103.  
  1104. var
  1105. TPA: TPointArray;
  1106.  
  1107. begin
  1108. SetLength(TPA, 13);
  1109. TPAFillIDsEx(TPA, [0, 1, 2, 6, 10, 11, 12], [Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)]);
  1110. WriteLn(ToStr(TPA));
  1111. end.[/simba]
  1112. [/spoiler]
  1113. [spoiler="TPAXValues"]
  1114. [simba]{==============================================================================]
  1115. Explanation: Returns all the x-values of TPA.
  1116. [==============================================================================}
  1117. function TPAXValues(TPA: TPointArray): TIntegerArray;
  1118. var
  1119. h, i: Integer;
  1120. begin
  1121. h := High(TPA);
  1122. SetLength(Result, (h + 1));
  1123. for i := 0 to h do
  1124. Result[i] := Integer(TPA[i].X);
  1125. end;
  1126.  
  1127. begin
  1128. WriteLn(ToStr(TPAXValues(TPAFromBox(IntToBox(1, 1, 3, 3)))));
  1129. end.[/simba]
  1130. [/spoiler]
  1131. [spoiler="TPAYValues"]
  1132. [simba]{==============================================================================]
  1133. Explanation: Returns all the y-values of TPA.
  1134. [==============================================================================}
  1135. function TPAYValues(TPA: TPointArray): TIntegerArray;
  1136. var
  1137. h, i: Integer;
  1138. begin
  1139. h := High(TPA);
  1140. SetLength(Result, (h + 1));
  1141. for i := 0 to h do
  1142. Result[i] := Integer(TPA[i].Y);
  1143. end;
  1144.  
  1145. begin
  1146. WriteLn(ToStr(TPAYValues(TPAFromBox(IntToBox(1, 1, 3, 3)))));
  1147. end.[/simba]
  1148. [/spoiler]
  1149. [spoiler="TPASwapValues"]
  1150. [simba]
  1151. procedure TPASwapValues(var TPA: TPointArray);
  1152. var
  1153. h, i, t: Integer;
  1154. begin
  1155. h := High(TPA);
  1156. for i := 0 to h do
  1157. begin
  1158. t := TPA[i].X;
  1159. TPA[i].X := TPA[i].Y;
  1160. TPA[i].Y := t;
  1161. end;
  1162. end;
  1163.  
  1164. procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
  1165. var
  1166. a, b, w, h: Integer;
  1167. begin
  1168. b := High(TPA);
  1169. if (b > -1) then
  1170. begin
  1171. try
  1172. GetBitmapSize(bmp, w, h);
  1173. except
  1174. Exit;
  1175. end;
  1176. for a := 0 to b do
  1177. if ((TPA[a].X > -1) and (TPA[a].Y > -1) and (TPA[a].X < w) and (TPA[a].Y < h)) then
  1178. FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  1179. end;
  1180. end;
  1181.  
  1182. {==============================================================================]
  1183. Explanation: Returns the line of points fromPt => toPt.
  1184. [==============================================================================}
  1185. function GetTPALine(fromPt, toPt: TPoint): TPointArray;
  1186. var
  1187. i, h: integer;
  1188. begin
  1189. if ((fromPt.X <> toPt.X) or (fromPt.Y <> toPt.Y)) then
  1190. begin
  1191. h := Max(Round(Abs(fromPt.X - toPt.X)), Round(Abs(fromPt.Y - toPt.Y)));
  1192. SetLength(Result, (h + 1));
  1193. for i := 0 to h do
  1194. Result[i] := Point((fromPt.X + Round((toPt.X - fromPt.X) * (Extended(i) / h))), (fromPt.Y + Round((toPt.Y - fromPt.Y) * (Extended(i) / h))));
  1195. end else
  1196. Result := [fromPt];
  1197. end;
  1198.  
  1199. var
  1200. i, l: Integer;
  1201. bmp: Integer;
  1202. TPA: TPointArray;
  1203.  
  1204. begin
  1205. bmp := CreateBitmap(500, 500);
  1206. DisplayDebugImgWindow(500, 500);
  1207. TPA := GetTPALine(Point(200, 200), Point(250, 300));
  1208. SetPixels(bmp, TPA, clBlue);
  1209. TPASwapValues(TPA);
  1210. SetPixels(bmp, TPA, clRed);
  1211. DrawBitmapDebugImg(bmp);
  1212. FreeBitmap(bmp);
  1213. end.[/simba]
  1214. [/spoiler]
  1215. [spoiler="TPADensity"]
  1216. [simba]{==============================================================================]
  1217. Explanation: Returns the calculated density from given TPA.
  1218. [==============================================================================}
  1219. function TPADensity(TPA: TPointArray): Extended;
  1220. var
  1221. h, l, i, d, x, y: Integer;
  1222. b: TBox;
  1223. begin
  1224. h := High(TPA);
  1225. if (h > -1) then
  1226. begin
  1227. b := IntToBox(TPA[0].X, TPA[0].Y, TPA[0].X, TPA[0].Y);
  1228. if (h > 0) then
  1229. for i := (h - d) downto 1 do
  1230. begin
  1231. if (TPA[i].X < b.X1) then
  1232. b.X1 := TPA[i].X
  1233. else
  1234. if (TPA[i].X > b.X2) then
  1235. b.X2 := TPA[i].X;
  1236. if (TPA[i].Y < b.Y1) then
  1237. b.Y1 := TPA[i].Y
  1238. else
  1239. if (TPA[i].Y > b.Y2) then
  1240. b.Y2 := TPA[i].Y;
  1241. for x := (i - 1) downto 0 do
  1242. if ((TPA[i].X = TPA[x].X) and (TPA[i].Y = TPA[x].Y)) then
  1243. begin
  1244. l := High(TPA);
  1245. for y := i to (l - 1) do
  1246. TPA[y] := TPA[(y + 1)];
  1247. SetLength(TPA, l);
  1248. Inc(d);
  1249. Break;
  1250. end;
  1251. end;
  1252. Result := (Extended(Length(TPA)) / (((b.X2 - b.X1) + 1) * ((b.Y2 - b.Y1) + 1)));
  1253. end else
  1254. Result := 0;
  1255. end;
  1256.  
  1257. var
  1258. TPA: TPointArray;
  1259. x, y: Integer;
  1260.  
  1261. begin
  1262. ClearDebug;
  1263. for x := 0 to 2 do
  1264. for y := 0 to 2 do
  1265. begin
  1266. AppendTPA(TPA, [Point(x, y)]);
  1267. WriteLn('TPA Density: ' + FloatToStr(TPADensity(TPA)) + ' [' + ToStr(TPA) + ']');
  1268. end;
  1269. end.[/simba]
  1270. [/spoiler]
  1271. [spoiler="TPACenter"]
  1272. [simba]{==============================================================================]
  1273. Explanation: Returns the center point by TPA bounds as TPoint.
  1274. [==============================================================================}
  1275. function TPACenter(TPA: TPointArray): TPoint;
  1276. var
  1277. h, i: Integer;
  1278. b: TBox;
  1279. begin
  1280. h := High(TPA);
  1281. if (h > -1) then
  1282. begin
  1283. b := IntToBox(TPA[0].X, TPA[0].Y, TPA[0].X, TPA[0].Y);
  1284. if (h > 0) then
  1285. for i := 1 to h do
  1286. begin
  1287. if (TPA[i].X < b.X1) then
  1288. b.X1 := TPA[i].X
  1289. else
  1290. if (TPA[i].X > b.X2) then
  1291. b.X2 := TPA[i].X;
  1292. if (TPA[i].Y < b.Y1) then
  1293. b.Y1 := TPA[i].Y
  1294. else
  1295. if (TPA[i].Y > b.Y2) then
  1296. b.Y2 := TPA[i].Y;
  1297. end;
  1298. Result := Point(Round(b.X1 + ((b.X2 - b.X1) div 2)), Round(b.Y1 + ((b.Y2 - b.Y1) div 2)));
  1299. end else
  1300. Result := Point(0, 0);
  1301. end;
  1302.  
  1303. var
  1304. TPA: TPointArray;
  1305.  
  1306. begin
  1307. TPA := [Point(1, 1), Point(3, 5)];
  1308. WriteLn(TPACenter(TPA));
  1309. WriteLn(MiddleTPA(TPA));
  1310. end.[/simba]
  1311. [/spoiler]
  1312. [spoiler="TPAExtractEveryX"]
  1313. [simba]{==============================================================================]
  1314. Explanation: Extracts every X point from TPA.
  1315. [==============================================================================}
  1316. procedure TPAExtractEveryX(var TPA: TPointArray; X: Integer);
  1317. var
  1318. i, h, t: Integer;
  1319. begin
  1320. h := High(TPA);
  1321. if (h > -1) then
  1322. begin
  1323. if (X > 0) then
  1324. for i := 0 to h do
  1325. if ((i mod X) = 0) then
  1326. begin
  1327. TPA[t] := TPA[i];
  1328. Inc(t);
  1329. end;
  1330. SetLength(TPA, t);
  1331. end;
  1332. end;
  1333.  
  1334. var
  1335. TPA, tmp: TPointArray;
  1336. i: Integer;
  1337.  
  1338. begin
  1339. ClearDebug;
  1340. TPA := [Point(0, 0), Point(1, 1), Point(2, 2), Point(3, 3), Point(4, 4),
  1341. Point(5, 5), Point(6, 6), Point(7, 7), Point(8, 8), Point(9, 9)];
  1342. for i := 0 to 11 do
  1343. begin
  1344. tmp := CopyTPA(TPA);
  1345. TPAExtractEveryX(tmp, i);
  1346. WriteLn('TPAExtractEveryX(TPA, ' + IntToStr(i) + '): ' + ToStr(tmp));
  1347. SetLength(tmp, 0);
  1348. end;
  1349. SetLength(TPA, 0);
  1350. end.[/simba]
  1351. [/spoiler]
  1352. [spoiler="TPAExtractEveryXEx"]
  1353. [simba]{==============================================================================]
  1354. Explanation: Extracts every X point from TPA - starting from offset.
  1355. [==============================================================================}
  1356. procedure TPAExtractEveryXEx(var TPA: TPointArray; X, offset: Integer);
  1357. var
  1358. i, h, t: Integer;
  1359. begin
  1360. h := High(TPA);
  1361. if (h > -1) then
  1362. begin
  1363. if ((X > 0) and ((offset > -1) and (offset <= h))) then
  1364. for i := offset to h do
  1365. if (((i - offset) mod X) = 0) then
  1366. begin
  1367. TPA[t] := TPA[i];
  1368. Inc(t);
  1369. end;
  1370. SetLength(TPA, t);
  1371. end;
  1372. end;
  1373.  
  1374. var
  1375. TPA, tmp: TPointArray;
  1376. i: Integer;
  1377.  
  1378. begin
  1379. ClearDebug;
  1380. TPA := [Point(0, 0), Point(1, 1), Point(2, 2), Point(3, 3), Point(4, 4),
  1381. Point(5, 5), Point(6, 6), Point(7, 7), Point(8, 8), Point(9, 9)];
  1382. for i := 0 to 9 do
  1383. begin
  1384. tmp := CopyTPA(TPA);
  1385. TPAExtractEveryXEx(tmp, i, 2);
  1386. WriteLn('TPAExtractEveryX(TPA, ' + IntToStr(i) + ', 2): ' + ToStr(tmp));
  1387. SetLength(tmp, 0);
  1388. end;
  1389. SetLength(TPA, 0);
  1390. end.[/simba]
  1391. [/spoiler]
  1392. [spoiler="TPAFilterEveryX"]
  1393. [simba]{==============================================================================]
  1394. Explanation: Filters every X point from TPA.
  1395. [==============================================================================}
  1396. procedure TPAFilterEveryX(var TPA: TPointArray; X: Integer);
  1397. var
  1398. i, h, t: Integer;
  1399. begin
  1400. h := High(TPA);
  1401. if ((h > -1) and (X > 0)) then
  1402. begin
  1403. for i := 0 to h do
  1404. if ((i mod X) <> 0) then
  1405. begin
  1406. TPA[t] := TPA[i];
  1407. Inc(t);
  1408. end;
  1409. SetLength(TPA, t);
  1410. end;
  1411. end;
  1412.  
  1413. var
  1414. TPA, tmp: TPointArray;
  1415. i: Integer;
  1416.  
  1417. begin
  1418. ClearDebug;
  1419. TPA := [Point(0, 0), Point(1, 1), Point(2, 2), Point(3, 3), Point(4, 4),
  1420. Point(5, 5), Point(6, 6), Point(7, 7), Point(8, 8), Point(9, 9)];
  1421. for i := 0 to 6 do
  1422. begin
  1423. tmp := CopyTPA(TPA);
  1424. TPAFilterEveryX(tmp, i);
  1425. WriteLn('TPAFilterEveryX(TPA, ' + IntToStr(i) + '): ' + ToStr(tmp));
  1426. SetLength(tmp, 0);
  1427. end;
  1428. SetLength(TPA, 0);
  1429. end.[/simba]
  1430. [/spoiler]
  1431. [spoiler="TPAFilterEveryXEx"]
  1432. [simba]{==============================================================================]
  1433. Explanation: Filters every X point from TPA - starting from offset.
  1434. [==============================================================================}
  1435. procedure TPAFilterEveryXEx(var TPA: TPointArray; X, offset: Integer);
  1436. var
  1437. i, h, t: Integer;
  1438. begin
  1439. h := High(TPA);
  1440. if ((h > -1) and (X > 0) and ((offset > -1) and (offset <= h))) then
  1441. begin
  1442. t := offset;
  1443. for i := offset to h do
  1444. if (((i - offset) mod X) <> 0) then
  1445. begin
  1446. TPA[t] := TPA[i];
  1447. Inc(t);
  1448. end;
  1449. SetLength(TPA, t);
  1450. end;
  1451. end;
  1452.  
  1453. var
  1454. TPA, tmp: TPointArray;
  1455. i: Integer;
  1456.  
  1457. begin
  1458. ClearDebug;
  1459. TPA := [Point(0, 0), Point(1, 1), Point(2, 2), Point(3, 3), Point(4, 4),
  1460. Point(5, 5), Point(6, 6), Point(7, 7), Point(8, 8), Point(9, 9)];
  1461. for i := 0 to 9 do
  1462. begin
  1463. tmp := CopyTPA(TPA);
  1464. TPAFilterEveryXEx(tmp, i, 2);
  1465. WriteLn('TPAFilterEveryXEx(TPA, ' + IntToStr(i) + ', 2): ' + ToStr(tmp));
  1466. SetLength(tmp, 0);
  1467. end;
  1468. SetLength(TPA, 0);
  1469. end.[/simba]
  1470. [/spoiler]
  1471. [spoiler="TPAExtractBoxes"]
  1472. [simba]{==============================================================================]
  1473. Explanation: Keeps all points in TPA that are found inside ANY box from boxes.
  1474. [==============================================================================}
  1475. procedure TPAExtractBoxes(var TPA: TPointArray; boxes: TBoxArray);
  1476. var
  1477. a, b, c, x, y: Integer;
  1478. begin
  1479. b := High(TPA);
  1480. y := High(boxes);
  1481. if ((b > -1) and (y > -1)) then
  1482. for a := 0 to b do
  1483. begin
  1484. for x := 0 to y do
  1485. if ((TPA[a].X >= boxes[x].X1) and (TPA[a].Y >= boxes[x].Y1) and (TPA[a].X <= boxes[x].X2) and (TPA[a].Y <= boxes[x].Y2)) then
  1486. Break;
  1487. if (x <= y) then
  1488. begin
  1489. TPA[c] := TPA[a];
  1490. Inc(c);
  1491. end;
  1492. end;
  1493. SetLength(TPA, c);
  1494. end;
  1495.  
  1496. var
  1497. TPA: TPointArray;
  1498. filter: TBoxArray;
  1499. bmp: Integer;
  1500. i, h: Integer;
  1501.  
  1502. begin
  1503. filter := [IntToBox(150, 150, 175, 175), IntToBox(110, 120, 115, 125), IntToBox(100, 100, 103, 103), IntToBox(190, 100, 200, 125)];
  1504. TPA := TPAFromBox(IntToBox(100, 100, 200, 200));
  1505. TPAExtractBoxes(TPA, filter);
  1506. bmp := CreateBitmap(500, 500);
  1507. DisplayDebugImgWindow(500, 500);
  1508. h := High(TPA);
  1509. for i := 0 to h do
  1510. FastSetPixel(bmp, TPA[i].X, TPA[i].Y, 255);
  1511. DrawBitmapDebugImg(bmp);
  1512. end.[/simba]
  1513. [/spoiler]
  1514. [spoiler="TPAFilterBoxes"]
  1515. [simba]{==============================================================================]
  1516. Explanation: Removes all points from TPA that are found inside ANY box from boxes.
  1517. [==============================================================================}
  1518. procedure TPAFilterBoxes(var TPA: TPointArray; boxes: TBoxArray);
  1519. var
  1520. a, b, c, x, y: Integer;
  1521. begin
  1522. b := High(TPA);
  1523. y := High(boxes);
  1524. if ((b > -1) and (y > -1)) then
  1525. for a := 0 to b do
  1526. begin
  1527. for x := 0 to y do
  1528. if ((TPA[a].X >= boxes[x].X1) and (TPA[a].Y >= boxes[x].Y1) and (TPA[a].X <= boxes[x].X2) and (TPA[a].Y <= boxes[x].Y2)) then
  1529. Break;
  1530. if (x > y) then
  1531. begin
  1532. TPA[c] := TPA[a];
  1533. Inc(c);
  1534. end;
  1535. end;
  1536. SetLength(TPA, c);
  1537. end;
  1538.  
  1539. var
  1540. TPA: TPointArray;
  1541. filter: TBoxArray;
  1542. bmp: Integer;
  1543. i, h: Integer;
  1544.  
  1545. begin
  1546. filter := [IntToBox(150, 150, 175, 175), IntToBox(110, 120, 115, 125), IntToBox(100, 100, 103, 103), IntToBox(190, 100, 200, 125)];
  1547. TPA := TPAFromBox(IntToBox(100, 100, 200, 200));
  1548. TPAFilterBoxes(TPA, filter);
  1549. bmp := CreateBitmap(500, 500);
  1550. DisplayDebugImgWindow(500, 500);
  1551. h := High(TPA);
  1552. for i := 0 to h do
  1553. FastSetPixel(bmp, TPA[i].X, TPA[i].Y, 255);
  1554. DrawBitmapDebugImg(bmp);
  1555. end.[/simba]
  1556. [/spoiler]
  1557. [spoiler="TPAExtractPoints"]
  1558. [simba]{==============================================================================]
  1559. Explanation: Keeps all points in TPA that are found in points.
  1560. [==============================================================================}
  1561. procedure TPAExtractPoints(var TPA: TPointArray; points: TPointArray);
  1562. var
  1563. a, b, c, x, y: Integer;
  1564. begin
  1565. b := High(TPA);
  1566. y := High(points);
  1567. if ((b > -1) and (y > -1)) then
  1568. for a := 0 to b do
  1569. begin
  1570. for x := 0 to y do
  1571. if ((TPA[a].X = points[x].X) and (TPA[a].Y = points[x].Y)) then
  1572. Break;
  1573. if (x <= y) then
  1574. begin
  1575. TPA[c] := TPA[a];
  1576. Inc(c);
  1577. end;
  1578. end;
  1579. SetLength(TPA, c);
  1580. end;
  1581.  
  1582. var
  1583. TPA, filter: TPointArray;
  1584. bmp: Integer;
  1585. i, h: Integer;
  1586.  
  1587. begin
  1588. filter := [Point(105, 105), Point(195, 195), Point(105, 195), Point(195, 105)];
  1589. TPA := TPAFromBox(IntToBox(100, 100, 200, 200));
  1590. TPAExtractPoints(TPA, filter);
  1591. bmp := CreateBitmap(500, 500);
  1592. DisplayDebugImgWindow(500, 500);
  1593. h := High(TPA);
  1594. for i := 0 to h do
  1595. FastSetPixel(bmp, TPA[i].X, TPA[i].Y, 16777215);
  1596. DrawBitmapDebugImg(bmp);
  1597. end.[/simba]
  1598. [/spoiler]
  1599. [spoiler="TPAFilterPoints"]
  1600. [simba]{==============================================================================]
  1601. Explanation: Removes all points from TPA that are found in points.
  1602. [==============================================================================}
  1603. procedure TPAFilterPoints(var TPA: TPointArray; points: TPointArray);
  1604. var
  1605. a, b, c, x, y: Integer;
  1606. begin
  1607. b := High(TPA);
  1608. y := High(points);
  1609. if ((b > -1) and (y > -1)) then
  1610. for a := 0 to b do
  1611. begin
  1612. for x := 0 to y do
  1613. if ((TPA[a].X = points[x].X) and (TPA[a].Y = points[x].Y)) then
  1614. Break;
  1615. if (x > y) then
  1616. begin
  1617. TPA[c] := TPA[a];
  1618. Inc(c);
  1619. end;
  1620. end;
  1621. SetLength(TPA, c);
  1622. end;
  1623.  
  1624. var
  1625. TPA, filter: TPointArray;
  1626. bmp: Integer;
  1627. i, h: Integer;
  1628.  
  1629. begin
  1630. filter := [Point(105, 105), Point(195, 195), Point(105, 195), Point(195, 105)];
  1631. TPA := TPAFromBox(IntToBox(100, 100, 200, 200));
  1632. TPAFilterPoints(TPA, filter);
  1633. bmp := CreateBitmap(500, 500);
  1634. DisplayDebugImgWindow(500, 500);
  1635. h := High(TPA);
  1636. for i := 0 to h do
  1637. FastSetPixel(bmp, TPA[i].X, TPA[i].Y, 16777215);
  1638. DrawBitmapDebugImg(bmp);
  1639. end.[/simba]
  1640. [/spoiler]
  1641. [spoiler="TPAExtractNearbyPoints"]
  1642. [simba]{==============================================================================]
  1643. Explanation: Keeps all points in TPA that are within distance from targets.
  1644. [==============================================================================}
  1645. procedure TPAExtractNearbyPoints(var TPA: TPointArray; targets: TPointArray; distance: Extended);
  1646. var
  1647. a, b, c, x, y: Integer;
  1648. begin
  1649. b := High(TPA);
  1650. y := High(targets);
  1651. if ((b > -1) and (y > -1)) then
  1652. for a := 0 to b do
  1653. begin
  1654. for x := 0 to y do
  1655. if (distance >= Sqrt(Sqr(TPA[a].X - targets[x].X) + Sqr(TPA[a].Y - targets[x].Y))) then
  1656. Break;
  1657. if (x <= y) then
  1658. begin
  1659. TPA[c] := TPA[a];
  1660. Inc(c);
  1661. end;
  1662. end;
  1663. SetLength(TPA, c);
  1664. end;
  1665.  
  1666. var
  1667. TPA, nearby: TPointArray;
  1668. bmp: Integer;
  1669. i, h: Integer;
  1670.  
  1671. begin
  1672. nearby := [Point(25, 25), Point(50, 50), Point(75, 75)];
  1673. TPA := TPAFromBox(IntToBox(0, 0, 99, 99));
  1674. TPAExtractNearbyPoints(TPA, nearby, 10);
  1675. WriteLn(ToStr(TPA));
  1676. bmp := CreateBitmap(100, 100);
  1677. DisplayDebugImgWindow(100, 100);
  1678. h := High(TPA);
  1679. for i := 0 to h do
  1680. FastSetPixel(bmp, TPA[i].X, TPA[i].Y, 16777215);
  1681. DrawBitmapDebugImg(bmp);
  1682. end.[/simba]
  1683. [/spoiler]
  1684. [spoiler="TPAExtractNearbyPointsEx"]
  1685. [simba]{==============================================================================]
  1686. Explanation: Keeps all points in TPA that are within distance range (minDistance, maxDistance) from targets.
  1687. [==============================================================================}
  1688. procedure TPAExtractNearbyPointsEx(var TPA: TPointArray; targets: TPointArray; minDistance, maxDistance: Extended);
  1689. var
  1690. a, b, c, x, y: Integer;
  1691. d: Extended;
  1692. begin
  1693. b := High(TPA);
  1694. y := High(targets);
  1695. if ((b > -1) and (y > -1)) then
  1696. begin
  1697. if (minDistance > maxDistance) then
  1698. Swap(minDistance, maxDistance);
  1699. for a := 0 to b do
  1700. begin
  1701. for x := 0 to y do
  1702. begin
  1703. d := Sqrt(Sqr(TPA[a].X - targets[x].X) + Sqr(TPA[a].Y - targets[x].Y));
  1704. if ((d >= minDistance) and (d <= maxDistance)) then
  1705. Break;
  1706. end;
  1707. if (x <= y) then
  1708. begin
  1709. TPA[c] := TPA[a];
  1710. Inc(c);
  1711. end;
  1712. end;
  1713. end;
  1714. SetLength(TPA, c);
  1715. end;
  1716.  
  1717. var
  1718. TPA, nearby: TPointArray;
  1719. bmp: Integer;
  1720. i, h: Integer;
  1721.  
  1722. begin
  1723. nearby := [Point(25, 25), Point(50, 50), Point(75, 75)];
  1724. TPA := TPAFromBox(IntToBox(0, 0, 99, 99));
  1725. TPAExtractNearbyPointsEx(TPA, nearby, 5, 10);
  1726. WriteLn(ToStr(TPA));
  1727. bmp := CreateBitmap(100, 100);
  1728. DisplayDebugImgWindow(100, 100);
  1729. h := High(TPA);
  1730. for i := 0 to h do
  1731. FastSetPixel(bmp, TPA[i].X, TPA[i].Y, 16777215);
  1732. DrawBitmapDebugImg(bmp);
  1733. end.[/simba]
  1734. [/spoiler]
  1735. [spoiler="TPAFilterNearbyPoints"]
  1736. [simba]{==============================================================================]
  1737. Explanation: Removes all points from TPA that are within distance from targets.
  1738. [==============================================================================}
  1739. procedure TPAFilterNearbyPoints(var TPA: TPointArray; targets: TPointArray; distance: Extended);
  1740. var
  1741. a, b, c, x, y: Integer;
  1742. begin
  1743. b := High(TPA);
  1744. y := High(targets);
  1745. if ((b > -1) and (y > -1)) then
  1746. for a := 0 to b do
  1747. begin
  1748. for x := 0 to y do
  1749. if (distance >= Sqrt(Sqr(TPA[a].X - targets[x].X) + Sqr(TPA[a].Y - targets[x].Y))) then
  1750. Break;
  1751. if (x > y) then
  1752. begin
  1753. TPA[c] := TPA[a];
  1754. Inc(c);
  1755. end;
  1756. end;
  1757. SetLength(TPA, c);
  1758. end;
  1759.  
  1760. var
  1761. TPA, nearby: TPointArray;
  1762. bmp: Integer;
  1763. i, h: Integer;
  1764.  
  1765. begin
  1766. nearby := [Point(25, 25), Point(50, 50), Point(75, 75)];
  1767. TPA := TPAFromBox(IntToBox(0, 0, 99, 99));
  1768. TPAFilterNearbyPoints(TPA, nearby, 10);
  1769. WriteLn(ToStr(TPA));
  1770. bmp := CreateBitmap(100, 100);
  1771. DisplayDebugImgWindow(100, 100);
  1772. h := High(TPA);
  1773. for i := 0 to h do
  1774. FastSetPixel(bmp, TPA[i].X, TPA[i].Y, 16777215);
  1775. DrawBitmapDebugImg(bmp);
  1776. end.[/simba]
  1777. [/spoiler]
  1778. [spoiler="TPAFilterNearbyPointsEx"]
  1779. [simba]{==============================================================================]
  1780. Explanation: Removes all points from TPA that are within distance range (minDistance, maxDistance) from targets.
  1781. [==============================================================================}
  1782. procedure TPAFilterNearbyPointsEx(var TPA: TPointArray; targets: TPointArray; minDistance, maxDistance: Extended);
  1783. var
  1784. a, b, c, x, y: Integer;
  1785. d: Extended;
  1786. begin
  1787. b := High(TPA);
  1788. y := High(targets);
  1789. if ((b > -1) and (y > -1)) then
  1790. begin
  1791. if (minDistance > maxDistance) then
  1792. Swap(minDistance, maxDistance);
  1793. for a := 0 to b do
  1794. begin
  1795. for x := 0 to y do
  1796. begin
  1797. d := Sqrt(Sqr(TPA[a].X - targets[x].X) + Sqr(TPA[a].Y - targets[x].Y));
  1798. if ((d >= minDistance) and (d <= maxDistance)) then
  1799. Break;
  1800. end;
  1801. if (x > y) then
  1802. begin
  1803. TPA[c] := TPA[a];
  1804. Inc(c);
  1805. end;
  1806. end;
  1807. end;
  1808. SetLength(TPA, c);
  1809. end;
  1810.  
  1811. var
  1812. TPA, nearby: TPointArray;
  1813. bmp: Integer;
  1814. i, h: Integer;
  1815.  
  1816. begin
  1817. nearby := [Point(25, 25), Point(50, 50), Point(75, 75)];
  1818. TPA := TPAFromBox(IntToBox(0, 0, 99, 99));
  1819. TPAFilterNearbyPointsEx(TPA, nearby, 5, 10);
  1820. WriteLn(ToStr(TPA));
  1821. bmp := CreateBitmap(100, 100);
  1822. DisplayDebugImgWindow(100, 100);
  1823. h := High(TPA);
  1824. for i := 0 to h do
  1825. FastSetPixel(bmp, TPA[i].X, TPA[i].Y, 16777215);
  1826. DrawBitmapDebugImg(bmp);
  1827. end.[/simba]
  1828. [/spoiler]
  1829. [spoiler="TPASetConstraints"]
  1830. [simba]{==============================================================================]
  1831. Explanation: Sets ALL the points from TPA inside a TBox (area), if they are not inside it.
  1832. Returns true if constraints were set to TPA (if any of the points in TPA was changed).
  1833. [==============================================================================}
  1834. function TPASetConstraints(var TPA: TPointArray; area: TBox): Boolean;
  1835. var
  1836. h, i: Integer;
  1837. tmp: TPoint;
  1838. begin
  1839. h := High(TPA);
  1840. Result := False;
  1841. for i := 0 to h do
  1842. begin
  1843. if not Result then
  1844. tmp := TPoint(TPA[i]);
  1845. if (TPA[i].X < area.X1) then
  1846. TPA[i].X := Integer(area.X1)
  1847. else
  1848. if (TPA[i].X > area.X2) then
  1849. TPA[i].X := Integer(area.X2);
  1850. if (TPA[i].Y < area.Y1) then
  1851. TPA[i].Y := Integer(area.Y1)
  1852. else
  1853. if (TPA[i].Y > area.Y2) then
  1854. TPA[i].Y := Integer(area.Y2);
  1855. if (not Result and ((TPA[i].X <> tmp.X) or (TPA[i].Y <> tmp.Y))) then
  1856. Result := True;
  1857. end;
  1858. end;
  1859.  
  1860. var
  1861. TPA: TPointArray;
  1862.  
  1863. begin
  1864. TPA := [Point(9, 10), Point(9, 9), Point(10, 9), Point(50, 50), Point(100, 99), Point(100, 100), Point(99, 100)];
  1865. if TPASetConstraints(TPA, IntToBox(10, 10, 99, 99)) then
  1866. WriteLn(ToStr(TPA));
  1867. end.[/simba]
  1868. [/spoiler]
  1869. [spoiler="TPAUnusedBoxPixels"]
  1870. [simba]{==============================================================================]
  1871. Explanation: Explanation: Returns all the points from box (bx) that aren't used in TPA.
  1872. [==============================================================================}
  1873. function TPAUnusedBoxPixels(TPA: TPointArray; bx: TBox): TPointArray;
  1874. var
  1875. v, x, y, h, r: Integer;
  1876. B: array of TBoolArray;
  1877. begin;
  1878. h := High(TPA);
  1879. if ((h > -1) and ((((bx.X2 - bx.X1) + 1) > 0) and (((bx.Y2 - bx.Y1) + 1) > 0))) then
  1880. begin
  1881. SetLength(B, ((bx.X2 - bx.X1) + 1));
  1882. for v := 0 to (bx.X2 - bx.X1) do
  1883. SetLength(B[v], ((bx.Y2 - bx.Y1) + 1));
  1884. for v := 0 to h do
  1885. if ((TPA[v].X >= bx.X1) and (TPA[v].Y >= bx.Y1) and (TPA[v].X <= bx.X2) and (TPA[v].Y <= bx.Y2)) then
  1886. if not B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] then
  1887. begin
  1888. B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] := True;
  1889. Inc(x);
  1890. end;
  1891. SetLength(Result, ((((bx.X2 - bx.X1) + 1) * ((bx.Y2 - bx.Y1) + 1)) - x));
  1892. if (Length(Result) > 0) then
  1893. for y := 0 to (bx.Y2 - bx.Y1) do
  1894. for x := 0 to (bx.X2 - bx.X1) do
  1895. if not B[x][y] then
  1896. begin
  1897. Result[r].X := (x + bx.X1);
  1898. Result[r].Y := (y + bx.Y1);
  1899. Inc(r);
  1900. end;
  1901. SetLength(B, 0);
  1902. end else
  1903. SetLength(Result, 0);
  1904. end;
  1905.  
  1906. procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
  1907. var
  1908. a, b, w, h: Integer;
  1909. begin
  1910. b := High(TPA);
  1911. if (b > -1) then
  1912. begin
  1913. try
  1914. GetBitmapSize(bmp, w, h);
  1915. except
  1916. Exit;
  1917. end;
  1918. for a := 0 to b do
  1919. if ((TPA[a].X > -1) and (TPA[a].Y > -1) and (TPA[a].X < w) and (TPA[a].Y < h)) then
  1920. FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  1921. end;
  1922. end;
  1923.  
  1924. var
  1925. TPA: TPointArray;
  1926. bmp: Integer;
  1927.  
  1928. begin
  1929. ClearDebug;
  1930. TPA := TPAUnusedBoxPixels(TPAFromBox(IntToBox(0, 0, 40, 40)), IntToBox(25, 25, 75, 75));
  1931. bmp := CreateBitmap(100, 100);
  1932. SetPixels(bmp, TPA, clRed);
  1933. DisplayDebugImgWindow(100, 100);
  1934. DrawBitmapDebugImg(bmp);
  1935. FreeBitmap(bmp);
  1936. end.[/simba]
  1937. [/spoiler]
  1938. [spoiler="TPAUsedBoxPixels"]
  1939. [simba]{==============================================================================]
  1940. Explanation: Returns all the points from box (bx) that aren't used in TPA.
  1941. [==============================================================================}
  1942. function TPAUsedBoxPixels(TPA: TPointArray; bx: TBox): TPointArray;
  1943. var
  1944. v, x, y, h, r: Integer;
  1945. B: array of TBoolArray;
  1946. begin;
  1947. h := High(TPA);
  1948. if ((h > -1) and ((((bx.X2 - bx.X1) + 1) > 0) and (((bx.Y2 - bx.Y1) + 1) > 0))) then
  1949. begin
  1950. SetLength(B, ((bx.X2 - bx.X1) + 1));
  1951. for v := 0 to (bx.X2 - bx.X1) do
  1952. SetLength(B[v], ((bx.Y2 - bx.Y1) + 1));
  1953. for v := 0 to h do
  1954. if ((TPA[v].X >= bx.X1) and (TPA[v].Y >= bx.Y1) and (TPA[v].X <= bx.X2) and (TPA[v].Y <= bx.Y2)) then
  1955. if not B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] then
  1956. begin
  1957. B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] := True;
  1958. Inc(x);
  1959. end;
  1960. if (x > 0) then
  1961. begin
  1962. SetLength(Result, x);
  1963. for y := 0 to (bx.Y2 - bx.Y1) do
  1964. for x := 0 to (bx.X2 - bx.X1) do
  1965. if B[x][y] then
  1966. begin
  1967. Result[r].X := (x + bx.X1);
  1968. Result[r].Y := (y + bx.Y1);
  1969. Inc(r);
  1970. end;
  1971. end;
  1972. SetLength(Result, r);
  1973. SetLength(B, 0);
  1974. end else
  1975. SetLength(Result, 0);
  1976. end;
  1977.  
  1978. procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
  1979. var
  1980. a, b, w, h: Integer;
  1981. begin
  1982. b := High(TPA);
  1983. if (b > -1) then
  1984. begin
  1985. try
  1986. GetBitmapSize(bmp, w, h);
  1987. except
  1988. Exit;
  1989. end;
  1990. for a := 0 to b do
  1991. if ((TPA[a].X > -1) and (TPA[a].Y > -1) and (TPA[a].X < w) and (TPA[a].Y < h)) then
  1992. FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  1993. end;
  1994. end;
  1995.  
  1996. var
  1997. TPA: TPointArray;
  1998. bmp: Integer;
  1999.  
  2000. begin
  2001. ClearDebug;
  2002. TPA := TPAUsedBoxPixels(TPAFromBox(IntToBox(0, 0, 40, 40)), IntToBox(25, 25, 75, 75));
  2003. bmp := CreateBitmap(100, 100);
  2004. SetPixels(bmp, TPA, 255);
  2005. DisplayDebugImgWindow(100, 100);
  2006. DrawBitmapDebugImg(bmp);
  2007. FreeBitmap(bmp);
  2008. end.[/simba]
  2009. [/spoiler]
  2010. [spoiler="TPAReverse"]
  2011. [simba]{==============================================================================]
  2012. Explanation: Reverses TPA.
  2013. [==============================================================================}
  2014. procedure TPAReverse(var TPA: TPointArray);
  2015. var
  2016. g, h, i: Integer;
  2017. begin
  2018. h := High(TPA);
  2019. if (h < 1) then
  2020. Exit;
  2021. g := (h div 2);
  2022. for i := 0 to g do
  2023. Swap(TPA[i], TPA[(h - i)]);
  2024. end;
  2025.  
  2026. var
  2027. TPA: TPointArray;
  2028.  
  2029. begin
  2030. ClearDebug;
  2031. TPA := [Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)];
  2032. TPAReverse(TPA);
  2033. WriteLn(ToStr(TPA));
  2034. end.[/simba]
  2035. [/spoiler]
  2036. [spoiler="TPAInvert"]
  2037. [simba]{==============================================================================]
  2038. Explanation: Inverts TPA by replacing all of the points inside the bounds that weren't defined in the array.
  2039. [==============================================================================}
  2040. procedure TPAInvert(var TPA: TPointArray);
  2041. var
  2042. v, x, y, h, r: Integer;
  2043. B: array of TBoolArray;
  2044. bx: TBox;
  2045. begin;
  2046. h := High(TPA);
  2047. if (h > 0) then
  2048. begin
  2049. bx := IntToBox(TPA[0].X, TPA[0].Y, TPA[0].X, TPA[0].Y);
  2050. for v := 1 to h do
  2051. begin
  2052. if (TPA[v].X < bx.X1) then
  2053. bx.X1 := TPA[v].X
  2054. else
  2055. if (TPA[v].X > bx.X2) then
  2056. bx.X2 := TPA[v].X;
  2057. if (TPA[v].Y < bx.Y1) then
  2058. bx.Y1 := TPA[v].Y
  2059. else
  2060. if (TPA[v].Y > bx.Y2) then
  2061. bx.Y2 := TPA[v].Y;
  2062. end;
  2063. SetLength(B, ((bx.X2 - bx.X1) + 1));
  2064. for v := 0 to (bx.X2 - bx.X1) do
  2065. SetLength(B[v], ((bx.Y2 - bx.Y1) + 1));
  2066. for v := 0 to h do
  2067. if not B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] then
  2068. begin
  2069. B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] := True;
  2070. Inc(x);
  2071. end;
  2072. SetLength(TPA, ((((bx.X2 - bx.X1) + 1) * ((bx.Y2 - bx.Y1) + 1)) - x));
  2073. if (Length(TPA) > 0) then
  2074. for y := 0 to (bx.Y2 - bx.Y1) do
  2075. for x := 0 to (bx.X2 - bx.X1) do
  2076. if not B[x][y] then
  2077. begin
  2078. TPA[r].X := (x + bx.X1);
  2079. TPA[r].Y := (y + bx.Y1);
  2080. Inc(r);
  2081. end;
  2082. SetLength(B, 0);
  2083. end else
  2084. SetLength(TPA, 0);
  2085. end;
  2086.  
  2087. var
  2088. bmp: Integer;
  2089. TPA: TPointArray;
  2090. h, i: Integer;
  2091.  
  2092. begin
  2093. ClearDebug;
  2094. TPA := [Point(25, 25), Point(75, 75)];
  2095. h := High(TPA);
  2096. bmp := CreateBitmap(100, 100);
  2097. TPAInvert(TPA);
  2098. h := High(TPA);
  2099. for i := 0 to h do
  2100. FastSetPixel(bmp, TPA[i].X, TPA[i].Y, 16777215);
  2101. DisplayDebugImgWindow(100, 100);
  2102. DrawBitmapDebugImg(bmp);
  2103. FreeBitmap(bmp);
  2104. end.[/simba]
  2105. [/spoiler]
  2106. [spoiler="TPAEdge"]
  2107. [simba]{==============================================================================]
  2108. Explanation: Replaces TPA with all the edge-points from TPA.
  2109. Edge-points are points that are on the edge of the TPA, not completely surrounded by other points.
  2110. [==============================================================================}
  2111. procedure TPAEdge(var TPA: TPointArray);
  2112. var
  2113. v, x, y, h, r: Integer;
  2114. B: array of TBoolArray;
  2115. bx: TBox;
  2116. begin;
  2117. h := High(TPA);
  2118. if (h > 3) then
  2119. begin
  2120. bx := IntToBox(TPA[0].X, TPA[0].Y, TPA[0].X, TPA[0].Y);
  2121. for v := 1 to h do
  2122. begin
  2123. if (TPA[v].X < bx.X1) then
  2124. bx.X1 := TPA[v].X
  2125. else
  2126. if (TPA[v].X > bx.X2) then
  2127. bx.X2 := TPA[v].X;
  2128. if (TPA[v].Y < bx.Y1) then
  2129. bx.Y1 := TPA[v].Y
  2130. else
  2131. if (TPA[v].Y > bx.Y2) then
  2132. bx.Y2 := TPA[v].Y;
  2133. end;
  2134. bx := IntToBox((bx.X1 - 1), (bx.Y1 - 1), (bx.X2 + 1), (bx.Y2 + 1));
  2135. SetLength(B, ((bx.X2 - bx.X1) + 1));
  2136. for v := 0 to (bx.X2 - bx.X1) do
  2137. SetLength(B[v], ((bx.Y2 - bx.Y1) + 1));
  2138. for v := 0 to h do
  2139. if not B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] then
  2140. B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] := True;
  2141. for y := 1 to ((bx.Y2 - bx.Y1) - 1) do
  2142. for x := 1 to ((bx.X2 - bx.X1) - 1) do
  2143. if B[x][y] then
  2144. if not (B[(x - 1)][y] and B[x][(y - 1)] and B[(x + 1)][y] and B[x][(y + 1)]) then
  2145. begin
  2146. TPA[r].X := (x + bx.X1);
  2147. TPA[r].Y := (y + bx.Y1);
  2148. Inc(r);
  2149. end;
  2150. SetLength(TPA, r);
  2151. SetLength(B, 0);
  2152. end;
  2153. end;
  2154.  
  2155. {==============================================================================]
  2156. Explanation: Removes all points from TPA that are found in points.
  2157. [==============================================================================}
  2158. procedure TPAFilterPoints(var TPA: TPointArray; points: TPointArray);
  2159. var
  2160. a, b, c, x, y: Integer;
  2161. begin
  2162. b := High(TPA);
  2163. y := High(points);
  2164. if ((b > -1) and (y > -1)) then
  2165. for a := 0 to b do
  2166. begin
  2167. for x := 0 to y do
  2168. if ((TPA[a].X = points[x].X) and (TPA[a].Y = points[x].Y)) then
  2169. Break;
  2170. if (x > y) then
  2171. begin
  2172. TPA[c] := TPA[a];
  2173. Inc(c);
  2174. end;
  2175. end;
  2176. SetLength(TPA, c);
  2177. end;
  2178.  
  2179. var
  2180. bmp: Integer;
  2181. TPA: TPointArray;
  2182. h, i: Integer;
  2183.  
  2184. begin
  2185. ClearDebug;
  2186. TPA := TPAFromBox(IntToBox(25, 25, 50, 50));
  2187. TPA[0] := Point(5, 5);
  2188. TPA[High(TPA)] := Point(95, 95);
  2189. TPAFilterPoints(TPA, [Point(36, 34), Point(47, 42)]);
  2190. bmp := CreateBitmap(100, 100);
  2191. TPAEdge(TPA);
  2192. h := High(TPA);
  2193. for i := 0 to h do
  2194. FastSetPixel(bmp, TPA[i].X, TPA[i].Y, 16777215);
  2195. DisplayDebugImgWindow(100, 100);
  2196. DrawBitmapDebugImg(bmp);
  2197. FreeBitmap(bmp);
  2198. end.[/simba]
  2199. [/spoiler]
  2200. [spoiler="TPARotate"]
  2201. [simba]{==============================================================================]
  2202. Explanation: Rotates all points in TPA around center by an angle (in radians).
  2203. [==============================================================================}
  2204. procedure TPARotate(var TPA: TPointArray; center: TPoint; angle: Extended);
  2205. var
  2206. h, i, x, y: Integer;
  2207. c, s: Extended;
  2208. begin
  2209. h := High(TPA);
  2210. if (h > -1) then
  2211. begin
  2212. c := Cos(angle);
  2213. s := Sin(angle);
  2214. for i := 0 to h do
  2215. begin
  2216. x := (TPA[i].X - center.X);
  2217. y := (TPA[i].Y - center.Y);
  2218. TPA[i].X := (Round((x * c) - (y * s)) + center.X);
  2219. TPA[i].Y := (Round((x * s) + (y * c)) + center.Y);
  2220. end;
  2221. end;
  2222. end;
  2223.  
  2224. var
  2225. TPA: TPointArray;
  2226. bmp, i: Integer;
  2227.  
  2228. begin
  2229. ClearDebug;
  2230. TPA := TPAFromBox(IntToBox(25, 25, 50, 50));
  2231. TPARotate(TPA, Point(37, 37), Radians(45))
  2232. bmp := CreateBitmap(100, 100);
  2233. for i := 0 to High(TPA) do
  2234. FastSetPixel(bmp, TPA[i].X, TPA[i].Y, 255);
  2235. SetLength(TPA, 0);
  2236. DrawBitmapDebugImg(bmp);
  2237. DisplayDebugImgWindow(100, 100);
  2238. FreeBitmap(bmp);
  2239. end.[/simba]
  2240. [/spoiler]
  2241. [spoiler="TPAOffset"]
  2242. [simba]{==============================================================================]
  2243. Explanation: Offsets TPA using offset point.
  2244. [==============================================================================}
  2245. procedure TPAOffset(var TPA: TPointArray; offset: TPoint);
  2246. var
  2247. h, i: Integer;
  2248. begin
  2249. h := High(TPA);
  2250. for i := 0 to h do
  2251. begin
  2252. TPA[i].X := (TPA[i].X + offset.X);
  2253. TPA[i].Y := (TPA[i].Y + offset.Y);
  2254. end;
  2255. end;
  2256.  
  2257. procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
  2258. var
  2259. a, b, w, h: Integer;
  2260. begin
  2261. b := High(TPA);
  2262. if (b > -1) then
  2263. begin
  2264. try
  2265. GetBitmapSize(bmp, w, h);
  2266. except
  2267. Exit;
  2268. end;
  2269. for a := 0 to b do
  2270. if ((TPA[a].X > -1) and (TPA[a].Y > -1) and (TPA[a].X < w) and (TPA[a].Y < h)) then
  2271. FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  2272. end;
  2273. end;
  2274.  
  2275. var
  2276. TPA: TPointArray;
  2277. bmp: Integer;
  2278.  
  2279. begin
  2280. ClearDebug;
  2281. TPA := TPAFromBox(IntToBox(0, 0, 9, 9));
  2282. TPAOffset(TPA, Point(25, 25));
  2283. WriteLn(ToStr(TPA));
  2284. bmp := CreateBitmap(100, 100);
  2285. SetPixels(bmp, TPA, clRed);
  2286. DisplayDebugImgWindow(100, 100);
  2287. DrawBitmapDebugImg(bmp);
  2288. FreeBitmap(bmp);
  2289. end.[/simba]
  2290. [/spoiler]
  2291. [spoiler="TPAOffsetEx"]
  2292. [simba]{==============================================================================]
  2293. Explanation: Offsets TPA using radius & angle (degrees).
  2294. NOTE: Angle is based on COMPASS degrees: http://www.blackknightassociation.com/Images/acirclueis360degrees.jpg
  2295. [==============================================================================}
  2296. procedure TPAOffsetEx(var TPA: TPointArray; radius, angle: Extended);
  2297. var
  2298. h, i: Integer;
  2299. begin
  2300. h := High(TPA);
  2301. for i := 0 to h do
  2302. begin
  2303. TPA[i].X := Round(radius * Sin(angle * (Pi / 180)) + TPA[i].X);
  2304. TPA[i].Y := Round(-radius * Cos(angle * (Pi / 180)) + TPA[i].Y);
  2305. end;
  2306. end;
  2307.  
  2308. procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
  2309. var
  2310. a, b, w, h: Integer;
  2311. begin
  2312. b := High(TPA);
  2313. if (b > -1) then
  2314. begin
  2315. try
  2316. GetBitmapSize(bmp, w, h);
  2317. except
  2318. Exit;
  2319. end;
  2320. for a := 0 to b do
  2321. if ((TPA[a].X > -1) and (TPA[a].Y > -1) and (TPA[a].X < w) and (TPA[a].Y < h)) then
  2322. FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  2323. end;
  2324. end;
  2325.  
  2326. var
  2327. TPA: TPointArray;
  2328. bmp: Integer;
  2329.  
  2330. begin
  2331. ClearDebug;
  2332. TPA := TPAFromBox(IntToBox(0, 0, 9, 9));
  2333. TPAOffsetEx(TPA, 35, 135.0);
  2334. WriteLn(ToStr(TPA));
  2335. bmp := CreateBitmap(100, 100);
  2336. SetPixels(bmp, TPA, clRed);
  2337. DisplayDebugImgWindow(100, 100);
  2338. DrawBitmapDebugImg(bmp);
  2339. FreeBitmap(bmp);
  2340. end.[/simba]
  2341. [/spoiler]
  2342. [spoiler="TPAUnique"]
  2343. [simba]{==============================================================================]
  2344. Explanation: Removes all duplicates from TPA.
  2345. [==============================================================================}
  2346. procedure TPAUnique(var TPA: TPointArray);
  2347. var
  2348. h, h2, i, i2, i3, d: Integer;
  2349. begin
  2350. h := High(TPA);
  2351. if (h < 1) then
  2352. Exit;
  2353. for i := (h - d) downto 1 do
  2354. for i2 := (i - 1) downto 0 do
  2355. if ((TPA[i].X = TPA[i2].X) and (TPA[i].Y = TPA[i2].Y)) then
  2356. begin
  2357. h2 := High(TPA);
  2358. for i3 := i to (h2 - 1) do
  2359. TPA[i3] := TPA[(i3 + 1)];
  2360. SetLength(TPA, h2);
  2361. Inc(d);
  2362. Break;
  2363. end;
  2364. end;
  2365.  
  2366. var
  2367. TPA: TPointArray;
  2368.  
  2369. begin
  2370. TPA := [Point(0, 0), Point(1, 1), Point(2, 2), Point(1, 1), Point(0, 0), Point(2, 2), Point(3, 3), Point(4, 4), Point(3, 3), Point(0, 0), Point(0, 0), Point(3, 3), Point(1, 1)];
  2371. TPAUnique(TPA);
  2372. WriteLn(ToStr(TPA));
  2373. end.[/simba]
  2374. [/spoiler]
  2375. [spoiler="TPAUnique2"]
  2376. [simba]{==============================================================================]
  2377. Explanation: Removes all duplicates from TPA. Optimized by masterBB!
  2378. [==============================================================================}
  2379. procedure TPAUnique2(var TPA: TPointArray);
  2380. var
  2381. v, h, r: Integer;
  2382. B: array of TBoolArray;
  2383. bx: TBox;
  2384. begin;
  2385. h := High(TPA);
  2386. if (h > 0) then
  2387. begin
  2388. bx := IntToBox(TPA[0].X, TPA[0].Y, TPA[0].X, TPA[0].Y);
  2389. for v := 1 to h do
  2390. begin
  2391. if (TPA[v].X < bx.X1) then
  2392. bx.X1 := TPA[v].X
  2393. else
  2394. if (TPA[v].X > bx.X2) then
  2395. bx.X2 := TPA[v].X;
  2396. if (TPA[v].Y < bx.Y1) then
  2397. bx.Y1 := TPA[v].Y
  2398. else
  2399. if (TPA[v].Y > bx.Y2) then
  2400. bx.Y2 := TPA[v].Y;
  2401. end;
  2402. SetLength(B, ((bx.X2 - bx.X1) + 1));
  2403. for v := 0 to (bx.X2 - bx.X1) do
  2404. SetLength(B[v], ((bx.Y2 - bx.Y1) + 1));
  2405. for v := 0 to h do
  2406. if not B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] then
  2407. begin
  2408. B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] := True;
  2409. TPA[r] := TPA[v];
  2410. Inc(r);
  2411. end;
  2412. SetLength(TPA, r);
  2413. SetLength(B, 0);
  2414. end;
  2415. end;
  2416.  
  2417. var
  2418. TPA: TPointArray;
  2419.  
  2420. begin
  2421. TPA := [Point(0, 0), Point(1, 1), Point(2, 2), Point(1, 1), Point(0, 0), Point(2, 2), Point(3, 3), Point(4, 4), Point(3, 3), Point(0, 0), Point(0, 0), Point(3, 3), Point(1, 1)];
  2422. TPAUnique2(TPA);
  2423. WriteLn(ToStr(TPA));
  2424. end.[/simba]
  2425. [/spoiler]
  2426. [spoiler="TPAUniqueIDs"]
  2427. [simba]{==============================================================================]
  2428. Explanation: Returns all indexes from TPA where the points are unique compared to other points in array.
  2429. [==============================================================================}
  2430. function TPAUniqueIDs(TPA: TPointArray): TIntegerArray;
  2431. var
  2432. h, r, x, y: Integer;
  2433. begin
  2434. h := High(TPA);
  2435. SetLength(Result, (h + 1));
  2436. if (h > -1) then
  2437. if (h > 0) then
  2438. begin
  2439. for x := 0 to h do
  2440. begin
  2441. for y := 0 to h do
  2442. if ((y <> x) and ((TPA[x].X = TPA[y].X) and (TPA[x].Y = TPA[y].Y))) then
  2443. Break;
  2444. if (y > h) then
  2445. begin
  2446. Result[r] := x;
  2447. Inc(r);
  2448. end;
  2449. end;
  2450. SetLength(Result, r);
  2451. end else
  2452. Result[0] := 0;
  2453. end;
  2454.  
  2455. var
  2456. TPA: TPointArray;
  2457.  
  2458. begin
  2459. ClearDebug;
  2460. TPA := [Point(0, 1), Point(2, 3), Point(4, 5), Point(4, 5),
  2461. Point(6, 7), Point(8, 9), Point(6, 7), Point(8, 9)];
  2462. WriteLn(ToStr(TPAUniqueIDs(TPA)));
  2463. end.[/simba]
  2464. [/spoiler]
  2465. [spoiler="TPAGrid"]
  2466. [simba]{==============================================================================]
  2467. Explanation: Returns/builds grid of points with parameters;
  2468. startPoint = start point of the grid
  2469. rows, columns = count of rows and columns
  2470. rowSpace, columnSpace = the space between points at rows and columns
  2471. [==============================================================================}
  2472. function TPAGrid(startPoint: TPoint; rows, columns, rowSpace, columnSpace: Integer): TPointArray;
  2473. var
  2474. r, c: Integer;
  2475. begin
  2476. if ((rows > 0) and (columns > 0) and ((rows * columns) > 0)) then
  2477. begin
  2478. SetLength(Result, (rows * columns));
  2479. for r := 0 to (rows - 1) do
  2480. for c := 0 to (columns - 1) do
  2481. Result[((r * columns) + c)] := Point((startPoint.X + (c * columnSpace)), (startPoint.Y + (r * rowSpace)));
  2482. end else
  2483. SetLength(Result, 0);
  2484. end;
  2485.  
  2486. const
  2487. START_X = 10;
  2488. START_Y = 10;
  2489. ROWS = 100;
  2490. COLUMNS = 200;
  2491. ROW_SPACE = 2;
  2492. COLUMN_SPACE = 2;
  2493.  
  2494. var
  2495. TPA: TPointArray;
  2496. b, i: Integer;
  2497.  
  2498. begin
  2499. b := CreateBitmap(500, 500);
  2500. TPA := TPAGrid(Point(START_X, START_Y), ROWS, COLUMNS, ROW_SPACE, COLUMN_SPACE);
  2501. for i := 0 to High(TPA) do
  2502. FastSetPixel(b, TPA[i].X, TPA[i].Y, 16777215);
  2503. SetLength(TPA, 0);
  2504. DisplayDebugImgWindow(500, 500);
  2505. DrawBitmapDebugImg(b);
  2506. FreeBitmap(b);
  2507. end.[/simba]
  2508. [/spoiler]
  2509. [spoiler="TPARow"]
  2510. [simba]{==============================================================================]
  2511. Explanation: Returns row of points. Starting from startPoint,
  2512. where rowSpace is the amount of space between each point.
  2513. NOTE: Example row = (0, 0), (0, 1), (0, 2), (0, 3), (0, 4) (rowSpace as 1)
  2514. [==============================================================================}
  2515. function TPARow(startPoint: TPoint; rows, rowSpace: Integer): TPointArray;
  2516. var
  2517. i: Integer;
  2518. begin
  2519. if (rows > 0) then
  2520. begin
  2521. SetLength(Result, rows);
  2522. for i := 0 to (rows - 1) do
  2523. Result[i] := Point(startPoint.X, (startPoint.Y + (i * rowSpace)));
  2524. end else
  2525. SetLength(Result, 0);
  2526. end;
  2527.  
  2528. const
  2529. START_X = 10;
  2530. START_Y = 10;
  2531. ROWS = 100;
  2532. ROW_SPACE = 4;
  2533.  
  2534. var
  2535. TPA: TPointArray;
  2536. b, i: Integer;
  2537.  
  2538. begin
  2539. b := CreateBitmap(500, 500);
  2540. TPA := TPARow(Point(START_X, START_Y), ROWS, ROW_SPACE);
  2541. for i := 0 to High(TPA) do
  2542. FastSetPixel(b, TPA[i].X, TPA[i].Y, 16777215);
  2543. SetLength(TPA, 0);
  2544. DisplayDebugImgWindow(500, 500);
  2545. DrawBitmapDebugImg(b);
  2546. FreeBitmap(b);
  2547. end.[/simba]
  2548. [/spoiler]
  2549. [spoiler="TPAColumn"]
  2550. [simba]{==============================================================================]
  2551. Explanation: Returns column of points. Starting from startPoint,
  2552. where columnSpace is the amount of space between each point.
  2553. NOTE: Example column = (0, 0), (1, 0), (2, 0), (3, 0), (4, 0) (columnSpace as 1)
  2554. [==============================================================================}
  2555. function TPAColumn(startPoint: TPoint; columns, columnSpace: Integer): TPointArray;
  2556. var
  2557. i: Integer;
  2558. begin
  2559. if (columns > 0) then
  2560. begin
  2561. SetLength(Result, columns);
  2562. for i := 0 to (columns - 1) do
  2563. Result[i] := Point((startPoint.X + (i * columnSpace)), startPoint.Y);
  2564. end else
  2565. SetLength(Result, 0);
  2566. end;
  2567.  
  2568. const
  2569. START_X = 10;
  2570. START_Y = 10;
  2571. COLUMNS = 100;
  2572. COLUMN_SPACE = 4;
  2573.  
  2574. var
  2575. TPA: TPointArray;
  2576. b, i: Integer;
  2577.  
  2578. begin
  2579. b := CreateBitmap(500, 500);
  2580. TPA := TPAColumn(Point(START_X, START_Y), COLUMNS, COLUMN_SPACE);
  2581. for i := 0 to High(TPA) do
  2582. FastSetPixel(b, TPA[i].X, TPA[i].Y, 16777215);
  2583. SetLength(TPA, 0);
  2584. DisplayDebugImgWindow(500, 500);
  2585. DrawBitmapDebugImg(b);
  2586. FreeBitmap(b);
  2587. end.[/simba]
  2588. [/spoiler]
  2589. [spoiler="TPACombine"]
  2590. [simba]{==============================================================================]
  2591. Explanation: Returns TPA1 and TPA2 combined together.
  2592. [==============================================================================}
  2593. function TPACombine(TPA1, TPA2: TPointArray): TPointArray;
  2594. var
  2595. l1, l2, i: Integer;
  2596. begin
  2597. l1 := Length(TPA1);
  2598. l2 := Length(TPA2);
  2599. SetLength(Result, (l1 + l2));
  2600. for i := 0 to (l1 - 1) do
  2601. Result[i] := TPoint(TPA1[i]);
  2602. for i := 0 to (l2 - 1) do
  2603. Result[(l1 + i)] := TPoint(TPA2[i]);
  2604. end;
  2605.  
  2606. begin
  2607. WriteLn(ToStr(TPACombine([Point(0, 1), Point(2, 3)], [Point(4, 5), Point(6, 7), Point(8, 9)])));
  2608. end.[/simba]
  2609. [/spoiler]
  2610. [spoiler="TPAContains"]
  2611. [simba]{==============================================================================]
  2612. Explanation: Returns true if TPA contains x.
  2613. [==============================================================================}
  2614. function TPAContains(TPA: TPointArray; x: TPoint): Boolean;
  2615. var
  2616. i, h: Integer;
  2617. begin
  2618. h := High(TPA);
  2619. for i := 0 to h do
  2620. begin
  2621. Result := ((x.X = TPA[i].X) and (x.Y = TPA[i].Y));
  2622. if Result then
  2623. Exit;
  2624. end;
  2625. Result := False;
  2626. end;
  2627.  
  2628. var
  2629. TPA: TPointArray;
  2630. i: Integer;
  2631.  
  2632. begin
  2633. ClearDebug;
  2634. TPA := [Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)];
  2635. for i := -1 to 5 do
  2636. if TPAContains(TPA, Point((i * 2), ((i * 2) + 1))) then
  2637. WriteLn(ToStr('Point(' + IntToStr(i * 2) + ', ' + IntToStr((i * 2) + 1)) + ') exists in TPA!')
  2638. else
  2639. WriteLn(ToStr('Point(' + IntToStr(i * 2) + ', ' + IntToStr((i * 2) + 1)) + ') DOES NOT exist in TPA!');
  2640. end.[/simba]
  2641. [/spoiler]
  2642. [spoiler="TPAContainsEx"]
  2643. [simba]{==============================================================================]
  2644. Explanation: Returns true if TPA contains ANY TPoint from pts.
  2645. [==============================================================================}
  2646. function TPAContainsEx(TPA, pts: TPointArray): Boolean;
  2647. var
  2648. a, b, x, y: Integer;
  2649. begin
  2650. b := High(TPA);
  2651. y := High(pts);
  2652. Result := True;
  2653. if ((b > -1) and (y > -1)) then
  2654. for a := 0 to b do
  2655. for x := 0 to y do
  2656. if ((TPA[a].X = pts[x].X) and (TPA[a].Y = pts[x].Y)) then
  2657. Exit;
  2658. Result := False;
  2659. end;
  2660.  
  2661. begin
  2662. ClearDebug;
  2663. if TPAContainsEx([Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)], [Point(8, 9), Point(4, 5)]) then
  2664. WriteLn('YEP!');
  2665. end.[/simba]
  2666. [/spoiler]
  2667. [spoiler="TPAContainsTPA"]
  2668. [simba]{==============================================================================]
  2669. Explanation: Returns true if TPA contains WHOLE chain of TPoints (arr) in it.
  2670. [==============================================================================}
  2671. function TPAContainsTPA(TPA, arr: TPointArray): Boolean;
  2672. var
  2673. a, b, x, y, z: Integer;
  2674. begin
  2675. z := High(TPA);
  2676. y := High(arr);
  2677. if ((z >= y) and (z > -1)) then
  2678. begin
  2679. b := (z - y);
  2680. for a := 0 to b do
  2681. begin
  2682. for x := 0 to y do
  2683. if ((TPA[(a + x)].X <> arr[x].X) or (TPA[(a + x)].Y <> arr[x].Y)) then
  2684. Break;
  2685. if (x > y) then
  2686. Break;
  2687. end;
  2688. Result := (a <= b);
  2689. end else
  2690. Result := False;
  2691. end;
  2692.  
  2693. begin
  2694. ClearDebug;
  2695. if TPAContainsTPA([Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)], [Point(8, 9), Point(4, 5)]) then
  2696. WriteLn('NOOOO!');
  2697. if TPAContainsTPA([Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)], [Point(4, 5), Point(6, 7), Point(8, 9)]) then
  2698. WriteLn('YEEAH!');
  2699. end.[/simba]
  2700. [/spoiler]
  2701. [spoiler="TPAPos"]
  2702. [simba]{==============================================================================]
  2703. Explanation: Returns index position from TPA which matched with pt.
  2704. Returns -1 if any of TPA items doesnt match with pt!
  2705. [==============================================================================}
  2706. function TPAPos(TPA: TPointArray; pt: TPoint): Integer;
  2707. var
  2708. h: Integer;
  2709. begin
  2710. h := High(TPA);
  2711. for Result := 0 to h do
  2712. if ((TPA[Result].X = pt.X) and (TPA[Result].Y = pt.Y)) then
  2713. Exit;
  2714. Result := -1;
  2715. end;
  2716.  
  2717. var
  2718. TPA: TPointArray;
  2719. i, p: Integer;
  2720.  
  2721. begin
  2722. ClearDebug;
  2723. TPA := [Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)];
  2724. for i := -1 to 5 do
  2725. begin
  2726. p := TPAPos(TPA, Point((i * 2), ((i * 2) + 1)));
  2727. if (p > -1) then
  2728. WriteLn(ToStr('Point(' + IntToStr(i * 2) + ', ' + IntToStr((i * 2) + 1)) + ') index in TPA: ' + IntToStr(p))
  2729. else
  2730. WriteLn(ToStr('Point(' + IntToStr(i * 2) + ', ' + IntToStr((i * 2) + 1)) + ') DOES NOT exist in TPA!');
  2731. end;
  2732. end.[/simba]
  2733. [/spoiler]
  2734. [spoiler="TPAEmpty"]
  2735. [simba]{==============================================================================]
  2736. Explanation: Returns true if TPA is empty (Length(TPA) = 0).
  2737. [==============================================================================}
  2738. function TPAEmpty(TPA: TPointArray): Boolean;
  2739. begin
  2740. Result := (Length(TPA) = 0);
  2741. end;
  2742.  
  2743. var
  2744. TPA: TPointArray;
  2745.  
  2746. begin
  2747. ClearDebug;
  2748. if TPAEmpty(TPA) then
  2749. WriteLn('Yeah, TPA is still empty of points... Obviously!');
  2750. SetLength(TPA, 1);
  2751. if not TPAEmpty(TPA) then
  2752. WriteLn('TPA is not empty anymore.');
  2753. end.[/simba]
  2754. [/spoiler]
  2755. [spoiler="TPABounds"]
  2756. [simba]{==============================================================================]
  2757. Explanation: Returns the bounds of TPA as TBox.
  2758. [==============================================================================}
  2759. function TPABounds(TPA: TPointArray): TBox;
  2760. var
  2761. h, i: Integer;
  2762. begin
  2763. h := High(TPA);
  2764. if (h > -1) then
  2765. begin
  2766. Result := IntToBox(TPA[0].X, TPA[0].Y, TPA[0].X, TPA[0].Y);
  2767. if (h > 0) then
  2768. for i := 1 to h do
  2769. begin
  2770. if (TPA[i].X < Result.X1) then
  2771. Result.X1 := TPA[i].X
  2772. else
  2773. if (TPA[i].X > Result.X2) then
  2774. Result.X2 := TPA[i].X;
  2775. if (TPA[i].Y < Result.Y1) then
  2776. Result.Y1 := TPA[i].Y
  2777. else
  2778. if (TPA[i].Y > Result.Y2) then
  2779. Result.Y2 := TPA[i].Y;
  2780. end;
  2781. end else
  2782. Result := IntToBox(0, 0, 0, 0);
  2783. end;
  2784.  
  2785. var
  2786. TPA: TPointArray;
  2787. i: Integer;
  2788.  
  2789. begin
  2790. ClearDebug;
  2791. TPA := TPAFromBox(IntToBox(100, 100, 200, 200));
  2792. for i := 0 to High(TPA) do
  2793. Swap(TPA[Random(Length(TPA))], TPA[Random(Length(TPA))]);
  2794. WriteLn('TPABounds(TPA): ' + ToStr(TPABounds(TPA)));
  2795. end.[/simba]
  2796. [/spoiler]
  2797. [spoiler="TPAMean"]
  2798. [simba]{==============================================================================]
  2799. Explanation: Returns the arithmetic mean point by TPA items.
  2800. [==============================================================================}
  2801. function TPAMean(TPA: TPointArray): TPoint;
  2802. var
  2803. i, h: Integer;
  2804. x, y: Extended;
  2805. begin
  2806. h:= High(TPA);
  2807. for i:= 0 to h do
  2808. begin
  2809. x := (x + (Extended(TPA[i].X) / (h + 1)));
  2810. y := (y + (Extended(TPA[i].Y) / (h + 1)));
  2811. end;
  2812. Result := Point(Round(x), Round(y));
  2813. end;
  2814.  
  2815. var
  2816. a, b: TPointArray;
  2817. i: Integer;
  2818.  
  2819. begin
  2820. ClearDebug;
  2821. a := TPAFromBox(IntToBox(0, 0, 9, 9));
  2822. SetLength(b, 10);
  2823. for i := 0 to 9 do
  2824. b[i] := TPoint(a[Random(Length(a))]);
  2825. WriteLn(ToStr(b) + ' => ' + ToStr(TPAMean(b)));
  2826. end.[/simba]
  2827. [/spoiler]
  2828. [spoiler="TPASplitEx"]
  2829. [simba]{==============================================================================]
  2830. Explanation: Splits given TPointArray (TPA) into T2DPointArray by grouping together the point values
  2831. that are within a given distance range (minDistance, maxDistance) from each other.
  2832. [==============================================================================}
  2833. function TPASplitEx(TPA: TPointArray; minDistance, maxDistance: Extended): T2DPointArray;
  2834. var
  2835. a, b, h, l, i, r: Integer;
  2836. d: Extended;
  2837. begin
  2838. h := High(TPA);
  2839. if (h > -1) then
  2840. begin
  2841. SetLength(Result, (h + 1));
  2842. Result[0] := [TPoint(TPA[0])];
  2843. if (h > 0) then
  2844. begin
  2845. r := 1;
  2846. if (minDistance > maxDistance) then
  2847. Swap(minDistance, maxDistance);
  2848. for i := 1 to h do
  2849. begin
  2850. for a := 0 to (r - 1) do
  2851. begin
  2852. l := Length(Result[a]);
  2853. for b := 0 to (l - 1) do
  2854. begin
  2855. d := Sqrt(Sqr(TPA[i].X - Result[a][b].X) + Sqr(TPA[i].Y - Result[a][b].Y));
  2856. if ((d >= minDistance) and (d <= maxDistance)) then
  2857. begin
  2858. SetLength(Result[a], (l + 1));
  2859. Result[a][l] := TPoint(TPA[i]);
  2860. Break;
  2861. end;
  2862. end;
  2863. if (b < l) then
  2864. Break;
  2865. end;
  2866. if (a >= r) then
  2867. begin
  2868. Result[r] := [TPoint(TPA[i])];
  2869. Inc(r);
  2870. end;
  2871. end;
  2872. end;
  2873. end;
  2874. SetLength(Result, r);
  2875. end;
  2876.  
  2877. const
  2878. MINIMUM_DIST = 0;
  2879. MAXIMUM_DIST = 4;
  2880.  
  2881. var
  2882. color: TIntegerArray;
  2883. TPA: TPointArray;
  2884. ATPA: T2DPointArray;
  2885. i, j, bmp: Integer;
  2886.  
  2887. begin
  2888. ClearDebug;
  2889. TPA := [Point(5, 5), Point(3, 4), Point(15, 15), Point(18, 16), Point(4, 5), Point(14, 18),
  2890. Point(78, 68), Point(75, 72), Point(74, 74), Point(6, 6), Point(79, 70), Point(20, 19)];
  2891. ATPA := TPASplitEx(TPA, MINIMUM_DIST, MAXIMUM_DIST);
  2892. WriteLn(ToStr(ATPA));
  2893. color := [255, 16777215, 16711680, 65535, 32768, 8421504];
  2894. bmp := CreateBitmap(100, 100);
  2895. for i := 0 to High(ATPA) do
  2896. for j := 0 to High(ATPA[i]) do
  2897. FastSetPixel(bmp, ATPA[i][j].X, ATPA[i][j].Y, color[(i mod 6)]);
  2898. DisplayDebugImgWindow(100, 100);
  2899. DrawBitmapDebugImg(bmp);
  2900. FreeBitmap(bmp);
  2901. end.[/simba]
  2902. [/spoiler]
  2903. [spoiler="TPAGroupEx"]
  2904. [simba]{==============================================================================]
  2905. Explanation: Splits given TPointArray (TPA) into T2DPointArray by grouping together the point values
  2906. that are within a given distance range (minDistance, maxDistance) of the first point value in the sub-array.
  2907. [==============================================================================}
  2908. function TPAGroupEx(TPA: TPointArray; minDistance, maxDistance: Extended): T2DPointArray;
  2909. var
  2910. a, h, l, i, r: Integer;
  2911. d: Extended;
  2912. begin
  2913. h := High(TPA);
  2914. if (h > -1) then
  2915. begin
  2916. SetLength(Result, (h + 1));
  2917. Result[0] := [TPoint(TPA[0])];
  2918. if (h > 0) then
  2919. begin
  2920. r := 1;
  2921. if (minDistance > maxDistance) then
  2922. Swap(minDistance, maxDistance);
  2923. for i := 1 to h do
  2924. begin
  2925. for a := 0 to (r - 1) do
  2926. begin
  2927. d := Sqrt(Sqr(TPA[i].X - Result[a][0].X) + Sqr(TPA[i].Y - Result[a][0].Y));
  2928. if ((d >= minDistance) and (d <= maxDistance)) then
  2929. begin
  2930. l := Length(Result[a]);
  2931. SetLength(Result[a], (l + 1));
  2932. Result[a][l] := TPoint(TPA[i]);
  2933. Break;
  2934. end;
  2935. end;
  2936. if (a >= r) then
  2937. begin
  2938. Result[r] := [TPoint(TPA[i])];
  2939. Inc(r);
  2940. end;
  2941. end;
  2942. end;
  2943. end;
  2944. SetLength(Result, r);
  2945. end;
  2946.  
  2947. const
  2948. MINIMUM_DIST = 1;
  2949. MAXIMUM_DIST = 4;
  2950.  
  2951. var
  2952. color: TIntegerArray;
  2953. TPA: TPointArray;
  2954. ATPA: T2DPointArray;
  2955. i, j, bmp: Integer;
  2956.  
  2957. begin
  2958. ClearDebug;
  2959. TPA := [Point(5, 5), Point(3, 4), Point(15, 15), Point(18, 16), Point(4, 5), Point(14, 18),
  2960. Point(78, 68), Point(75, 72), Point(74, 74), Point(6, 6), Point(79, 70), Point(20, 19)];
  2961. ATPA := TPAGroupEx(TPA, MINIMUM_DIST, MAXIMUM_DIST);
  2962. WriteLn(ToStr(ATPA));
  2963. color := [255, 16777215, 16711680, 65535, 32768, 8421504];
  2964. bmp := CreateBitmap(100, 100);
  2965. for i := 0 to High(ATPA) do
  2966. for j := 0 to High(ATPA[i]) do
  2967. FastSetPixel(bmp, ATPA[i][j].X, ATPA[i][j].Y, color[(i mod 6)]);
  2968. DisplayDebugImgWindow(100, 100);
  2969. DrawBitmapDebugImg(bmp);
  2970. FreeBitmap(bmp);
  2971. end.[/simba]
  2972. [/spoiler]
  2973. [spoiler="TPAToParts"]
  2974. [simba]type
  2975. TPartitionMethod = (pm_PartSize, pm_PartAmount);
  2976.  
  2977. {==============================================================================]
  2978. Explanation: Breaks TPA to parts (TPA => ATPA). Contains 2 methods:
  2979. -pm_PartSize (Breaks TPA to ATPA by size of the parts) [x = size]
  2980. -pm_PartAmount (Breaks TPA to ATPA by amount of the parts) [x = amount]
  2981. [==============================================================================}
  2982. function TPAToParts(TPA: TPointArray; method: TPartitionMethod; x: Integer): T2DPointArray;
  2983. var
  2984. a, e, h, h2, i, i2, p, z, l: Integer;
  2985. f: Boolean;
  2986. begin
  2987. h := High(TPA);
  2988. if ((h > -1) and (x > 0)) then
  2989. begin
  2990. case method of
  2991. pm_PartSize:
  2992. if (x <= h) then
  2993. begin
  2994. Inc(h);
  2995. p := (h div x);
  2996. if ((p * x) < h) then
  2997. Inc(p);
  2998. SetLength(Result, p);
  2999. for i := 0 to (p - 1) do
  3000. for i2 := 0 to (x - 1) do
  3001. begin
  3002. SetLength(Result[i], x);
  3003. if (a < h) then
  3004. begin
  3005. Result[i][i2] := TPoint(TPA[a]);
  3006. Inc(a);
  3007. end else
  3008. begin
  3009. SetLength(Result[i], i2);
  3010. Exit;
  3011. end;
  3012. end;
  3013. end else
  3014. f := True;
  3015. pm_PartAmount:
  3016. if (h > -1) then
  3017. begin
  3018. if (h < (x - 1)) then
  3019. x := (h + 1);
  3020. p := Floor((h + 1) / x);
  3021. if (p = 0) then
  3022. p := 1;
  3023. e := ((h + 1) - (p * x));
  3024. if (e >= (h + 1)) then
  3025. e := 0;
  3026. SetLength(Result, x);
  3027. for i := 0 to (x - 1) do
  3028. begin
  3029. if ((e >= (i + 1)) and (e > 0)) then
  3030. SetLength(Result[i], (p + 1))
  3031. else
  3032. if (i <= h) then
  3033. SetLength(Result[i], p);
  3034. h2 := High(Result[i]);
  3035. for i2 := 0 to h2 do
  3036. begin
  3037. Result[i][i2] := TPoint(TPA[a]);
  3038. Inc(a);
  3039. end;
  3040. end;
  3041. end else
  3042. f := True;
  3043. end;
  3044. if f then
  3045. begin
  3046. SetLength(Result, 1);
  3047. l := Length(TPA);
  3048. SetLength(Result[0], l);
  3049. for z := 0 to (l - 1) do
  3050. Result[0][z] := TPoint(TPA[z]);
  3051. end;
  3052. end else
  3053. SetLength(Result, 0);
  3054. end;
  3055.  
  3056. var
  3057. TPA: TPointArray;
  3058.  
  3059. begin
  3060. ClearDebug;
  3061. TPA := [Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9),
  3062. Point(0, 1), Point(2, 3), Point(4, 5), Point(6, 7), Point(8, 9)];
  3063. WriteLn('TPAToParts(TPA, pm_PartAmount, 3): ' + ToStr(TPAToParts(TPA, pm_PartAmount, 3)));
  3064. WriteLn('TPAToParts(TPA, pm_PartSize, 3): ' + ToStr(TPAToParts(TPA, pm_PartSize, 3)));
  3065. end.[/simba]
  3066. [/spoiler]
  3067. [spoiler="ATPAMerge"]
  3068. [simba]{==============================================================================]
  3069. Explanation: Merges T2DPointArray (ATPA) to TPointArray.
  3070. [==============================================================================}
  3071. function ATPAMerge(ATPA: T2DPointArray): TPointArray;
  3072. var
  3073. i, i2, h, h2, r: Integer;
  3074. begin
  3075. h := High(ATPA);
  3076. if (h > -1) then
  3077. begin
  3078. for i := 0 to h do
  3079. IncEx(r, (High(ATPA[i]) + 1));
  3080. SetLength(Result, r);
  3081. r := 0;
  3082. for i := 0 to h do
  3083. begin
  3084. h2 := High(ATPA[i]);
  3085. for i2 := 0 to h2 do
  3086. begin
  3087. Result[r] := TPoint(ATPA[i][i2]);
  3088. Inc(r);
  3089. end;
  3090. end;
  3091. end else
  3092. SetLength(Result, 0);
  3093. end;
  3094.  
  3095. var
  3096. ATPA: T2DPointArray;
  3097.  
  3098. begin
  3099. SetLength(ATPA, 3);
  3100. ATPA[0] := [Point(0, 1), Point(2, 3)];
  3101. ATPA[1] := [Point(4, 5)];
  3102. ATPA[2] := [Point(6, 7), Point(8, 9)];
  3103. WriteLn(ToStr(ATPAMerge(ATPA)));
  3104. end.[/simba]
  3105. [/spoiler]
  3106. [spoiler="ATPAEmpty"]
  3107. [simba]{==============================================================================]
  3108. Explanation: Returns true if ATPA does not contain any points in it.
  3109. [==============================================================================}
  3110. function ATPAEmpty(ATPA: T2DPointArray): Boolean;
  3111. var
  3112. a, b: Integer;
  3113. begin
  3114. b := High(ATPA);
  3115. for a := 0 to b do
  3116. if (Length(ATPA[a]) > 0) then
  3117. Break;
  3118. Result := (a > b);
  3119. end;
  3120.  
  3121. var
  3122. ATPA: T2DPointArray;
  3123.  
  3124. begin
  3125. ClearDebug;
  3126. if ATPAEmpty(ATPA) then
  3127. WriteLn('As you can see, ATPA does NOT contain any points in it.');
  3128. SetLength(ATPA, 100);
  3129. if ATPAEmpty(ATPA) then
  3130. WriteLn('As you can see, ATPA STILL does NOT contain any points in it...');
  3131. ATPA[75] := [Point(0, 0)];
  3132. if not ATPAEmpty(ATPA) then
  3133. WriteLn('We can finally find a point now!');
  3134. end.[/simba]
  3135. [/spoiler]
  3136. [spoiler="ATPASize"]
  3137. [simba]{==============================================================================]
  3138. Explanation: Returns total amount of points that ATPA contains in it.
  3139. [==============================================================================}
  3140. function ATPASize(ATPA: T2DPointArray): Integer;
  3141. var
  3142. a, b: Integer;
  3143. begin
  3144. Result := 0;
  3145. b := High(ATPA);
  3146. for a := 0 to b do
  3147. Result := (Result + Length(ATPA[a]));
  3148. end;
  3149.  
  3150. var
  3151. ATPA: T2DPointArray;
  3152.  
  3153. begin
  3154. ClearDebug;
  3155. WriteLn('1. ATPASize(ATPA): ' + IntToStr(ATPASize(ATPA)));
  3156. SetLength(ATPA, 100);
  3157. WriteLn('2. ATPASize(ATPA): ' + IntToStr(ATPASize(ATPA)));
  3158. ATPA[75] := [Point(0, 0)];
  3159. WriteLn('3. ATPASize(ATPA): ' + IntToStr(ATPASize(ATPA)));
  3160. ATPA[38] := [Point(1, 2), Point(3, 4)];
  3161. WriteLn('4. ATPASize(ATPA): ' + IntToStr(ATPASize(ATPA)));
  3162. end.[/simba]
  3163. [/spoiler]
  3164. [spoiler="ATPAClean"]
  3165. [simba]{==============================================================================]
  3166. Explanation: Removes all the empty indexes from ATPA.
  3167. [==============================================================================}
  3168. procedure ATPAClean(var ATPA: T2DPointArray);
  3169. var
  3170. a, b, c: Integer;
  3171. begin
  3172. b := High(ATPA);
  3173. for a := 0 to b do
  3174. if (Length(ATPA[a]) > 0) then
  3175. begin
  3176. ATPA[c] := ATPA[a];
  3177. Inc(c);
  3178. end;
  3179. SetLength(ATPA, c);
  3180. end;
  3181.  
  3182. var
  3183. ATPA: T2DPointArray;
  3184.  
  3185. begin
  3186. ClearDebug;
  3187. SetLength(ATPA, 100);
  3188. ATPAClean(ATPA);
  3189. WriteLn('ATPA: ' + ToStr(ATPA));
  3190. SetLength(ATPA, 100);
  3191. ATPA[55] := [Point(0, 1), Point(2, 3)];
  3192. ATPAClean(ATPA);
  3193. WriteLn('ATPA: ' + ToStr(ATPA));
  3194. SetLength(ATPA, 100);
  3195. ATPA[74] := [Point(6, 7), Point(8, 9)];
  3196. ATPA[6] := [Point(4, 5)];
  3197. ATPAClean(ATPA);
  3198. WriteLn('ATPA: ' + ToStr(ATPA));
  3199. end.[/simba]
  3200. [/spoiler]
  3201. [spoiler="ATPABounds"]
  3202. [simba]{==============================================================================]
  3203. Explanation: Returns the bounds of ATPA as TBox.
  3204. [==============================================================================}
  3205. function ATPABounds(ATPA: T2DPointArray): TBox;
  3206. var
  3207. a, b, x, y: Integer;
  3208. s: Boolean;
  3209. begin
  3210. b := High(ATPA);
  3211. if (b > -1) then
  3212. begin
  3213. for a := 0 to b do
  3214. begin
  3215. y := High(ATPA[a]);
  3216. for x := 0 to y do
  3217. if s then
  3218. begin
  3219. if (ATPA[a][x].X < Result.X1) then
  3220. Result.X1 := ATPA[a][x].X
  3221. else
  3222. if (ATPA[a][x].X > Result.X2) then
  3223. Result.X2 := ATPA[a][x].X;
  3224. if (ATPA[a][x].Y < Result.Y1) then
  3225. Result.Y1 := ATPA[a][x].Y
  3226. else
  3227. if (ATPA[a][x].Y > Result.Y2) then
  3228. Result.Y2 := ATPA[a][x].Y;
  3229. end else
  3230. begin
  3231. Result := IntToBox(ATPA[a][x].X, ATPA[a][x].Y, ATPA[a][x].X, ATPA[a][x].Y);
  3232. s := True;
  3233. end;
  3234. end;
  3235. end else
  3236. Result := IntToBox(0, 0, 0, 0);
  3237. end;
  3238.  
  3239. var
  3240. ATPA: T2DPointArray;
  3241.  
  3242. begin
  3243. SetLength(ATPA, 1000);
  3244. ATPA[628] := [Point(102, 40), Point(89, 105)];
  3245. ATPA[750] := [Point(55, 5)];
  3246. ATPA[58] := [Point(5, 69), Point(105, 99), Point(10, 10)];
  3247. WriteLn(ToStr(ATPABounds(ATPA)));
  3248. end.[/simba]
  3249. [/spoiler]
  3250. [spoiler="ATPAAllBounds"]
  3251. [simba]{==============================================================================]
  3252. Explanation: Returns the bounds of ALL ATPA indexes as TBoxArray.
  3253. [==============================================================================}
  3254. function ATPAAllBounds(ATPA: T2DPointArray): TBoxArray;
  3255. var
  3256. a, b, x, y: Integer;
  3257. s: Boolean;
  3258. begin
  3259. b := High(ATPA);
  3260. SetLength(Result, (b + 1));
  3261. for a := 0 to b do
  3262. begin
  3263. y := High(ATPA[a]);
  3264. if (y > -1) then
  3265. begin
  3266. Result[a] := IntToBox(ATPA[a][0].X, ATPA[a][0].Y, ATPA[a][0].X, ATPA[a][0].Y);
  3267. if (y > 0) then
  3268. for x := 1 to y do
  3269. begin
  3270. if (ATPA[a][x].X < Result[a].X1) then
  3271. Result[a].X1 := ATPA[a][x].X
  3272. else
  3273. if (ATPA[a][x].X > Result[a].X2) then
  3274. Result[a].X2 := ATPA[a][x].X;
  3275. if (ATPA[a][x].Y < Result[a].Y1) then
  3276. Result[a].Y1 := ATPA[a][x].Y
  3277. else
  3278. if (ATPA[a][x].Y > Result[a].Y2) then
  3279. Result[a].Y2 := ATPA[a][x].Y;
  3280. end;
  3281. end else
  3282. Result[a] := IntToBox(0, 0, 0, 0);
  3283. end;
  3284. end;
  3285.  
  3286. var
  3287. ATPA: T2DPointArray;
  3288.  
  3289. begin
  3290. SetLength(ATPA, 10);
  3291. ATPA[5] := [Point(102, 40), Point(89, 105)];
  3292. ATPA[8] := [Point(55, 5)];
  3293. ATPA[3] := [Point(5, 69), Point(105, 99), Point(10, 10)];
  3294. WriteLn(ToStr(ATPAAllBounds(ATPA)));
  3295. end.[/simba]
  3296. [/spoiler]
  3297.  
  3298. Going to add more stuff soon. :stirthepot:
  3299.  
  3300. ..oh and, as always:
  3301. Feel free to use/take/improve/anything - it's all open-source!
  3302. Giving credit is always appreciated, but not really necessary for me. :)
  3303.  
  3304. Have fun!
  3305. -Jani
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!