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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 29.05.2016, 15:59   #1
Ollla_la
Новичок
Джуниор
 
Регистрация: 29.05.2016
Сообщений: 1
По умолчанию Запуск движения шарика через меню (программа почему-то виснет...)

Добрый день! Помогите, пожалуйста....
Есть меню, состоящее из 3 пунктов: титул, начать и выход. Переход по пунктам осуществляется с помощью клавиш PgUp и PgDn, выбор пункта с помощью Enter, выход из какого-либо пункта меню - с помощью клавиши Esc. В игре движется шарик по траектории и должен останавливаться при нажатии на пробел, продолжать движение при нажатии на Enter, ну и возврат в меню из игры должен осуществляться через клавишу Esc.
С пунктами меню 1 и 3 все норм, а вот когда выбираешь игру (пункт "начать"), то программа просто виснет....
Пожалуйста, помогите...................
Код:
uses graphABC, Events;
Const p:array[1..3] of string[25]=('Титульный лист','Начать','Выход') ;
Var a, i:byte;
b:char;
c:byte;
t:integer;
d,r,x1,y1,x2,y2,x3,y3,dx,dy:integer;
    f:boolean;
    x,y:integer;
{------------------------}
procedure okno;
var x,y:integer;
s:string;
begin
x:=windowwidth;
y:=windowheight;
str(x,s);
textout(100,100,s);
str(y,s);
textout(100,500,s);
end;
 
procedure text_menu(a:byte);
var i:byte;
begin
for i:=1 to 3 do
begin
if i=a then
setfontcolor(clred)
else
setfontcolor(clblack);
textout(280,170+30*i,p[i]);
end;
end;
{---------}
Procedure titulniy;
begin
 
Setfontcolor((clblack));
 
Textout(215,110,'Проект на языке Pascal');
Textout(256,125,' информатикf');
Textout(215,145,'"Движение фигуры по траектории"');
 
 
 
end;
 
  
procedure KeyPress(key:char);
begin
case key of
#32:begin
    dx:=0;
    dy:=0;
    end;
#13:begin
    dx:=5;
    dy:=5;
    end;
#27:begin
  textout(200,250,'Программа завершена');
  
    halt; text_menu(a);
    end;
end;
end;
procedure KeyDown(key:integer);
begin
if key=VK_Escape then begin f:=false;clearwindow; text_menu(a); end;;
end;
 
{Vk_Escape:begin if a=1 then begin clearwindow; text_menu(a); end;
if a=6 then begin clearwindow;end ;
if a=2 then begin clearwindow; text_menu(a); end;
if a=3 then begin clearwindow; text_menu(a); end;
if a=4 then begin clearwindow; text_menu(a); end;
if a=5 then begin clearwindow; text_menu(a); end;
end;}
 
procedure fon;
begin
x1:=250-d;
y1:=250-d;
x3:=250+d;
y3:=250+d;
rectangle(x1,y1,x3,y3);
x1:=x1+r;
y1:=250-d+r;
x2:=250;
y2:=250;
x3:=x3-r;;
y3:=y3-r;
setpenwidth(2);
line(x1,y2,x2,y1);
line(x2,y1,x3,y2);
line(x3,y2,x2,y3);
line(x2,y3,x1,y2);
end;
 
procedure shar(x,y:integer);
begin
setpencolor(clBlue);
setpenwidth(2);
circle(x,y,r);
end;
 
 
procedure game;
begin
setwindowsize(500,500);
centerwindow;
f:=true;
d:=round(500*sqrt(0.7)/2);
r:=10;
fon;
x:=x3;
y:=y2;
shar(x,y);
lockdrawing;
onkeypress:=KeyPress;
dx:=5;
dy:=5;
repeat
while (x>=x2)and f do
 begin
  clearwindow;
  x:=x-dx;
  y:=y-dy;
  fon;
  shar(x,y);
  sleep(50);
  redraw;
 end;
while (x>=x1)and f do
 begin
  clearwindow;
  x:=x-dx;
  y:=y+dy;
  fon;
  shar(x,y);
  sleep(50);
  redraw;
 end;
while (x<=x2)and f do
 begin
  clearwindow;
  x:=x+dx;
  y:=y+dy;
  fon;
  shar(x,y);
  sleep(50);
  redraw;
 end;
while (x<=x3)and f do
 begin
  clearwindow;
  x:=x+dx;
  y:=y-dy;
  fon;
  shar(x,y);
  sleep(50);
  redraw;
 end;
until not f;
 
end;
 
 
{-перед всем этим должны идти пункты игры }
procedure knopki(t:integer);
begin
case t of
Vk_enter:
if a=1 then begin clearwindow; titulniy ; end
else begin if a=2 then begin game 
 end; if a=3 then begin clearwindow;textout(250,145,'Game Over');end;
end;
 
VK_PageUp: begin a:=a-1; if a=0 then a:=3;text_menu(a); end;
 
VK_PageDown: begin a:=a+1; if a=4 then a:=1;text_menu(a); end;
 
Vk_Escape:begin if a=1 then begin clearwindow; text_menu(a); end;
//if a=6 then begin clearwindow;end ;
if a=2 then a:=1; 
if a=3 then begin clearwindow; text_menu(a); end;
//if a=4 then begin clearwindow; text_menu(a); end;
//if a=5 then begin clearwindow; text_menu(a); end;
end;
end;
end;
begin
a:=1;
text_menu(a);
onkeydown:=knopki;
 end.

Последний раз редактировалось Аватар; 29.05.2016 в 16:16.
Ollla_la вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
занести уникальное ID БД сделал через goto, но виснет ( Black_Wolf БД в Delphi 4 17.02.2013 09:51
Виснет программа Mrsqler Работа с сетью в Delphi 32 10.07.2012 10:41
Помогите понять почему прога виснет Asira Помощь студентам 5 21.12.2009 22:57
Потоки. Почему всё-равно виснет окно? TwiX Общие вопросы Delphi 10 13.12.2009 11:51
нужна программа: моделирование прыгающего шарика, переход к хаосу Milanta Фриланс 3 11.12.2006 23:13