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

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

23.05.2010, 19:37. Показов 8548. Ответов 4
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
не могу найти ошибку в коде(( когда переходит в режим игры на экране нарисовано поле склетками а вот цифры не на местах а черт знает где....
Pascal
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
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
Program p9tnashki;
Uses Crt,Graph;{Подключение библиотеки Crt и модуля Grap}
 
var {раздел описания переменных}
   dm:array [1..4,1..4] of string;{двумерный масссив, содержит элементы табло}
   om:array [1..16] of integer;{одномерный массив, содержит элементы табло}
   im:array [1..10] of string;{имена лучших игроков}
   res:array [1..10] of integer;{результаты лучших игроков}
   imn:array [1..10] of string;{массив со вновь сформированным списком лучших игроков}
   resn:array [1..10] of integer;{массив со вновь сформированным списком лучших результатов}
   i,j:integer;{переменные для работы с массивами}
   ch:char;{переменная которой присваивается код нажатой клавиши}
   f:text;{файловая переменная}
   stb,stk:integer;{координаты пустого элемента}
   xod:integer;{счетчик, считывает каждый ход}
   name:string;{имя игравшего пользователя}
   prov:boolean;{проверка правильности расклада}
 
 
 
{процедура подключения графики}
Procedure OpenGraph;
var
   GraphDriver, GraphMode:integer;
begin
   GraphDriver:=Detect;
   InitGraph(GraphDriver,GraphMode,'C:\BP');{инициализация графики}
end;
 
 
 
{информация об авторе}
Procedure avtor;
begin
clrscr;
   TextColor(Cyan);
   OutTextXY(70,100,'#########################################');
   OutTextXY(70,110,'#                                       #');
   OutTextXY(70,120,'#              Made by                  #');
   OutTextXY(70,130,'#                                       #');
   OutTextXY(70,140,'#              Sabrina                  #');
   OutTextXY(70,150,'#                                       #');
   OutTextXY(70,160,'#########################################');
   OutTextXY(20,170,'Press any Key...');
   ch:=readkey;
end;
 
 
 
{управление в игре}
Procedure help;
begin
clrscr;
   OutTextXY(70,30,'Menu pomoshi igrbl');
   OutTextXY(30,45,'Dl9 perdvigeni9 cifr v igre ispolzyite strelki');
   OutTextXY(30,55,'Dl9 vblxoda iz igrbl nagati Esc');
   OutTextXY(70,70,'Pravila igrbl');
   OutTextXY(30,80,'P9tnashki- popul9rna9 igra, predstavl9et soboi kvadratnoe pole 4x4,');
   OutTextXY(30,90,'sosto0shee iz 16 9cheek 15 iz kotorblx sodergat nepovtor9ushies9');
   OutTextXY(30,100,'cifrbl ot 1 do 15, i odny pystyu 9cheiky. Cifrbl na pole raspologenbl');
   OutTextXY(30,110,'xaoticheski, zadacha igroka, sdelav kak mogno menshe xodov, peremeshat cifrbl');
   OutTextXY(30,120,'po polu i rastavit ix po nomeram.');
   OutTextXY(15,130,'Press any key...');
   ch:=readkey;
end;
 
 
 
{Вывод на экран табло с цифрами}
Procedure vblvod;
var
   x1,y1:integer;{координаты двумерного массива}
   x,y:integer;{координаты клеток}
   i1,j1:integer;{переменные счетчики для рисования клеток}
   w1,h1:integer;{Ширина и высота клеток}
begin
   OutTextXY(210,50,'Chto bbl pokinut igry nagmite Esc');
   w1:=30;{рисование рамки}
   h1:=30;
   for i1:=0 to 3 do
   for j1:=0 to 3 do
      begin
         x:=235+j1*35;{сдвиг клеток по оси x}
         y:=150+i1*35;{сдвиг клеток по оси y}
         SetFillStyle(1,4);{цвет и стиль клеток}
         bar(x,y,x+w1,y+h1);{рисование клетки}
      end;
   x1:=245;
   y1:=162;
{цикл вывода двумерного массива по верх клеток}
   for i:=1 to 4 do
      begin
         for j:=1 to 4 do
            begin
               OutTextXY(x1,y1,dm[i,j]);{вывод текста на экран}
               x1:=x1+35;
            end;
         x1:=245;
         y1:=y+35;
      end;
  {Рисование рамки}
   line(220,135,220,300);
   line(385,135,385,300);
   line(220,135,385,135);
   line(220,300,385,300);
end;
 
 
 
{Формирование табло, заполненное случайными числами}
Procedure tablo;
var
   a:integer;{переменная которой прсваивается случайное число}
   k,q:integer;{счетчики для операций с массивами}
begin
   randomize;
   for q:=1 to 16 do
      begin
         a:=random(15);{выбор случайного числа}
         k:=1;
   {пока не будет заполнен массив случайными числами, выполнять}
         while k<>17 do
            begin
               if om[k]=a then
                  begin
                     a:=random(17);
                     k:=1;
                  end
               else k:=k+1;
            end;
         om[q]:=a{присвоение очередного неповторяющегося элемента массива}
      end;
   q:=1;
   {заполнение двумерного массива}
   for i:=1 to 4 do
      begin
         for j:=1 to 4 do
            begin
               case om[q] of{вместо цифр одномерного масива присваиваем сктоковые эелементы}
              1:dm[i,j]:='1';
              2:dm[i,j]:='2';
              3:dm[i,j]:='3';
              4:dm[i,j]:='4';
              5:dm[i,j]:='5';
              5:dm[i,j]:='6';
              7:dm[i,j]:='7';
              8:dm[i,j]:='8';
              9:dm[i,j]:='9';
              10:dm[i,j]:='10';
              11:dm[i,j]:='11';
              12:dm[i,j]:='12';
              13:dm[i,j]:='13';
              14:dm[i,j]:='14';
              15:dm[i,j]:='15';
              16:dm[i,j]:=' ';
            end;
         q:=q+1;
      end;
end;
vblvod;{вывод табло на экран}
end;
 
 
 
{поиск пустого элемента}
procedure poisk;
begin
   for i:=1 to 4 do
      begin
          for j:=1 to 4 do
             begin
             {цикл, равен ли текущий элемент пробелу}
                if dm[i,j]=' ' then
                   begin
                      stk:=i;{то присваиваем координаты пустого элемента}
                      stb:=j;
                   end;
             end;
       end;
end;
 
 
 
{передвижение клеток с цифрами по табло}
procedure napravlenie;
begin
   ch:=readkey;{переменной присваивается код нажатой клавиши}
   if ord(ch)=75 then {Если нажата клавиша влево}
      begin
         if stb<>4 then {Если это не последний элемент, стоящий у границы табло}
            begin
               dm[stk,stb]:=dm[stk,stb+1]; {На место пустого элемента присваивается элемент стоящий справа от пустого}
               dm[stk,stb+1]:=' '; {Элементу стоящему справа от пустого присваивается пустой элемент}
               stb:=stb+1; {Новая координата пустого элемента}
               xod:=xod+1; {Очередной сделанный ход}
            end;
      end;
   if ord(ch)=72 then {Если нажата клавиша вверх}
      begin
         if stk<>4 then 
            begin
               dm[stk,stb]:=dm[stk+1,stb]; 
               dm[stk+1,stb]:=' '; 
               stk:=stk+1;
               xod:=xod+1; 
            end;
       end;
   if ord(ch)=77 then {Если нажата клавиша вправо}
       begin
          if stb<>1 then 
             begin
                dm[stk,stb]:=dm[stk,stb-1]; 
                dm[stk,stb-1]:=' '; 
                stb:=stb-1; 
                xod:=xod+1; 
             end;
       end;
   if ord(ch)= 80 then {Если нажата клавиша вниз}
      begin
         if stk<>1 then {Если это не последний элемент, стоящий у границы табло}
            begin
               dm[stk,stb]:=dm[stk-1,stb];{На место пустого элемента присваивается элемент стоящий сверху от пустого}
               dm[stk-1,stb]:=' '; {Элементу стоящему сверху от пустого присваивается пустой элемент}
               stk:=stk-1; {Новая координата пустого элемента}
               xod:=xod+1; {Очередной сделанный ход}
            end;
      end;
    Vblvod;
end;           
 
 
 
{Добавляет в файл информацию о лучших результатах}
procedure readFile;
begin
   assign(f,'res.txt'); {Объявления файла}
   reset(f); {Открытие файла}
   j:=1;
   for i:=1 to 10 do
      begin
         readln(f,im[i]); {Занесение имен лучших игроков из файла в массив}
         readln(f,res[j]); {Занесение результатов лучших игроков в массив}
         j:=j+1; {Счетчик для лучших результатов}
      end;
   close(f);
end;
 
 
 
{Считывает файл с лучшими результатами}
procedure writeFile;
begin
   assign(f,'res.txt');{Объявление файла}
   rewrite(f);{Открытие в режиме перезаписи}
   for i:=1 to 10 do
      begin
         writeln(f,imn[i]);{Внесение информации о лучших игроках и их результатах из массивов в файл}
         writeln(f,resn[i]);  
      end;
   close(f);
end;
 
 
 
{Процедура в которой устанавливается занял ли игрок какое либо место} 
procedure Mesto;
var chetchik:integer;{Счетчик, объявляет что информация о лучим игроке уже внесена, повторной информации не должно быть}
begin
   if prov = true then {Если игрок разложил расклад}
      begin
         readfile; {Процедура считывание информации из файла с лучшими результатами}
         chetchik:=0;
         j:=1;
         for i:=1 to 10 do
            begin
               if (xod<=res[i]) and (xod>=res[i-1]) and (chetchik<1) then
                  begin
             {Ввод имени игрока}
                     OutTextXY(132,325,'will Enter name and press Enter:');
                     line(400,338,530,338);
                     GoToXY(52,21);
                     read(name);
               {Присвоение очередному элементу данных текущего игрока}
                     resn[i]:=xod;
                     imn[i]:=name;
                     j:=j+1;
                     chetchik:=1;
                  end;
          {Перенос из одного массива в другой}
               if j<=10 then
                  begin
                     resn[j]:=res[i];
                     imn[j]:=im[i];
                     j:=j+1;
                  end;
            end;
      writeFile; {Сохранение информации в файл}
      OutTextXY(230,360,'For leaving press ENTER');
      readln;
   end;
end;
 
 
 
{Проверка правильно ли разложено табло}
procedure proverka;
begin
   prov:=false;
   if  (dm[1,1]='1 ') and (dm[1,2]='2 ') and (dm[1,3]='3 ') and (dm[1,4]='4 ')
   and (dm[2,1]='5 ') and (dm[2,2]='6 ') and (dm[2,3]='7 ') and (dm[2,4]='8 ')
   and (dm[3,1]='9 ') and (dm[3,2]='10') and (dm[3,3]='11') and (dm[3,4]='12')
   and (dm[4,1]='13') and (dm[4,2]='14') and (dm[4,3]='15') and (dm[4,4]='  ')
   then
      begin
         prov:=true; {Если табло разложено верно, то ИСТИНА}
         OutTextXY(230,100,'Congratulate You have won');
         Mesto; {Процедура, устанавливающая на каком месте текущий пользователь}
      end;
end;
 
 
 
{Переход в режим игры}
procedure Game;
begin
   xod:=0;
   OpenGraph;{инициализация графики}
   tablo;{формирование табло}
   poisk;{поиск пустого элемента}
{цикл, пока не будет нажата клавиша Esc или пока игрок не победил играть}
   repeat
   napravlenie;{перемещение клеток}
   until (ord(ch)=27) or (prov=true);
   closeGraph;{закрытие графики}
end;
 
 
{Отображение лучших игроков}
procedure result;
begin
   clrscr;
   GoToXY(26,5);
   writeln('Best players');
   assign(f,'res.txt');
   reset(f);
   readfile; {Считывание информации из файла лучших результатов}
{Вывод на экран в строгом порядке имена и результаты лучших игроков}
   GoToXY(26,8); write('Move Name');
   GoToXY(26,10); write(res[1]);
     GoToXY(36,10); writeln(im[1]);
   GoToXY(26,11); write(res[2]);
     GoToXY(36,11);writeln(im[2]);
   GoToXY(26,12); write(res[3]);
     GoToXY(36,12);writeln(im[3]);
   GoToXY(26,13); write(res[4]);
     GoToXY(36,13);writeln(im[4]);
   GoToXY(26,14); write(res[5]);
     GoToXY(36,14);writeln(im[5]);
   GoToXY(26,15); write(res[6]);
     GoToXY(36,15);writeln(im[6]);
   GoToXY(26,16); write(res[7]);
     GoToXY(36,16);writeln(im[7]);
   GoToXY(26,17); write(res[8]);
     GoToXY(36,17);writeln(im[8]);
   GoToXY(26,18); write(res[9]);
     GoToXY(36,18);writeln(im[9]);
   GoToXY(26,19); write(res[10]);
     GoToXY(36,19);;writeln(im[10]);
   GoToXY(26,23);writeln('Press any key');
   readln;
   ch:=readkey;
end;
 
{Основная программа}
begin
OpenGraph;
avtor;
help;
result;
Game;
result;
end.
Может кто поможет? тока там если у себя будете побывать ее надо файлик создать res.txt.
0
Programming
Эксперт
39485 / 9562 / 3019
Регистрация: 12.04.2006
Сообщений: 41,671
Блог
23.05.2010, 19:37
Ответы с готовыми решениями:

Игра 15 (пятнашки)
Мне вот задали курсовую написать игру.Так незнаю что делать.... Может кто-то написать?

Это должны были быть пятнашки
Старался старался и вот что получил: Unit Unit1; interface uses System, System.Drawing, System.Windows.Forms; type ...

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

4
 Аватар для Wizzy
41 / 40 / 11
Регистрация: 12.11.2009
Сообщений: 115
23.05.2010, 20:10 2
Врядля кто-то ответ на такой вопрос касающийся програмы на 400 строк бесплатно )))) щас попробую поправить...
0
0 / 0 / 0
Регистрация: 26.01.2010
Сообщений: 36
23.05.2010, 20:26  [ТС] 3
она в принципе работает просто когда в режиме игры цифры не на месте стоят.... первая строка нормально а вот последующие 3 гдето внизу друг на друге...
0
 Аватар для Wizzy
