Редактирование кода программы

unit soberi_;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes,
  Graphics, Controls, Forms, Dialogs;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
 
    // эти объявления вставлены сюда вручную
    procedure ShowPole;
    procedure Mixer;
    procedure NewGame;
 
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
const
    H = 4;   W = 4;   // размер поля - 4х4
var
 
    wc,hc: integer; // ширина и высота клетки
 
    // игровое поле
    pole: array[1..H, 1..W] of byte;
    ex,ey: integer; // координаты пустой клетки
 
    // правильное расположение клеток
    stp : array[1..H, 1..W] of byte =
    (( 1, 2, 3, 4),
     ( 5, 6, 7, 8),
     ( 9,10,11,12),
     (13,14,15, 0));
 
     pic: TBitmap;   // картинка
 
// новая игра
procedure TForm1.NewGame;
var
    fname: string[20]; // файл картинки
    i,j: integer;
begin
    { сюда можно вставить инструкции,
    обеспечивающие, например, случайный
    выбор загружаемой картинки }
 
    fname := 'DAY1.bmp';
    try
        pic.LoadFromFile(fname);
        except
            on EFopenError do
               begin
                ShowMessage('Ошибка обращения к файлу ' + fname);
                Form1.Close;
               end;
    end;
    // Установить размер формы равный
    //  равный размеру картинки.
 
    // размер клетки
    hc := Pic.Height div H;
    wc := Pic.Width div W;
 
    // размер формы
    ClientWidth  := 636;
    ClientHeight := 900;
 
    // исходное (правильное) положение
    for i:=1 to H do
        for j:=1 to W 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;
    // Обмен. Переместим фишку из x,y в ex,ey
    Pole[ey,ex] := Pole[cy,cx];
    Pole[cy,cx] := 0;
    ex:=cx;
    ey:=cy;
    // отрисовать поле
    Form1.ShowPole;
    if Finish then
    begin
        pole[4,4] := 16;
        Form1.ShowPole;
        r := MessageDlg('Цель достигнута!'+ #13+
        'Еще раз?',mtInformation,[mbYes,mbNo],0);
        if r = mrNo then Form1.Close; // завершить работу программы
        Form1.NewGame;
    end;
end;
 
// щелчок в клетке
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
    cx,cy: integer; // координаты клетки
begin
    // преобразуем мыши в координаты клетки
    cx := Trunc(X / wc) + 1;
    cy := Trunc(Y / hc) + 1;
    Move(cx,cy);
end;
 
// выводит игровое поле
procedure TForm1.ShowPole;
var
    Source, Dest: Trect; // области: источник и приемник
    sx,sy: integer;      // левый верхний угол области источника
    i,j: integer;
 
begin
 
    // содержимое клеток
    for i := 1 to W do
        for j := 1 to H do
        begin
            // преобразуем номер картинки
            // в координаты левого верхнего
            // угла области источника
            sy := ((pole[i,j] -1 ) div W) * hc;
            sx := ((pole[i,j] -1 ) mod W) * wc;
 
            Source := Bounds(sx,sy,wc,hc);
            Dest := Bounds((j-1)*wc,(i-1)*hc,wc,hc);
            if pole[i,j] <> 0
                then Canvas.CopyRect(Dest,pic.Canvas,Source)
                else Canvas.Rectangle((j-1)*wc,(i-1)*hc,j*wc,i*hc);
        end;
end;
 
// "перемешивает" фишки
procedure TForm1.Mixer;
var
    x1,y1: integer; // пустая клетка
    x2,y2: integer; // эту переместить в пустую
    d: integer;     // направление, относительно пустой
    i: integer;
begin
    x1:=4; y1:=4; // см. описание массива stp
    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;
 
// обработка события OnCreate
procedure TForm1.FormCreate(Sender: TObject);
begin
    pic := TBitMap.Create;
    NewGame;
end;
 
// обработка события OnPaint
procedure TForm1.FormPaint(Sender: TObject);
begin
    Form1.ShowPole;
end;
 
end.

        r := MessageDlg('Цель достигнута!'+ #13+
        'Еще раз?',mtInformation,[mbYes,mbNo],0);
        if r = mrNo then Form1.Close; // завершить работу программы