2 / 2 / 0
Регистрация: 27.12.2011
Сообщений: 30
1

Игра пятнашки

08.11.2012, 18:21. Показов 2519. Ответов 2
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
Уважаемые форумчане помогите плиз с этой программой. Не пойму чего не хватает, или что то лишнее?
Выводит только пустые клетки 4*16.
PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
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.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
08.11.2012, 18:21
Ответы с готовыми решениями:

Игра Пятнашки
Я не очень хорошо знаю Делфи, скопировал с методички код проги, запускаю выдает ошибку, помогите...

Пятнашки
Есть программа пятнашки, нужно что бы можно было менять размер поля. Сделала кнопки которые меняют...

Пятнашки.
Доброго времени суток! Пишу игру Пятнашки (TPanel(поле 4х4), на Button реализовывается игровые...

Пятнашки с автоматическим решением)
Здравствуйте всем! Помогите написать программу &quot;Пятнашки&quot; в визуальном режиме. В интернете много...

2
angstrom
08.11.2012, 22:33 2
Скинь в архиве, лень по зкрану разбираться.
Могу скинуть исходный код на API, но там сам понимаешь не 200 строчек кода.
3530 / 2270 / 279
Регистрация: 24.12.2010
Сообщений: 13,723
08.11.2012, 22:48 3
Полон же гугль готовых пятнашек)
http://www.delphisources.ru/pa... ashki.html
0
08.11.2012, 22:48
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
08.11.2012, 22:48
Помогаю со студенческими работами здесь

игра Пятнашки
Здравствуйте!Подскажите пожалуйста как сделать игру 'Пятнашки' с помощью stringgrid.Заранее спасибо)

Игра пятнашки
Нужно вместо кнопки новая игра,чтобы было число проделанных ходов,т.е. нажимаем на цифры считает...

Игра Пятнашки
program joc; uses crt; var a:arrayof integer; i,j,k,l,b:integer; function finish:boolean; ...

Игра в 15(пятнашки)
Всем доброго времени суток. Помогите, пожалуйста, реализовать алгоритм игры 15(пятнашки)....


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

Новые блоги и статьи
Как преобразовать список списков в простой список в Python
bytestream 22.01.2025
При работе с Python разработчики часто сталкиваются с необходимостью обработки сложных структур данных, среди которых особое место занимают вложенные списки. Эти структуры представляют собой списки,. . .
Что такое GUID / UUID и как их создать
bytestream 22.01.2025
В мире разработки программного обеспечения существует постоянная потребность в уникальной идентификации объектов, записей и ресурсов. Эта задача становится особенно актуальной в распределенных. . .
Как добавить пустую директорию в репозиторий Git
bytestream 22.01.2025
При работе с системой контроля версий Git разработчики часто сталкиваются с ситуацией, когда необходимо сохранить пустую директорию в репозитории. Данная задача может показаться простой на первый. . .
Как валидировать адрес email в JavaScript
bytestream 22.01.2025
JavaScript, как основной язык веб-разработки, предоставляет разработчикам множество инструментов для реализации эффективной валидации email-адресов. От простых встроенных решений до сложных. . .
Как заменить все вхождения подстроки в JavaScript
bytestream 22.01.2025
Строки в JavaScript представляют собой неизменяемые последовательности символов, что делает их обработку особенно интересной с точки зрения оптимизации и выбора правильного подхода к решению задач. . . .
Управление версиями пакетов в Node.js. В чем разница между тильдой (~) и кареткой (^) в package.json
bytestream 22.01.2025
В современной разработке программного обеспечения управление версиями пакетов играет ключевую роль в обеспечении стабильности и надежности проектов. Node. js, как одна из самых популярных платформ для. . .
Аутентификация на сайте с помощью формы
bytestream 21.01.2025
В современном цифровом мире безопасная аутентификация становится краеугольным камнем защиты веб-приложений и пользовательских данных. Каждый день миллионы людей используют различные онлайн-сервисы,. . .
Как получить индекс в цикле for в Python
bytestream 21.01.2025
При работе с коллекциями данных в Python часто возникает необходимость не только получить доступ к элементам последовательности, но и знать их позицию в процессе итерации. Индексация в циклах. . .
Как определить адрес, из которого локальный репозиторий Git был клонирован
bytestream 21.01.2025
В современной разработке программного обеспечения система контроля версий Git стала неотъемлемой частью рабочего процесса. При работе с Git разработчики часто сталкиваются с необходимостью. . .
Какая разница между операторами == и === в сравнениях в JavaScript
bytestream 21.01.2025
В мире веб-разработки JavaScript занимает особое место как динамический язык программирования, предоставляющий разработчикам широкий набор инструментов для создания интерактивных веб-приложений. . . .
Из чего и как собрать свой домашний кинотеатр
bt_guru 21.01.2025
Создание домашнего кинотеатра: от идеи до реализации В современном мире домашний кинотеатр стал неотъемлемой частью комфортного жилого пространства, предоставляя возможность наслаждаться. . .
Ошибки стиральных машин
bt_guru 21.01.2025
Современные стиральные машины представляют собой сложные электронные устройства, оснащенные множеством датчиков и систем контроля. Они способны самостоятельно определять вес загруженного белья,. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2025, CyberForum.ru