Számrendező (15-ös játék)

Valószínű sokan ismerik a 15-ös játékot. Ennek az a lényege, hogy egy 4x4-es mezőn összekeverve helyezkedik el 1-től 15-ig feliratozva egy-egy kis lapocska. Egy üresen van hagyva. Az üres helyre a mellette lévő lapszomszédos helyről a lapocska áttolható. Cél az, hogy sorfolytonosan 1-től 15-ig rendezetten kell, tologatással elhelyezni a lapocskákat úgy, hogy a jobb alsó hely maradjon üresen. A számítógépes megoldás ennél annyival több, hogy maximálisan 10x10–ig mi választhatjuk meg a játékteret. Természetesen akkor is csak egy üres hely marad, így a lapocskák száma mindig N x M -1. A program számolja az átrakások számát, és ha készen vagyunk, Gratuláló szöveget jelenít meg. Szerencsés próbálgatást.

A program egy futási képe:

A program listája:

unit USzamRend;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms, Dialogs, StdCtrls, Grids;

type
TfmSzamRend = class(TForm)
lbSzamRend: TLabel;
lbSorSzam: TLabel;
edSorSzam: TEdit;
lbOszlSzam: TLabel;
edOszlSzam: TEdit;
btKilepes: TButton;
btKeveres: TButton;
sgSzamRend: TStringGrid;
lbLepes: TLabel;
lbLepesSz: TLabel;
Procedure StartUp;
Function Vege: Boolean;
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure edSorSzamChange(Sender: TObject);
procedure edOszlSzamChange(Sender: TObject);
procedure btKeveresClick(Sender: TObject);
procedure sgSzamRendDblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fmSzamRend: TfmSzamRend;
Nx, Ny, Ux, Uy, L: Word;

implementation

{$R *.dfm}

Procedure TfmSzamRend.StartUp;
Var I, J, N : Word;
Begin
Nx:= StrToInt(edOszlSzam.Text);
  Ny:= StrToInt(edSorSzam.Text);
With sgSzamRend Do
Begin
ColCount:= Nx+1; RowCount:= Ny+1;
For I:= 1 To ColCount-1 Do For J:= 1 To RowCount-1 Do Cells[I,J]:= '';
For I:= 1 To ColCount Do Cells[I,0]:= '*';
For J:= 1 To RowCount Do Cells[0,J]:= '*';
DefaultColWidth:= Round(400/Nx); DefaultRowHeight:= Round(320/Ny);
ColWidths[0]:= 0; RowHeights[0]:= 0;
Font.Size:= 24-Nx; Font.Style:=[fsBold]; Col:= 1; Row:= 1;
    N:= Nx*Ny-1;
For I:= 1 To N Do
Cells[(I-1) Mod Nx+1,(I-1) Div Nx+1]:= IntToStr(I);
Ux:= ColCount-1; Uy:= RowCount-1;
End;
  L:= 0; lbLepesSz.Caption:= IntToStr(L);
End;

Function TfmSzamRend.Vege: Boolean;
Var I: Word;
Begin
Vege:= False;
With sgSzamRend Do
Begin
If Cells[ColCount-1,RowCount-1]<>'' Then Exit;
For I:= 1 To Nx*Ny-1 Do
If Cells[(I-1) Mod Nx+1,(I-1) Div Nx+1]<>'' Then
If StrToInt(Cells[(I-1) Mod Nx+1,(I-1) Div Nx+1])<>I Then Exit;
End;
Vege:= True;
End;

procedure TfmSzamRend.btKilepesClick(Sender: TObject);
begin
Close;
end;

procedure TfmSzamRend.FormCreate(Sender: TObject);
begin
Randomize;
StartUp;
btKeveresClick(Sender);
end;

procedure TfmSzamRend.edSorSzamChange(Sender: TObject);
Var Kod: Integer;
begin
With edSorSzam Do
Begin
Val(Text,Ny,Kod); If Kod=0 Then
Begin
      L:= 0; If Ny>10 Then Ny:= 10; Text:= IntToStr(Ny);
StartUp; btKeveresClick(Sender);
End;
End;
end;

procedure TfmSzamRend.edOszlSzamChange(Sender: TObject);
Var Kod: Integer;
begin
With edOszlSzam Do
Begin
Val(Text,Nx,Kod); If Kod=0 Then
Begin
      L:= 0; If Nx>10 Then Nx:= 10; Text:= IntToStr(Nx);
StartUp; btKeveresClick(Sender);
End;
End;
end;

procedure TfmSzamRend.btKeveresClick(Sender: TObject);
Var I, N: Word;
    P: String;
begin
StartUp;
  N:= 100*Nx*Ny;
For I:= 1 To N Do With sgSzamRend Do
Case Random(4) Of
    0: If Uy-1 In [1..Ny] Then
Begin
         P:= Cells[Ux,Uy-1]; Cells[Ux,Uy-1]:= '';

Cells[Ux,Uy]:= P; Dec(Uy);
End;
    1: If Ux+1 In [1..Nx] Then
Begin
         P:= Cells[Ux+1,Uy]; Cells[Ux+1,Uy]:= '';

Cells[Ux,Uy]:= P; Inc(Ux);
End;
    2: If Uy+1 In [1..Ny] Then
Begin
         P:= Cells[Ux,Uy+1]; Cells[Ux,Uy+1]:= ''; 

Cells[Ux,Uy]:= P; Inc(Uy);
End;
    3: If Ux-1 In [1..Nx] Then
Begin
         P:= Cells[Ux-1,Uy]; Cells[Ux-1,Uy]:= '';

Cells[Ux,Uy]:= P; Dec(Ux);
End;
End;
end;

procedure TfmSzamRend.sgSzamRendDblClick(Sender: TObject);
Var P: String;
    Volt: Boolean;
begin
  Volt:= False;
With sgSzamRend Do
Begin
If Row-1 In [1..Ny] Then If Cells[Col,Row-1]='' Then
Begin
      P:= Cells[Col,Row]; Cells[Col,Row]:= ''; Cells[Col,Row-1]:= P;
      Volt:= True;
End;
If Col+1 In [1..Nx] Then If Cells[Col+1,Row]='' Then
Begin
      P:= Cells[Col,Row]; Cells[Col,Row]:= ''; Cells[Col+1,Row]:= P;
      Volt:= True;
End;
If Row+1 In [1..Ny] Then If Cells[Col,Row+1]='' Then
Begin
P:= Cells[Col,Row]; Cells[Col,Row]:= ''; Cells[Col,Row+1]:= P;
      Volt:= True;
End;
If Col-1 In [1..Nx] Then If Cells[Col-1,Row]='' Then
Begin
      P:= Cells[Col,Row]; Cells[Col,Row]:= ''; Cells[Col-1,Row]:= P;
      Volt:= True;
End;
End;
If Volt Then
Begin
    Inc(L); lbLepesSz.Caption:= IntToStr(L);
If Vege Then
Begin
MessageDlg('Gratulálok',mtInformation,[mbOK],0);
btKeveresClick(sender);
End;
End;
end;

end.