41 / 40 / 11
Регистрация: 12.11.2009
Сообщений: 115
23.05.2010, 20:26 4
Pascal
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
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
Program p9tnashki;
Uses Crt,Graph;{Подключение библиотеки Crt и модуля Grap}
 
var {раздел описания переменных}
   dm:array [1..4,1..4] of string;{двумерный масссив, содержит элементы табло}
   om:array [1..16] of integer;{одномерный массив, содержит элементы табло}
   im:array [1..10] of string;{имена лучших игроков}
   res:array [1..10] of integer;{результаты лучших игроков}
   imn:array [1..10] of string;{массив со вновь сформированным списком лучших игроков}
   resn:array [1..10] of integer;{массив со вновь сформированным списком лучших результатов}
   i,j:integer;{переменные для работы с массивами}
   ch:char;{переменная которой присваивается код нажатой клавиши}
   f:text;{файловая переменная}
   stb,stk:integer;{координаты пустого элемента}
   xod:integer;{счетчик, считывает каждый ход}
   name:string;{имя игравшего пользователя}
   prov:boolean;{проверка правильности расклада}
 
 
 
{процедура подключения графики}
Procedure OpenGraph;
var
   GraphDriver, GraphMode:integer;
begin
   GraphDriver:=Detect;
   InitGraph(GraphDriver,GraphMode,'C:\BP');{инициализация графики}
