Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 31.03.2009, 21:39   #1
Batonchik
Пользователь
 
Регистрация: 17.01.2009
Сообщений: 10
По умолчанию 15 в Паскале

Помогите пожалуйста написать игру 15 в Паскале. При этом нужно установить счетчик ходов. И таблицу рекордов.
Заранее спасибо.
Batonchik вне форума Ответить с цитированием
Старый 31.03.2009, 22:54   #2
Iceman
Форумчанин
 
Регистрация: 08.07.2007
Сообщений: 154
По умолчанию

А что ето за игра. Я прост не особый знаток народных игр.
Iceman вне форума Ответить с цитированием
Старый 01.04.2009, 07:44   #3
Batonchik
Пользователь
 
Регистрация: 17.01.2009
Сообщений: 10
По умолчанию

Это игра, где на поле размером 4*4 в беспорядочной последовательности появляются 15 фишек с нанесенными на них цифрами от 1 до 15 при этом правый нижний угол остается пустым и надо передвигая фишки расставить их так чтобы они все стали по порядку.
Batonchik вне форума Ответить с цитированием
Старый 01.04.2009, 08:31   #4
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

А помочь то в чем?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 01.04.2009, 14:15   #5
Batonchik
Пользователь
 
Регистрация: 17.01.2009
Сообщений: 10
По умолчанию

Нужно как раз и написать эту игру в Паскале. то есть программа должна выкидывать на поле 4 на 4 16 фишек 15 с цифрами одна пустая и вы должны переставить их по порядку при этом программа должна считать количество ходов и в конце выводить список рекордов. Вообщем нужно написать компьютерный код программы в Паскале.
Batonchik вне форума Ответить с цитированием
Старый 01.04.2009, 15:57   #6
Вадим Буренков
Участник клуба
 
Аватар для Вадим Буренков
 
Регистрация: 06.03.2009
Сообщений: 1,346
По умолчанию

А свои исходники не покажешь?Или ты хочешь чтобы тебе за просто так написали игру?
Вадим Буренков вне форума Ответить с цитированием
Старый 01.04.2009, 16:39   #7
DM_bite
Участник клуба
 
Аватар для DM_bite
 
Регистрация: 29.07.2008
Сообщений: 1,091
По умолчанию

Так проблема-то в чем? Пока ничего конкретного не увидел. Я не уверен на продолжительное существование темы, хотя бы потому что:
Цитата:
Вообщем нужно написать компьютерный код
Кто бы ты ни был - не думай о себе слишком (с)
DM_bite вне форума Ответить с цитированием
Старый 01.04.2009, 16:40   #8
maladoy
delphi-ст!
Форумчанин
 
Аватар для maladoy
 
Регистрация: 02.01.2009
Сообщений: 825
По умолчанию

пятнашки!!!!
вступлю в команду разработчиков ПО на Delphi
maladoy вне форума Ответить с цитированием
Старый 08.04.2009, 15:18   #9
Batonchik
Пользователь
 
Регистрация: 17.01.2009
Сообщений: 10
По умолчанию

program pr_15;
Uses
Crt, Graph;

const
a=50;
pole_a : array [1..4, 1..4] of byte = ((1, 2, 3, 4),
(5, 6, 7, 8),
(9, 10, 11, 12),
(13, 14, 15, 16));
var
y, x, j, i, y_z, x_z : byte;
pole: array [1..4, 1..4] of byte;
r, wec : byte;
flag : boolean;
f_key, flag_hod, flag_end : boolean;
key: char;
f_data : text;
n_game : byte;
n_hod : longint;
m_name: array[1.. 10] of string[30];
m_rez : array[1.. 10] of longint;
name_user : string;


procedure in_gr;
Var
grDriver: Integer;
grMode : Integer;
Begin
grDriver := Detect;
InitGraph(grDriver, grMode,'bgi');
If GraphResult <> 0
Then
Begin
WriteLn('Oshibka inicializacii graphiki:');
ReadLn;
halt;
End;
End;


