Игра пятнашки - Delphi - Ответ 3670607

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
 
type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure ShowPole;
    procedure Mixer;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
  
 
{$R *.dfm}
 
 
 const
    H = 4;  W = 4;     //размер поля - 4х4
    CH = 64; CW = 64;  //размер клеток - 16х16
 
 var
    //правельное расположение фишек
    stp: array [1..H, 1..W] of byte =
    ((1, 2, 3, 4),
     (5, 6, 7, 8),
     (9,10,11,12),
     (13,14,15,0));
 
     //игровое поле
     pole: array[1..H, 1..W] of byte;
     ex,ey: integer;   //координаты пустой клетки
 
     //новая игра
   procedure NewGame;
   var
    i,j:integer;
   begin
   //исходные (правельное) положение
     for i:=0 to H+1 do
      for j:=0 to W+1 do
       pole[i,j] := stp[i,j];
     Form1.Mixer;    //перемещать фишки
     Form1.ShowPole; //отобразить поле
     end;
 
//проверка, расположены фишки в нужном порядке
Function Finish: boolean;
var
  row,col: integer;
  i: integer;
begin
  row :=1; col :=1;
  Finish := True;  //пусть фишки в нужном порядке
  for i:=1 to 15 do
  begin
    if pole [row,col] <> i then
    begin
     Finish:=False;
     break;
     end;
     if col < 4
      then inc(col)
       else begin
        col :=1;
        inc(row);
       end;
      end;
     end;
//перемещение фишки в соседнию пустую клетку
Procedure Move(cx,cy: integer);
// cx,cy - клетка, в которой игрок сделал щелчек
var
  r: integer; //выбор игрока
  begin
  //проверка возможен ли обмен
  if not ((abs(cx-ex) = 1) and (cy-ey = 0) or
          (abs(cy-ey) = 1) and (cx-ex = 0))
  then exit;
  //  Обен фишек
  Pole[ey,ex] := Pole[cy,cx];
  Pole[cy,cx] := 0;
  ex:=cx;
  ey:=cy;
  //отрисовать поле
  Form1.ShowPole;
  if Finish then
  begin
   r := MessageDlg('Миссия выполнена! =)'+ #13 + 'Replay?',mtInformation,[mbYes,mbNo],0);
   if r = mrNo then Form1.Close;
  end;
 end;
//клетка
 
 
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
   cx,cy:integer;
begin
   cx := Trunc(X / CW) + 1;
   cy := Trunc(Y / CH) + 1;
   Move(cx,cy);
end;
//вывод игрового поля
Procedure TForm1.ShowPole;
var
   i,j,x,y: integer;
 begin
//сетка: вертикальные линии
  for i:= 1 to W - 1 do
   begin
     Canvas.MoveTo(i*CW,0);
     Canvas.LineTo(i*CW,ClientHeight);
   end;
//сетка: горизонтальные линии
  for i:=1 to H - 1 do
   begin
    Canvas.MoveTo(0,i*CH);
    Canvas.LineTo(ClientWidth,i*CH);
   end;
//содержимое клеток
  for i:= 1 to H do
   begin
    y:=(i-1)*CH + 15;
    for j:=1 to W do
     begin
      x:= (j-1)*CW+15;
    case Pole[i,j] of
      0:      Canvas.TextOut(x,y,'    ');
      1..9:   Canvas.TextOut(x,y,' '+ IntToStr (Pole[i,j])+ '  ');
      10..15: Canvas.TextOut(x,y,IntToSTR(Pole[i,j]));
     end;
    end;
   end;
  end;
 
// перемешивание фишек
Procedure TForm1.Mixer;
var
  x1,x2,y1,y2,d,i:integer;
  begin
    x1:=4;
    y1:=4;
    randomize;
    for i:= 1 to 150 do
     begin
      repeat
          x2:=x1;
          y2:=y1;
          d:=random(4)+1;
          case d of
             1: dec(x2);
             2: inc(x2);
             3: dec(y2);
             4: inc(y2);
          end;
       until (x2>=1) and (x2<=4) and (y2>=1) and (y2<=4);
//ОПРЕДЕЛЕНИЕ ФИШКИ ПЕРЕМЕЩЕНИЕ В ПУСТУЮ КЛЕТКУ
        Pole [y1,x1] := Pole[y2,x2];
        Pole [y2,x2] := 0;
        x1:=x2;
        y1:=y2;
      end;
     ex:= x1;
     ey:= y1;
    end;
 
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  ClientWidth := CW * W;
  ClientHeight := CH * H;
  Canvas.Font.Name := 'Times New Roman';
  Canvas.Font.Size := 22;
end;
 
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  Form1.ShowPole;
end;
 
end.