end;
 
 
 
{информация об авторе}
Procedure avtor;
begin
clrscr;
   TextColor(Cyan);
   OutTextXY(70,100,'#########################################');
   OutTextXY(70,110,'#                                       #');
   OutTextXY(70,120,'#              Made by                  #');
   OutTextXY(70,130,'#                                       #');
   OutTextXY(70,140,'#              Sabrina                  #');
   OutTextXY(70,150,'#                                       #');
   OutTextXY(70,160,'#########################################');
   OutTextXY(20,170,'Press any Key...');
   ch:=readkey;
end;
 
 
 
{управление в игре}
Procedure help;
begin
clrscr;
   OutTextXY(70,30,'Menu pomoshi igrbl');
   OutTextXY(30,45,'Dl9 perdvigeni9 cifr v igre ispolzyite strelki');
   OutTextXY(30,55,'Dl9 vblxoda iz igrbl nagati Esc');
   OutTextXY(70,70,'Pravila igrbl');
   OutTextXY(30,80,'P9tnashki- popul9rna9 igra, predstavl9et soboi kvadratnoe pole 4x4,');
   OutTextXY(30,90,'sosto0shee iz 16 9cheek 15 iz kotorblx sodergat nepovtor9ushies9');
   OutTextXY(30,100,'cifrbl ot 1 do 15, i odny pystyu 9cheiky. Cifrbl na pole raspologenbl');
   OutTextXY(30,110,'xaoticheski, zadacha igroka, sdelav kak mogno menshe xodov, peremeshat cifrbl');
   OutTextXY(30,120,'po polu i rastavit ix po nomeram.');
   OutTextXY(15,130,'Press any key...');
   ch:=readkey;
