API tools faq
paste
Advertisement
g0ku

Untitled

g0ku
Feb 27th, 2017
97
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 30.55 KB | None | 0 0
raw download clone embed print report
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8. Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9. StdCtrls, CustomDrawnControls,customdrawn_common, MaskEdit;
  10.  
  11. type
  12.  
  13. { TForm1 }
  14.  
  15. TForm1 = class(TForm)
  16. CDButton1: TCDButton;
  17. CDButton2: TCDButton;
  18. CDButton3: TCDButton;
  19. Label1: TLabel;
  20. cTurn: TShape;
  21. pTurn: TShape;
  22. Timer1: TTimer;
  23. procedure CDButton1Click(Sender: TObject);
  24. procedure CDButton2Click(Sender: TObject);
  25. procedure FormCreate(Sender: TObject);
  26. procedure pShapeMouseDown(Sender: TObject; Button: TMouseButton;
  27. Shift: TShiftState; X, Y: Integer);
  28. function pOdigraj(p,q:integer):boolean;
  29. function desno(x,y,tip:integer):integer;
  30. function levo(x,y,tip:integer):integer;
  31. function gore(x,y,tip:integer):integer;
  32. function dole(x,y,tip:integer):integer;
  33. function adesno(x,y:integer):integer;
  34. function alevo(x,y:integer):integer;
  35. function agore(x,y:integer):integer;
  36. function adole(x,y:integer):integer;
  37. function isPotopljen(x,y,tip:integer):boolean;
  38. procedure boji(x,y,tip:integer);
  39. procedure Timer1StartTimer(Sender: TObject);
  40.  
  41. procedure Timer1Timer(Sender: TObject);
  42. procedure zameni(var a,b:integer; max:integer);
  43. function Guess:integer;
  44. function Racunaj(x,y,max:integer):integer ;
  45. procedure pozovi;
  46. procedure cOdigraj;
  47. procedure kraj;
  48.  
  49. private
  50. { private declarations }
  51. public
  52.  
  53. end;
  54.  
  55. var
  56. Form1: TForm1;
  57. pBoard,pShots,cBoard,cShots: array[0..9,0..9] of integer;
  58.  
  59. PMat,CMat:array[0..9,0..9] of TShape;
  60. mode:integer;
  61. prob:array[0..9,0..9] of integer;
  62. maxprob:array[0..100]of integer;
  63. prethodni:integer;
  64. pships,cships:array[1..4]of integer;
  65. hit:boolean;
  66. uzast,smer,ort:integer; {ort=0 horizontalno smer=-1 levo smer=1 desno
  67. ort=1 vertikalno smer=-1 gore smer=1 dole}
  68.  
  69. implementation
  70.  
  71. {$R *.lfm}
  72.  
  73. { TForm1 }
  74.  
  75. procedure TForm1.FormCreate(Sender: TObject); {Pravi matricu shapeova i podesava pocetne vrednosti}
  76. var i,j:integer;
  77. begin
  78. mode:=1;
  79. for i:=0 to 9 do
  80. for j:=0 to 9 do
  81. begin pMat[i,j]:= TShape.Create(Form1);
  82. with pMat[i,j] do
  83. begin
  84. width:=30;
  85. height:=30;
  86. left:=j*30+30;
  87. top:=i*30+30;
  88. visible:=true;
  89. parent:=Form1;
  90. shape:=stRectangle;
  91. name:='shapeA'+ IntToStr(i)+Inttostr(j);
  92. brush.color:=clwhite;
  93. brush.style:=bsSolid;
  94. pen.color:=clblack;
  95. pen.style:=psSolid;
  96. pen.width:=1;
  97. enabled:=true;
  98.  
  99.  
  100. end;
  101. end;
  102. for i:=0 to 9 do
  103. for j:=0 to 9 do
  104. begin cMat[i,j]:= TShape.Create(Form1);
  105. with cMat[i,j] do
  106. begin
  107. width:=30;
  108. height:=30;
  109. left:=j*30+420;
  110. top:=i*30+30;
  111. visible:=true;
  112. parent:=Form1;
  113. shape:=stRectangle;
  114. name:='shapeB'+ IntToStr(i)+Inttostr(j);
  115. brush.color:=clwhite;
  116. brush.style:=bsSolid;
  117. pen.color:=clblack;
  118. pen.style:=psSolid;
  119. pen.width:=1;
  120. enabled:=true;
  121. OnMouseDown:=@Form1.pShapeMouseDown;
  122.  
  123.  
  124. end;
  125.  
  126. end;
  127.  
  128.  
  129. end;
  130. procedure TForm1.kraj;
  131. var br,i,j:integer;
  132. begin
  133. br:=0;
  134. for i:=1 to 4 do
  135. if pShips[i]<>0 then
  136. br:=br+1;
  137. if br=0 then
  138. Showmessage('DEFEAT');
  139. br:=0;
  140. for i:=1 to 4 do
  141. if cShips[i]<>0 then
  142. br:=br+1;
  143. if br=0 then
  144. Showmessage('VICTORY');
  145.  
  146. end;
  147. function TForm1.desno(x,y,tip:integer):integer;
  148. var br:integer;
  149. begin
  150. br:=0;
  151. if tip=1 then
  152. begin
  153. if x+1<=9 then
  154. begin
  155. if pShots[x,y]=1 then
  156. br:=1+desno(x+1,y,1)
  157. else br:=0;
  158. end
  159. else br:=0;
  160. end;
  161.  
  162. if tip=2 then
  163. begin
  164. if x+1<=9 then
  165. begin
  166. if cShots[x,y]=1 then
  167. br:=1+desno(x+1,y,2)
  168. else br:=0;
  169. end
  170. else br:=0;
  171. end;
  172. desno:=br;
  173. end;
  174. function TForm1.levo(x,y,tip:integer):integer;
  175. var br:integer;
  176. begin
  177. br:=0;
  178. if tip=1 then
  179. begin
  180. if x-1>=0 then
  181. begin
  182. if pShots[x,y]=1 then
  183. br:=1+levo(x-1,y,1)
  184. else br:=0;
  185. end
  186. else br:=0;
  187. end;
  188.  
  189. if tip=2 then
  190. begin
  191. if x-1>=0 then
  192. begin
  193. if cShots[x,y]=1 then
  194. br:=1+levo(x-1,y,2)
  195. else br:=0;
  196. end
  197. else br:=0;
  198. end;
  199. levo:=br;
  200. end;
  201. function TForm1.gore(x,y,tip:integer):integer;
  202. var br:integer;
  203. begin
  204. br:=0;
  205. if tip=1 then
  206. begin
  207. if y-1>=0 then
  208. begin
  209. if pShots[x,y]=1 then
  210. br:=1+gore(x,y-1,1)
  211. else br:=0;
  212. end
  213. else br:=0;
  214. end;
  215.  
  216. if tip=2 then
  217. begin
  218. if y-1>=0 then
  219. begin
  220. if cShots[x,y]=1 then
  221. br:=1+gore(x,y-1,2)
  222. else br:=0;
  223. end
  224. else br:=0;
  225. end;
  226. gore:=br;
  227. end;
  228. function TForm1.dole(x,y,tip:integer):integer;
  229. var br:integer;
  230. begin
  231. br:=0;
  232. if tip=1 then
  233. begin
  234. if y+1<=9 then
  235. begin
  236. if pShots[x,y]=1 then
  237. br:=1+dole(x,y+1,1)
  238. else br:=0;
  239. end
  240. else br:=0;
  241. end;
  242.  
  243. if tip=2 then
  244. begin
  245. if y+1<=9 then
  246. begin
  247. if cShots[x,y]=1 then
  248. br:=1+dole(x,y+1,2)
  249. else br:=0;
  250. end
  251. else br:=0;
  252. end;
  253. dole:=br;
  254. end;
  255. function TForm1.isPotopljen(x,y,tip:integer):boolean;
  256. begin
  257. if tip=1 then
  258. begin
  259. if (gore(x,y,1)+dole(x,y,1)-1=cBoard[x,y])or(levo(x,y,1)+desno(x,y,1)-1=cBoard[x,y])or(levo(x,y,1)=cBoard[x,y])or(dole(x,y,1)=cBoard[x,y])or(desno(x,y,1)=cBoard[x,y])or(gore(x,y,1)=cBoard[x,y])then
  260. isPotopljen:=true
  261. else isPotopljen:=false;
  262. end;
  263.  
  264. if tip=2 then
  265. begin
  266. if (gore(x,y,2)+dole(x,y,2)-1=pBoard[x,y])or(levo(x,y,2)+desno(x,y,2)-1=pBoard[x,y])or(levo(x,y,2)=pBoard[x,y])or(dole(x,y,2)=pBoard[x,y])or(desno(x,y,2)=pBoard[x,y])or(gore(x,y,2)=pBoard[x,y])then
  267. isPotopljen:=true
  268. else isPotopljen:=false;
  269. end;
  270.  
  271. end;
  272. procedure TForm1.boji(x,y,tip:integer);
  273. var l,i,k:integer;
  274. begin
  275. if tip=1 then
  276. begin
  277. l:=cBoard[x,y];
  278. if l=1 then
  279. begin
  280. cMat[x,y].Brush.color:=clRed;
  281. if x-1>=0 then
  282. cMat[x-1,y].brush.color:=clGray;
  283. if x+1<=9 then
  284. cMat[x+l,y].brush.color:=clGray;
  285. if y-1>=0 then
  286. cMat[x,y-1].brush.color:=clGray;
  287. if y+1<=9 then
  288. cMat[x,y+1].brush.color:=clGray;
  289. end;
  290. if (((levo(x,y,1)+desno(x,y,1))>(gore(x,y,1)+dole(x,y,1)))or(levo(x,y,1)=l)or(desno(x,y,1)=l))and (l<>1)then
  291. begin
  292. k:=x-levo(x,y,1)+1;
  293. if k-1>=0 then
  294. cMat[k-1,y].brush.color:=clGray;
  295. if k+l<=9 then
  296. cMat[k+l,y].brush.color:=clGray;
  297. for i:=0 to l-1 do
  298. cMat[k+i,y].brush.color:=clRed;
  299. end;
  300. if (((gore(x,y,1)+dole(x,y,1))>(levo(x,y,1)+desno(x,y,1)))or(gore(x,y,1)=l)or(dole(x,y,1)=l))and (l<>1) then
  301. begin
  302. k:=y-gore(x,y,1)+1;
  303. if k-1>=0 then
  304. cMat[x,k-1].brush.color:=clGray;
  305. if k+l<=9 then
  306. cMat[x,k+l].brush.color:=clGray;
  307. for i:=0 to l-1 do
  308. cMat[x,k+i].brush.color:=clRed;
  309. end;
  310. end;
  311.  
  312. if tip=2 then
  313. begin
  314. l:=pBoard[x,y];
  315. if l=1 then
  316. begin
  317. pMat[x,y].Brush.color:=clRed;
  318. if x-1>=0 then
  319. pMat[x-1,y].brush.color:=clGray;
  320. if x+1<=9 then
  321. pMat[x+l,y].brush.color:=clGray;
  322. if y-1>=0 then
  323. pMat[x,y-1].brush.color:=clGray;
  324. if y+1<=9 then
  325. pMat[x,y+1].brush.color:=clGray;
  326. end;
  327. if (((levo(x,y,2)+desno(x,y,2))>(gore(x,y,2)+dole(x,y,2)))or(levo(x,y,2)=l)or(desno(x,y,2)=l))and (l<>1)then
  328. begin
  329. k:=x-levo(x,y,1)+1;
  330. if k-1>=0 then
  331. pMat[k-1,y].brush.color:=clGray;
  332. if k+l<=9 then
  333. pMat[k+l,y].brush.color:=clGray;
  334. for i:=0 to l-1 do
  335. pMat[k+i,y].brush.color:=clRed;
  336. end;
  337. if (((gore(x,y,2)+dole(x,y,2))>(levo(x,y,2)+desno(x,y,2)))or(gore(x,y,1)=2)or(dole(x,y,2)=l))and (l<>1) then
  338. begin
  339. k:=y-gore(x,y,1)+1;
  340. if k-1>=0 then
  341. pMat[x,k-1].brush.color:=clGray;
  342. if k+l<=9 then
  343. pMat[x,k+l].brush.color:=clGray;
  344. for i:=0 to l-1 do
  345. pMat[x,k+i].brush.color:=clRed;
  346. end;
  347. end;
  348. end;
  349.  
  350. procedure TForm1.Timer1StartTimer(Sender: TObject);
  351. begin
  352.  
  353. end;
  354.  
  355.  
  356.  
  357. procedure TForm1.Timer1Timer(Sender: TObject);
  358. begin
  359. if cTurn.brush.color=clGreen then
  360. begin
  361.  
  362. cOdigraj;
  363.  
  364. end;
  365. {Timer1.Stop;}
  366. end;
  367.  
  368. function TForm1.agore(x,y:integer):integer;
  369. var br:integer;
  370. begin
  371. br:=0;
  372.  
  373. if y-1>=0 then
  374. begin
  375. if cShots[x,y-1]=0 then
  376. br:=1+agore(x,y-1)
  377. else br:=0;
  378. end
  379. else br:=0;
  380. if br>3 then
  381. agore:=3
  382. else agore:=br;
  383. end;
  384.  
  385. function TForm1.adole(x,y:integer):integer;
  386. var br:integer;
  387. begin
  388. br:=0;
  389.  
  390. if y+1<=9 then
  391. begin
  392. if cShots[x,y+1]=0 then
  393. br:=1+adole(x,y+1)
  394. else br:=0;
  395. end
  396. else br:=0;
  397. if br>3 then
  398. adole:=3
  399. else adole:=br;
  400. end;
  401.  
  402. function TForm1.alevo(x,y:integer):integer;
  403. var br:integer;
  404. begin
  405. br:=0;
  406.  
  407. if x-1>=0 then
  408. begin
  409. if cShots[x-1,y]=0 then
  410. br:=1+alevo(x-1,y)
  411. else br:=0;
  412. end
  413. else br:=0;
  414. if br>3 then
  415. alevo:=3
  416. else alevo:=br;
  417. end;
  418.  
  419. function TForm1.adesno(x,y:integer):integer;
  420. var br:integer;
  421. begin
  422. br:=0;
  423.  
  424. if x+1<=9 then
  425. begin
  426. if cShots[x+1,y]=0 then
  427. br:=1+adesno(x+1,y)
  428. else br:=0;
  429. end
  430. else br:=0;
  431. if br>3 then
  432. adesno:=3
  433. else adesno:=br;
  434. end;
  435. procedure TForm1.zameni(var a,b:integer; max:integer);
  436. var pom:integer;
  437. begin
  438. if b>a then
  439. begin
  440. pom:=b;
  441. b:=a;
  442. a:=pom;
  443. end;
  444. if a>max-1 then
  445. a:=max-1;
  446. if b>max-1 then
  447. b:=max-1;
  448.  
  449. end;
  450.  
  451.  
  452. function TForm1.Racunaj(x,y,max:integer):integer;
  453. var a,b,h,v:integer;
  454. begin
  455. if cShots[x,y]=0 then
  456. begin
  457. if max=1 then
  458. racunaj:=1;
  459.  
  460. if max=2 then
  461. begin
  462. a:=alevo(x,y);
  463. b:=adesno(x,y);
  464. zameni(a,b,max);
  465. if a=1 then
  466. begin
  467. if b=1 then
  468. h:=2;
  469. if b=0 then
  470. h:=1;
  471. end
  472. else h:=0;
  473.  
  474. a:=agore(x,y);
  475. b:=adole(x,y);
  476. zameni(a,b,max);
  477. if a=1 then
  478. begin
  479. if b=1 then
  480. v:=2;
  481. if b=0 then
  482. v:=1;
  483. end
  484. else v:=0;
  485. racunaj:=h+v;
  486. end;
  487.  
  488. if max=3 then
  489. begin
  490. a:=alevo(x,y);
  491. b:=adesno(x,y);
  492. zameni(a,b,max);
  493. if a=1 then
  494. begin
  495. if b=1 then
  496. h:=1;
  497. if b=0 then
  498. h:=0;
  499. end;
  500.  
  501. if a=2 then
  502. begin
  503. if b=2 then
  504. h:=3;
  505. if b=1 then
  506. h:=2;
  507. if b=0 then
  508. h:=1;
  509. end;
  510.  
  511. if a=0 then
  512. h:=0;
  513.  
  514. a:=agore(x,y);
  515. b:=adole(x,y);
  516. zameni(a,b,max);
  517. if a=1 then
  518. begin
  519. if b=1 then
  520. v:=1;
  521. if b=0 then
  522. v:=0;
  523. end;
  524.  
  525. if a=2 then
  526. begin
  527. if b=2 then
  528. v:=3;
  529. if b=1 then
  530. v:=2;
  531. if b=0 then
  532. v:=1;
  533. end;
  534.  
  535. if a=0 then
  536. v:=0;
  537.  
  538. racunaj:=h+v;
  539. end;
  540.  
  541. if max=4 then
  542. begin
  543. a:=alevo(x,y);
  544. b:=adesno(x,y);
  545. zameni(a,b,max);
  546. if a=1 then
  547. h:=0;
  548.  
  549. if a=2 then
  550. begin
  551. if b=2 then
  552. h:=2;
  553. if b=1 then
  554. h:=1;
  555. if b=0 then
  556. h:=0;
  557. end;
  558.  
  559. if a=3 then
  560. begin
  561. if b=3 then
  562. h:=4;
  563. if b=2 then
  564. h:=3;
  565. if b=1 then
  566. h:=2;
  567. if b=0 then
  568. h:=1;
  569. end;
  570.  
  571. if a=0 then
  572. h:=0;
  573.  
  574. a:=agore(x,y);
  575. b:=adole(x,y);
  576. zameni(a,b,max);
  577. if a=1 then
  578. v:=0;
  579.  
  580. if a=2 then
  581. begin
  582. if b=2 then
  583. v:=2;
  584. if b=1 then
  585. v:=1;
  586. if b=0 then
  587. v:=0;
  588. end;
  589.  
  590. if a=3 then
  591. begin
  592. if b=3 then
  593. v:=4;
  594. if b=2 then
  595. v:=3;
  596. if b=1 then
  597. v:=2;
  598. if b=0 then
  599. v:=1;
  600. end;
  601.  
  602. if a=0 then
  603. v:=0;
  604.  
  605. racunaj:=h+v;
  606.  
  607. end;
  608.  
  609. end
  610. else
  611. racunaj:=0;
  612. end;
  613. function TForm1.Guess:integer;
  614. var
  615. a,b,i,j,max,maks,br,k,m1,m2:integer; {max je najveca dostupna duzina broda, a maks je najveci element u prob matrici}
  616. begin
  617. if cTurn.brush.color=clGreen then
  618. begin
  619. if mode=1 then
  620. begin
  621. for i:=1 to 100 do
  622. maxprob[i]:=0;
  623. for i:=1 to 4 do
  624. if pships[i]<>0 then
  625. max:=i;
  626. for i:=0 to 9 do
  627. for j:=0 to 9 do
  628. begin
  629. prob[i,j]:=Racunaj(i,j,max);
  630.  
  631. end;
  632.  
  633. maks:=0;
  634. for i:=0 to 9 do
  635. for j:=0 to 9 do
  636. if prob[i,j]>maks then
  637. maks:=prob[i,j];
  638. br:=0;
  639. for i:=0 to 9 do
  640. for j:=0 to 9 do
  641. if prob[i,j]=maks then
  642. begin
  643. maxprob[br]:=i*10+j;
  644. br:=br+1;
  645. end;
  646. k:=random(br);
  647. Guess:=maxprob[k];
  648.  
  649. end;
  650.  
  651. if mode=2 then
  652. begin
  653. if uzast=1 then {DRUGO GADJANJE}
  654. begin
  655. a:=prethodni div 10;
  656. b:=prethodni mod 10;
  657.  
  658. if (adesno(a,b)+alevo(a,b))>=(agore(a,b)+adole(a,b)) then {KEKEKEK}
  659. begin
  660. if alevo(a,b)>=adesno(a,b) then
  661. begin
  662. m1:=a-1;
  663. m2:=b;
  664. k:=m1*10+m2;
  665. Guess:=k;
  666. end
  667.  
  668. else
  669. begin
  670. m1:=a+1;
  671. m2:=b;
  672. k:=m1*10+m2;
  673. Guess:=k;
  674. end;
  675. end
  676. else
  677. begin
  678. if agore(a,b)>=adole(a,b) then
  679. begin
  680. m1:=a;
  681. m2:=b-1;
  682. k:=m1*10+m2;
  683. Guess:=k;
  684. end
  685. else
  686. begin
  687. m1:=a;
  688. m2:=b+1;
  689. k:=m1*10+m2;
  690. Guess:=k;
  691. end
  692.  
  693.  
  694.  
  695. end;
  696.  
  697. if uzast=2 then {TRECE GADJANJE}
  698. begin
  699. a:=prethodni div 10;
  700. b:=prethodni mod 10;
  701. if ort=0 then {HORIZONTALNO}
  702. begin
  703. if smer=-1 then
  704. begin
  705. if alevo(a,b)<>0 then
  706. begin
  707. m1:=a-1;
  708. m2:=b;
  709. k:=m1*10+m2;
  710. Guess:=k;
  711. end
  712. else
  713. begin
  714. m1:=a+2;
  715. m2:=b;
  716. smer:=1;
  717. k:=m1*10+m2;
  718. Guess:=k;
  719. end;
  720. end
  721. else
  722. begin
  723. if adesno(a,b)<>0 then
  724. begin
  725. m1:=a+1;
  726. m2:=b;
  727. k:=m1*10+m2;
  728. Guess:=k;
  729. end
  730. else
  731. begin
  732. m1:=a-2;
  733. m2:=b;
  734. smer:=-1;
  735. k:=m1*10+m2;
  736. Guess:=k;
  737. end;
  738.  
  739. end;
  740. end;
  741.  
  742. if ort=1 then {VERTIKALNO}
  743. begin
  744. if smer=-1 then
  745. begin
  746. if agore(a,b)<>0 then
  747. begin
  748. m1:=a;
  749. m2:=b-1;
  750. k:=m1*10+m2;
  751. Guess:=k;
  752. end
  753. else
  754. begin
  755. m1:=a;
  756. m2:=b+1;
  757. smer:=1;
  758. k:=m1*10+m2;
  759. Guess:=k;
  760. end;
  761. end
  762.  
  763. else
  764. begin
  765. if adole(a,b)<>0 then
  766. begin
  767. m1:=a;
  768. m2:=b+1;
  769. k:=m1*10+m2;
  770. Guess:=k;
  771. end
  772. else
  773. begin
  774. m1:=a;
  775. m2:=b-1;
  776. smer:=-1;
  777. k:=m1*10+m2;
  778. Guess:=k;
  779. end;
  780. end;
  781.  
  782. end;
  783. end;
  784.  
  785.  
  786. if uzast=3 then {CETVRTO GADJANjE}
  787. begin
  788. a:=prethodni div 10;
  789. b:=prethodni mod 10;
  790. if ort=0 then {HORIZONTALNO}
  791. begin
  792. if smer=-1 then
  793. begin
  794. if alevo(a,b)<>0 then
  795. begin
  796. m1:=a-1;
  797. m2:=b;
  798. k:=m1*10+m2;
  799. Guess:=k;
  800. end
  801. else
  802. begin
  803. m1:=a+3;
  804. m2:=b;
  805. smer:=1;
  806. k:=m1*10+m2;
  807. Guess:=k;
  808. end;
  809. end
  810.  
  811. else
  812. begin
  813. if adesno(a,b)<>0 then
  814. begin
  815. m1:=a+1;
  816. m2:=b;
  817. k:=m1*10+m2;
  818. Guess:=k;
  819. end
  820. else
  821. begin
  822. m1:=a-3;
  823. m2:=b;
  824. smer:=-1;
  825. k:=m1*10+m2;
  826. Guess:=k;
  827. end;
  828. end;
  829.  
  830. end;
  831.  
  832.  
  833. if ort=1 then {VERTIKALNO}
  834. begin
  835. if smer=-1 then
  836. begin
  837. if agore(a,b)<>0 then
  838. begin
  839. m1:=a;
  840. m2:=b-1;
  841. k:=m1*10+m2;
  842. Guess:=k;
  843. end
  844. else
  845. begin
  846. m1:=a;
  847. m2:=b+3;
  848. smer:=1;
  849. k:=m1*10+m2;
  850. Guess:=k;
  851. end;
  852. end
  853. else
  854. begin
  855. m1:=a;
  856. m2:=b-3;
  857. smer:=1;
  858. k:=m1*10+m2;
  859. Guess:=k;
  860. end;
  861.  
  862. end;
  863. end;
  864. end;
  865. end;
  866. end;
  867. end;
  868. procedure TForm1.cOdigraj;
  869. var x,y,i:integer;
  870. begin
  871. x:=guess;
  872. y:=x mod 10;
  873. x:=x div 10;
  874.  
  875. if (pBoard[x,y]<>0) and (pBoard[x,y]<>5) then
  876. begin
  877. cShots[x,y]:=1;
  878. pMat[x,y].Brush.Color:=clYellow;
  879.  
  880. if x-1>=0 then
  881. begin
  882. if y-1>=0 then
  883. begin
  884. pMat[x-1,y-1].Brush.Color:=clGray;
  885. cShots[x-1,y-1]:=2;
  886. end;
  887. if y+1<=9 then
  888. begin
  889. pMat[x-1,y+1].Brush.Color:=clGray;
  890. cShots[x-1,y+1]:=2;
  891. end;
  892. end;
  893. if x+1<=9 then
  894. begin
  895. if y-1>=0 then
  896. begin
  897. pMat[x+1,y-1].Brush.Color:=clGray;
  898. cShots[x+1,y-1]:=2;
  899. end;
  900. if y+1<=9 then
  901. begin
  902. pMat[x+1,y+1].Brush.Color:=clGray;
  903. cShots[x+1,y+1]:=2;
  904. end;
  905. end;
  906.  
  907. if ispotopljen(x,y,2) then
  908. begin
  909. boji(x,y,2);
  910. mode:=1;
  911. uzast:=0;
  912. pShips[pBoard[x,y]]:=pShips[pBoard[x,y]]-1;
  913. hit:=true;
  914. end
  915. else
  916. begin
  917. uzast:=uzast+1;
  918. mode:=2;
  919. prethodni:=x*10+y;
  920. hit:=true;
  921. end;
  922. end
  923. else
  924. begin
  925. pMat[x,y].Brush.Color:=clGray;
  926. cShots[x,y]:=2;
  927. pTurn.brush.color:=clGreen;
  928. cTurn.brush.color:=clRed;
  929.  
  930. end;
  931. end;
  932. procedure TForm1.pozovi;
  933. begin
  934. hit:=false;
  935. cOdigraj;
  936. If hit then
  937. pozovi;
  938. end;
  939.  
  940. procedure TForm1.pShapeMouseDown(Sender: TObject; Button: TMouseButton; {Boji polje u zavisnosti da li je pogodjeno ili ne i unosi vrednosti u pShots}
  941. Shift: TShiftState; X, Y: Integer);
  942. var m1,m2,i,j,k:integer;
  943. begin
  944. if pTurn.Brush.color=clGreen then
  945. begin
  946.  
  947. m1:=0;
  948. m2:=0;
  949. for i:=0 to 9 do
  950. for j:=0 to 9 do
  951. if Sender=cMat[i,j] then
  952. begin
  953. m1:=i;
  954. m2:=j;
  955. end;
  956.  
  957. if (cBoard[m1,m2]<>0)and(cBoard[m1,m2]<>5) then
  958. begin
  959. pShots[m1,m2]:=1;
  960. cMat[m1,m2].Brush.Color:=clYellow;
  961. cMat[m1,m2].enabled:=false;
  962. if m1-1>=0 then
  963. begin
  964. if m2-1>=0 then
  965. begin
  966. cMat[m1-1,m2-1].Brush.Color:=clGray;
  967. cMat[m1-1,m2-1].enabled:=false;
  968. end;
  969. if m2+1<=9 then
  970. begin
  971. cMat[m1-1,m2+1].Brush.Color:=clGray;
  972. cMat[m1-1,m2+1].enabled:=false;
  973. end;
  974. end;
  975. if m1+1<=9 then
  976. begin
  977. if m2-1>=0 then
  978. begin
  979. cMat[m1+1,m2-1].Brush.Color:=clGray;
  980. cMat[m1+1,m2-1].enabled:=false;
  981. end;
  982. if m2+1<=9 then
  983. begin
  984. cMat[m1+1,m2+1].Brush.Color:=clGray;
  985. cMat[m1+1,m2+1].enabled:=false;
  986. end;
  987. end;
  988. CDButton1.enabled:=false;
  989. if isPotopljen(m1,m2,1) then
  990. begin
  991. boji(m1,m2,1);
  992. cShips[cBoard[m1,m2]]:=cShips[cBoard[m1,m2]]-1;
  993. kraj;
  994. end;
  995. end
  996. else
  997. begin
  998. pShots[m1,m2]:=2;
  999. cMat[m1,m2].Brush.Color:=clGray;
  1000. cMat[m1,m2].enabled:=false;
  1001. pTurn.Brush.color:=clRed;
  1002. cTurn.Brush.color:=clGreen;
  1003. CDButton1.enabled:=false;
  1004. pozovi;
  1005. end;
  1006.  
  1007.  
  1008.  
  1009. end;
  1010. end;
  1011.  
  1012.  
  1013. function TForm1.pOdigraj(p, q: integer): boolean;
  1014. begin
  1015. if cBoard[p,q]=1 then
  1016. pOdigraj:=true
  1017. else
  1018. pOdigraj:=false;
  1019. end;
  1020.  
  1021.  
  1022.  
  1023. function PCheckForShip(m,k,x,l:integer):boolean;
  1024. var ok:boolean;
  1025. br,i,j:integer;
  1026.  
  1027. begin
  1028. ok:=false;
  1029. if x=0 then
  1030. begin
  1031. br:=0;
  1032. if m>=l then
  1033. begin
  1034. for i:=m-l+1 to m do
  1035. if pBoard[i,k]=0 then
  1036. br:=br+1;
  1037. if br=l then
  1038. ok:=true;
  1039.  
  1040. end;
  1041. end;
  1042.  
  1043. if x=1 then
  1044. begin
  1045. br:=0;
  1046. if m+l-1<=9 then
  1047. begin
  1048. for i:=m to m+l-1 do
  1049. if PBoard[i,k]=0 then
  1050. br:=br+1;
  1051. if br=l then
  1052. ok:=true;
  1053.  
  1054. end;
  1055. end;
  1056.  
  1057. if x=2 then
  1058. begin
  1059. br:=0;
  1060. if k>=l then
  1061. begin
  1062. for j:=k-l+1 to k do
  1063. if PBoard[m,j]=0 then
  1064. br:=br+1;
  1065. if br=l then
  1066. ok:=true;
  1067.  
  1068. end;
  1069. end;
  1070.  
  1071. if x=3 then
  1072. begin
  1073. br:=0;
  1074. if k+l-1<=9 then
  1075. begin
  1076. for j:=k to k+l-1 do
  1077. if PBoard[m,j]=0 then
  1078. br:=br+1;
  1079. if br=l then
  1080. ok:=true;
  1081.  
  1082. end;
  1083. end;
  1084.  
  1085. PCheckForShip:=ok;
  1086. end;
  1087.  
  1088. procedure PSetShip(m,k,x,l:integer);
  1089. var i,j:integer;
  1090. begin
  1091. if x=0 then
  1092. begin
  1093. for i:=m-l to m+1 do
  1094. for j:=k-1 to k+1 do
  1095. if (i>=0)and(i<=9)and(j>=0)and(j<=9)and(pBoard[i,j]<>1)and(pBoard[i,j]<>2)and(pBoard[i,j]<>3)and(pBoard[i,j]<>4) then
  1096. PBoard[i,j]:=5;
  1097. for i:=m-l+1 to m do
  1098. begin
  1099. PBoard[i,k]:=l;
  1100. PMat[i,k].brush.color:=clblue;
  1101. end;
  1102. end;
  1103. if x=1 then
  1104. begin
  1105. for i:=m-1 to m+l do
  1106. for j:=k-1 to k+1 do
  1107. if (i>=0)and(i<=9)and(j>=0)and(j<=9)and(pBoard[i,j]<>1)and(pBoard[i,j]<>2)and(pBoard[i,j]<>3)and(pBoard[i,j]<>4) then
  1108. PBoard[i,j]:=5;
  1109. for i:=m to m+l-1 do
  1110. begin
  1111. PBoard[i,k]:=l;
  1112. PMat[i,k].brush.color:=clblue;
  1113. end;
  1114. end;
  1115. if x=2 then
  1116. begin
  1117. for i:=m-1 to m+1 do
  1118. for j:=k-l to k+1 do
  1119. if (i>=0)and(i<=9)and(j>=0)and(j<=9)and(pBoard[i,j]<>1)and(pBoard[i,j]<>2)and(pBoard[i,j]<>3)and(pBoard[i,j]<>4) then
  1120. PBoard[i,j]:=5;
  1121. for j:=k-l+1 to k do
  1122. begin
  1123. PBoard[m,j]:=l;
  1124. PMat[m,j].brush.color:=clblue;
  1125. end;
  1126. end;
  1127. if x=3 then
  1128. begin
  1129. for i:=m-1 to m+1 do
  1130. for j:=k-1 to k+l do
  1131. if (i>=0)and(i<=9)and(j>=0)and(j<=9)and(pBoard[i,j]<>1)and(pBoard[i,j]<>2)and(pBoard[i,j]<>3)and(pBoard[i,j]<>4) then
  1132. PBoard[i,j]:=5;
  1133. for j:=k to k+l-1 do
  1134. begin
  1135. PBoard[m,j]:=l;
  1136. PMat[m,j].brush.color:=clblue;
  1137. end;
  1138. end;
  1139.  
  1140. end;
  1141.  
  1142. procedure PGenerateRandom;
  1143. var
  1144. x,l,m,k,i,j:integer;
  1145. begin
  1146.  
  1147. for l:=4 downto 1 do
  1148. begin
  1149. j:=4-l+1;
  1150.  
  1151. for i:=1 to j do
  1152. begin
  1153. repeat
  1154. randomize;
  1155. m:=random(9);
  1156. k:=random(9);
  1157. until PCheckForShip(m,k,0,l) OR PCheckForShip(m,k,1,l) OR PCheckForShip(m,k,2,l) OR PCheckForShip(m,k,3,l);
  1158.  
  1159. repeat
  1160. x:=random(3);
  1161. until PCheckForShip(m,k,x,l);
  1162.  
  1163. PSetShip(m,k,x,l);
  1164.  
  1165. end;
  1166.  
  1167.  
  1168.  
  1169.  
  1170. end;
  1171.  
  1172. end;
  1173. function cCheckForShip(m,k,x,l:integer):boolean;
  1174. var ok:boolean;
  1175. br,i,j:integer;
  1176.  
  1177. begin
  1178. ok:=false;
  1179. if x=0 then
  1180. begin
  1181. br:=0;
  1182. if m>=l then
  1183. begin
  1184. for i:=m-l+1 to m do
  1185. if cBoard[i,k]=0 then
  1186. br:=br+1;
  1187. if br=l then
  1188. ok:=true;
  1189.  
  1190. end;
  1191. end;
  1192.  
  1193. if x=1 then
  1194. begin
  1195. br:=0;
  1196. if m+l-1<=9 then
  1197. begin
  1198. for i:=m to m+l-1 do
  1199. if cBoard[i,k]=0 then
  1200. br:=br+1;
  1201. if br=l then
  1202. ok:=true;
  1203.  
  1204. end;
  1205.  
  1206. end;
  1207.  
  1208. if x=2 then
  1209. begin
  1210. br:=0;
  1211. if k>=l then
  1212. begin
  1213. for j:=k-l+1 to k do
  1214. if cBoard[m,j]=0 then
  1215. br:=br+1;
  1216. if br=l then
  1217. ok:=true;
  1218.  
  1219. end;
  1220. end;
  1221.  
  1222. if x=3 then
  1223. begin
  1224. br:=0;
  1225. if k+l-1<=9 then
  1226. begin
  1227. for j:=k to k+l-1 do
  1228. if cBoard[m,j]=0 then
  1229. br:=br+1;
  1230. if br=l then
  1231. ok:=true;
  1232.  
  1233. end;
  1234.  
  1235. end;
  1236.  
  1237. cCheckForShip:=ok;
  1238. end;
  1239. procedure cSetShip(m,k,x,l:integer);
  1240. var i,j:integer;
  1241. begin
  1242. if x=0 then
  1243. begin
  1244.  
  1245. for i:=m-l to m+1 do
  1246. for j:=k-1 to k+1 do
  1247. if (i>=0)and(i<=9)and(j>=0)and(j<=9)and(cBoard[i,j]<>1)and(cBoard[i,j]<>2)and(cBoard[i,j]<>3)and(cBoard[i,j]<>4) then
  1248. cBoard[i,j]:=5;
  1249. for i:=m-l+1 to m do
  1250.  
  1251. cBoard[i,k]:=l;
  1252.  
  1253. end;
  1254. if x=1 then
  1255. begin
  1256.  
  1257. for i:=m-1 to m+l do
  1258. for j:=k-1 to k+1 do
  1259. if (i>=0)and(i<=9)and(j>=0)and(j<=9)and(cBoard[i,j]<>1)and(cBoard[i,j]<>2)and(cBoard[i,j]<>3)and(cBoard[i,j]<>4) then
  1260. cBoard[i,j]:=5;
  1261. for i:=m to m+l-1 do
  1262.  
  1263. cBoard[i,k]:=l;
  1264.  
  1265. end;
  1266. if x=2 then
  1267. begin
  1268.  
  1269. for i:=m-1 to m+1 do
  1270. for j:=k-l to k+1 do
  1271. if (i>=0)and(i<=9)and(j>=0)and(j<=9)and(cBoard[i,j]<>1)and(cBoard[i,j]<>2)and(cBoard[i,j]<>3)and(cBoard[i,j]<>4) then
  1272. cBoard[i,j]:=5;
  1273. for j:=k-l+1 to k do
  1274.  
  1275. cBoard[m,j]:=l;
  1276.  
  1277. end;
  1278. if x=3 then
  1279. begin
  1280.  
  1281. for i:=m-1 to m+1 do
  1282. for j:=k-1 to k+l do
  1283. if (i>=0)and(i<=9)and(j>=0)and(j<=9)and(cBoard[i,j]<>1)and(cBoard[i,j]<>2)and(cBoard[i,j]<>3)and(cBoard[i,j]<>4) then
  1284. cBoard[i,j]:=5;
  1285. for j:=k to k+l-1 do
  1286. cBoard[m,j]:=l;
  1287. end;
  1288.  
  1289. end;
  1290. procedure cGenerateRandom;
  1291. var
  1292. x,l,m,k,i,j:integer;
  1293. begin
  1294.  
  1295. for l:=4 downto 1 do
  1296. begin
  1297. j:=4-l+1;
  1298.  
  1299. for i:=1 to j do
  1300. begin
  1301. repeat
  1302. randomize;
  1303. m:=random(9);
  1304. k:=random(9);
  1305. until CCheckForShip(m,k,0,l) OR CCheckForShip(m,k,1,l) OR CCheckForShip(m,k,2,l) OR CCheckForShip(m,k,3,l);
  1306.  
  1307. repeat
  1308. x:=random(3);
  1309. until CCheckForShip(m,k,x,l);
  1310.  
  1311. CSetShip(m,k,x,l);
  1312.  
  1313. end;
  1314.  
  1315.  
  1316.  
  1317. end;
  1318.  
  1319. end;
  1320.  
  1321. procedure TForm1.CDButton1Click(Sender: TObject);
  1322.  
  1323. begin
  1324.  
  1325.  
  1326. cGenerateRandom;
  1327. pGenerateRandom;
  1328.  
  1329. end;
  1330.  
  1331. procedure TForm1.CDButton2Click(Sender: TObject);
  1332. var i,j:integer;
  1333. begin
  1334. CDbutton1.enabled:=true;
  1335. pTurn.Brush.color:=clGreen;
  1336. cTurn.Brush.color:=clRed;
  1337. for i:=0 to 9 do
  1338. for j:=0 to 9 do
  1339. begin
  1340. cBoard[i,j]:=0;
  1341. cMat[i,j].brush.color:=clWhite;
  1342. cMat[i,j].enabled:=true;
  1343. end;
  1344. for i:=0 to 9 do
  1345. for j:=0 to 9 do
  1346. begin
  1347. PBoard[i,j]:=0;
  1348. PMat[i,j].brush.color:=clwhite;
  1349. end;
  1350. for i:=1 to 4 do
  1351. begin
  1352. cships[i]:=4-i+1;
  1353. pships[i]:=4-i+1
  1354. end;
  1355. prethodni:=0;
  1356. uzast:=0;
  1357. mode:=1;
  1358. end;
  1359.  
  1360. 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!