|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
|
Опции темы | Поиск в этой теме |
31.03.2009, 21:39 | #1 |
Пользователь
Регистрация: 17.01.2009
Сообщений: 10
|
15 в Паскале
Помогите пожалуйста написать игру 15 в Паскале. При этом нужно установить счетчик ходов. И таблицу рекордов.
Заранее спасибо. |
31.03.2009, 22:54 | #2 |
Форумчанин
Регистрация: 08.07.2007
Сообщений: 154
|
А что ето за игра. Я прост не особый знаток народных игр.
|
01.04.2009, 07:44 | #3 |
Пользователь
Регистрация: 17.01.2009
Сообщений: 10
|
Это игра, где на поле размером 4*4 в беспорядочной последовательности появляются 15 фишек с нанесенными на них цифрами от 1 до 15 при этом правый нижний угол остается пустым и надо передвигая фишки расставить их так чтобы они все стали по порядку.
|
01.04.2009, 08:31 | #4 |
Белик Виталий :)
Старожил
Регистрация: 23.07.2007
Сообщений: 57,097
|
А помочь то в чем?
I'm learning to live...
|
01.04.2009, 14:15 | #5 |
Пользователь
Регистрация: 17.01.2009
Сообщений: 10
|
Нужно как раз и написать эту игру в Паскале. то есть программа должна выкидывать на поле 4 на 4 16 фишек 15 с цифрами одна пустая и вы должны переставить их по порядку при этом программа должна считать количество ходов и в конце выводить список рекордов. Вообщем нужно написать компьютерный код программы в Паскале.
|
01.04.2009, 15:57 | #6 |
Участник клуба
Регистрация: 06.03.2009
Сообщений: 1,346
|
А свои исходники не покажешь?Или ты хочешь чтобы тебе за просто так написали игру?
|
01.04.2009, 16:39 | #7 | |
Участник клуба
Регистрация: 29.07.2008
Сообщений: 1,091
|
Так проблема-то в чем? Пока ничего конкретного не увидел. Я не уверен на продолжительное существование темы, хотя бы потому что:
Цитата:
Кто бы ты ни был - не думай о себе слишком (с)
|
|
01.04.2009, 16:40 | #8 |
delphi-ст!
Форумчанин
Регистрация: 02.01.2009
Сообщений: 825
|
вступлю в команду разработчиков ПО на Delphi
|
08.04.2009, 15:18 | #9 |
Пользователь
Регистрация: 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. |
08.04.2009, 15:19 | #10 |
Пользователь
Регистрация: 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. |
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
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 |