end;
 
 
 
{Вывод на экран табло с цифрами}
Procedure vblvod;
var
   x1,y1:integer;{координаты двумерного массива}
   x,y:integer;{координаты клеток}
   i1,j1:integer;{переменные счетчики для рисования клеток}
   w1,h1:integer;{Ширина и высота клеток}
begin
   OutTextXY(210,50,'Chto bbl pokinut igry nagmite Esc');
   w1:=30;{рисование рамки}
   h1:=30;
   for i1:=0 to 3 do
   for j1:=0 to 3 do
      begin
         x:=235+j1*35;{сдвиг клеток по оси x}
         y:=150+i1*35;{сдвиг клеток по оси y}
         SetFillStyle(1,4);{цвет и стиль клеток}
         bar(x,y,x+w1,y+h1);{рисование клетки}
      end;
   x1:=245;
   y1:=162;
{цикл вывода двумерного массива по верх клеток}
   for i:=1 to 4 do
      begin
         for j:=1 to 4 do
            begin
               OutTextXY(x1,y1,dm[i,j]);{вывод текста на экран}
               x1:=x1+35;
            end;
         x1:=245;
         y1:=y1+35;
      end;
  {Рисование рамки}
   line(220,135,220,300);
   line(385,135,385,300);
   line(220,135,385,135);
   line(220,300,385,300);
