Anonymní profil ASTONEK – Programujte.com
 x   TIP: Přetáhni ikonu na hlavní panel pro připnutí webu

Anonymní profil ASTONEK – Programujte.comAnonymní profil ASTONEK – Programujte.com

 

Příspěvky odeslané z IP adresy 85.132.180.–

ASTONEK
Delphi › POROVNÁNÍ POLE NEBO POLOHY,…
4. 9. 2008   #84406

Potřeboval bych vytvořit podmínu solved aby se hra ukončila. Ale nevím jak, přemýšlel jsem o vygenerování druhého stejného pole pro porovníní ale to se mi nepodařilo. Jdná se pole Hlavní hrací pole a funkci solved. Kdyby náááhodou někdo měl čas a věděl, byl bych rád. Tohle jsem celé nevytvořil já, jen jsem využil zdroje z netu a chci to dodělat aby hra správně hlásila výhru.

unit U_Puzzle;


{..............................................................................}
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Menus;
{..............................................................................}






{..............................................................................}
type
TBoardrec=record
SliderIndex:integer;
col,row:Integer;
end;

TSliderBoard=class(TPanel)
public
Sidex,Sidey:integer;
Board: array of TBoardrec;
Sliders:array of TPanel;
Empty :integer;
Slotw:integer;
UpdateMode:boolean;

constructor create(panel:TPanel; newSideX,newSideY:integer);
destructor destroy;
procedure move(index:integer);
procedure slideit(sender:Tobject);
function canmove(index:integer):boolean;
function solved:boolean;
procedure beginupdate;
procedure endupdate;
end;

TForm1 = class(TForm)
Panel1: TPanel;
ScrambleBtn: TButton;
SizeGrp: TRadioGroup;
Label1: TLabel;
MainMenu1: TMainMenu;
KONEC1: TMenuItem;
Npovda1: TMenuItem;
N1Vybertevelikosthrachopole1: TMenuItem;
N2Vygenerujesevmpoledanhorozmru1: TMenuItem;
Vygenerovanpolezobrazujevteznstavhry1: TMenuItem;
N4Zvoltetlatkozamchat1: TMenuItem;
Kliknutmnapoadovanslojejpesunetenaprznpolko1: TMenuItem;
Clemjeposkldatpoleseldostavupedzamchnm1: TMenuItem;
Button1: TButton;
Ukonit1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure ScrambleBtnClick(Sender: TObject);
procedure SizeGrpClick(Sender: TObject);
procedure HELP(Sender: TObject);
procedure Ukonit1Click(Sender: TObject);

private

public
SliderBoard:TSliderBoard;
end;
{..............................................................................}







{..............................................................................}
var
Form1: TForm1;
implementation

{$R *.DFM}

const
steps=20; {rychlost slide}
{..............................................................................}






{..............................................................................}
{hlavni hraci pole}
constructor TSliderBoard.create(panel:TPanel;newsidex,newsidey:integer);

var
i:integer;
j:integer;


begin
sidex:=newsidex;
sidey:=newsidey;
setlength(sliders,sidex*sidey);
setlength(board,sidex*sidey);
inherited create(panel.owner);
height:=panel.height;
width:=panel.Width;
if height>width then height:=width
else width:=height;
left:=panel.Left;
top:=panel.Top;
parent:=panel.parent;
color:=panel.color;
slotw:=width div sidex;
for i:=1 to sidex*sidey-1 do
begin
sliders[i]:=TPanel.create(self);
with sliders[i] do
begin
parent:=self;
board[i-1].sliderindex:=i;
board[i-1].col:=((i-1) mod sidex);
board[i-1].row:=((i-1) div sidex);
left:= board[i-1].col*slotw;
top:= board[i-1].row*slotw;
width:=slotw;
height:=slotw;
caption:=inttostr(i);
tag:=i;
onclick:=slideit;

end;


end;
empty:=sidex*sidey-1;
board[empty].Sliderindex:=0;
with board[empty] do
begin
col:=empty mod sidex;
row:=empty div sidex;
end;
invalidate;
updatemode:=false;
end;
{..............................................................................}





{..............................................................................}
destructor TSliderBoard.destroy;
var
i:integer;
begin
for i:= 1 to high(sliders) do sliders[i].free;
setlength(board,0);
setlength(sliders,0);
inherited;
end;
{..............................................................................}






