просмотров:34325 | комметариев: 26

Игра "Пятнашки"


Представляю Вашему вниманию прототип программы «Игра Пятнашки». Прототип потому как, хоть прога и является законченной реализацией алгоритма самой игры пятнашки, но ей явно не хватает доп. функций которые сделают прогу удобной для пользователя, ну и над внешним видом нужно потрудиться.

Сначала я хотел написать подробную статью, описывающею весь процесс создания сего чуда, от зарождения неких идей в туманных закоулках моего мозга, до их реализации в виде откомпилированного екзешника. Но потом передумал. Сделаем так, выложу код + исходник в архиве, и если возникнут какие либо вопросы, милости прошу, спрашивайте в комментариях.

Еще несколько слов. В реализации данного алгоритма использовался для отображения игровых фишек стандартный тип TButton. Вы можете использовать другой визуальный компонент для отображения костей-фишек. Для этого достаточно в строке

type Tfish = TButton; вместо TButton вписать нужный Вам тип.

 

Хочу сразу показать, как будет выглядеть наш прототип игры «Пятнашки»

А вот такой стала игрушка после обработки напильником см. Мои программы

Прога получилась легко масштабируемой, (так и задумывалось) так что, размер поля можно указать любой, а не только с кол-вом фишек 4х4. Например, чтобы сделать поле 10х10 нужно поменять значения двух констант:

 

const ........ NXM = 10; M = 100; ........

Скачать архив с исходником можно ***ЗДЕСЬ***.
Разбирайтесь, ковыряйте исходник, если что-то не понятно - спрашивайте. Удачи.
ЗЫ. Кликайте на той фишке, которую хотите переместить.


Листинг проги:

unit main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus; type TForm1 = class(TForm) MainMenu1: TMainMenu; N1: TMenuItem; N2: TMenuItem; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); private procedure ButClicked(Sender: TObject); procedure CreatFishkas(); procedure KillOldFihkas(); function position(const x, y: integer): integer; procedure victopia(); { Private declarations } public { Public declarations } end; type Tfish = TButton; // указываем тип наших фишек, не нравится бутон - укажите другой const W = 80; // ширина фишки D = 10; // растояние между фишками L = D + W; // растояние между "х" у фишек NXM = 4; // размер поля 4х4 N = 1; M = 16; // размерность массива фишек POLET = 10; POLEL = 10; //начальные позиции поля фишек на форме prefix = 'Fishka'; var Form1: TForm1; btn: array[N..M] of Tfish; sorseAr: array[N..M] of boolean; zeroX, zeroY: integer; XYmatrix: array[1..M, 1..2] of integer; implementation {$R *.dfm} //размер формы procedure FormSize; begin Form1.Width := (POLEL * 2) + (L * NXM); Form1.Height := (L * NXM) + POLET + 50; end; procedure TForm1.FormCreate(Sender: TObject); var i, ty, lx: integer; begin randomize; i := 0; // заполняем массив коорденатами на которые будут случайным образом ставиться // фишки в начале новой игры ty := POLET; lx := POLEL; for i := N to M do begin XYmatrix[i, 1] := lx; XYmatrix[i, 2] := ty; lx := lx + L; if i mod NXM = 0 then begin ty := ty + L; lx := POLEL; end; end; FormSize(); end; procedure TForm1.FormShow(Sender: TObject); begin CreatFishkas(); end; // клик по пункту меню - "новая игра" procedure TForm1.N1Click(Sender: TObject); begin KillOldFihkas(); FormSize(); CreatFishkas(); end; { сбрасывает все элементы массива в true, массив отвечает за неповторяющиеся порядковые номера фишек которые выбираются случайным образом нужно при иницилизации новой игры} function dump(): boolean; var i: integer; begin i := 0; for i := N to M do sorseAr[i] := true; ; end; // непосредственно алгоритм выборки неповторяющихся значений случайным образом function choose(): integer; var i: integer; begin i := 0; result := random(M) + 1; while sorseAr[result] = false do result := random(M) + 1; sorseAr[result] := false; end; procedure TForm1.CreatFishkas; // НОВАЯ ИГРА, создание игрового поля var i, ty, lx, ch: integer; begin randomize; dump(); // But.Enabled:=false; BitBtn1.Enabled:=true; BitBtn2.Enabled:=true; ty := POLET; lx := POLEL; for i := N to M do begin btn[i] := Tfish.Create(Self); btn[i].Width := W; btn[i].Height := W; btn[i].Font.Size := 26; btn[i].Font.Style := [fsBold]; ch := choose(); // получаем случайным образом число 1-16, числа не повторяются btn[i].Left := XYmatrix[ch, 1]; // получаем коорденату Х btn[i].Top := XYmatrix[ch, 2]; // получаем коорденату У btn[i].Tag := ch; // в Tag будем держать текущее положение фишки btn[i].Name := prefix + inttostr(i); if i <> M then begin btn[i].Caption := inttostr(i); btn[i].OnClick := ButClicked; end else begin // это пустая кнопка, без каптион и обработчика OnClick btn[i].Caption := ''; zeroX := btn[i].Left; zeroY := btn[i].Top; end; btn[i].Parent := Self; end; end; // определяет позицию на которой стоит фишка в данный момент по ее коорденатам function TForm1.position(const x, y: integer): integer; var i: integer; begin i := 0; result := -32; for i := N to M do begin if ((XYmatrix[i, 1] = x) and (XYmatrix[i, 2] = y)) then begin result := i; break; end; end; end; // перемешение фишки на новую позицию procedure TForm1.ButClicked(Sender: TObject); var X, Y, ps: integer; begin X := Tfish(Sender).left; Y := Tfish(Sender).Top; if ((X = zeroX + L) and (Y = zeroY)) or ((X = zeroX - L) and (Y = zeroY)) or ((X = zeroX) and (Y = zeroY + L)) or ((X = zeroX) and (Y = zeroY - L)) then begin Tfish(Sender).Left := zeroX; Tfish(Sender).Top := zeroY; Tfish(FindComponent(prefix + inttostr(M))).left := X; Tfish(FindComponent(prefix + inttostr(M))).top := Y; ps := position(zeroX, zeroY); if ps <> -32 then Tfish(Sender).Tag := ps else ShowMessage('Ошибка в логике проги. КООРДЕНАТЫ'); zeroX := X; zeroY := Y; victopia(); // проверка - ПОБЕДА или играем дальше end; end; // проверка - ПОБЕДА или играем дальше... procedure TForm1.victopia; var i: integer; b: boolean; begin b := true; i := 0; for i := N to M - 1 do begin if strtoint(Tfish(FindComponent(prefix + inttostr(i))).Caption) <> Tfish(FindComponent(prefix + inttostr(i))).Tag then begin b := false; break; end; end; if b then ShowMessage('Вы побелили'); end; procedure TForm1.KillOldFihkas; // уничтожаем кнопки-фишки, нужно перед началом новой игры var i: integer; begin for i := N to M do FreeAndNil(btn[i]); end; procedure TForm1.N2Click(Sender: TObject); begin Application.Terminate(); end; end.



просмотров:34325 | комметариев: 26
Андрей
20 июня 2010, 11:58
Спасибо, стал писать свои пятнашки на основе вашего алгоритма
lovelace
10 января 2011, 13:19
а у вас нет автоматической реализации "Пятнашек"? Т.е. чтоб компьютер сам играл, находил оптимизированные ходы?
Губарев Михаил
10 января 2011, 22:48
Такого нету, алгоритма тоже не встречал. Успехов
Катюшка
12 марта 2011, 16:16
у меня она не запускаетса,выдает ошибки,что мне делать?
Губарев Михаил
13 марта 2011, 10:01
Что за ошибки? Вы исходник скачали?
Денис
12 апреля 2011, 05:45
А можно исходник вторых пятнашек
Губарев Михаил
17 апреля 2011, 07:45
Исходник вторых пятнашек канул в лету...
Света
01 июня 2011, 18:57
что за процедура,которая описывает сколько костей находится на своем месте?
Губарев Михаил
01 июня 2011, 20:42
procedure TForm1.victopia; - проверяет все ли кости стоят на своих местах, если - да - победа
Aleksandr-Golodin
25 октября 2011, 11:28
Spasibo Pomogli ochen
Modestrom
11 декабря 2011, 22:13
А вы не подскажите, как сделать так, что бы программа сама двигала фишки с интервалом в 2 сек.(в случайном порядке)?
Губарев Михаил
12 декабря 2011, 22:13
Вычислить какие кнопки можно в данный момент нажимать, нажать случайным образом, запомнить какую нажали(что-бы не двигать туда-суда), повторить цикл, пока все не сложится.

