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

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

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

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 07.05.2013, 14:39   #1
yzen
Пользователь
 
Регистрация: 02.10.2012
Сообщений: 37
По умолчанию Арконоид

Помогите.Игра арканоид.Пишу через PascalABC.NET . Вот такой в коде лаг: появляются блоки платформа, Платформа перемещается свободно
нажимаю пробел, пуск шарика , начинается процедура игра и в ней событие onkeydown или onmousedown игнорит
пробывал мышкой кнопками не как


Программа:
uses modul,graphabc,events;
type matr=array[1..8,1..13] of integer;
type lev=text;

var xx,yy,dx,dy,x,y,x1,i,vib,level,star t:integer;
a:matr;
les:lev;
w:boolean;
put:smod;
//
procedure risblock(a:matr);
var i,j,x1,y1:integer;
begin
x1:=5;y1:=10;
for i:=1 to 8 do begin
for j:=1 to 13 do if a[i,j]=0 then begin
rectangle(x1,y1,x1+50,y1+10);
x1:=x1+53;
end
else x1:=x1+53;
x1:=5;
y1:=y1+13;
end;

end;

procedure block(ai:lev;l:integer;var a:matr);
var i,j,k,x1,y1:integer;
begin
x1:=5;y1:=10;
assign(ai,IntToStr(l)+'level.txt');
reset(ai);
k:=1;
j:=0;
while not eof(ai) do
begin
readln(ai,i);
j:=j+1;
a[k,j]:=i;
if j=13 then begin j:=0; k:=k+1;end;

end;
end;

procedure hide(ax,ay:integer);
begin
setpencolor(clwhite);
circle(ax,ay,6);
setpencolor(clblack);
end;

procedure hideplat(ax:integer);
begin
SetBrushColor(clwhite);
FillRectangle(ax,387,ax+80,400);
SetBrushColor(clblue);
end;

procedure hidecircl(ax,ay:integer);
begin
SetBrushColor(clWhite);
fillcircle(ax,ay,6);
SetBrushColor(clYellow);
end;

procedure circl(ax,ay:integer);
begin

hidecircl(xx,yy);
fillcircle(ax,ay,6);
xx:=ax;
yy:=ay;

end;

procedure platforma;
begin

if start=0 then begin x:=x1+40; y:=382; circl(x,y); end;
SetBrushColor(clblue);
FillRectangle(x1,390,x1+80,400);
end;

procedure game;forward;
procedure dvig(key:integer);
begin
case key of
vk_left: if x1>=5 then begin hideplat(x1);x1:=x1-10;platforma; end;
vk_right: if x1+80<=695 then begin hideplat(x1);x1:=x1+10;platforma; end;
vk_space: if start=0 then begin start:=1;game;end;
end;
end;

procedure Mousemove(x,y,mb:integer);
begin
hideplat(x1);
x1:=x-40;platforma;
end;

procedure game;
begin
repeat
sleep(20);
lockdrawing;
x:=dx+x;
y:=y+dy;
circl(x,y);
risblock(a);
if (x>=695) or (x<=5) then dx:=-dx;
if (y<=5) or ((abs(x-x1-40)<=40) and (abs(y-390)<=7)) then dy:=-dy;
if y>=405 then w:=false;

redraw;
//OnMousemove:=Mousemove;
OnKeyDown:=dvig;
until w=false

end;


procedure newgame;
begin
level:=1;
clearwindow;
block(les,level,a);
risblock(a);
x1:=310;
platforma;
w:=true;
//OnMousemove:=Mousemove;
onkeydown:=dvig;
end;

procedure MouseDown(x,y,mb:integer);
begin
if (x>=312) and (y>=120) and (x<=390) and(y<=140) then newgame;
end;



begin
SetWindowCaption('Арканоид');
setwindowsize(700,400);
start:=0;
dx:=5;dy:=-7;
put.menu;
OnMouseDown:=MouseDown;
end.


Модуль:
unit modul;

interface
uses graphabc,events;
type
smod = class
private

public
procedure menu;
end;

implementation


procedure smod.menu;
var i,x,y:integer;
begin

SetBrushColor(clYellow);
FillRectangle(0,0,700,400);
SetBrushColor(clblue);
for i:=1 to 100 do begin x:=random(700);y:=random(400);circl e(x,y,random(20)+5);floodfill(x+4,y +4,RGB(random(255),random(255),rand om(255)));end;
Fillcircle(350,205,120);
SetBrushColor(cltomato);
Fillcircle(350,205,110);
SetFontName('Times New Roman');
SetFontStyle(fsBoldUnderline);
SetFontSize(12);
SetFontColor(cllime);
textout(310,120,'Новая игра');
end;


begin
end.
yzen вне форума Ответить с цитированием
Ответ


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