end;
 
 
 
{Формирование табло, заполненное случайными числами}
Procedure tablo;
var
   a:integer;{переменная которой прсваивается случайное число}
   k,q:integer;{счетчики для операций с массивами}
begin
   randomize;
   for q:=1 to 16 do
      begin
         a:=random(15);{выбор случайного числа}
         k:=1;
   {пока не будет заполнен массив случайными числами, выполнять}
         while k<>17 do
            begin
               if om[k]=a then
                  begin
                     a:=random(17);
                     k:=1;
                  end
               else k:=k+1;
            end;
         om[q]:=a{присвоение очередного неповторяющегося элемента массива}
      end;
   q:=1;
   {заполнение двумерного массива}
   for i:=1 to 4 do
      begin
         for j:=1 to 4 do
            begin
               case om[q] of{вместо цифр одномерного масива присваиваем сктоковые эелементы}
              1:dm[i,j]:='1';
              2:dm[i,j]:='2';
              3:dm[i,j]:='3';
              4:dm[i,j]:='4';
              5:dm[i,j]:='5';
              5:dm[i,j]:='6';
              7:dm[i,j]:='7';
              8:dm[i,j]:='8';
              9:dm[i,j]:='9';
              10:dm[i,j]:='10';
              11:dm[i,j]:='11';
              12:dm[i,j]:='12';
              13:dm[i,j]:='13';
              14:dm[i,j]:='14';
              15:dm[i,j]:='15';
              16:dm[i,j]:=' ';
            end;
         q:=q+1;
      end;