Или еще проще алгоритм, вообще случайным образом тыкать пока не нажмете доступную. Но запоминать какую нажали все-же нужно, ибо не красиво будет.

Удачи!
ал_гор
26 декабря 2011, 01:55
алгоритм неповторяющихся значений некорректен. Правильнее использовать уменьшающийся массив
ал_гор
26 декабря 2011, 02:05
Да и если использовать кнопы то лучше SpeedButton без фокуса ввода)

простите за занудство
ал_гор
26 декабря 2011, 02:17
Нужна проверка собираемости расклада и поворот доски при несобираемом раскладе.



P.s Мне не спится просто
ал_гор
26 декабря 2011, 12:12
Да кстати и зачем вобще двигать кнопки если можно просто менять текст на них?
Губарев Михаил
28 декабря 2011, 05:07
Можно двигать, можно менять текст, как вам по душе так и делайте.

Алгоритм не собираемости расклада видел на просторах инета, ничего сложного там нет. Можно сразу вычислить складываемый расклад или нет. К тому времени как узнал о нем, уже перегорел, заленился его прикручивать.

В чем не корректность алгоритма не повторяющихся значений?
al_gor
28 декабря 2011, 09:43
Некорректность в количестве проходов. если поставить счетчик и посмотреть за сколько проходов находятся числа не выпадавшие до этого, особенно 13-ое, 14-е и 15-е. Использование же массива дает ровно 15 проходов:

var

ind:array [0..14] of Byte;

y,x:Byte;

begin

for y:=0 to 14 do begin ind[y]:=y; end;

for y:=14 downto 0 do begin Randomize;

x:= Random(y+1);

// ind[x]+1 каждый раз будет разным. от 1 до 15

ind[x]:=ind[y];// ставим последний эл массива на место выпавшего

end;end;
Диана
21 апреля 2012, 14:30
а вы не могли ли подробней еще описать процесс создания формы. а то еще только начинающий программист)))
Губарев Михаил
21 апреля 2012, 17:12
Диана, а для кого архив с исходником лежит? Скачать и посмотреть никак?
Дима
11 сентября 2014, 20:16
dump() надо было объявить как процедуру, он же не возвращает никакого значения.
Александр
14 апреля 2015, 23:56
Можно как-то реализовать то, что бы была картинка а не цифры? Собирать картинку, а не цифры.
Григорий
26 октября 2015, 19:31
Не понял комментарий к этим строкам:
POLET = 10; POLEL = 10; //начальные позиции поля фишек на форме
L = D + W; // растояние между "х" у фишек
Можно по подробней??
Андрей
30 октября 2016, 15:33
Спасибо.Отличная игра.
Андрей
23 апреля 2017, 02:15
ППЦ. Ну и алгоритм неповторяющихся значений...
А просто нельзя заполнить массив числами от 1 до 15, а потом перемешать?
Ал-гор, спасибо за идею с поворотом доски.
Нига
19 декабря 2018, 18:00
{ Игра "15"}
unit game15_;

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;

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;
// Обмен. Переместим фишку из x,y в ex,ey
Pole[ey,ex] := Pole[cy,cx];
Pole[cy,cx] := 0;
ex:=cx;
ey:=cy;
// отрисовать поле
Form1.ShowPole;
if Finish then
begin
r := MessageDlg('Цель достигнута!'+ #13+
'Еще раз?',mtInformation,[mbYes,mbNo],0);
if r = mrNo then Form1.Close; // завершить работу программы
end;
//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: integer;
x,y: integer; // x,y - координаты вывода
// текста в клетке
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;

// содержимое клеток
// x,y - координаты вывода текста
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,y1: integer; // пустая клетка
x2,y2: integer; // эту переместить в пустую
d: integer; // направление, относительно пустой
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=1) and (y2
просмотров:34325 | комметариев: 26

Оставить комментарий:    

Ваше имя:
 
Текст комментария:
 
+ 1 =