procedure start;
begin
for y := 1 to 4 do
for x := 1 to 4 do
pole[y, x] := 0;
randomize;
for y := 1 to 4 do
for x := 1 to 4 do
begin
flag := true;
while flag do
begin
pole[y, x] := random(16)+1;
flag := false;
for j := 1 to 4 do
for i := 1 to 4 do
if ((x <> i) or (y <> j)) and
(pole[y, x] = pole[j, i]) then flag := true;
end;
if pole[y, x] = 16 then begin y_z := y; x_z := x end;
end;
end;


procedure out_kl(yk, xk, n : byte);
var
s : string[2];
begin
str(n, s);
if n < 10 then s :='' + s;
setcolor(14);
if n = 16 then SetFillStyle(1, 0) else SetFillStyle(1, 12);
bar(xk*a, yk*a, xk*a + a, yk*a + a);
rectangle(xk*a, yk*a, xk*a + a, yk*a + a);
moveto(xk*a + a div 3, yk*a + a div 2);
setcolor(15);
if n <> 16 then outtext(s);
end;

procedure key_in;
begin
if keypressed
then
begin
key := readkey;
if key = #0
then
f_key := true
else
f_key := false;
if f_key
then
begin
key := readkey;
if (key = #77) then wec:=1; {vpravo}
if (key = #80) then wec:=2; {vniz}
if (key = #75) then wec:=3; {vlevo}
if (key = #72) then wec:=4; {vverh}
end;
end;
end;

procedure out_pole;
begin
for y:= 1 to 4 do
for x := 1 to 4 do
out_kl(y, x, pole[y, x]);
end;

procedure out_f_data;
var
s_rez : string;
k : integer;

procedure read_dat;
begin
assign(f_data,'Rez.txt');
reset(f_data);
if IOResult = 0
then
begin
i := 0;
while not seekEof(f_data) do
begin
inc(i);
readln(f_data, m_name[i]);
readln(f_data, m_rez[i]);
end;
n_game := i;
close(f_data);
end;
end;


begin
read_dat;
k := 50;
moveto(400, k);
outtext('Desyatka luchshih');
moveto(400, k+10);
outtext('==========');
k := 60;
for i := 1 to n_game do
begin
moveto(400, k + i*(a div 3));
outtext(m_name[i]);
str(m_rez[i], s_rez);
moveto(520, k + i*(a div 3));
outtext(s_rez);


end;
moveto(400, k + i*(a div 3)+10);
outtext('===========');
end;

procedure record_f;
var
f_sort : boolean;
r_sort: integer;
name_sort: string;

begin
if (n_game < 10)
then
begin
n_game := n_game + 1;
m_rez[n_game] := n_hod;
m_name[n_game] := name_user;
end
else
begin
m_rez[n_game] := n_hod;
m_name[n_game] := name_user;
end;

f_sort := true;
while f_sort do
begin
f_sort := false;
for i := 1 to n_game - 1 do
if m_rez[i] > m_rez[i+1]
then
begin
f_sort := true;
r_sort := m_rez[i];
name_sort := m_name[i];
m_name[i] := m_name[i+1];
m_rez[i] := m_rez[i+1];
m_name[i+1] := name_sort;
m_rez[i+1] := r_sort;
end;
end;

rewrite(f_data);
for i := 1 to n_game do
begin
writeln(f_data, m_name[i]);
writeln(f_data, m_rez[i]);
end;
close(f_data);
end;

function pole_pole_a : boolean;
var
z : boolean;
begin
z := true;
for y := 1 to 4 do
for x := 1 to 4 do
if pole[y, x] <> pole_a[y, x] then z := false;
if z then pole_pole_a := true else pole_pole_a := false;
end;

procedure work;
var
s_hod : string[10];

procedure zwuk;
begin
sound(1000);
delay(3000);
nosound;
end;

Последний раз редактировалось Batonchik; 08.04.2009 в 15:32.
Batonchik вне форума Ответить с цитированием
Старый 08.04.2009, 15:19   #10
Batonchik
Пользователь
 
Регистрация: 17.01.2009
Сообщений: 10
По умолчанию

procedure hod(c_hod : word);
begin
setcolor(c_hod);
moveto(180,300);
str(n_hod, s_hod);
Outtext(s_hod);
end;

procedure out_rez;
begin
if (key = #27)
then
begin
setcolor(14);
moveto(50,350);
Outtext('Vupolnenie programmu prervano igrokom!');
end
else
begin
setcolor(14);
moveto(50,350);
Outtext('Vash resultat ');
moveto(180,350);
str(n_hod, s_hod);
Outtext(s_hod);
end;
if ((n_hod < m_rez[n_game]) or (n_game < 10)) and (key <> #27)
then
record_f;
setcolor(7);
moveto(390,450);
Outtext('Dlya vuhoda Shmi <Enter> ');
readln;
end;

begin
start;
out_pole;
out_f_data;
n_hod := 0;
setcolor(14);
moveto(50,280);
Outtext(name_user);
moveto(50,300);
Outtext('Chislo hodov = ');
hod(15);
flag_end := true;
while (key <> #27) and (flag_end) do
begin
flag_hod := false;
key_in;

{================================== ============}

if wec = 3 {vlevo}
then
begin
wec:=0;
if x_z < 4
then
begin
r := pole[y_z, x_z];
pole[y_z, x_z] := pole[y_z, x_z+1];
pole[y_z, x_z+1] := r;
out_kl(y_z, x_z+1, pole[y_z, x_z+1]);
out_kl(y_z, x_z, pole[y_z, x_z]);
inc(x_z);
flag_hod := true;
end
else zwuk;
end;

{================================== ============}


if wec = 4 {vverh}
then
begin
wec := 0;
if y_z < 4
then
begin
r := pole[y_z, x_z];
pole[y_z, x_z] := pole[y_z+1, x_z];
pole[y_z+ 1, x_z] := r;
out_kl(y_z, x_z, pole[y_z, x_z]);
out_kl(y_z+1, x_z, pole[y_z+1, x_z]);
inc(y_z);
flag_hod := true;
end
else zwuk;
end;

{================================== ============}


if wec=2 {vniz}

then
begin
wec := 0;
if y_z > 1
then
begin
r := pole[y_z, x_z];
pole[y_z, x_z] := pole[y_z-1, x_z];
pole[y_z-1, x_z] := r;
out_kl(y_z, x_z, pole[y_z, x_z]);
out_kl(y_z-1, x_z, pole[y_z-1, x_z]);
dec(y_z);
flag_hod := true;
end
else zwuk;
end;

{================================== ============}


if wec = 1 {vpravo}
then
begin
wec :=0;
if x_z>1
then
begin
r:= pole[y_z, x_z];
pole[y_z, x_z] := pole[y_z, x_z-1];
pole[y_z, x_z-1] := r;
out_kl(y_z, x_z, pole[y_z, x_z]);
out_kl(y_z, x_z-1, pole[y_z, x_z-1]);
dec(x_z);
flag_hod := true;
end
else zwuk;
end;


if flag_hod
then
begin
hod(0);
inc(n_hod);
hod(15);
if pole_pole_a then flag_end := false;
end;
end;
if key = #27
then
begin
flag_end := false;
end;
out_rez;
end;


begin
clrscr;
write('Vvedite vashe imya => ');
readln(name_user);
in_gr;
work;
CloseGraph;
end.

Последний раз редактировалось Batonchik; 08.04.2009 в 15:32.
Batonchik вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Pi на Паскале. Anarion Помощь студентам 5 25.03.2009 16:04
L=2*pi*R и S=pi*R на паскале. MjRed Помощь студентам 1 02.02.2009 09:52
привет всем! помогите пожалуйста решить две задачи на паскале. я в паскале полный ноль. Пищенок Саша Паскаль, Turbo Pascal, PascalABC.NET 5 20.01.2009 13:46
БД На Паскале igorjouk Помощь студентам 12 21.11.2008 13:22
На Паскале Bagsi Помощь студентам 13 21.11.2007 21:40