API tools faq
paste
Janilabo

Box Commands [18.07.2013]

Janilabo
Jul 17th, 2013
63
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 58.96 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] | [url=http://villavu.com/forum/showthread.php?t=104687]Point Commands[/url] |[/SIZE] [SIZE="5"][COLOR="red"]Box Commands[/COLOR][/SIZE][SIZE="0"] | [url=http://villavu.com/forum/showthread.php?t=104689]Integer Commands[/url][/SIZE]
  2.  
  3. Here is another little "topic of contributions" from me to the SRL community! :p
  4. Really hoping to get this one someday as big as String Handling Commands topic.
  5.  
  6. 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...
  7. Also most (if not all) will have small explanations included aswell.
  8.  
  9. [b]List of [color=blue]Functions[/color] & [color=blue]Procedures[/color]:[/b]
  10.  
  11. [code][u]### / Date Added / Command Name[/u]
  12.  
  13. 000 / 07-05-2013 / Box()
  14. 001 / 07-05-2013 / BoxCenter()
  15. 002 / 07-15-2013 / BoxPixelCount()
  16. 003 / 07-05-2013 / BoxFromPoint()
  17. 004 / 07-05-2013 / BoxToPoint()
  18. 005 / 07-05-2013 / PointsToBox()
  19. 006 / 07-05-2013 / CombineBoxes()
  20. 007 / 07-05-2013 / SetBoxConstraints()
  21. 008 / 07-05-2013 / ResizeBoxEx() [*]
  22. 009 / 07-05-2013 / FixBox()
  23. 010 / 07-05-2013 / BoxesOverlap()
  24. 011 / 07-05-2013 / BoxDimensions()
  25. 012 / 07-05-2013 / BoxCentralization() [*]
  26. 013 / 07-05-2013 / CountBoxesInBoxBySize()
  27. 014 / 07-05-2013 / GetBoxesInBoxBySize()
  28. 015 / 07-05-2013 / BoxInBox()
  29. 016 / 07-05-2013 / BoxInsideBox()
  30. 017 / 07-05-2013 / BoxInBoxes()
  31. 018 / 07-05-2013 / BoxInsideBoxes()
  32. 019 / 07-05-2013 / ValidBox()
  33. 020 / 07-05-2013 / SameBoxes()
  34. 021 / 07-05-2013 / SimilarBoxDimensionsEx()
  35. 022 / 07-05-2013 / SimilarBoxDimensions()
  36. 023 / 07-05-2013 / MergeTBA()
  37. 024 / 07-05-2013 / BoxInTPA()
  38. 025 / 07-05-2013 / TBABounds()
  39. 026 / 07-05-2013 / TBAGrid()
  40. 027 / 07-05-2013 / TBARow()
  41. 028 / 07-05-2013 / TBAColumn()
  42. 029 / 07-05-2013 / TBACopyEx()
  43. 030 / 07-05-2013 / TBAClone()
  44. 031 / 07-05-2013 / TBACombine()
  45. 032 / 07-05-2013 / TBADelete()
  46. 033 / 07-05-2013 / TBARemove()
  47. 034 / 07-05-2013 / TBASame()
  48. 035 / 07-05-2013 / TBAInsert()
  49. 036 / 07-05-2013 / TBAAppend()
  50. 037 / 07-05-2013 / TBAAdd()
  51. 038 / 07-05-2013 / TBAPlant()
  52. 039 / 07-05-2013 / TBAUnique()
  53. 040 / 07-05-2013 / TBARandomizeEx()
  54. 041 / 07-05-2013 / TBARandomize()
  55. 042 / 07-05-2013 / TBAContains()
  56. 043 / 07-05-2013 / TBAPositions()
  57. 044 / 07-05-2013 / TBAGet()
  58. 045 / 07-05-2013 / TBAMove()
  59. 046 / 07-05-2013 / TBAToParts() [*]
  60. 047 / 07-05-2013 / TBACenterPointsEx()
  61. 048 / 07-05-2013 / TBACenterPoints()
  62. 049 / 07-05-2013 / ATBAMerge()
  63.  
  64. [i]* = Amount of custom types required.[/i][/code]
  65.  
  66. [spoiler="Box"]
  67. [simba]{==============================================================================]
  68. Explanation: Creates a TBox with X1,Y1,X2,Y2 values..
  69. Automatically corrects/fixes the incorrect values.
  70. [==============================================================================}
  71. function Box(X1, Y1, X2, Y2: Integer): TBox;
  72. begin
  73. Result := IntToBox(X1, Y1, X2, Y2);
  74. if (Result.X1 > Result.X2) then
  75. Swap(Result.X1, Result.X2);
  76. if (Result.Y1 > Result.Y2) then
  77. Swap(Result.Y1, Result.Y2);
  78. end;
  79.  
  80. begin
  81. WriteLn(Box(100, 100, 100, 100));
  82. WriteLn(Box(100, 85, 85, 100));
  83. end.[/simba]
  84. [/spoiler]
  85. [spoiler="BoxCenter"]
  86. [simba]{==============================================================================]
  87. Explanation: Returns the center point of bx.
  88. [==============================================================================}
  89. function BoxCenter(bx: TBox): TPoint;
  90. begin
  91. if ((bx.X1 > bx.X2) or (bx.Y1 > bx.Y2)) then
  92. begin
  93. if (bx.X1 > bx.X2) then
  94. Swap(bx.X1, bx.X2);
  95. if (bx.Y1 > bx.Y2) then
  96. Swap(bx.Y1, bx.Y2);
  97. end;
  98. Result := Point(Round(bx.X1 + ((bx.X2 - bx.X1) div 2)), Round(bx.Y1 + ((bx.Y2 - bx.Y1) div 2)));
  99. end;
  100.  
  101. begin
  102. WriteLn(ToStr(BoxCenter(IntToBox(1, 1, 50, 50))));
  103. end.[/simba]
  104. [/spoiler]
  105. [spoiler="BoxPixelCount"]
  106. [simba]{==============================================================================]
  107. Explanation: Calculates the amount of pixels in TBox (bx).
  108. Returns -1 with invalid TBox.
  109. [==============================================================================}
  110. function BoxPixelCount(bx: TBox): Integer;
  111. begin
  112. if ((bx.X1 > bx.X2) or (bx.Y1 > bx.Y2)) then
  113. Result := -1
  114. else
  115. Result := Integer(((bx.X2 - bx.X1) + 1) * ((bx.Y2 - bx.Y1) + 1));
  116. end;
  117.  
  118. var
  119. w, h: Integer;
  120.  
  121. begin
  122. ClearDebug;
  123. GetClientDimensions(w, h);
  124. WriteLn('Client pixel count: ' + IntToStr(BoxPixelCount(IntToBox(0, 0, (w - 1), (h - 1)))));
  125. end.[/simba]
  126. [/spoiler]
  127. [spoiler="BoxFromPoint"]
  128. [simba]{==============================================================================]
  129. Explanation: Creates box from point, where pt is the middle point of the box.
  130. wRadius = width radius, hRadius = height radius
  131. [==============================================================================}
  132. function BoxFromPoint(pt: TPoint; wRadius, hRadius: Integer): TBox;
  133. begin
  134. if (wRadius < 0) then
  135. wRadius := 0;
  136. if (hRadius < 0) then
  137. hRadius := 0;
  138. Result := IntToBox((pt.X - wRadius), (pt.Y - hRadius), (pt.X + wRadius), (pt.Y + hRadius));
  139. end;
  140.  
  141. begin
  142. WriteLn(BoxFromPoint(Point(200, 200), 100, 100));
  143. end.[/simba]
  144. [/spoiler]
  145. [spoiler="BoxToPoint"]
  146. [simba]{==============================================================================]
  147. Explanation: Creates box to point, where pt is the start point of the box.
  148. width and height can be positive or negative.
  149. [==============================================================================}
  150. function BoxToPoint(pt: TPoint; width, height: Integer): TBox;
  151. var
  152. o: TPoint;
  153. begin
  154. if ((width < 0) or (height < 0)) then
  155. begin
  156. if (width < 0) then
  157. o.X := Integer(width);
  158. if (height < 0) then
  159. o.Y := Integer(height);
  160. pt.X := (pt.X + o.X);
  161. pt.Y := (pt.Y + o.Y);
  162. end;
  163. {$IFNDEF Lape}
  164. Result := IntToBox(pt.X, pt.Y, (pt.X + iAbs(width - 1)), (pt.Y + iAbs(height - 1)));
  165. {$ELSE}
  166. Result := IntToBox(pt.X, pt.Y, (pt.X + Abs(width - 1)), (pt.Y + Abs(height - 1)));
  167. {$ENDIF}
  168. end;
  169.  
  170. begin
  171. WriteLn(BoxToPoint(Point(50, 50), 100, 100));
  172. end.[/simba]
  173. [/spoiler]
  174. [spoiler="PointsToBox"]
  175. [simba]{==============================================================================]
  176. Explanation: Creates a TBox with 2 points (p1, p2)..
  177. Automatically corrects/fixes the incorrect values.
  178. [==============================================================================}
  179. function PointsToBox(p1, p2: TPoint): TBox;
  180. begin
  181. Result := IntToBox(Min(p1.X, p2.X), Min(p1.Y, p2.Y), Max(p1.X, p2.X), Max(p1.Y, p2.Y));
  182. end;
  183.  
  184. begin
  185. WriteLn(PointsToBox(Point(50, 50), Point(10, 10)));
  186. end.[/simba]
  187. [/spoiler]
  188. [spoiler="CombineBoxes"]
  189. [simba]{==============================================================================]
  190. Explanation: Combines 2 boxes (a and b) to 1 box.
  191. [==============================================================================}
  192. function CombineBoxes(a, b: TBox): TBox;
  193. begin
  194. Result.X1 := Min(Min(a.X1, a.X2), Min(b.X1, b.X2));
  195. Result.Y1 := Min(Min(a.Y1, a.Y2), Min(b.Y1, b.Y2));
  196. Result.X2 := Max(Max(a.X1, a.X2), Max(b.X1, b.X2));
  197. Result.Y2 := Max(Max(a.Y1, a.Y2), Max(b.Y1, b.Y2));
  198. end;
  199.  
  200. var
  201. a, b: TBox;
  202.  
  203. begin
  204. a := IntToBox(10, 50, 20, 100);
  205. b := IntToBox(50, 10, 100, 20);
  206. WriteLn(CombineBoxes(a, b));
  207. end.[/simba]
  208. [/spoiler]
  209. [spoiler="SetBoxConstraints"]
  210. [simba]{==============================================================================]
  211. Explanation: Set minimum / maximum size to bx.
  212. size.X1 = min. X1, size.Y1 = min. Y1, size.X2 = max. X2, size.Y2 = max. Y2
  213. Returns true if constraints were set to bx.
  214. [==============================================================================}
  215. function SetBoxConstraints(var bx: TBox; size: TBox): Boolean;
  216. var
  217. tmp: TBox;
  218. begin
  219. if ((size.X1 <= size.X2) and (size.Y1 <= size.Y2)) then
  220. begin
  221. tmp := TBox(bx);
  222. if (bx.X1 < size.X1) then
  223. bx.X1 := Integer(size.X1);
  224. if (bx.X1 > size.X2) then
  225. bx.X1 := Integer(size.X2);
  226. if (bx.Y1 < size.Y1) then
  227. bx.Y1 := Integer(size.Y1);
  228. if (bx.Y1 > size.Y2) then
  229. bx.Y1 := Integer(size.Y2);
  230. if (bx.X2 > size.X2) then
  231. bx.X2 := Integer(size.X2);
  232. if (bx.X2 < size.X1) then
  233. bx.X2 := Integer(size.X1);
  234. if (bx.Y2 > size.Y2) then
  235. bx.Y2 := Integer(size.Y2);
  236. if (bx.Y2 < size.Y1) then
  237. bx.Y2 := Integer(size.Y1);
  238. Result := ((bx.X1 <> tmp.X1) or (bx.Y1 <> tmp.Y1) or (bx.X2 <> tmp.X2) or (bx.Y2 <> tmp.Y2));
  239. end else
  240. Result := False;
  241. end;
  242.  
  243. var
  244. b: TBox;
  245.  
  246. begin
  247. b := IntToBox(100, 100, 400, 400);
  248. if SetBoxConstraints(b, IntToBox(250, 250, 500, 500)) then
  249. WriteLn(b);
  250. b := IntToBox(100, 100, 400, 400);
  251. if SetBoxConstraints(b, IntToBox(0, 0, 300, 300)) then
  252. WriteLn(b);
  253. end.[/simba]
  254. [/spoiler]
  255. [spoiler="ResizeBoxEx"]
  256. [simba]{==============================================================================]
  257. Explanation: Methods for box resizing (for ResizeBoxEx).
  258. [==============================================================================}
  259. type
  260. TResizeMethod = (rmFull, rmWidth, rmHeight, rmUp, rmDown, rmLeft, rmRight, rmTopLeft, rmTopRight, rmBottomLeft, rmBottomRight);
  261.  
  262. {==============================================================================]
  263. Explanation: Resizes bx by sizeChange..
  264. Contains 11 methods (MSSL_TResizeMethod).
  265. Negative sizeChange = Shrinking, Positive sizeChange = Expanding.
  266. [==============================================================================}
  267. procedure ResizeBoxEx(var bx: TBox; method: TResizeMethod; sizeChange: Integer);
  268. begin
  269. if (sizeChange <> 0) then
  270. case method of
  271. rmFull: bx := IntToBox((bx.X1 - sizeChange), (bx.Y1 - sizeChange), (bx.X2 + sizeChange), (bx.Y2 + sizeChange)); // FULL AREA
  272. rmWidth: bx := IntToBox((bx.X1 - sizeChange), bx.Y1, (bx.X2 + sizeChange), bx.Y2); // WIDTH
  273. rmHeight: bx := IntToBox(bx.X1, (bx.Y1 - sizeChange), bx.X2, (bx.Y2 + sizeChange)); // HEIGHT
  274. rmUp: bx := IntToBox(bx.X1, (bx.Y1 - sizeChange), bx.X2, bx.Y2); // UP
  275. rmDown: bx := IntToBox(bx.X1, bx.Y1, bx.X2, (bx.Y2 + sizeChange)); // DOWN
  276. rmLeft: bx := IntToBox((bx.X1 - sizeChange), bx.Y1, bx.X2, bx.Y2); // LEFT
  277. rmRight: bx := IntToBox(bx.X1, bx.Y1, (bx.X2 + sizeChange), bx.Y2); // RIGHT
  278. rmTopLeft: bx := IntToBox((bx.X1 - sizeChange), (bx.Y1 - sizeChange), bx.X2, bx.Y2); // TOP-LEFT CORNER
  279. rmTopRight: bx := IntToBox(bx.X1, (bx.Y1 - sizeChange), (bx.X2 + sizeChange), bx.Y2); // TOP-RIGHT CORNER
  280. rmBottomLeft: bx := IntToBox((bx.X1 - sizeChange), bx.Y1, bx.X2, (bx.Y2 + sizeChange)); // BOTTOM-LEFT CORNER
  281. rmBottomRight: bx := IntToBox(bx.X1, bx.Y1, (bx.X2 + sizeChange), (bx.Y2 + sizeChange)); // BOTTOM-RIGHT CORNER
  282. end;
  283. end;
  284.  
  285. var
  286. r: array of TResizeMethod;
  287. i, p, x, y: Integer;
  288. b: TBox;
  289.  
  290. begin
  291. r := [rmUp, rmDown, rmLeft, rmRight, rmTopLeft, rmTopRight, rmBottomLeft, rmBottomRight, rmWidth, rmHeight, rmFull];
  292. DisplayDebugImgWindow(500, 500);
  293. b := IntToBox(246, 246, 254, 254);
  294. p := CreateBitmap(500, 500);
  295. for x := b.X1 to b.X2 do
  296. for y := b.Y1 to b.Y2 do
  297. FastSetPixel(p, x, y, 16777215);
  298. DrawBitmapDebugImg(p);
  299. FreeBitmap(p);
  300. for i := 0 to High(r) do
  301. begin
  302. Wait(300);
  303. ResizeBoxEx(b, r[i], 5);
  304. p := CreateBitmap(500, 500);
  305. for x := b.X1 to b.X2 do
  306. for y := b.Y1 to b.Y2 do
  307. FastSetPixel(p, x, y, 16777215);
  308. DrawBitmapDebugImg(p);
  309. FreeBitmap(p);
  310. Wait(1200);
  311. end;
  312. end.[/simba]
  313. [/spoiler]
  314. [spoiler="FixBox"]
  315. [simba]{==============================================================================]
  316. Explanation: Fixes the bx. Swaps incorrectly set values (XS/YS > XE/YE).
  317. Returns true if bx was fixed.
  318. Example: (200*, 100, 100*, 200) => (100, 100, 200, 200)
  319. [==============================================================================}
  320. function FixBox(var bx: TBox): Boolean;
  321. var
  322. o: TBox;
  323. begin
  324. o := bx;
  325. if (bx.X1 > bx.X2) then
  326. Swap(bx.X1, bx.X2);
  327. if (bx.Y1 > bx.Y2) then
  328. Swap(bx.Y1, bx.Y2);
  329. Result := ((o.X1 <> bx.X1) or (o.Y1 <> bx.Y1) or (o.X2 <> bx.X2) or (o.Y2 <> bx.Y2));
  330. end;
  331.  
  332. var
  333. a, b: TBox;
  334.  
  335. begin
  336. a := IntToBox(100, 100, 80, 80);
  337. b := IntToBox(80, 80, 100, 100);
  338. if FixBox(a) then
  339. WriteLn('Fixed A!');
  340. if FixBox(b) then
  341. WriteLn('Fixed B!');
  342. WriteLn(ToStr(a));
  343. WriteLn(ToStr(b));
  344. end.[/simba]
  345. [/spoiler]
  346. [spoiler="BoxesOverlap"]
  347. [simba]{==============================================================================]
  348. Explanation: Returns true if a and b are in anykind of contact with each other.
  349. [==============================================================================}
  350. function BoxesOverlap(a, b: TBox): Boolean;
  351. begin
  352. Result := not ((a.X1 > b.X2) or (a.X2 < b.X1) or (a.Y1 > b.Y2) or (a.Y2 < b.Y1));
  353. end;
  354.  
  355. var
  356. a, t: TPointArray;
  357. i, p, x, y: Integer;
  358. b, c: TBox;
  359.  
  360. begin
  361. b := IntToBox(50, 50, 60, 60);
  362. a := TPAFromBox(b);
  363. DisplayDebugImgWindow(100, 100);
  364. for x := 0 to 89 do
  365. for y := 0 to 89 do
  366. begin
  367. p := CreateBitmap(100, 100);
  368. for i := 0 to High(a) do
  369. FastSetPixel(p, a[i].X, a[i].Y, 255);
  370. c := IntToBox(x, y, (x + 9), (y + 9));
  371. t := TPAFromBox(c);
  372. for i := 0 to High(t) do
  373. FastSetPixel(p, t[i].X, t[i].Y, 16711680);
  374. SetLength(t, 0);
  375. DrawBitmapDebugImg(p);
  376. FreeBitmap(p);
  377. if BoxesOverlap(b, c) then
  378. begin
  379. WriteLn('OVERLAPPING!');
  380. Exit;
  381. end;
  382. end;
  383. SetLength(a, 0);
  384. end.[/simba]
  385. [/spoiler]
  386. [spoiler="BoxDimensions"]
  387. [simba]procedure BoxDimensions(bx: TBox; var w, h: Integer);
  388. begin
  389. w := ((bx.X2 - bx.X1) + 1);
  390. h := ((bx.Y2 - bx.Y1) + 1);
  391. end;
  392.  
  393. var
  394. width, height: Integer;
  395.  
  396. begin
  397. BoxDimensions(IntToBox(220, 140, 280, 200), width, height);
  398. WriteLn(IntToStr(width) + 'x' + IntToStr(height));
  399. end.[/simba]
  400. [/spoiler]
  401. [spoiler="BoxCentralization"]
  402. [simba]{==============================================================================]
  403. Explanation: Centering methods for BoxCentralization.
  404. [==============================================================================}
  405. type
  406. TCenterMethod = (cmWidthwise, cmHeightwise, cmBoth);
  407.  
  408. {==============================================================================]
  409. Explanation: Sets inner bx to center of outer bx. Contains 3 methods.
  410. muWidthHeight = center width & heightwise, muWidth = center widthwise, muHeight = center heightwise.
  411. [==============================================================================}
  412. procedure BoxCentralization(var inner_bx: TBox; outer_bx: TBox; method: TCenterMethod);
  413. var
  414. o: TPoint;
  415. begin
  416. case method of
  417. cmBoth: o := Point(((Round(outer_bx.X1 + ((outer_bx.X2 - outer_bx.X1) / 2)) - (((inner_bx.X2 - inner_bx.X1) + 1) div 2)) - inner_bx.X1), ((Round(outer_bx.Y1 + ((outer_bx.Y2 - outer_bx.Y1) / 2)) - (((inner_bx.Y2 - inner_bx.Y1) + 1) div 2)) - inner_bx.Y1));
  418. cmWidthwise: o := Point(((Round(outer_bx.X1 + ((outer_bx.X2 - outer_bx.X1) / 2)) - (((inner_bx.X2 - inner_bx.X1) + 1) div 2)) - inner_bx.X1), 0);
  419. cmHeightwise: o := Point(0, ((Round(outer_bx.Y1 + ((outer_bx.Y2 - outer_bx.Y1) / 2)) - (((inner_bx.Y2 - inner_bx.Y1) + 1) div 2)) - inner_bx.Y1));
  420. else
  421. Exit;
  422. end;
  423. inner_bx := IntToBox((inner_bx.X1 + o.X), (inner_bx.Y1 + o.Y), (inner_bx.X2 + o.X), (inner_bx.Y2 + o.Y));
  424. end;
  425.  
  426. var
  427. a, b: TBox;
  428. x, y, i: Integer;
  429. t, p: TPointArray;
  430.  
  431. begin
  432. a := IntToBox(50, 50, 99, 99);
  433. p := TPAFromBox(a);
  434. b := IntToBox(0, 0, 24, 24);
  435. t := TPAFromBox(b);
  436. i := CreateBitmap(150, 150);
  437. for x := a.X1 to a.X2 do
  438. for y := a.Y1 to a.Y2 do
  439. FastSetPixel(i, x, y, 16711680);
  440. BoxCentralization(b, a, cmBoth); // You can change that cmWidthHeight - see the effect.. :)
  441. for x := b.X1 to b.X2 do
  442. for y := b.Y1 to b.Y2 do
  443. FastSetPixel(i, x, y, 16777215);
  444. DisplayDebugImgWindow(150, 150);
  445. DrawBitmapDebugImg(i);
  446. FreeBitmap(i);
  447. SetLength(p, 0);
  448. SetLength(t, 0);
  449. WriteLn('a: ' + ToStr(a) + ', b: ' + ToStr(b));
  450. end.[/simba]
  451. [/spoiler]
  452. [spoiler="CountBoxesInBoxBySize"]
  453. [simba]{==============================================================================]
  454. Explanation: Returns count of ALL the possible boxes in a box (bx) by size (width*height).
  455. [==============================================================================}
  456. function CountBoxesInBoxBySize(bx: TBox; width, height: Integer): Integer;
  457. var
  458. w, h: Integer;
  459. begin
  460. Result := 0;
  461. if ((bx.X1 > bx.X2) or (bx.Y1 > bx.Y2) or (width < 1) or (height < 1)) then
  462. Exit;
  463. w := ((bx.X2 - bx.X1) + 1);
  464. h := ((bx.Y2 - bx.Y1) + 1);
  465. if ((width < (w + 1)) and (height < (h + 1))) then
  466. Result := ((h - (height - 1)) * (w - (width - 1)));
  467. end;
  468.  
  469. begin
  470. WriteLn(CountBoxesInBoxBySize(IntToBox(25, 25, 50, 50), 25, 25));
  471. end.[/simba]
  472. [/spoiler]
  473. [spoiler="GetBoxesInBoxBySize"]
  474. [simba]{==============================================================================]
  475. Explanation: Returns ALL the possible boxes in a box (bx) by size (width*height).
  476. [==============================================================================}
  477. function GetBoxesInBoxBySize(bx: TBox; width, height: Integer): TBoxArray;
  478. var
  479. r, c, w, h, x, y: Integer;
  480. begin
  481. if ((bx.X1 <= bx.X2) and (bx.Y1 <= bx.Y2) and (width > 0) and (height > 0)) then
  482. begin
  483. w := ((bx.X2 - bx.X1) + 1);
  484. h := ((bx.Y2 - bx.Y1) + 1);
  485. if ((width < (w + 1)) and (height < (h + 1))) then
  486. begin
  487. r := (h - (height - 1));
  488. c := (w - (width - 1));
  489. SetLength(Result, (r * c));
  490. for y := bx.Y1 to (bx.Y1 + (r - 1)) do
  491. for x := bx.X1 to (bx.X1 + (c - 1)) do
  492. Result[(((y - bx.Y1) * c) + (x - bx.X1))] := IntToBox(x, y, (x + (width - 1)), (y + (height - 1)));
  493. end else
  494. SetLength(Result, 0);
  495. end else
  496. SetLength(Result, 0);
  497. end;
  498.  
  499. begin
  500. WriteLn(GetBoxesInBoxBySize(IntToBox(25, 25, 50, 50), 25, 25));
  501. end.[/simba]
  502. [/spoiler]
  503. [spoiler="BoxInBox"]
  504. [simba]{==============================================================================]
  505. Explanation: Returns true if inner_bx is in/within outer_bx.
  506. [==============================================================================}
  507. function BoxInBox(inner_bx, outer_bx: TBox): Boolean;
  508. begin
  509. Result := ((inner_bx.X1 >= outer_bx.X1) and (inner_bx.X1 <= outer_bx.X2) and (inner_bx.X2 >= outer_bx.X1) and (inner_bx.X2 <= outer_bx.X2) and (inner_bx.Y1 >= outer_bx.Y1) and (inner_bx.Y1 <= outer_bx.Y2) and (inner_bx.Y2 >= outer_bx.Y1) and (inner_bx.Y2 <= outer_bx.Y2));
  510. end;
  511.  
  512. var
  513. a, t: TPointArray;
  514. i, p, x, y: Integer;
  515. b, c: TBox;
  516.  
  517. begin
  518. b := IntToBox(50, 50, 61, 61);
  519. a := TPAFromBox(b);
  520. DisplayDebugImgWindow(100, 100);
  521. for x := 0 to 89 do
  522. for y := 0 to 89 do
  523. begin
  524. p := CreateBitmap(100, 100);
  525. for i := 0 to High(a) do
  526. FastSetPixel(p, a[i].X, a[i].Y, 255);
  527. c := IntToBox(x, y, (x + 9), (y + 9));
  528. t := TPAFromBox(c);
  529. for i := 0 to High(t) do
  530. FastSetPixel(p, t[i].X, t[i].Y, 16711680);
  531. SetLength(t, 0);
  532. DrawBitmapDebugImg(p);
  533. FreeBitmap(p);
  534. if BoxInBox(c, b) then
  535. begin
  536. WriteLn('IN!');
  537. Exit;
  538. end;
  539. end;
  540. SetLength(a, 0);
  541. end.[/simba]
  542. [/spoiler]
  543. [spoiler="BoxInsideBox"]
  544. [simba]{==============================================================================]
  545. Explanation: Returns true if inner_bx is INSIDE outer_bx.
  546. [==============================================================================}
  547. function BoxInsideBox(inner_bx, outer_bx: TBox): Boolean;
  548. begin
  549. Result := ((inner_bx.X1 > outer_bx.X1) and (inner_bx.X1 < outer_bx.X2) and (inner_bx.X2 > outer_bx.X1) and (inner_bx.X2 < outer_bx.X2) and (inner_bx.Y1 > outer_bx.Y1) and (inner_bx.Y1 < outer_bx.Y2) and (inner_bx.Y2 > outer_bx.Y1) and (inner_bx.Y2 < outer_bx.Y2));
  550. end;
  551.  
  552. var
  553. a, t: TPointArray;
  554. i, p, x, y: Integer;
  555. b, c: TBox;
  556.  
  557. begin
  558. b := IntToBox(50, 50, 61, 61);
  559. a := TPAFromBox(b);
  560. DisplayDebugImgWindow(100, 100);
  561. for x := 0 to 89 do
  562. for y := 0 to 89 do
  563. begin
  564. p := CreateBitmap(100, 100);
  565. for i := 0 to High(a) do
  566. FastSetPixel(p, a[i].X, a[i].Y, 255);
  567. c := IntToBox(x, y, (x + 9), (y + 9));
  568. t := TPAFromBox(c);
  569. for i := 0 to High(t) do
  570. FastSetPixel(p, t[i].X, t[i].Y, 16711680);
  571. SetLength(t, 0);
  572. DrawBitmapDebugImg(p);
  573. FreeBitmap(p);
  574. if BoxInsideBox(c, b) then
  575. begin
  576. WriteLn('INSIDE!');
  577. Exit;
  578. end;
  579. end;
  580. SetLength(a, 0);
  581. end.[/simba]
  582. [/spoiler]
  583. [spoiler="BoxInBoxes"]
  584. [simba]{==============================================================================]
  585. Explanation: Returns true if inner_bx is in/within any of the outer_bxs.
  586. [==============================================================================}
  587. function BoxInBoxes(inner_bx: TBox; outer_bxs: TBoxArray): Boolean;
  588. var
  589. h, i: Integer;
  590. begin
  591. h := High(outer_bxs);
  592. for i := 0 to h do
  593. begin
  594. Result := ((inner_bx.X1 >= outer_bxs[i].X1) and (inner_bx.X1 <= outer_bxs[i].X2) and (inner_bx.X2 >= outer_bxs[i].X1) and (inner_bx.X2 <= outer_bxs[i].X2) and (inner_bx.Y1 >= outer_bxs[i].Y1) and (inner_bx.Y1 <= outer_bxs[i].Y2) and (inner_bx.Y2 >= outer_bxs[i].Y1) and (inner_bx.Y2 <= outer_bxs[i].Y2));
  595. if Result then
  596. Exit;
  597. end;
  598. Result := False;
  599. end;
  600.  
  601. var
  602. a, t: TPointArray;
  603. i, p, x, y: Integer;
  604. b, c, d: TBox;
  605.  
  606. begin
  607. b := IntToBox(50, 50, 61, 61);
  608. d := IntToBox(53, 20, 64, 31);
  609. a := CombineTPA(TPAFromBox(b), TPAFromBox(d));
  610. DisplayDebugImgWindow(100, 100);
  611. for x := 0 to 89 do
  612. for y := 0 to 89 do
  613. begin
  614. p := CreateBitmap(100, 100);
  615. for i := 0 to High(a) do
  616. FastSetPixel(p, a[i].X, a[i].Y, 255);
  617. c := IntToBox(x, y, (x + 9), (y + 9));
  618. t := TPAFromBox(c);
  619. for i := 0 to High(t) do
  620. FastSetPixel(p, t[i].X, t[i].Y, 16711680);
  621. SetLength(t, 0);
  622. DrawBitmapDebugImg(p);
  623. FreeBitmap(p);
  624. if BoxInBoxes(c, [b, d]) then
  625. begin
  626. WriteLn('IN!');
  627. Exit;
  628. end;
  629. end;
  630. SetLength(a, 0);
  631. end.[/simba]
  632. [/spoiler]
  633. [spoiler="BoxInsideBoxes"]
  634. [simba]{==============================================================================]
  635. Explanation: Returns true if inner_bx is INSIDE any of the outer_bxs.
  636. [==============================================================================}
  637. function BoxInsideBoxes(inner_bx: TBox; outer_bxs: TBoxArray): Boolean;
  638. var
  639. h, i: Integer;
  640. begin
  641. h := High(outer_bxs);
  642. for i := 0 to h do
  643. begin
  644. Result := ((inner_bx.X1 > outer_bxs[i].X1) and (inner_bx.X1 < outer_bxs[i].X2) and (inner_bx.X2 > outer_bxs[i].X1) and (inner_bx.X2 < outer_bxs[i].X2) and (inner_bx.Y1 > outer_bxs[i].Y1) and (inner_bx.Y1 < outer_bxs[i].Y2) and (inner_bx.Y2 > outer_bxs[i].Y1) and (inner_bx.Y2 < outer_bxs[i].Y2));
  645. if Result then
  646. Exit;
  647. end;
  648. Result := False;
  649. end;
  650.  
  651. var
  652. a, t: TPointArray;
  653. i, p, x, y: Integer;
  654. b, c, d: TBox;
  655.  
  656. begin
  657. b := IntToBox(50, 50, 61, 61);
  658. d := IntToBox(53, 20, 64, 31);
  659. a := CombineTPA(TPAFromBox(b), TPAFromBox(d));
  660. DisplayDebugImgWindow(100, 100);
  661. for x := 0 to 89 do
  662. for y := 0 to 89 do
  663. begin
  664. p := CreateBitmap(100, 100);
  665. for i := 0 to High(a) do
  666. FastSetPixel(p, a[i].X, a[i].Y, 255);
  667. c := IntToBox(x, y, (x + 9), (y + 9));
  668. t := TPAFromBox(c);
  669. for i := 0 to High(t) do
  670. FastSetPixel(p, t[i].X, t[i].Y, 16711680);
  671. SetLength(t, 0);
  672. DrawBitmapDebugImg(p);
  673. FreeBitmap(p);
  674. if BoxInsideBoxes(c, [b, d]) then
  675. begin
  676. WriteLn('INSIDE!');
  677. Exit;
  678. end;
  679. end;
  680. SetLength(a, 0);
  681. end.[/simba]
  682. [/spoiler]
  683. [spoiler="ValidBox"]
  684. [simba]{==============================================================================]
  685. Explanation: Returns true if bx is valid (X1 <= X2 AND Y1 <= Y2).
  686. [==============================================================================}
  687. function ValidBox(bx: TBox): Boolean;
  688. begin
  689. Result := ((bx.X1 <= bx.X2) and (bx.Y1 <= bx.Y2));
  690. end;
  691.  
  692. begin
  693. if ValidBox(IntToBox(999, 999, 100, 100)) then
  694. WriteLn('What?! This is not valid...');
  695. if ValidBox(IntToBox(100, 100, 999, 999)) then
  696. WriteLn('Now we are talking. ;)');
  697. end.[/simba]
  698. [/spoiler]
  699. [spoiler="SameBoxes"]
  700. [simba]{==============================================================================]
  701. Explanation: Returns true if bx1 and bx2 are identical.
  702. [==============================================================================}
  703. function SameBoxes(bx1, bx2: TBox): Boolean;
  704. begin
  705. Result := ((bx1.X1 = bx2.X1) and (bx1.Y1 = bx2.Y1) and (bx1.X2 = bx2.X2) and (bx1.Y2 = bx2.Y2));
  706. end;
  707.  
  708. begin
  709. if SameBoxes(IntToBox(0, 0, 0, 0), IntToBox(1, 1, 1, 1)) then
  710. WriteLn('NOPE!');
  711. if SameBoxes(IntToBox(1, 2, 3, 4), IntToBox(1, 2, 3, 4)) then
  712. WriteLn('YEAH!');
  713. end.[/simba]
  714. [/spoiler]
  715. [spoiler="SimilarBoxDimensionsEx"]
  716. [simba]{==============================================================================]
  717. Explanation: Returns true if the dimensions from boxes bx1 and bx2
  718. are within maxWDif (max width differency) and maxHDif (max height differency).
  719. [==============================================================================}
  720. function SimilarBoxDimensionsEx(bx1, bx2: TBox; maxWDif, maxHDif: Integer): Boolean;
  721. begin
  722. {$IFNDEF Lape}
  723. Result := ((IAbs(((bx2.X2 - bx2.X1) + 1) - ((bx1.X2 - bx1.X1) + 1)) <= maxWDif) and (IAbs(((bx2.Y2 - bx2.Y1) + 1) - ((bx1.Y2 - bx1.Y1) + 1)) <= maxHDif));
  724. {$ELSE}
  725. Result := ((Abs(((bx2.X2 - bx2.X1) + 1) - ((bx1.X2 - bx1.X1) + 1)) <= maxWDif) and (Abs(((bx2.Y2 - bx2.Y1) + 1) - ((bx1.Y2 - bx1.Y1) + 1)) <= maxHDif));
  726. {$ENDIF}
  727. end;
  728.  
  729. const
  730. WIDTH_DIFFERENCE = 2;
  731. HEIGHT_DIFFERENCE = 2;
  732.  
  733. var
  734. TBA: TBoxArray;
  735. a, b: Integer;
  736.  
  737. begin
  738. TBA := [IntToBox(10, 10, 20, 20), IntToBox(8, 8, 22, 22), IntToBox(12, 12, 20, 20),
  739. IntToBox(7, 7, 21, 21), IntToBox(11, 11, 20, 20), IntToBox(9, 9, 23, 23)];
  740. for a := 0 to (High(TBA) - 1) do
  741. for b := (a + 1) to High(TBA) do
  742. if SimilarBoxDimensionsEx(TBA[a], TBA[b], WIDTH_DIFFERENCE, HEIGHT_DIFFERENCE) then
  743. WriteLn('TBA[' + IntToStr(a) + '] (' + IntToStr(((TBA[a].X2 - TBA[a].X1) + 1)) + 'x' + IntToStr(((TBA[a].Y2 - TBA[a].Y1) + 1)) + ') and TBA[' + IntToStr(b) + '] (' + IntToStr(((TBA[b].X2 - TBA[b].X1) + 1)) + 'x' + IntToStr(((TBA[b].Y2 - TBA[b].Y1) + 1)) + ') are similar.');
  744. end.[/simba]
  745. [/spoiler]
  746. [spoiler="SimilarBoxDimensions"]
  747. [simba]{==============================================================================]
  748. Explanation: Returns true if the dimensions from boxes bx1 and bx2
  749. are within dif (differency).
  750. [==============================================================================}
  751. function SimilarBoxDimensions(bx1, bx2: TBox; dif: Integer): Boolean;
  752. begin
  753. {$IFNDEF Lape}
  754. Result := ((IAbs(((bx2.X2 - bx2.X1) + 1) - ((bx1.X2 - bx1.X1) + 1)) <= dif) and (IAbs(((bx2.Y2 - bx2.Y1) + 1) - ((bx1.Y2 - bx1.Y1) + 1)) <= dif));
  755. {$ELSE}
  756. Result := ((Abs(((bx2.X2 - bx2.X1) + 1) - ((bx1.X2 - bx1.X1) + 1)) <= dif) and (Abs(((bx2.Y2 - bx2.Y1) + 1) - ((bx1.Y2 - bx1.Y1) + 1)) <= dif));
  757. {$ENDIF}
  758. end;
  759.  
  760. const
  761. DIFFERENCE = 2;
  762.  
  763. var
  764. TBA: TBoxArray;
  765. a, b: Integer;
  766.  
  767. begin
  768. TBA := [IntToBox(10, 10, 20, 20), IntToBox(8, 8, 22, 22), IntToBox(12, 12, 20, 20),
  769. IntToBox(7, 7, 21, 21), IntToBox(11, 11, 20, 20), IntToBox(9, 9, 23, 23)];
  770. for a := 0 to (High(TBA) - 1) do
  771. for b := (a + 1) to High(TBA) do
  772. if SimilarBoxDimensions(TBA[a], TBA[b], DIFFERENCE) then
  773. WriteLn('TBA[' + IntToStr(a) + '] (' + IntToStr(((TBA[a].X2 - TBA[a].X1) + 1)) + 'x' + IntToStr(((TBA[a].Y2 - TBA[a].Y1) + 1)) + ') and TBA[' + IntToStr(b) + '] (' + IntToStr(((TBA[b].X2 - TBA[b].X1) + 1)) + 'x' + IntToStr(((TBA[b].Y2 - TBA[b].Y1) + 1)) + ') are similar.');
  774. end.[/simba]
  775. [/spoiler]
  776. [spoiler="MergeTBA"]
  777. [simba]{==============================================================================]
  778. Explanation: Merges array of boxes (TBA) to 1 box.
  779. [==============================================================================}
  780. function MergeTBA(TBA: TBoxArray): TBox;
  781. var
  782. h, i: Integer;
  783. e: TBox;
  784. begin
  785. h := High(TBA);
  786. if (h > -1) then
  787. begin
  788. Result := IntToBox(Min(TBA[0].X1, TBA[0].X2), Min(TBA[0].Y1, TBA[0].Y2), Max(TBA[0].X1, TBA[0].X2), Max(TBA[0].Y1, TBA[0].Y2));
  789. if (h > 0) then
  790. for i := 1 to h do
  791. begin
  792. if (TBA[i].X1 < Result.X1) then
  793. Result.X1 := Integer(TBA[i].X1);
  794. if (TBA[i].X2 < Result.X1) then
  795. Result.X1 := Integer(TBA[i].X2);
  796. if (TBA[i].Y1 < Result.Y1) then
  797. Result.Y1 := Integer(TBA[i].Y1);
  798. if (TBA[i].Y2 < Result.Y1) then
  799. Result.Y1 := Integer(TBA[i].Y2);
  800. if (TBA[i].X2 > Result.X2) then
  801. Result.X2 := Integer(TBA[i].X2);
  802. if (TBA[i].X1 > Result.X2) then
  803. Result.X2 := Integer(TBA[i].X1);
  804. if (TBA[i].Y2 > Result.Y2) then
  805. Result.Y2 := Integer(TBA[i].Y2);
  806. if (TBA[i].Y1 > Result.Y2) then
  807. Result.Y2 := Integer(TBA[i].Y1);
  808. end;
  809. end else
  810. Result := e;
  811. end;
  812.  
  813. begin
  814. WriteLn(MergeTBA([IntToBox(10, 10, 20, 20), IntToBox(5, 5, 10, 10), IntToBox(25, 25, 50, 50)]));
  815. end.[/simba]
  816. [/spoiler]
  817. [spoiler="BoxInTPA"]
  818. [simba]{==============================================================================]
  819. Explanation: Returns true if bx is in TPA (TPA contains all points from bx).
  820. [==============================================================================}
  821. function BoxInTPA(bx: TBox; TPA: TPointArray): Boolean;
  822. begin
  823. if ((bx.X1 <= bx.X2) and (bx.Y1 <= bx.Y2) and (Length(TPA) >= (((bx.X2 - bx.X1) + 1) * ((bx.Y2 - bx.Y1) + 1)))) then
  824. Result := (Length(ReturnPointsNotInTPA(TPA, bx)) = 0)
  825. else
  826. Result := False;
  827. end;
  828.  
  829. begin
  830. if BoxInTPA(IntToBox(25, 25, 50, 50), TPAFromBox(IntToBox(0, 0, 100, 100))) then
  831. WriteLn('YEA!');
  832. if BoxInTPA(IntToBox(25, 25, 50, 50), TPAFromBox(IntToBox(26, 25, 50, 50))) then
  833. WriteLn('YEA!');
  834. end.[/simba]
  835. [/spoiler]
  836. [spoiler="TBABounds"]
  837. [simba]{==============================================================================]
  838. Explanation: Returns the bounds of TBA.
  839. [==============================================================================}
  840. function TBABounds(TBA: TBoxArray): TBox;
  841. var
  842. h, i: Integer;
  843. e: TBox;
  844. begin
  845. h := High(TBA);
  846. if (h > -1) then
  847. begin
  848. Result := TBox(TBA[0]);
  849. if (h < 1) then
  850. Exit;
  851. for i := 1 to h do
  852. begin
  853. if (Result.X1 > TBA[i].X1) then
  854. Result.X1 := Integer(TBA[i].X1);
  855. if (Result.Y1 > TBA[i].Y1) then
  856. Result.Y1 := Integer(TBA[i].Y1);
  857. if (Result.X2 < TBA[i].X2) then
  858. Result.X2 := Integer(TBA[i].X2);
  859. if (Result.Y2 < TBA[i].Y2) then
  860. Result.Y2 := Integer(TBA[i].Y2);
  861. end;
  862. end else
  863. Result := e;
  864. end;
  865.  
  866. begin
  867. WriteLn(TBABounds([IntToBox(5, 5, 10, 10), IntToBox(25, 25, 50, 50)]));
  868. end.[/simba]
  869. [/spoiler]
  870. [spoiler="TBAGrid"]
  871. [simba]{==============================================================================]
  872. Explanation: Returns/builds grid of boxes with parameters;
  873. startPoint = start point of the grid
  874. boxWidth, boxHeight = dimensions of all boxes
  875. rows, columns = count of rows and columns
  876. rowSpace, columnSpace = the space between points at rows and columns
  877. [==============================================================================}
  878. function TBAGrid(startPoint: TPoint; boxWidth, boxHeight, rows, columns, rowSpace, columnSpace: Integer): TBoxArray;
  879. var
  880. r, c: Integer;
  881. begin
  882. if ((rows > -1) and (columns > -1) and (boxWidth > 0) and (boxHeight > 0) and ((rows * columns) > 0)) then
  883. begin
  884. SetLength(Result, (rows * columns));
  885. for r := 0 to (rows - 1) do
  886. for c := 0 to (columns - 1) do
  887. Result[((r * columns) + c)] := IntToBox((startPoint.X + (c * columnSpace)), (startPoint.Y + (r * rowSpace)), ((startPoint.X + (c * columnSpace)) + (boxWidth - 1)), ((startPoint.Y + (r * rowSpace)) + (boxHeight - 1)));
  888. end else
  889. SetLength(Result, 0);
  890. end;
  891.  
  892. const
  893. START_X = 10; START_Y = 10;
  894. WIDTH = 10; HEIGHT = 5;
  895. ROWS = 8; COLUMNS = 16;
  896. ROW_SPACE = (HEIGHT + 1); COLUMN_SPACE = (WIDTH + 2);
  897.  
  898. var
  899. b, i: Integer;
  900. TPA: TPointArray;
  901. TBA: TBoxArray;
  902.  
  903. begin
  904. DisplayDebugImgWindow(500, 500);
  905. TBA := TBAGrid(Point(START_X, START_Y), WIDTH, HEIGHT, ROWS, COLUMNS, ROW_SPACE, COLUMN_SPACE);
  906. for i := 0 to High(TBA) do
  907. TPA := CombineTPA(TPA, TPAFromBox(TBA[i]));
  908. SetLength(TBA, 0);
  909. b := CreateBitmap(500, 500);
  910. for i := 0 to High(TPA) do
  911. FastSetPixel(b, TPA[i].X, TPA[i].Y, 255);
  912. DrawBitmapDebugImg(b);
  913. SetLength(TPA, 0);
  914. FreeBitmap(b);
  915. end.[/simba]
  916. [/spoiler]
  917. [spoiler="TBARow"]
  918. [simba]{==============================================================================]
  919. Explanation: Returns row of boxes. Starting from startPoint,
  920. where rowSpace is the amount of space between each box.
  921. [==============================================================================}
  922. function TBARow(startPoint: TPoint; boxWidth, boxHeight, rows, rowSpace: Integer): TBoxArray;
  923. var
  924. i: Integer;
  925. begin
  926. if ((rows > 0) and (boxWidth > 0) and (boxHeight > 0)) then
  927. begin
  928. SetLength(Result, rows);
  929. for i := 0 to (rows - 1) do
  930. Result[i] := IntToBox(startPoint.X, (startPoint.Y + (i * rowSpace)), (startPoint.X + (boxWidth - 1)), ((startPoint.Y + (i * rowSpace)) + (boxHeight - 1)));
  931. end else
  932. SetLength(Result, 0);
  933. end;
  934.  
  935. const
  936. START_X = 10; START_Y = 10;
  937. WIDTH = 10; HEIGHT = 5;
  938. ROWS = 50;
  939. ROW_SPACE = (HEIGHT + 1);
  940.  
  941. var
  942. b, i: Integer;
  943. TPA: TPointArray;
  944. TBA: TBoxArray;
  945.  
  946. begin
  947. DisplayDebugImgWindow(500, 500);
  948. TBA := TBARow(Point(START_X, START_Y), WIDTH, HEIGHT, ROWS, ROW_SPACE);
  949. WriteLn(ToStr(TBA));
  950. for i := 0 to High(TBA) do
  951. TPA := CombineTPA(TPA, TPAFromBox(TBA[i]));
  952. SetLength(TBA, 0);
  953. b := CreateBitmap(500, 500);
  954. for i := 0 to High(TPA) do
  955. FastSetPixel(b, TPA[i].X, TPA[i].Y, 255);
  956. DrawBitmapDebugImg(b);
  957. SetLength(TPA, 0);
  958. FreeBitmap(b);
  959. end.[/simba]
  960. [/spoiler]
  961. [spoiler="TBAColumn"]
  962. [simba]{==============================================================================]
  963. Explanation: Returns column of boxes. Starting from startPoint,
  964. where columnSpace is the amount of space between each box.
  965. [==============================================================================}
  966. function TBAColumn(startPoint: TPoint; boxWidth, boxHeight, columns, columnSpace: Integer): TBoxArray;
  967. var
  968. i: Integer;
  969. begin
  970. if ((columns > 0) and (boxWidth > 0) and (boxHeight > 0)) then
  971. begin
  972. SetLength(Result, columns);
  973. for i := 0 to (columns - 1) do
  974. Result[i] := IntToBox((startPoint.X + (i * columnSpace)), startPoint.Y, ((startPoint.X + (i * columnSpace)) + (boxWidth - 1)), (startPoint.Y + (boxHeight - 1)));
  975. end else
  976. SetLength(Result, 0);
  977. end;
  978.  
  979. const
  980. START_X = 10; START_Y = 10;
  981. WIDTH = 10; HEIGHT = 5;
  982. COLUMNS = 25;
  983. COLUMN_SPACE = (WIDTH + 1);
  984.  
  985. var
  986. b, i: Integer;
  987. TPA: TPointArray;
  988. TBA: TBoxArray;
  989.  
  990. begin
  991. DisplayDebugImgWindow(500, 500);
  992. TBA := TBAColumn(Point(START_X, START_Y), WIDTH, HEIGHT, COLUMNS, COLUMN_SPACE);
  993. WriteLn(ToStr(TBA));
  994. for i := 0 to High(TBA) do
  995. TPA := CombineTPA(TPA, TPAFromBox(TBA[i]));
  996. SetLength(TBA, 0);
  997. b := CreateBitmap(500, 500);
  998. for i := 0 to High(TPA) do
  999. FastSetPixel(b, TPA[i].X, TPA[i].Y, 255);
  1000. DrawBitmapDebugImg(b);
  1001. SetLength(TPA, 0);
  1002. FreeBitmap(b);
  1003. end.[/simba]
  1004. [/spoiler]
  1005. [spoiler="TBACopyEx"]
  1006. [simba]{==============================================================================]
  1007. Explanation: Copies TBA items from pos1 to pos2.
  1008. Supports reversed copying aswell (pos1 > pos2)!
  1009. [==============================================================================}
  1010. function TBACopyEx(TBA: TBoxArray; pos1, pos2: Integer): TBoxArray;
  1011. var
  1012. i, l: Integer;
  1013. begin
  1014. l := Length(TBA);
  1015. if (l > 0) then
  1016. begin
  1017. if (pos1 < 0) then
  1018. pos1 := 0;
  1019. if (pos1 > (l - 1)) then
  1020. pos1 := (l - 1);
  1021. if (pos2 < 0) then
  1022. pos2 := 0;
  1023. if (pos2 > (l - 1)) then
  1024. pos2 := (l - 1);
  1025. if (pos1 <> pos2) then
  1026. begin
  1027. {$IFNDEF Lape}
  1028. SetLength(Result, (IAbs(pos1 - pos2) + 1));
  1029. {$ELSE}
  1030. SetLength(Result, (Abs(pos1 - pos2) + 1));
  1031. {$ENDIF}
  1032. if (pos1 < pos2) then
  1033. begin
  1034. for i := pos1 to pos2 do
  1035. Result[(i - pos1)] := TBox(TBA[i]);
  1036. end else
  1037. for i := pos1 downto pos2 do
  1038. Result[(pos1 - i)] := TBox(TBA[i]);
  1039. end else
  1040. Result := [TBox(TBA[pos1])];
  1041. end else
  1042. SetLength(Result, 0);
  1043. end;
  1044.  
  1045. begin
  1046. // Copying indexes 2=>1:
  1047. WriteLn(ToStr(TBACopyEx([IntToBox(0, 0, 5, 5), IntToBox(1, 1, 6, 6), IntToBox(2, 2, 4, 4), IntToBox(1, 1, 3, 3)], 2, 1)));
  1048. // Copying indexes 1=>2:
  1049. WriteLn(ToStr(TBACopyEx([IntToBox(0, 0, 5, 5), IntToBox(1, 1, 6, 6), IntToBox(2, 2, 4, 4), IntToBox(1, 1, 3, 3)], 1, 2)));
  1050. end.[/simba]
  1051. [/spoiler]
  1052. [spoiler="TBAClone"]
  1053. [simba]{==============================================================================]
  1054. Explanation: Returns copy/"clone" of TBA.
  1055. [==============================================================================}
  1056. function TBAClone(TBA: TBoxArray): TBoxArray;
  1057. var
  1058. h, i: Integer;
  1059. begin
  1060. h := High(TBA);
  1061. SetLength(Result, (h + 1));
  1062. for i := 0 to h do
  1063. Result[i] := TBox(TBA[i]);
  1064. end;
  1065.  
  1066. begin
  1067. WriteLn(ToStr(TBAClone([IntToBox(0, 0, 5, 5), IntToBox(1, 1, 6, 6), IntToBox(2, 2, 4, 4), IntToBox(1, 1, 3, 3)])));
  1068. end.[/simba]
  1069. [/spoiler]
  1070. [spoiler="TBACombine"]
  1071. [simba]{==============================================================================]
  1072. Explanation: Returns TBA1 and TBA2 combined together.
  1073. [==============================================================================}
  1074. function TBACombine(TBA1, TBA2: TBoxArray): TBoxArray;
  1075. var
  1076. l1, l2, i: Integer;
  1077. begin
  1078. l1 := Length(TBA1);
  1079. l2 := Length(TBA2);
  1080. SetLength(Result, (l1 + l2));
  1081. for i := 0 to (l1 - 1) do
  1082. Result[i] := TBox(TBA1[i]);
  1083. for i := 0 to (l2 - 1) do
  1084. Result[(l1 + i)] := TBox(TBA2[i]);
  1085. end;
  1086.  
  1087. begin
  1088. WriteLn(ToStr(TBACombine([IntToBox(1, 2, 3, 4)], [IntToBox(5, 6, 7, 8)])));
  1089. end.[/simba]
  1090. [/spoiler]
  1091. [spoiler="TBADelete"]
  1092. [simba]{==============================================================================]
  1093. Explanation: Deletes TBA item by x as the index position. Returns true with success.
  1094. [==============================================================================}
  1095. function TBADelete(var TBA: TBoxArray; x: Integer): Boolean;
  1096. var
  1097. i, h: Integer;
  1098. begin
  1099. h := High(TBA);
  1100. Result := ((x < (h + 1)) and (x > -1));
  1101. if not Result then
  1102. Exit;
  1103. for i := x to (h - 1) do
  1104. TBA[i] := TBA[(i + 1)];
  1105. SetLength(TBA, h);
  1106. end;
  1107.  
  1108. var
  1109. TBA: TBoxArray;
  1110. i: Integer;
  1111.  
  1112. begin
  1113. SetLength(TBA, 5);
  1114. for i := 5 downto -1 do
  1115. if TBADelete(TBA, i) then
  1116. WriteLn('Deleted index ' + IntToStr(i) + ' from TBA => ' + ToStr(TBA))
  1117. else
  1118. WriteLn('Couldn''t delete index ' + IntToStr(i) + ' from TBA => ' + ToStr(TBA));
  1119. end.[/simba]
  1120. [/spoiler]
  1121. [spoiler="TBARemove"]
  1122. [simba]{==============================================================================]
  1123. Explanation: Removes boxes from TBA, x = array of indexes.
  1124. NOTE: DYNAMIC index deletion! Doesn't pay attention to duplicate indexes.
  1125. Deletes indexes with the loop, so place the indexes the way you need them to be deleted. :)
  1126. [==============================================================================}
  1127. procedure TBARemove(var TBA: TBoxArray; x: TIntegerArray);
  1128. var
  1129. i, i2, h, h2: Integer;
  1130. begin
  1131. h := High(TBA);
  1132. h2 := High(x);
  1133. if ((h < 0) or (h2 < 0)) then
  1134. Exit;
  1135. for i2 := 0 to h2 do
  1136. if ((x[i2] <= h) and (x[i2] > -1)) then
  1137. begin
  1138. for i := x[i2] to (h - 1) do
  1139. TBA[i] := TBA[(i + 1)];
  1140. Dec(h);
  1141. end;
  1142. SetLength(TBA, (h + 1));
  1143. end;
  1144.  
  1145. var
  1146. TBA: TBoxArray;
  1147.  
  1148. begin
  1149. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1150. IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6),
  1151. IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)];
  1152. TBARemove(TBA, [0, 1, 2]); // Without reversed indexes
  1153. WriteLn(ToStr(TBA));
  1154. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1155. IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6),
  1156. IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)];
  1157. TBARemove(TBA, [2, 1, 0]); // With reversed indexes
  1158. WriteLn(ToStr(TBA));
  1159. end.[/simba]
  1160. [/spoiler]
  1161. [spoiler="TBASame"]
  1162. [simba]{==============================================================================]
  1163. Explanation: Returns true if TBA1 and TBA2 are identical.
  1164. [==============================================================================}
  1165. function TBASame(TBA1, TBA2: TBoxArray): Boolean;
  1166. var
  1167. h, i: Integer;
  1168. begin
  1169. Result := False;
  1170. h := High(TBA1);
  1171. if (h <> High(TBA2)) then
  1172. Exit;
  1173. for i := 0 to h do
  1174. if ((TBA1[i].X1 <> TBA2[i].X1) or (TBA1[i].Y1 <> TBA2[i].Y1) or (TBA1[i].X2 <> TBA2[i].X2) or (TBA1[i].Y2 <> TBA2[i].Y2)) then
  1175. Exit;
  1176. Result := True;
  1177. end;
  1178.  
  1179. begin
  1180. if TBASame([], []) then
  1181. WriteLn('YEP 1!');
  1182. if TBASame([IntToBox(0, 0, 0, 0), IntToBox(1, 2, 3, 4)], [IntToBox(0, 0, 0, 0), IntToBox(1, 2, 3, 4)]) then
  1183. WriteLn('YEP 2!');
  1184. if TBASame([IntToBox(0, 0, 0, 0), IntToBox(1, 2, 3, 4)], [IntToBox(0, 0, 0, 1), IntToBox(1, 2, 3, 4)]) then
  1185. WriteLn('NOPE 1!');
  1186. end.[/simba]
  1187. [/spoiler]
  1188. [spoiler="TBAInsert"]
  1189. [simba]{==============================================================================]
  1190. Explanation: Inserts bx to index position of TBA.
  1191. [==============================================================================}
  1192. procedure TBAInsert(var TBA: TBoxArray; index: Integer; bx: TBox);
  1193. var
  1194. i, l: Integer;
  1195. begin
  1196. l := Length(TBA);
  1197. SetLength(TBA, (l + 1));
  1198. if (index < 0) then
  1199. index := 0;
  1200. if (index > l) then
  1201. index := l;
  1202. if (l > index) then
  1203. for i := (l - 1) downto index do
  1204. TBA[(i + 1)] := TBA[i];
  1205. TBA[index] := TBox(bx);
  1206. end;
  1207.  
  1208. var
  1209. TBA: TBoxArray;
  1210.  
  1211. begin
  1212. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1213. IntToBox(3, 3, 4, 4), IntToBox(5, 5, 6, 6),
  1214. IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)];
  1215. TBAInsert(TBA, 4, IntToBox(4, 4, 5, 5));
  1216. WriteLn(ToStr(TBA));
  1217. end.[/simba]
  1218. [/spoiler]
  1219. [spoiler="TBAAppend"]
  1220. [simba]{==============================================================================]
  1221. Explanation: Appends TBA with bx.
  1222. [==============================================================================}
  1223. procedure TBAAppend(var TBA: TBoxArray; bx: TBox);
  1224. var
  1225. aL: Integer;
  1226. begin
  1227. aL := (Length(TBA) + 1);
  1228. SetLength(TBA, aL);
  1229. TBA[(aL - 1)] := TBox(bx);
  1230. end;
  1231.  
  1232. var
  1233. TBA: TBoxArray;
  1234.  
  1235. begin
  1236. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1237. IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6),
  1238. IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8)];
  1239. TBAAppend(TBA, IntToBox(8, 8, 9, 9));
  1240. WriteLn(ToStr(TBA));
  1241. end.[/simba]
  1242. [/simba]
  1243. [/spoiler]
  1244. [spoiler="TBAAdd"]
  1245. [simba]{==============================================================================]
  1246. Explanation: Adds all addTBA items to TBA. Returns the highest index in the end.
  1247. [==============================================================================}
  1248. function TBAAdd(var TBA: TBoxArray; addTBA: TBoxArray): Integer;
  1249. var
  1250. h, l, i: Integer;
  1251. begin
  1252. h := High(addTBA);
  1253. if (h > -1) then
  1254. begin
  1255. l := Length(TBA);
  1256. SetLength(TBA, (l + (h + 1)));
  1257. for i := 0 to h do
  1258. TBA[(i + l)] := TBox(addTBA[i]);
  1259. end;
  1260. Result := High(TBA);
  1261. end;
  1262.  
  1263. var
  1264. TBA: TBoxArray;
  1265.  
  1266. begin
  1267. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1268. IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6)];
  1269. TBAAdd(TBA, [IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)]);
  1270. WriteLn(ToStr(TBA));
  1271. end.[/simba]
  1272. [/spoiler]
  1273. [spoiler="TBAPlant"]
  1274. [simba]{==============================================================================]
  1275. Explanation: Plants/places bxs to index position in TBA.
  1276. Like TBAInsert(), with an exception that this inserts array of boxes.
  1277. Returns the highest index from TBA in the end.
  1278. [==============================================================================}
  1279. function TBAPlant(var TBA: TBoxArray; index: Integer; bxs: TBoxArray): Integer;
  1280. var
  1281. i, l, h: Integer;
  1282. begin
  1283. h := High(bxs);
  1284. if (h > -1) then
  1285. begin
  1286. l := Length(TBA);
  1287. SetLength(TBA, (l + (h + 1)));
  1288. if (index < 0) then
  1289. index := 0;
  1290. if (index > l) then
  1291. index := l;
  1292. for i := (l + (h + 1) - 1) downto (index + (h + 1)) do
  1293. TBA[i] := TBA[(i - (h + 1))];
  1294. for i := 0 to h do
  1295. TBA[(i + index)] := TBox(bxs[i]);
  1296. end;
  1297. Result := High(TBA);
  1298. end;
  1299.  
  1300. var
  1301. TBA: TBoxArray;
  1302.  
  1303. begin
  1304. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1305. IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)];
  1306. TBAPlant(TBA, 3, [IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6)]);
  1307. WriteLn(ToStr(TBA));
  1308. end.[/simba]
  1309. [/spoiler]
  1310. [spoiler="TBAUnique"]
  1311. [simba]{==============================================================================]
  1312. Explanation: Removes any and all duplicates from TBA.
  1313. [==============================================================================}
  1314. procedure TBAUnique(var TBA: TBoxArray);
  1315. var
  1316. h, h2, i, i2, i3, d: Integer;
  1317. begin
  1318. h := High(TBA);
  1319. if (h < 1) then
  1320. Exit;
  1321. for i := (h - d) downto 1 do
  1322. for i2 := (i - 1) downto 0 do
  1323. if ((TBA[i].X1 = TBA[i2].X1) and (TBA[i].Y1 = TBA[i2].Y1) and (TBA[i].X2 = TBA[i2].X2) and (TBA[i].Y2 = TBA[i2].Y2)) then
  1324. begin
  1325. h2 := High(TBA);
  1326. for i3 := i to (h2 - 1) do
  1327. TBA[i3] := TBA[(i3 + 1)];
  1328. SetLength(TBA, h2);
  1329. Inc(d);
  1330. Break;
  1331. end;
  1332. end;
  1333.  
  1334. var
  1335. TBA: TBoxArray;
  1336.  
  1337. begin
  1338. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3), IntToBox(0, 0, 1, 1),
  1339. IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6),
  1340. IntToBox(6, 6, 7, 7), IntToBox(2, 2, 3, 3), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)];
  1341. TBAUnique(TBA);
  1342. WriteLn(ToStr(TBA));
  1343. end.[/simba]
  1344. [/spoiler]
  1345. [spoiler="TBARandomizeEx"]
  1346. [simba]{==============================================================================]
  1347. Explanation: Randomizes the TBA.
  1348. With higher shuffles you get "stronger" randomization..
  1349. [==============================================================================}
  1350. procedure TBARandomizeEx(var TBA: TBoxArray; shuffles: Integer);
  1351. var
  1352. i, l, s: integer;
  1353. begin
  1354. l := Length(TBA);
  1355. for s := 0 to shuffles do
  1356. for i := 0 to (l - 1) do
  1357. Swap(TBA[Random(l)], TBA[Random(l)]);
  1358. end;
  1359.  
  1360. var
  1361. TBA: TBoxArray;
  1362.  
  1363. begin
  1364. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1365. IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6),
  1366. IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)];
  1367. TBARandomizeEx(TBA, (Random(2) + 1));
  1368. WriteLn(ToStr(TBA));
  1369. end.[/simba]
  1370. [/spoiler]
  1371. [spoiler="TBARandomize"]
  1372. [simba]{==============================================================================]
  1373. Explanation: Randomizes the TBA.
  1374. [==============================================================================}
  1375. procedure TBARandomize(var TBA: TBoxArray);
  1376. var
  1377. i, l: integer;
  1378. begin
  1379. l := Length(TBA);
  1380. for i := 0 to (l - 1) do
  1381. Swap(TBA[Random(l)], TBA[Random(l)]);
  1382. end;
  1383.  
  1384. var
  1385. TBA: TBoxArray;
  1386.  
  1387. begin
  1388. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1389. IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6),
  1390. IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)];
  1391. TBARandomize(TBA);
  1392. WriteLn(ToStr(TBA));
  1393. end.[/simba]
  1394. [/spoiler]
  1395. [spoiler="TBAContains"]
  1396. [simba]{==============================================================================]
  1397. Explanation: Returns true if TBA contains bx.
  1398. [==============================================================================}
  1399. function TBAContains(TBA: TBoxArray; bx: TBox): Boolean;
  1400. var
  1401. i, h: Integer;
  1402. begin
  1403. h := High(TBA);
  1404. for i := 0 to h do
  1405. begin
  1406. Result := ((bx.X1 = TBA[i].X1) and (bx.Y1 = TBA[i].Y1) and (bx.X2 = TBA[i].X2) and (bx.Y2 = TBA[i].Y2));
  1407. if Result then
  1408. Exit;
  1409. end;
  1410. Result := False;
  1411. end;
  1412.  
  1413. var
  1414. TBA: TBoxArray;
  1415.  
  1416. begin
  1417. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1418. IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6),
  1419. IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)];
  1420. if TBAContains(TBA, IntToBox(7, 7, 8, 8)) then
  1421. WriteLn('YUP!');
  1422. if TBAContains(TBA, IntToBox(1, 2, 3, 4)) then
  1423. WriteLn('The heck?!');
  1424. end.[/simba]
  1425. [/spoiler]
  1426. [spoiler="TBAPositions"]
  1427. [simba]{==============================================================================]
  1428. Explanation: Returns all the positions in TBA where bx is found/matched.
  1429. [==============================================================================}
  1430. function TBAPositions(TBA: TBoxArray; bx: TBox): TIntegerArray;
  1431. var
  1432. i, h, r: Integer;
  1433. begin
  1434. h := High(TBA);
  1435. if (h > -1) then
  1436. begin
  1437. SetLength(Result, (h + 1));
  1438. for i := 0 to h do
  1439. if ((bx.X1 = TBA[i].X1) and (bx.Y1 = TBA[i].Y1) and (bx.X2 = TBA[i].X2) and (bx.Y2 = TBA[i].Y2)) then
  1440. begin
  1441. Result[r] := i;
  1442. Inc(r);
  1443. end;
  1444. end;
  1445. SetLength(Result, r);
  1446. end;
  1447.  
  1448. var
  1449. TBA: TBoxArray;
  1450.  
  1451. begin
  1452. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1453. IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6),
  1454. IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9),
  1455. IntToBox(0, 0, 1, 1)];
  1456. WriteLn(ToStr(TBAPositions(TBA, IntToBox(0, 0, 1, 1))));
  1457. end.[/simba]
  1458. [/spoiler]
  1459. [spoiler="TBAGet"]
  1460. [simba]{==============================================================================]
  1461. Explanation: Returns item[s] from TBA by IDs. Ignores invalid ID's.
  1462. [==============================================================================}
  1463. function TBAGet(TBA: TBoxArray; IDs: TIntegerArray): TBoxArray;
  1464. var
  1465. i, h, h2, rC: Integer;
  1466. begin
  1467. h := High(TBA);
  1468. h2 := High(IDs);
  1469. if (h2 > -1) then
  1470. begin
  1471. SetLength(Result, (h2 + 1));
  1472. for i := 0 to h2 do
  1473. if ((IDs[i] <= h) and (IDs[i] > -1)) then
  1474. begin
  1475. Result[rC] := TBox(TBA[IDs[i]]);
  1476. Inc(rC);
  1477. end;
  1478. end;
  1479. SetLength(Result, rC);
  1480. end;
  1481.  
  1482. var
  1483. TBA: TBoxArray;
  1484.  
  1485. begin
  1486. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1487. IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6),
  1488. IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)];
  1489. WriteLn(ToStr(TBAGet(TBA, [-1342, 0, 9949993, 1, -2342, 2, 45454, 3])));
  1490. end.[/simba]
  1491. [/spoiler]
  1492. [spoiler="TBAMove"]
  1493. [simba]{==============================================================================]
  1494. Explanation: Moves oldIndex to newIndex in TBA. Returns true, if movement was succesfully done!
  1495. [==============================================================================}
  1496. function TBAMove(var TBA: TBoxArray; oldIndex, newIndex: Integer): Boolean;
  1497. var
  1498. h, i: Integer;
  1499. begin
  1500. h := High(TBA);
  1501. Result := ((h > 0) and (oldIndex <> newIndex) and InRange(oldIndex, 0, h) and InRange(newIndex, 0, h));
  1502. if Result then
  1503. if (oldIndex > newIndex) then
  1504. begin
  1505. for i := oldIndex downto (newIndex + 1) do
  1506. Swap(TBA[i], TBA[(i - 1)]);
  1507. end else
  1508. for i := oldIndex to (newIndex - 1) do
  1509. Swap(TBA[i], TBA[(i + 1)]);
  1510. end;
  1511.  
  1512. var
  1513. TBA: TBoxArray;
  1514.  
  1515. begin
  1516. TBA := [IntToBox(0, 0, 1, 1), IntToBox(6, 6, 7, 7), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1517. IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6),
  1518. IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)];
  1519. TBAMove(TBA, 1, 6);
  1520. WriteLn(ToStr(TBA));
  1521. end.[/simba]
  1522. [/spoiler]
  1523. [spoiler="TBAToParts"]
  1524. [simba]type
  1525. TPartitionMethod = (pm_PartSize, pm_PartAmount);
  1526.  
  1527. function TBAToParts(TBA: TBoxArray; method: TPartitionMethod; x: Integer): array of TBoxArray;
  1528. {==============================================================================]
  1529. Explanation: Breaks TBA to parts (TBA => ATBA). Contains 2 methods:
  1530. -pm_PartSize (Breaks TBA to ATBA by size of the parts) [x = size]
  1531. -pm_PartAmount (Breaks TBA to ATBA by amount of the parts) [x = amount]
  1532. [==============================================================================}
  1533. var
  1534. a, e, h, h2, i, i2, p, l, z: Integer;
  1535. f: Boolean;
  1536. begin
  1537. h := High(TBA);
  1538. if ((h > -1) and (x > 0)) then
  1539. begin
  1540. case method of
  1541. pm_PartSize:
  1542. if (x <= h) then
  1543. begin
  1544. Inc(h);
  1545. p := (h div x);
  1546. if ((p * x) < h) then
  1547. Inc(p);
  1548. SetLength(Result, p);
  1549. for i := 0 to (p - 1) do
  1550. for i2 := 0 to (x - 1) do
  1551. begin
  1552. SetLength(Result[i], x);
  1553. if (a < h) then
  1554. begin
  1555. Result[i][i2] := TBox(TBA[a]);
  1556. Inc(a);
  1557. end else
  1558. begin
  1559. SetLength(Result[i], i2);
  1560. Exit;
  1561. end;
  1562. end;
  1563. end else
  1564. f := True;
  1565. pm_PartAmount:
  1566. if (h > -1) then
  1567. begin
  1568. if (h < (x - 1)) then
  1569. x := (h + 1);
  1570. p := Floor((h + 1) / x);
  1571. if (p = 0) then
  1572. p := 1;
  1573. e := ((h + 1) - (p * x));
  1574. if (e >= (h + 1)) then
  1575. e := 0;
  1576. SetLength(Result, x);
  1577. for i := 0 to (x - 1) do
  1578. begin
  1579. if ((e >= (i + 1)) and (e > 0)) then
  1580. SetLength(Result[i], (p + 1))
  1581. else
  1582. if (i <= h) then
  1583. SetLength(Result[i], p);
  1584. h2 := High(Result[i]);
  1585. for i2 := 0 to h2 do
  1586. begin
  1587. Result[i][i2] := TBox(TBA[a]);
  1588. Inc(a);
  1589. end;
  1590. end;
  1591. end else
  1592. f := True;
  1593. end;
  1594. if f then
  1595. begin
  1596. SetLength(Result, 1);
  1597. l := Length(TBA);
  1598. SetLength(Result[0], l);
  1599. for z := 0 to (l - 1) do
  1600. Result[0][z] := TBox(TBA[z]);
  1601. end;
  1602. end else
  1603. SetLength(Result, 0);
  1604. end;
  1605.  
  1606. var
  1607. TBA: TBoxArray;
  1608.  
  1609. begin
  1610. TBA := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3),
  1611. IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6),
  1612. IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)];
  1613. WriteLn('TBAToParts(TBA, pm_PartSize, 4): ' + ToStr(TBAToParts(TBA, pm_PartSize, 4)));
  1614. WriteLn('TBAToParts(TBA, pm_PartAmount, 4): ' + ToStr(TBAToParts(TBA, pm_PartAmount, 4)));
  1615. end.[/simba]
  1616. [/spoiler]
  1617. [spoiler="TBACenterPointsEx"]
  1618. [simba]{==============================================================================]
  1619. Explanation: Returns center points from all TBA indexes.
  1620. Adds randomness to the points, if you set XOffsetRadius or/and YOffsetRadius HIGHER than 0.
  1621. [==============================================================================}
  1622. function TBACenterPointsEx(TBA: TBoxArray; XOffsetRadius, YOffsetRadius: Integer): TPointArray;
  1623. var
  1624. h, i: Integer;
  1625. begin
  1626. h := High(TBA);
  1627. if (h > -1) then
  1628. begin
  1629. SetLength(Result, (h + 1));
  1630. if ((XOffsetRadius > 0) or (YOffsetRadius > 0)) then
  1631. begin
  1632. if (XOffsetRadius < 0) then
  1633. XOffsetRadius := 0;
  1634. if (YOffsetRadius < 0) then
  1635. YOffsetRadius := 0;
  1636. for i := 0 to h do
  1637. begin
  1638. if ((TBA[i].X1 <= TBA[i].X2) and (TBA[i].Y1 <= TBA[i].Y2)) then
  1639. Result[i] := Point(Round(TBA[i].X1 + ((TBA[i].X2 - TBA[i].X1) div 2)), Round(TBA[i].Y1 + ((TBA[i].Y2 - TBA[i].Y1) div 2)))
  1640. else
  1641. Result[i] := Point(0, 0);
  1642. Result[i].X := (Result[i].X + RandomRange(-XOffsetRadius, (XOffsetRadius + 1)));
  1643. Result[i].Y := (Result[i].Y + RandomRange(-YOffsetRadius, (YOffsetRadius + 1)));
  1644. end;
  1645. end else
  1646. for i := 0 to h do
  1647. if ((TBA[i].X1 <= TBA[i].X2) and (TBA[i].Y1 <= TBA[i].Y2)) then
  1648. Result[i] := Point(Round(TBA[i].X1 + ((TBA[i].X2 - TBA[i].X1) div 2)), Round(TBA[i].Y1 + ((TBA[i].Y2 - TBA[i].Y1) div 2)))
  1649. else
  1650. Result[i] := Point(0, 0);
  1651. end else
  1652. SetLength(Result, 0);
  1653. end;
  1654.  
  1655. var
  1656. r: Integer;
  1657. TBA: TBoxArray;
  1658.  
  1659. begin
  1660. TBA := [IntToBox(0, 0, 49, 49), IntToBox(100, 100, 199, 199), IntToBox(250, 250, 499, 499)];
  1661. for r := 0 to 5 do
  1662. WriteLn('TBACenterPointsEx(TBA, ' + IntToStr(r) + ', ' + IntToStr(r) + '): ' + ToStr(TBACenterPointsEx(TBA, r, r)));
  1663. end.[/simba]
  1664. [/spoiler]
  1665. [spoiler="TBACenterPoints"]
  1666. [simba]{==============================================================================]
  1667. Explanation: Returns center points from all TBA indexes.
  1668. Results will be without randomness. So, "perfect" center points!
  1669. [==============================================================================}
  1670. function TBACenterPoints(TBA: TBoxArray): TPointArray;
  1671. var
  1672. h, i: Integer;
  1673. begin
  1674. h := High(TBA);
  1675. if (h > -1) then
  1676. begin
  1677. SetLength(Result, (h + 1));
  1678. for i := 0 to h do
  1679. if ((TBA[i].X1 <= TBA[i].X2) and (TBA[i].Y1 <= TBA[i].Y2)) then
  1680. Result[i] := Point(Round(TBA[i].X1 + ((TBA[i].X2 - TBA[i].X1) div 2)), Round(TBA[i].Y1 + ((TBA[i].Y2 - TBA[i].Y1) div 2)))
  1681. else
  1682. Result[i] := Point(0, 0);
  1683. end else
  1684. SetLength(Result, 0);
  1685. end;
  1686.  
  1687. var
  1688. TBA: TBoxArray;
  1689.  
  1690. begin
  1691. TBA := [IntToBox(0, 0, 49, 49), IntToBox(100, 100, 199, 199), IntToBox(250, 250, 499, 499)];
  1692. WriteLn('TBACenterPoints(TBA): ' + ToStr(TBACenterPoints(TBA)));
  1693. end.[/simba]
  1694. [/spoiler]
  1695. [spoiler="ATBAMerge"]
  1696. [simba]function ATBAMerge(ATBA: array of TBoxArray): TBoxArray;
  1697. var
  1698. i, i2, h, h2, r: Integer;
  1699. begin
  1700. h := High(ATBA);
  1701. if (h > -1) then
  1702. begin
  1703. for i := 0 to h do
  1704. IncEx(r, (High(ATBA[i]) + 1));
  1705. SetLength(Result, r);
  1706. r := 0;
  1707. for i := 0 to h do
  1708. begin
  1709. h2 := High(ATBA[i]);
  1710. for i2 := 0 to h2 do
  1711. begin
  1712. Result[r] := TBox(ATBA[i][i2]);
  1713. Inc(r);
  1714. end;
  1715. end;
  1716. end else
  1717. SetLength(Result, 0);
  1718. end;
  1719.  
  1720. var
  1721. ATBA: array of TBoxArray;
  1722.  
  1723. begin
  1724. SetLength(ATBA, 3);
  1725. ATBA[0] := [IntToBox(0, 0, 1, 1), IntToBox(1, 1, 2, 2), IntToBox(2, 2, 3, 3)];
  1726. ATBA[1] := [IntToBox(3, 3, 4, 4), IntToBox(4, 4, 5, 5), IntToBox(5, 5, 6, 6)];
  1727. ATBA[2] := [IntToBox(6, 6, 7, 7), IntToBox(7, 7, 8, 8), IntToBox(8, 8, 9, 9)];
  1728. WriteLn(ToStr(ATBAMerge(ATBA)));
  1729. SetLength(ATBA, 0);
  1730. end.[/simba]
  1731. [/spoiler]
  1732.  
  1733. Going to add more stuff soon. :stirthepot:
  1734.  
  1735. ..oh and, just like for the String Handling Commands:
  1736. Feel free to use/take/improve/anything - it's all open-source!
  1737. Giving credit is always appreciated, but not really necessary for me. :)
  1738.  
  1739. Have fun!
  1740. -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!