просмотров:32118 | комметариев: 25

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


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

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

Еще несколько слов. В реализации данного алгоритма использовался для отображения игровых фишек стандартный тип 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.

просмотров:32118 | комметариев: 25
Андрей
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, а потом перемешать?
Ал-гор, спасибо за идею с поворотом доски.
просмотров:32118 | комметариев: 25

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

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