{..............................................................................}
function TSliderBoard.solved:boolean;
var
i:integer;
j:integer;
a:integer;

begin





solved:=true;
end;



{..............................................................................}




{..............................................................................}
procedure TSliderBoard.slideit(sender:TObject);
var
i,j,k:integer;
begin

i:=TPanel(sender).tag;
k:=0;
for j:=0 to high(board) do
if board[j].sliderindex=i then break;
if canmove(j) then move(j);
if solved then
begin
showmessage('------VYHRAL JSI------');
end;
end;
{..............................................................................}




{..............................................................................}
procedure TSliderBoard.move(index:integer);
var
stepx,stepy:integer;
destx,desty,i:integer;
begin
destx:=board[empty].col*slotw;
desty:=board[empty].row*slotw;
with sliders[board[index].Sliderindex] do
begin
stepx:=(destx-left) div steps;
stepy:=(desty-top) div steps;
if not updatemode then
for i:= 1 to steps do
begin
left:=left+stepx;
top:=top+stepy;
invalidate;
sleep(10);
application.processmessages;
end;
left:=destx;
top:=desty;
invalidate;
end;
board[empty].sliderindex:=board[index].sliderindex;
board[index].sliderindex:=0;
empty:=index;
end;
{..............................................................................}




{..............................................................................}
function TSliderBoard.canmove(index:Integer):boolean;
var
x,y:integer;
begin
x:=board[index].col;
y:=board[index].row;
result:=false;
if x=board[empty].col then
if (y+1=board[empty].row)
or (y-1=board[empty].row)
then result:=true
else
else
if y=board[empty].row then
if (x+1=board[empty].col)
or (x-1=board[empty].col)
then result:=true;
end;
{..............................................................................}




{..............................................................................}
procedure TSliderBoard.beginupdate;
begin
updatemode:=true;
end;
{..............................................................................}



{..............................................................................}
procedure TSliderBoard.endupdate;
var
i:integer;
begin
updatemode:=false;
for i:=1 to high(sliders) do sliders[i].invalidate;
end;
{..............................................................................}




{..............................................................................}
procedure TForm1.FormCreate(Sender: TObject);
var
n:integer;
begin
randomize;
n:=sizegrp.itemindex+3;
SliderBoard:=TSliderBoard.create(Panel1,n,n);
end;
{..............................................................................}





{..............................................................................}
procedure TForm1.ScrambleBtnClick(Sender: TObject);

var
n,prev,i:integer;
begin
sizegrp.enabled:=false;
sliderboard.beginupdate;
i:=0;
prev:=-1;
with sliderboard do
repeat
n:=random(4);
case n of
0: {doleva}
if (prev<>2) and (board[empty].col>0) then
begin
move(empty-1);
inc(i);
prev:=n;
end;
1: {nahoru}
if (prev<>3) and (board[empty].row>0) then
begin
move(empty-sidex);
inc(i);
prev:=n;
end;
2: {doprava}
if (prev<>0) and (board[empty].col<sidex-1) then
begin
move(empty+1);
inc(i);
prev:=n;
end;
3: {dolu}
if (prev<>1) and (board[empty].row<sidey-1) then
begin
move(empty+sidex);
inc(i);
prev:=n;
end;
end;
until i>=100;
sliderboard.endupdate;
sizegrp.enabled:=true;
end;
{..............................................................................}





{..............................................................................}
procedure TForm1.SizeGrpClick(Sender: TObject);
var
n:integer;
begin
sliderboard.free;
n:=sizegrp.itemindex+3;
SliderBoard:=TSliderBoard.create(panel1,n,n);
end;
{..............................................................................}





{..............................................................................}
procedure TForm1.HELP(Sender: TObject);
begin
showmessage('Seřaďte čísla podle vzoru před zamícháním.'); beep;
end;
{..............................................................................}



{..............................................................................}
{konec}
procedure TForm1.Ukonit1Click(Sender: TObject);
begin
close
end;
{........................................................................}






end.

 

 

Hostujeme u Českého hostingu       ISSN 1801-1586       ⇡ Nahoru Webtea.cz logo © 20032024 Programujte.com
Zasadilo a pěstuje Webtea.cz, šéfredaktor Lukáš Churý