API tools faq
paste
Advertisement
g0ku

Untitled

g0ku
Feb 12th, 2017
99
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 5.80 KB | None | 0 0
raw download clone embed print report
  1.  
  2.  
  3. function PCheckForShip(m,k,x,l:integer):boolean;
  4. var ok:boolean;
  5. br,i,j:integer;
  6.  
  7. begin
  8. ok:=false;
  9. if x=0 then
  10. begin
  11. br:=0;
  12. for i:=m-l+1 to m do
  13. if pBoard[i,k]=0 then
  14. br:=br+1;
  15. if br=l then
  16. ok:=true;
  17. end;
  18.  
  19. if x=1 then
  20. begin
  21. br:=0;
  22. for i:=m to m+l-1 do
  23. if PBoard[i,k]=0 then
  24. br:=br+1;
  25. if br=l then
  26. ok:=true;
  27. end;
  28.  
  29. if x=2 then
  30. begin
  31. br:=0;
  32. for j:=k-l+1 to k do
  33. if PBoard[m,j]=0 then
  34. br:=br+1;
  35. if br=l then
  36. ok:=true;
  37. end;
  38.  
  39. if x=3 then
  40. begin
  41. br:=0;
  42. for j:=k to k+l-1 do
  43. if PBoard[m,j]=0 then
  44. br:=br+1;
  45. if br=l then
  46. ok:=true;
  47. end;
  48.  
  49. PCheckForShip:=ok;
  50. end;
  51.  
  52. procedure PSetShip(m,k,x,l:integer);
  53. var i,j:integer;
  54. begin
  55. if x=0 then
  56. begin
  57. for i:=m-l to m+1 do
  58. for j:=k-1 to k+1 do
  59. PBoard[i,j]:=2;
  60. for i:=m-l+1 to m do
  61. begin
  62. PBoard[i,k]:=1;
  63. PMat[i,k].brush.color:=clblue;
  64. end;
  65. end;
  66. if x=1 then
  67. begin
  68. for i:=m-1 to m+l do
  69. for j:=k-1 to k+1 do
  70. PBoard[i,j]:=2;
  71. for i:=m to m+l-1 do
  72. begin
  73. PBoard[i,k]:=1;
  74. PMat[i,k].brush.color:=clblue;
  75. end;
  76. end;
  77. if x=2 then
  78. begin
  79. for i:=m-1 to m+1 do
  80. for j:=k-l to k+1 do
  81. PBoard[i,j]:=2;
  82. for j:=k-l+1 to k do
  83. begin
  84. PBoard[m,j]:=1;
  85. PMat[m,j].brush.color:=clblue;
  86. end;
  87. end;
  88. if x=3 then
  89. begin
  90. for i:=m-1 to m+1 do
  91. for j:=k-1 to k+l do
  92. PBoard[i,j]:=2;
  93. for j:=k to k+l-1 do
  94. begin
  95. PBoard[m,j]:=1;
  96. PMat[m,j].brush.color:=clblue;
  97. end;
  98. end;
  99.  
  100. end;
  101.  
  102. procedure PGenerateRandom;
  103. var
  104. x,l,m,k,i,j:integer;
  105. begin
  106. for i:=0 to 9 do
  107. for j:=0 to 9 do
  108. PBoard[i,j]:=0;
  109. for l:=4 downto 1 do
  110. begin
  111. j:=4-l+1;
  112.  
  113. for i:=1 to j do
  114. begin
  115. repeat
  116. m:=random(9);
  117. k:=random(9);
  118. until PCheckForShip(m,k,0,l) OR PCheckForShip(m,k,1,l) OR PCheckForShip(m,k,2,l) OR PCheckForShip(m,k,3,l);
  119.  
  120. repeat
  121. x:=random(3);
  122. until PCheckForShip(m,k,x,l);
  123.  
  124. PSetShip(m,k,x,l);
  125.  
  126. end;
  127.  
  128.  
  129.  
  130.  
  131. end;
  132.  
  133. end;
  134. function cCheckForShip(m,k,x,l:integer):boolean;
  135. var ok:boolean;
  136. br,i,j:integer;
  137.  
  138. begin
  139. ok:=false;
  140. if x=0 then
  141. begin
  142. br:=0;
  143. for i:=m-l+1 to m do
  144. if cBoard[i,k]=0 then
  145. br:=br+1;
  146. if br=l then
  147. ok:=true;
  148. end;
  149.  
  150. if x=1 then
  151. begin
  152. br:=0;
  153. for i:=m to m+l-1 do
  154. if cBoard[i,k]=0 then
  155. br:=br+1;
  156. if br=l then
  157. ok:=true;
  158. end;
  159.  
  160. if x=2 then
  161. begin
  162. br:=0;
  163. for j:=k-l+1 to k do
  164. if cBoard[m,j]=0 then
  165. br:=br+1;
  166. if br=l then
  167. ok:=true;
  168. end;
  169.  
  170. if x=3 then
  171. begin
  172. br:=0;
  173. for j:=k to k+l-1 do
  174. if cBoard[m,j]=0 then
  175. br:=br+1;
  176. if br=l then
  177. ok:=true;
  178. end;
  179.  
  180. cCheckForShip:=ok;
  181. end;
  182. procedure cSetShip(m,k,x,l:integer);
  183. var i,j:integer;
  184. begin
  185. if x=0 then
  186. begin
  187. for i:=m-l to m+1 do
  188. for j:=k-1 to k+1 do
  189. cBoard[i,j]:=2;
  190. for i:=m-l+1 to m do
  191.  
  192. cBoard[i,k]:=1;
  193.  
  194. end;
  195. if x=1 then
  196. begin
  197. for i:=m-1 to m+l do
  198. for j:=k-1 to k+1 do
  199. cBoard[i,j]:=2;
  200. for i:=m to m+l-1 do
  201.  
  202. cBoard[i,k]:=1;
  203.  
  204. end;
  205. if x=2 then
  206. begin
  207. for i:=m-1 to m+1 do
  208. for j:=k-l to k+1 do
  209. cBoard[i,j]:=2;
  210. for j:=k-l+1 to k do
  211.  
  212. cBoard[m,j]:=1;
  213.  
  214. end;
  215. if x=3 then
  216. begin
  217. for i:=m-1 to m+1 do
  218. for j:=k-1 to k+l do
  219. cBoard[i,j]:=2;
  220. for j:=k to k+l-1 do
  221. cBoard[m,j]:=1;
  222. end;
  223. shipsset:=true;
  224. end;
  225. procedure cGenerateRandom;
  226. var
  227. x,l,m,k,i,j:integer;
  228. begin
  229. for i:=0 to 9 do
  230. for j:=0 to 9 do
  231. cBoard[i,j]:=0;
  232. for l:=4 downto 1 do
  233. begin
  234. j:=4-l+1;
  235.  
  236. for i:=1 to j do
  237. begin
  238. repeat
  239. m:=random(9);
  240. k:=random(9);
  241. until CCheckForShip(m,k,0,l) OR CCheckForShip(m,k,1,l) OR CCheckForShip(m,k,2,l) OR CCheckForShip(m,k,3,l);
  242.  
  243. repeat
  244. x:=random(3);
  245. until CCheckForShip(m,k,x,l);
  246.  
  247. CSetShip(m,k,x,l);
  248.  
  249. end;
  250.  
  251.  
  252.  
  253. end;
  254.  
  255. end;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
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!