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.
Fórum › Delphi
POROVNÁNÍ POLE NEBO POLOHY, nebo jinak
Zjistit počet nových příspěvků
Přidej příspěvek
Toto téma je starší jak čtvrt roku – přidej svůj příspěvek jen tehdy, máš-li k tématu opravdu co říct!
Ano, opravdu chci reagovat → zobrazí formulář pro přidání příspěvku
×Vložení zdrojáku
×Vložení obrázku
×Vložení videa
Aktuálně jsou podporována videa ze serverů YouTube, Vimeo a Dailymotion.
×
Uživatelé prohlížející si toto vlákno
Uživatelé on-line: 0 registrovaných, 16 hostů
Podobná vlákna
Software developer C++ nebo C# nebo Java (Android) se znalostí AJ — založil Kateřina Mrkáčková
Vytvoření záznamu (array nebo hash nebo?) — založil VencaT
Dvourozměrné pole nebo pole struktur? — založil mardon
Porovnání pole — založil Alesh