end;
vblvod;{вывод табло на экран}
end;
 
 
 
{поиск пустого элемента}
procedure poisk;
begin
   for i:=1 to 4 do
      begin
          for j:=1 to 4 do
             begin
             {цикл, равен ли текущий элемент пробелу}
                if dm[i,j]=' ' then
                   begin
                      stk:=i;{то присваиваем координаты пустого элемента}
                      stb:=j;
                   end;
             end;
       end;
end;
 
 
 
{передвижение клеток с цифрами по табло}
procedure napravlenie;
begin
   ch:=readkey;{переменной присваивается код нажатой клавиши}
   if ord(ch)=75 then {Если нажата клавиша влево}
      begin
         if stb<>4 then {Если это не последний элемент, стоящий у границы табло}
            begin
               dm[stk,stb]:=dm[stk,stb+1]; {На место пустого элемента присваивается элемент стоящий справа от пустого}
               dm[stk,stb+1]:=' '; {Элементу стоящему справа от пустого присваивается пустой элемент}
               stb:=stb+1; {Новая координата пустого элемента}
               xod:=xod+1; {Очередной сделанный ход}
            end;
      end;
   if ord(ch)=72 then {Если нажата клавиша вверх}
      begin
         if stk<>4 then 
            begin
               dm[stk,stb]:=dm[stk+1,stb]; 
               dm[stk+1,stb]:=' '; 
               stk:=stk+1;
               xod:=xod+1; 
            end;
       end;
   if ord(ch)=77 then {Если нажата клавиша вправо}
       begin
          if stb<>1 then 
             begin
                dm[stk,stb]:=dm[stk,stb-1]; 
                dm[stk,stb-1]:=' '; 
                stb:=stb-1; 
                xod:=xod+1; 
             end;
       end;
   if ord(ch)= 80 then {Если нажата клавиша вниз}
      begin
         if stk<>1 then {Если это не последний элемент, стоящий у границы табло}
            begin
               dm[stk,stb]:=dm[stk-1,stb];{На место пустого элемента присваивается элемент стоящий сверху от пустого}
               dm[stk-1,stb]:=' '; {Элементу стоящему сверху от пустого присваивается пустой элемент}
               stk:=stk-1; {Новая координата пустого элемента}
               xod:=xod+1; {Очередной сделанный ход}
            end;
      end;
    Vblvod;
end;           
 
 
 
{Добавляет в файл информацию о лучших результатах}
procedure readFile;
begin
   assign(f,'res.txt'); {Объявления файла}
   reset(f); {Открытие файла}
   j:=1;
   for i:=1 to 10 do
      begin
         readln(f,im[i]); {Занесение имен лучших игроков из файла в массив}
         readln(f,res[j]); {Занесение результатов лучших игроков в массив}
         j:=j+1; {Счетчик для лучших результатов}
      end;
   close(f);
end;
 
 
 
{Считывает файл с лучшими результатами}
procedure writeFile;
begin
   assign(f,'res.txt');{Объявление файла}
   rewrite(f);{Открытие в режиме перезаписи}
   for i:=1 to 10 do
      begin
         writeln(f,imn[i]);{Внесение информации о лучших игроках и их результатах из массивов в файл}
         writeln(f,resn[i]);  
      end;
   close(f);
end;
 
 
 
