Pastebin
API
tools
faq
paste
Login
Sign up
Please fix the following errors:
New Paste
Syntax Highlighting
unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, CustomDrawnControls,customdrawn_common, MaskEdit; type { TForm1 } TForm1 = class(TForm) CDButton1: TCDButton; CDButton2: TCDButton; CDButton3: TCDButton; Label1: TLabel; cTurn: TShape; pTurn: TShape; Timer1: TTimer; procedure CDButton1Click(Sender: TObject); procedure CDButton2Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure pShapeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); function pOdigraj(p,q:integer):boolean; function desno(x,y,tip:integer):integer; function levo(x,y,tip:integer):integer; function gore(x,y,tip:integer):integer; function dole(x,y,tip:integer):integer; function adesno(x,y:integer):integer; function alevo(x,y:integer):integer; function agore(x,y:integer):integer; function adole(x,y:integer):integer; function isPotopljen(x,y,tip:integer):boolean; procedure boji(x,y,tip:integer); procedure Timer1StartTimer(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure zameni(var a,b:integer; max:integer); function Guess:integer; function Racunaj(x,y,max:integer):integer ; procedure pozovi; procedure cOdigraj; procedure kraj; private { private declarations } public end; var Form1: TForm1; pBoard,pShots,cBoard,cShots: array[0..9,0..9] of integer; PMat,CMat:array[0..9,0..9] of TShape; mode:integer; prob:array[0..9,0..9] of integer; maxprob:array[0..100]of integer; prethodni:integer; pships,cships:array[1..4]of integer; hit:boolean; uzast,smer,ort:integer; {ort=0 horizontalno smer=-1 levo smer=1 desno ort=1 vertikalno smer=-1 gore smer=1 dole} implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject); {Pravi matricu shapeova i podesava pocetne vrednosti} var i,j:integer; begin mode:=1; for i:=0 to 9 do for j:=0 to 9 do begin pMat[i,j]:= TShape.Create(Form1); with pMat[i,j] do begin width:=30; height:=30; left:=j*30+30; top:=i*30+30; visible:=true; parent:=Form1; shape:=stRectangle; name:='shapeA'+ IntToStr(i)+Inttostr(j); brush.color:=clwhite; brush.style:=bsSolid; pen.color:=clblack; pen.style:=psSolid; pen.width:=1; enabled:=true; end; end; for i:=0 to 9 do for j:=0 to 9 do begin cMat[i,j]:= TShape.Create(Form1); with cMat[i,j] do begin width:=30; height:=30; left:=j*30+420; top:=i*30+30; visible:=true; parent:=Form1; shape:=stRectangle; name:='shapeB'+ IntToStr(i)+Inttostr(j); brush.color:=clwhite; brush.style:=bsSolid; pen.color:=clblack; pen.style:=psSolid; pen.width:=1; enabled:=true; OnMouseDown:=@Form1.pShapeMouseDown; end; end; end; procedure TForm1.kraj; var br,i,j:integer; begin br:=0; for i:=1 to 4 do if pShips[i]<>0 then br:=br+1; if br=0 then Showmessage('DEFEAT'); br:=0; for i:=1 to 4 do if cShips[i]<>0 then br:=br+1; if br=0 then Showmessage('VICTORY'); end; function TForm1.desno(x,y,tip:integer):integer; var br:integer; begin br:=0; if tip=1 then begin if x+1<=9 then begin if pShots[x,y]=1 then br:=1+desno(x+1,y,1) else br:=0; end else br:=0; end; if tip=2 then begin if x+1<=9 then begin if cShots[x,y]=1 then br:=1+desno(x+1,y,2) else br:=0; end else br:=0; end; desno:=br; end; function TForm1.levo(x,y,tip:integer):integer; var br:integer; begin br:=0; if tip=1 then begin if x-1>=0 then begin if pShots[x,y]=1 then br:=1+levo(x-1,y,1) else br:=0; end else br:=0; end; if tip=2 then begin if x-1>=0 then begin if cShots[x,y]=1 then br:=1+levo(x-1,y,2) else br:=0; end else br:=0; end; levo:=br; end; function TForm1.gore(x,y,tip:integer):integer; var br:integer; begin br:=0; if tip=1 then begin if y-1>=0 then begin if pShots[x,y]=1 then br:=1+gore(x,y-1,1) else br:=0; end else br:=0; end; if tip=2 then begin if y-1>=0 then begin if cShots[x,y]=1 then br:=1+gore(x,y-1,2) else br:=0; end else br:=0; end; gore:=br; end; function TForm1.dole(x,y,tip:integer):integer; var br:integer; begin br:=0; if tip=1 then begin if y+1<=9 then begin if pShots[x,y]=1 then br:=1+dole(x,y+1,1) else br:=0; end else br:=0; end; if tip=2 then begin if y+1<=9 then begin if cShots[x,y]=1 then br:=1+dole(x,y+1,2) else br:=0; end else br:=0; end; dole:=br; end; function TForm1.isPotopljen(x,y,tip:integer):boolean; begin if tip=1 then begin 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 isPotopljen:=true else isPotopljen:=false; end; if tip=2 then begin 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 isPotopljen:=true else isPotopljen:=false; end; end; procedure TForm1.boji(x,y,tip:integer); var l,i,k:integer; begin if tip=1 then begin l:=cBoard[x,y]; if l=1 then begin cMat[x,y].Brush.color:=clRed; if x-1>=0 then cMat[x-1,y].brush.color:=clGray; if x+1<=9 then cMat[x+l,y].brush.color:=clGray; if y-1>=0 then cMat[x,y-1].brush.color:=clGray; if y+1<=9 then cMat[x,y+1].brush.color:=clGray; end; 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 begin k:=x-levo(x,y,1)+1; if k-1>=0 then cMat[k-1,y].brush.color:=clGray; if k+l<=9 then cMat[k+l,y].brush.color:=clGray; for i:=0 to l-1 do cMat[k+i,y].brush.color:=clRed; end; 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 begin k:=y-gore(x,y,1)+1; if k-1>=0 then cMat[x,k-1].brush.color:=clGray; if k+l<=9 then cMat[x,k+l].brush.color:=clGray; for i:=0 to l-1 do cMat[x,k+i].brush.color:=clRed; end; end; if tip=2 then begin l:=pBoard[x,y]; if l=1 then begin pMat[x,y].Brush.color:=clRed; if x-1>=0 then pMat[x-1,y].brush.color:=clGray; if x+1<=9 then pMat[x+l,y].brush.color:=clGray; if y-1>=0 then pMat[x,y-1].brush.color:=clGray; if y+1<=9 then pMat[x,y+1].brush.color:=clGray; end; 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 begin k:=x-levo(x,y,1)+1; if k-1>=0 then pMat[k-1,y].brush.color:=clGray; if k+l<=9 then pMat[k+l,y].brush.color:=clGray; for i:=0 to l-1 do pMat[k+i,y].brush.color:=clRed; end; 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 begin k:=y-gore(x,y,1)+1; if k-1>=0 then pMat[x,k-1].brush.color:=clGray; if k+l<=9 then pMat[x,k+l].brush.color:=clGray; for i:=0 to l-1 do pMat[x,k+i].brush.color:=clRed; end; end; end; procedure TForm1.Timer1StartTimer(Sender: TObject); begin end; procedure TForm1.Timer1Timer(Sender: TObject); begin if cTurn.brush.color=clGreen then begin cOdigraj; end; {Timer1.Stop;} end; function TForm1.agore(x,y:integer):integer; var br:integer; begin br:=0; if y-1>=0 then begin if cShots[x,y-1]=0 then br:=1+agore(x,y-1) else br:=0; end else br:=0; if br>3 then agore:=3 else agore:=br; end; function TForm1.adole(x,y:integer):integer; var br:integer; begin br:=0; if y+1<=9 then begin if cShots[x,y+1]=0 then br:=1+adole(x,y+1) else br:=0; end else br:=0; if br>3 then adole:=3 else adole:=br; end; function TForm1.alevo(x,y:integer):integer; var br:integer; begin br:=0; if x-1>=0 then begin if cShots[x-1,y]=0 then br:=1+alevo(x-1,y) else br:=0; end else br:=0; if br>3 then alevo:=3 else alevo:=br; end; function TForm1.adesno(x,y:integer):integer; var br:integer; begin br:=0; if x+1<=9 then begin if cShots[x+1,y]=0 then br:=1+adesno(x+1,y) else br:=0; end else br:=0; if br>3 then adesno:=3 else adesno:=br; end; procedure TForm1.zameni(var a,b:integer; max:integer); var pom:integer; begin if b>a then begin pom:=b; b:=a; a:=pom; end; if a>max-1 then a:=max-1; if b>max-1 then b:=max-1; end; function TForm1.Racunaj(x,y,max:integer):integer; var a,b,h,v:integer; begin if cShots[x,y]=0 then begin if max=1 then racunaj:=1; if max=2 then begin a:=alevo(x,y); b:=adesno(x,y); zameni(a,b,max); if a=1 then begin if b=1 then h:=2; if b=0 then h:=1; end else h:=0; a:=agore(x,y); b:=adole(x,y); zameni(a,b,max); if a=1 then begin if b=1 then v:=2; if b=0 then v:=1; end else v:=0; racunaj:=h+v; end; if max=3 then begin a:=alevo(x,y); b:=adesno(x,y); zameni(a,b,max); if a=1 then begin if b=1 then h:=1; if b=0 then h:=0; end; if a=2 then begin if b=2 then h:=3; if b=1 then h:=2; if b=0 then h:=1; end; if a=0 then h:=0; a:=agore(x,y); b:=adole(x,y); zameni(a,b,max); if a=1 then begin if b=1 then v:=1; if b=0 then v:=0; end; if a=2 then begin if b=2 then v:=3; if b=1 then v:=2; if b=0 then v:=1; end; if a=0 then v:=0; racunaj:=h+v; end; if max=4 then begin a:=alevo(x,y); b:=adesno(x,y); zameni(a,b,max); if a=1 then h:=0; if a=2 then begin if b=2 then h:=2; if b=1 then h:=1; if b=0 then h:=0; end; if a=3 then begin if b=3 then h:=4; if b=2 then h:=3; if b=1 then h:=2; if b=0 then h:=1; end; if a=0 then h:=0; a:=agore(x,y); b:=adole(x,y); zameni(a,b,max); if a=1 then v:=0; if a=2 then begin if b=2 then v:=2; if b=1 then v:=1; if b=0 then v:=0; end; if a=3 then begin if b=3 then v:=4; if b=2 then v:=3; if b=1 then v:=2; if b=0 then v:=1; end; if a=0 then v:=0; racunaj:=h+v; end; end else racunaj:=0; end; function TForm1.Guess:integer; var 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} begin if cTurn.brush.color=clGreen then begin if mode=1 then begin for i:=1 to 100 do maxprob[i]:=0; for i:=1 to 4 do if pships[i]<>0 then max:=i; for i:=0 to 9 do for j:=0 to 9 do begin prob[i,j]:=Racunaj(i,j,max); end; maks:=0; for i:=0 to 9 do for j:=0 to 9 do if prob[i,j]>maks then maks:=prob[i,j]; br:=0; for i:=0 to 9 do for j:=0 to 9 do if prob[i,j]=maks then begin maxprob[br]:=i*10+j; br:=br+1; end; k:=random(br); Guess:=maxprob[k]; end; if mode=2 then begin if uzast=1 then {DRUGO GADJANJE} begin a:=prethodni div 10; b:=prethodni mod 10; if (adesno(a,b)+alevo(a,b))>=(agore(a,b)+adole(a,b)) then {KEKEKEK} begin if alevo(a,b)>=adesno(a,b) then begin m1:=a-1; m2:=b; k:=m1*10+m2; Guess:=k; end else begin m1:=a+1; m2:=b; k:=m1*10+m2; Guess:=k; end; end else begin if agore(a,b)>=adole(a,b) then begin m1:=a; m2:=b-1; k:=m1*10+m2; Guess:=k; end else begin m1:=a; m2:=b+1; k:=m1*10+m2; Guess:=k; end end; if uzast=2 then {TRECE GADJANJE} begin a:=prethodni div 10; b:=prethodni mod 10; if ort=0 then {HORIZONTALNO} begin if smer=-1 then begin if alevo(a,b)<>0 then begin m1:=a-1; m2:=b; k:=m1*10+m2; Guess:=k; end else begin m1:=a+2; m2:=b; smer:=1; k:=m1*10+m2; Guess:=k; end; end else begin if adesno(a,b)<>0 then begin m1:=a+1; m2:=b; k:=m1*10+m2; Guess:=k; end else begin m1:=a-2; m2:=b; smer:=-1; k:=m1*10+m2; Guess:=k; end; end; end; if ort=1 then {VERTIKALNO} begin if smer=-1 then begin if agore(a,b)<>0 then begin m1:=a; m2:=b-1; k:=m1*10+m2; Guess:=k; end else begin m1:=a; m2:=b+1; smer:=1; k:=m1*10+m2; Guess:=k; end; end else begin if adole(a,b)<>0 then begin m1:=a; m2:=b+1; k:=m1*10+m2; Guess:=k; end else begin m1:=a; m2:=b-1; smer:=-1; k:=m1*10+m2; Guess:=k; end; end; end; end; if uzast=3 then {CETVRTO GADJANjE} begin a:=prethodni div 10; b:=prethodni mod 10; if ort=0 then {HORIZONTALNO} begin if smer=-1 then begin if alevo(a,b)<>0 then begin m1:=a-1; m2:=b; k:=m1*10+m2; Guess:=k; end else begin m1:=a+3; m2:=b; smer:=1; k:=m1*10+m2; Guess:=k; end; end else begin if adesno(a,b)<>0 then begin m1:=a+1; m2:=b; k:=m1*10+m2; Guess:=k; end else begin m1:=a-3; m2:=b; smer:=-1; k:=m1*10+m2; Guess:=k; end; end; end; if ort=1 then {VERTIKALNO} begin if smer=-1 then begin if agore(a,b)<>0 then begin m1:=a; m2:=b-1; k:=m1*10+m2; Guess:=k; end else begin m1:=a; m2:=b+3; smer:=1; k:=m1*10+m2; Guess:=k; end; end else begin m1:=a; m2:=b-3; smer:=1; k:=m1*10+m2; Guess:=k; end; end; end; end; end; end; end; procedure TForm1.cOdigraj; var x,y,i:integer; begin x:=guess; y:=x mod 10; x:=x div 10; if (pBoard[x,y]<>0) and (pBoard[x,y]<>5) then begin cShots[x,y]:=1; pMat[x,y].Brush.Color:=clYellow; if x-1>=0 then begin if y-1>=0 then begin pMat[x-1,y-1].Brush.Color:=clGray; cShots[x-1,y-1]:=2; end; if y+1<=9 then begin pMat[x-1,y+1].Brush.Color:=clGray; cShots[x-1,y+1]:=2; end; end; if x+1<=9 then begin if y-1>=0 then begin pMat[x+1,y-1].Brush.Color:=clGray; cShots[x+1,y-1]:=2; end; if y+1<=9 then begin pMat[x+1,y+1].Brush.Color:=clGray; cShots[x+1,y+1]:=2; end; end; if ispotopljen(x,y,2) then begin boji(x,y,2); mode:=1; uzast:=0; pShips[pBoard[x,y]]:=pShips[pBoard[x,y]]-1; hit:=true; end else begin uzast:=uzast+1; mode:=2; prethodni:=x*10+y; hit:=true; end; end else begin pMat[x,y].Brush.Color:=clGray; cShots[x,y]:=2; pTurn.brush.color:=clGreen; cTurn.brush.color:=clRed; end; end; procedure TForm1.pozovi; begin hit:=false; cOdigraj; If hit then pozovi; end; procedure TForm1.pShapeMouseDown(Sender: TObject; Button: TMouseButton; {Boji polje u zavisnosti da li je pogodjeno ili ne i unosi vrednosti u pShots} Shift: TShiftState; X, Y: Integer); var m1,m2,i,j,k:integer; begin if pTurn.Brush.color=clGreen then begin m1:=0; m2:=0; for i:=0 to 9 do for j:=0 to 9 do if Sender=cMat[i,j] then begin m1:=i; m2:=j; end; if (cBoard[m1,m2]<>0)and(cBoard[m1,m2]<>5) then begin pShots[m1,m2]:=1; cMat[m1,m2].Brush.Color:=clYellow; cMat[m1,m2].enabled:=false; if m1-1>=0 then begin if m2-1>=0 then begin cMat[m1-1,m2-1].Brush.Color:=clGray; cMat[m1-1,m2-1].enabled:=false; end; if m2+1<=9 then begin cMat[m1-1,m2+1].Brush.Color:=clGray; cMat[m1-1,m2+1].enabled:=false; end; end; if m1+1<=9 then begin if m2-1>=0 then begin cMat[m1+1,m2-1].Brush.Color:=clGray; cMat[m1+1,m2-1].enabled:=false; end; if m2+1<=9 then begin cMat[m1+1,m2+1].Brush.Color:=clGray; cMat[m1+1,m2+1].enabled:=false; end; end; CDButton1.enabled:=false; if isPotopljen(m1,m2,1) then begin boji(m1,m2,1); cShips[cBoard[m1,m2]]:=cShips[cBoard[m1,m2]]-1; kraj; end; end else begin pShots[m1,m2]:=2; cMat[m1,m2].Brush.Color:=clGray; cMat[m1,m2].enabled:=false; pTurn.Brush.color:=clRed; cTurn.Brush.color:=clGreen; CDButton1.enabled:=false; pozovi; end; end; end; function TForm1.pOdigraj(p, q: integer): boolean; begin if cBoard[p,q]=1 then pOdigraj:=true else pOdigraj:=false; end; function PCheckForShip(m,k,x,l:integer):boolean; var ok:boolean; br,i,j:integer; begin ok:=false; if x=0 then begin br:=0; if m>=l then begin for i:=m-l+1 to m do if pBoard[i,k]=0 then br:=br+1; if br=l then ok:=true; end; end; if x=1 then begin br:=0; if m+l-1<=9 then begin for i:=m to m+l-1 do if PBoard[i,k]=0 then br:=br+1; if br=l then ok:=true; end; end; if x=2 then begin br:=0; if k>=l then begin for j:=k-l+1 to k do if PBoard[m,j]=0 then br:=br+1; if br=l then ok:=true; end; end; if x=3 then begin br:=0; if k+l-1<=9 then begin for j:=k to k+l-1 do if PBoard[m,j]=0 then br:=br+1; if br=l then ok:=true; end; end; PCheckForShip:=ok; end; procedure PSetShip(m,k,x,l:integer); var i,j:integer; begin if x=0 then begin for i:=m-l to m+1 do for j:=k-1 to k+1 do 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 PBoard[i,j]:=5; for i:=m-l+1 to m do begin PBoard[i,k]:=l; PMat[i,k].brush.color:=clblue; end; end; if x=1 then begin for i:=m-1 to m+l do for j:=k-1 to k+1 do 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 PBoard[i,j]:=5; for i:=m to m+l-1 do begin PBoard[i,k]:=l; PMat[i,k].brush.color:=clblue; end; end; if x=2 then begin for i:=m-1 to m+1 do for j:=k-l to k+1 do 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 PBoard[i,j]:=5; for j:=k-l+1 to k do begin PBoard[m,j]:=l; PMat[m,j].brush.color:=clblue; end; end; if x=3 then begin for i:=m-1 to m+1 do for j:=k-1 to k+l do 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 PBoard[i,j]:=5; for j:=k to k+l-1 do begin PBoard[m,j]:=l; PMat[m,j].brush.color:=clblue; end; end; end; procedure PGenerateRandom; var x,l,m,k,i,j:integer; begin for l:=4 downto 1 do begin j:=4-l+1; for i:=1 to j do begin repeat randomize; m:=random(9); k:=random(9); until PCheckForShip(m,k,0,l) OR PCheckForShip(m,k,1,l) OR PCheckForShip(m,k,2,l) OR PCheckForShip(m,k,3,l); repeat x:=random(3); until PCheckForShip(m,k,x,l); PSetShip(m,k,x,l); end; end; end; function cCheckForShip(m,k,x,l:integer):boolean; var ok:boolean; br,i,j:integer; begin ok:=false; if x=0 then begin br:=0; if m>=l then begin for i:=m-l+1 to m do if cBoard[i,k]=0 then br:=br+1; if br=l then ok:=true; end; end; if x=1 then begin br:=0; if m+l-1<=9 then begin for i:=m to m+l-1 do if cBoard[i,k]=0 then br:=br+1; if br=l then ok:=true; end; end; if x=2 then begin br:=0; if k>=l then begin for j:=k-l+1 to k do if cBoard[m,j]=0 then br:=br+1; if br=l then ok:=true; end; end; if x=3 then begin br:=0; if k+l-1<=9 then begin for j:=k to k+l-1 do if cBoard[m,j]=0 then br:=br+1; if br=l then ok:=true; end; end; cCheckForShip:=ok; end; procedure cSetShip(m,k,x,l:integer); var i,j:integer; begin if x=0 then begin for i:=m-l to m+1 do for j:=k-1 to k+1 do 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 cBoard[i,j]:=5; for i:=m-l+1 to m do cBoard[i,k]:=l; end; if x=1 then begin for i:=m-1 to m+l do for j:=k-1 to k+1 do 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 cBoard[i,j]:=5; for i:=m to m+l-1 do cBoard[i,k]:=l; end; if x=2 then begin for i:=m-1 to m+1 do for j:=k-l to k+1 do 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 cBoard[i,j]:=5; for j:=k-l+1 to k do cBoard[m,j]:=l; end; if x=3 then begin for i:=m-1 to m+1 do for j:=k-1 to k+l do 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 cBoard[i,j]:=5; for j:=k to k+l-1 do cBoard[m,j]:=l; end; end; procedure cGenerateRandom; var x,l,m,k,i,j:integer; begin for l:=4 downto 1 do begin j:=4-l+1; for i:=1 to j do begin repeat randomize; m:=random(9); k:=random(9); until CCheckForShip(m,k,0,l) OR CCheckForShip(m,k,1,l) OR CCheckForShip(m,k,2,l) OR CCheckForShip(m,k,3,l); repeat x:=random(3); until CCheckForShip(m,k,x,l); CSetShip(m,k,x,l); end; end; end; procedure TForm1.CDButton1Click(Sender: TObject); begin cGenerateRandom; pGenerateRandom; end; procedure TForm1.CDButton2Click(Sender: TObject); var i,j:integer; begin CDbutton1.enabled:=true; pTurn.Brush.color:=clGreen; cTurn.Brush.color:=clRed; for i:=0 to 9 do for j:=0 to 9 do begin cBoard[i,j]:=0; cMat[i,j].brush.color:=clWhite; cMat[i,j].enabled:=true; end; for i:=0 to 9 do for j:=0 to 9 do begin PBoard[i,j]:=0; PMat[i,j].brush.color:=clwhite; end; for i:=1 to 4 do begin cships[i]:=4-i+1; pships[i]:=4-i+1 end; prethodni:=0; uzast:=0; mode:=1; end; end.
Optional Paste Settings
Category:
None
Cryptocurrency
Cybersecurity
Fixit
Food
Gaming
Haiku
Help
History
Housing
Jokes
Legal
Money
Movies
Music
Pets
Photo
Science
Software
Source Code
Spirit
Sports
Travel
TV
Writing
Tags:
Syntax Highlighting:
None
Bash
C
C#
C++
CSS
HTML
JSON
Java
JavaScript
Lua
Markdown (PRO members only)
Objective C
PHP
Perl
Python
Ruby
Swift
4CS
6502 ACME Cross Assembler
6502 Kick Assembler
6502 TASM/64TASS
ABAP
AIMMS
ALGOL 68
APT Sources
ARM
ASM (NASM)
ASP
ActionScript
ActionScript 3
Ada
Apache Log
AppleScript
Arduino
Asymptote
AutoIt
Autohotkey
Avisynth
Awk
BASCOM AVR
BNF
BOO
Bash
Basic4GL
Batch
BibTeX
Blitz Basic
Blitz3D
BlitzMax
BrainFuck
C
C (WinAPI)
C Intermediate Language
C for Macs
C#
C++
C++ (WinAPI)
C++ (with Qt extensions)
C: Loadrunner
CAD DCL
CAD Lisp
CFDG
CMake
COBOL
CSS
Ceylon
ChaiScript
Chapel
Clojure
Clone C
Clone C++
CoffeeScript
ColdFusion
Cuesheet
D
DCL
DCPU-16
DCS
DIV
DOT
Dart
Delphi
Delphi Prism (Oxygene)
Diff
E
ECMAScript
EPC
Easytrieve
Eiffel
Email
Erlang
Euphoria
F#
FO Language
Falcon
Filemaker
Formula One
Fortran
FreeBasic
FreeSWITCH
GAMBAS
GDB
GDScript
Game Maker
Genero
Genie
GetText
Go
Godot GLSL
Groovy
GwBasic
HQ9 Plus
HTML
HTML 5
Haskell
Haxe
HicEst
IDL
INI file
INTERCAL
IO
ISPF Panel Definition
Icon
Inno Script
J
JCL
JSON
Java
Java 5
JavaScript
Julia
KSP (Kontakt Script)
KiXtart
Kotlin
LDIF
LLVM
LOL Code
LScript
Latex
Liberty BASIC
Linden Scripting
Lisp
Loco Basic
Logtalk
Lotus Formulas
Lotus Script
Lua
M68000 Assembler
MIX Assembler
MK-61/52
MPASM
MXML
MagikSF
Make
MapBasic
Markdown (PRO members only)
MatLab
Mercury
MetaPost
Modula 2
Modula 3
Motorola 68000 HiSoft Dev
MySQL
Nagios
NetRexx
Nginx
Nim
NullSoft Installer
OCaml
OCaml Brief
Oberon 2
Objeck Programming Langua
Objective C
Octave
Open Object Rexx
OpenBSD PACKET FILTER
OpenGL Shading
Openoffice BASIC
Oracle 11
Oracle 8
Oz
PARI/GP
PCRE
PHP
PHP Brief
PL/I
PL/SQL
POV-Ray
ParaSail
Pascal
Pawn
Per
Perl
Perl 6
Phix
Pic 16
Pike
Pixel Bender
PostScript
PostgreSQL
PowerBuilder
PowerShell
ProFTPd
Progress
Prolog
Properties
ProvideX
Puppet
PureBasic
PyCon
Python
Python for S60
QBasic
QML
R
RBScript
REBOL
REG
RPM Spec
Racket
Rails
Rexx
Robots
Roff Manpage
Ruby
Ruby Gnuplot
Rust
SAS
SCL
SPARK
SPARQL
SQF
SQL
SSH Config
Scala
Scheme
Scilab
SdlBasic
Smalltalk
Smarty
StandardML
StoneScript
SuperCollider
Swift
SystemVerilog
T-SQL
TCL
TeXgraph
Tera Term
TypeScript
TypoScript
UPC
Unicon
UnrealScript
Urbi
VB.NET
VBScript
VHDL
VIM
Vala
Vedit
VeriLog
Visual Pro Log
VisualBasic
VisualFoxPro
WHOIS
WhiteSpace
Winbatch
XBasic
XML
XPP
Xojo
Xorg Config
YAML
YARA
Z80 Assembler
ZXBasic
autoconf
jQuery
mIRC
newLISP
q/kdb+
thinBasic
Paste Expiration:
Never
Burn after read
10 Minutes
1 Hour
1 Day
1 Week
2 Weeks
1 Month
6 Months
1 Year
Paste Exposure:
Public
Unlisted
Private
Folder:
(members only)
Password
NEW
Enabled
Disabled
Burn after read
NEW
Paste Name / Title:
Create New Paste
Hello
Guest
Sign Up
or
Login
Sign in with Facebook
Sign in with Twitter
Sign in with Google
You are currently not logged in, this means you can not edit or delete anything you paste.
Sign Up
or
Login
Public Pastes
I made $15,000 in 2 days
CSS | 29 min ago | 0.21 KB
✅ API Glitch (Docs Leak)
CSS | 30 min ago | 0.21 KB
This summer smells like money
CSS | 30 min ago | 0.21 KB
Untitled
mIRC | 3 hours ago | 0.57 KB
ifm isu iolink [WIP]
Python | 4 hours ago | 1.18 KB
HELLO PROGRAMMER
18 hours ago | 0.03 KB
Untitled
23 hours ago | 2.26 KB
FB2600 User Handbook v0.91
1 day ago | 6.06 KB
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!