{Процедура в которой устанавливается занял ли игрок какое либо место} 
procedure Mesto;
var chetchik:integer;{Счетчик, объявляет что информация о лучим игроке уже внесена, повторной информации не должно быть}
begin
   if prov = true then {Если игрок разложил расклад}
      begin
         readfile; {Процедура считывание информации из файла с лучшими результатами}
         chetchik:=0;
         j:=1;
         for i:=1 to 10 do
            begin
               if (xod<=res[i]) and (xod>=res[i-1]) and (chetchik<1) then
                  begin
             {Ввод имени игрока}
                     OutTextXY(132,325,'will Enter name and press Enter:');
                     line(400,338,530,338);
                     GoToXY(52,21);
                     read(name);
               {Присвоение очередному элементу данных текущего игрока}
                     resn[i]:=xod;
                     imn[i]:=name;
                     j:=j+1;
                     chetchik:=1;
                  end;
          {Перенос из одного массива в другой}
               if j<=10 then
                  begin
                     resn[j]:=res[i];
                     imn[j]:=im[i];
                     j:=j+1;
                  end;
            end;
      writeFile; {Сохранение информации в файл}
      OutTextXY(230,360,'For leaving press ENTER');
      readln;
   end;
end;
 
 
 
{Проверка правильно ли разложено табло}
procedure proverka;
begin
   prov:=false;
   if  (dm[1,1]='1 ') and (dm[1,2]='2 ') and (dm[1,3]='3 ') and (dm[1,4]='4 ')
   and (dm[2,1]='5 ') and (dm[2,2]='6 ') and (dm[2,3]='7 ') and (dm[2,4]='8 ')
   and (dm[3,1]='9 ') and (dm[3,2]='10') and (dm[3,3]='11') and (dm[3,4]='12')
   and (dm[4,1]='13') and (dm[4,2]='14') and (dm[4,3]='15') and (dm[4,4]='  ')
   then
      begin
         prov:=true; {Если табло разложено верно, то ИСТИНА}
         OutTextXY(230,100,'Congratulate You have won');
         Mesto; {Процедура, устанавливающая на каком месте текущий пользователь}
      end;
end;
 
 
 
{Переход в режим игры}
procedure Game;
begin
   xod:=0;
   OpenGraph;{инициализация графики}
   tablo;{формирование табло}
   poisk;{поиск пустого элемента}
{цикл, пока не будет нажата клавиша Esc или пока игрок не победил играть}
   repeat
   napravlenie;{перемещение клеток}
   until (ord(ch)=27) or (prov=true);
   closeGraph;{закрытие графики}
end;
 
 
{Отображение лучших игроков}
procedure result;
begin
   clrscr;
   GoToXY(26,5);
   writeln('Best players');
   assign(f,'res.txt');
   reset(f);
   readfile; {Считывание информации из файла лучших результатов}
{Вывод на экран в строгом порядке имена и результаты лучших игроков}
   GoToXY(26,8); write('Move Name');
   GoToXY(26,10); write(res[1]);
     GoToXY(36,10); writeln(im[1]);
   GoToXY(26,11); write(res[2]);
     GoToXY(36,11);writeln(im[2]);
   GoToXY(26,12); write(res[3]);
     GoToXY(36,12);writeln(im[3]);
   GoToXY(26,13); write(res[4]);
     GoToXY(36,13);writeln(im[4]);
   GoToXY(26,14); write(res[5]);
     GoToXY(36,14);writeln(im[5]);
   GoToXY(26,15); write(res[6]);
     GoToXY(36,15);writeln(im[6]);
   GoToXY(26,16); write(res[7]);
     GoToXY(36,16);writeln(im[7]);
   GoToXY(26,17); write(res[8]);
     GoToXY(36,17);writeln(im[8]);
   GoToXY(26,18); write(res[9]);
     GoToXY(36,18);writeln(im[9]);
   GoToXY(26,19); write(res[10]);
     GoToXY(36,19);;writeln(im[10]);
   GoToXY(26,23);writeln('Press any key');
   readln;
   ch:=readkey;
end;
 
{Основная программа}
begin
OpenGraph;
avtor;
help;
result;
Game;
result;
end.
вот поправил Удачи, игрушка зачётная вышла )))
1
0 / 0 / 0
Регистрация: 26.01.2010
Сообщений: 36
23.05.2010, 20:31  [ТС] 5
Огромное спасибо!
0
23.05.2010, 20:31
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
inter-admin
Эксперт
29715 / 6470 / 2152
Регистрация: 06.03.2009
Сообщений: 28,500
Блог
23.05.2010, 20:31
Помогаю со студенческими работами здесь

Игра "Пятнашки"
Сделать игру &quot;15&quot;, используя графический режим, буду очень благодарен) Добавлено через 7 минут Извините, вот еще продолжение...

Игра в «Одиннадцать предметов», игра Баше.
прошу помощи в создании программы! Разработать программную модель следующей игры двух игроков(пользователь-компьютер),реализовав...

Игра "Пятнашки"
ПОМОГИТЕ СОЗДАТЬ ПРОСТЕНЬКУЮ игру, можно бонально калькулятор или пятнашки

Вставить изображение в игру Пятнашки
Вот у меня есть игра &quot;пятнашки&quot; и цифры нужно заменить рисунками. Плиз, подскажите как это сделать? Uses GraphABC,Events; var f:arrayof...

Нужен код игры Пятнашки
У кого нибудь есть пятнашки на PascalABC?????Помогите пожалуйста!?!?!?!?


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

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

Редактор формул (кликните на картинку в правом углу, чтобы закрыть)
Опции темы

Новые блоги и статьи
Язык программировани­я C++: сравнение с другими языками
Programming 06.02.2025
Современная разработка программного обеспечения предлагает множество языков программирования, каждый из которых обладает уникальными характеристиками и областями применения. C++ занимает особое место. . .
Язык программировани­­­я C++: достоинства и недостатки
Programming 06.02.2025
C++ считается одним из самых влиятельных языков программирования, продолжающим занимать ведущие позиции в мире разработки программного обеспечения. Этот язык появился как расширение языка C с. . .
Регулярные выражения в Python
BasicMan 06.02.2025
Регулярные выражения - это последовательности символов, определяющие правила поиска и сопоставления текстовых данных. В Python они используются для поиска подстрок, проверки соответствия текста. . .
Как создать свой мод для Майнкрафт с нуля на Java
IT_Exp 06.02.2025
Разработка мода для Minecraft начинается с правильной настройки среды разработки. Для создания мода потребуется Java Development Kit (JDK), интегрированная среда разработки и Minecraft Forge. JDK. . .
Async/await и асинхронное программировани­е в Java
IT_Exp 06.02.2025
Асинхронное программирование - это подход к организации вычислительных процессов, позволяющий приложениям эффективно использовать доступные ресурсы системы. В контексте Java этот метод приобретает. . .
Как исправить android.os.Netw­orkOnMain­Thread­Exception
hw_wired 06.02.2025
Исключение NetworkOnMainThreadException возникает при попытке выполнить сетевые операции в главном потоке Android-приложения. Главный поток отвечает за обработку пользовательского интерфейса и должен. . .
Как в Java определить, что массив содержит определенное значение
hw_wired 06.02.2025
В Java класс Arrays предлагает несколько способов для проверки наличия значений в массивах. Наиболее широко применяемый метод заключается в использовании комбинации Arrays. asList() и contains(). . . .
Как использовать virtualenv в Python. Виртуальные среды/окружения
hw_wired 06.02.2025
В Python виртуальные окружения решают одну из ключевых задач разработки - изоляцию зависимостей между проектами. Virtualenv создает отдельное пространство для каждого проекта, где устанавливаются. . .
Кнопка в HTML, которая работает как ссылка
hw_wired 06.02.2025
В HTML существует несколько подходов к созданию кнопки, которая функционирует как ссылка. Базовым элементом выступает тег button, который можно преобразовать в ссылку с помощью JavaScript. Для этого. . .
Как обновить страницу с помощью JavaScript
bytestream 06.02.2025
JavaScript предоставляет несколько базовых методов для обновления веб-страницы, которые встроены непосредственно в язык и доступны через объектную модель браузера. Основной метод обновления страницы. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2025, CyberForum.ru