Помощь - Поиск - Пользователи - Календарь
Полная версия: Змейка на паскале
Форум «Всё о Паскале» > Pascal, Object Pascal > Написание игр
-QWERTY-
Вот, только там есть маленькие недорабоки:
uses CRT, Graph;
type TPoint = record
X, Y: integer;
end;
MAS = array[1..1000] of TPoint;
var A: MAS;
N, C: integer;
T1: TPoint;
Key: Char;
procedure DRIVER;
var Gd, Gm: integer;
begin
Gd:=Detect;
InitGraph(Gd, Gm, '');
end;
procedure POLE;
begin
moveto(51, 51);
lineto(428, 51);
lineto(428, 428);
lineto(51, 428);
lineto(51, 51);
end;
procedure PAINT(T: TPoint; N: integer);
begin
case N of
1: SetColor(White);
2: SetColor(Black);
3: SetColor(Red);
end;
Rectangle(T.X*15-15+52, T.Y*15-15+52, T.X*15+52, T.Y*15+52);
end;
procedure GAMEOVER(A: MAS; N: integer; var Key: char);
var I: integer;
begin
if (A[N].X=0) or (A[N].X=26) or (A[N].Y=0) or (A[N].Y=26) then
Key:='q';
for I:=1 to N-1 do
if (A[N].X=A[I].X) and (A[N].Y=A[I].Y) then
Key:='q';
end;
procedure METKA(var T1: TPoint);
begin
T1.X:=Random(25)+1; T1.Y:=Random(25)+1;
Paint(T1, 3);
end;
procedure SNAKE(A: MAS; N: integer; Key: char; var B: MAS);
var T: TPoint;
I, X, Y: integer;
begin
case Key of
'w': begin X:=0; Y:=-1; end;
'a': begin X:=-1; Y:=0; end;
's': begin X:=0; Y:=1; end;
'd': begin X:=1; Y:=0; end;
end;
T:=A[1];
for I:=1 to N-1 do
A[I]:=A[I+1];
A[N].X:=A[N].X+X; A[N].Y:=A[N].Y+Y;
PAINT(T, 2);
for I:=1 to N do
PAINT(A[I], 1);
for I:=1 to N do
B[I]:=A[I];
end;
begin
DRIVER;
POLE;
A[1].X:=1; A[1].Y:=1; A[2].X:=2; A[2].Y:=1;
N:=2;
C:=0;
Key:='d';
repeat
if C=30 then
begin
PAINT(T1, 2);
METKA(T1);
C:=0;
end;
inc©;
if (T1.X=A[N].X) and (T1.Y=A[N].Y) then
begin
inc(N);
C:=30;
A[N]:=T1;
end;
if KeyPressed then
Key:=readkey;
Delay(9000);
SNAKE(A, N, Key, A);
GAMEOVER(A, N, Key);
until Key='q';
OutTextXY(315, 238, 'GAME OVER');
OutTextXY(302, 250, 'press any key');
readkey;
end.
volvo
Ну, так зачем постишь, если недоработки есть? Исправь, тогда и покажешь...
Гость
ктонить пробовал то
Bokul
Цитата
ктонить пробовал то

У меня только прямоугольник показывает blink.gif
Altair
Гость, а ты будешь пробовать продукт, в котором по словам-же разработчика есть недоработки ?
Некачественный товар - никому не нужен, как и производитель, создавший его!
Гость
Вот
uses CRT, Graph;
type TPoint = record
X, Y: integer;
end;
MAS = array[1..1000] of TPoint;
var A: MAS;
N, C: integer;
T1: TPoint;
Key: Char;
S: string;
procedure DRIVER;
var Gd, Gm: integer;
begin
Gd:=Detect;
InitGraph(Gd, Gm, '');
end;
procedure POLE;
begin
moveto(51, 51);
lineto(428, 51);
lineto(428, 428);
lineto(51, 428);
lineto(51, 51);
setcolor(white);
outtextxy(545, 50, 'Score:');
outtextxy(545, 220, '- exit');
outtextxy(545, 120, '- up');
outtextxy(545, 140, '- left');
outtextxy(545, 160, '- down');
outtextxy(545, 180, '- right');
setcolor(Yellow);
outtextxy(520, 220, '''q''');
outtextxy(520, 120, '''w''');
outtextxy(520, 140, '''a''');
outtextxy(520, 160, '''s''');
outtextxy(520, 180, '''d''');
end;
procedure PAINT(T: TPoint; N: integer);
begin
case N of
1: SetColor(White);
2: SetColor(Black);
3: begin SetColor(Red); Circle(T.X*15-8+52, T.Y*15-8+52, 7); exit; end;
4: Begin SetColor(Black); Circle(T.X*15-8+52, T.Y*15-8+52, 7); exit; end;
end;
Rectangle(T.X*15-15+52, T.Y*15-15+52, T.X*15+52, T.Y*15+52);
end;
procedure GAMEOVER(A: MAS; N: integer; var Key: char);
var I: integer;
begin
if (A[N].X=0) or (A[N].X=26) or (A[N].Y=0) or (A[N].Y=26) then
Key:='q';
for I:=1 to N-1 do
if (A[N].X=A[I].X) and (A[N].Y=A[I].Y) then
Key:='q';
end;
procedure METKA(var T1: TPoint);
begin
T1.X:=Random(25)+1; T1.Y:=Random(25)+1;
Paint(T1, 3);
end;
procedure SNAKE(A: MAS; N: integer; Key: char; var B: MAS);
var T: TPoint;
I, X, Y: integer;
begin
case Key of
'w': begin X:=0; Y:=-1; end;
'a': begin X:=-1; Y:=0; end;
's': begin X:=0; Y:=1; end;
'd': begin X:=1; Y:=0; end;
end;
T:=A[1];
for I:=1 to N-1 do
A[I]:=A[I+1];
A[N].X:=A[N].X+X; A[N].Y:=A[N].Y+Y;
PAINT(T, 2);
for I:=1 to N do
PAINT(A[I], 1);
for I:=1 to N do
B[I]:=A[I];
end;
begin
Randomize;
DRIVER;
POLE;
A[1].X:=1; A[1].Y:=1; A[2].X:=2; A[2].Y:=1;
N:=2;
C:=0;
Key:='d';
repeat
if C=30 then
begin
PAINT(T1, 4);
METKA(T1);
C:=0;
end;
inc©;
if (T1.X=A[N].X) and (T1.Y=A[N].Y) then
begin
inc(N);
C:=30;
A[N]:=T1;
setcolor(Black);
outtextxy(600, 50, S);
str(N-2, S);
setcolor(Yellow);
outtextxy(600, 50, S);
end;
if KeyPressed then
Key:=readkey;
Delay(9000);
SNAKE(A, N, Key, A);
GAMEOVER(A, N, Key);
until Key='q';
OutTextXY(315, 238, 'GAME OVER');
OutTextXY(302, 250, 'press any key');
readkey;
end.
Гость
uses CRT, Graph;
type TPoint = record
X, Y: integer;
end;
MAS = array[1..1000] of TPoint;
label 23,24;
var A: MAS;
ag, N, C, sp, speed: integer;
T1: TPoint;
Key: Char;
S: string;
procedure POLE;
begin
moveto(51, 51);
lineto(428, 51);
lineto(428, 428);
lineto(51, 428);
lineto(51, 51);
setcolor(white);
outtextxy(545, 50, 'Schet:');
outtextxy(545, 220, '- Vihod');
outtextxy(545, 120, '- vverh');
outtextxy(545, 140, '- vlevo');
outtextxy(545, 160, '- vniz');
outtextxy(545, 180, '- vpravo');
setcolor(Yellow);
outtextxy(520, 220, '''q''');
outtextxy(520, 120, '''w''');
outtextxy(520, 140, '''a''');
outtextxy(520, 160, '''s''');
outtextxy(520, 180, '''d''');
end;
procedure PAINT(T: TPoint; N: integer);
begin
case N of
1: SetColor(White);
2: SetColor(Black);
3: begin SetColor(Red); Circle(T.X*15-8+52, T.Y*15-8+52, 7); exit; end;
4: Begin SetColor(Black); Circle(T.X*15-8+52, T.Y*15-8+52, 7); exit; end;
end;
Rectangle(T.X*15-15+52, T.Y*15-15+52, T.X*15+52, T.Y*15+52);
end;
procedure GAMEOVER(A: MAS; N: integer; var Key: char);
var I: integer;
begin
if (A[N].X=0) or (A[N].X=26) or (A[N].Y=0) or (A[N].Y=26) then
Key:='q';
for I:=1 to N-1 do
if (A[N].X=A[I].X) and (A[N].Y=A[I].Y) then
Key:='q';
end;
procedure METKA(var T1: TPoint);
begin
T1.X:=Random(25)+1; T1.Y:=Random(25)+1;
Paint(T1, 3);
end;
procedure SNAKE(A: MAS; N: integer; Key: char; var B: MAS);
var T: TPoint;
I, X, Y: integer;
begin
case Key of
'w': begin X:=0; Y:=-1; end;
'a': begin X:=-1; Y:=0; end;
's': begin X:=0; Y:=1; end;
'd': begin X:=1; Y:=0; end;
end;
T:=A[1];
for I:=1 to N-1 do
A[I]:=A[I+1];
A[N].X:=A[N].X+X; A[N].Y:=A[N].Y+Y;
PAINT(T, 2);
for I:=1 to N do
PAINT(A[I], 1);
for I:=1 to N do
B[I]:=A[I];
end;
procedure GrInit;
var Graphdriver, graphmode, errorcode :integer;
Begin GraphDriver:=detect;
initgraph(graphdriver,graphmode,'f:\pascal\tp7\bgi\');
errorcode:=graphresult;
if errorcode<>grok then begin writeln('Oshibka',GraphErrorMsg(ErrorCode));
exit;
end;
end;
begin
writeln(' Dobro pozhalovat v zmeyku! ');
writeln(' Chtobi nachat igru - nazmite lubuy knopku!');
writeln;
writeln;
writeln('Programmu razrabotal');
writeln('Student gruppi PZ-06-1');
writeln('Metelin S.Y.');
readln;
GrInit;
Randomize;
23: cleardevice;
outtextxy(10, 10, 'Vvedite scorost zmeyki (1-3):');
writeln;
writeln;
readln(speed);
case speed of
1: sp:=9000;
2: sp:=15000;
3: sp:=18000;
else begin
setcolor(RED);
outtextxy(200,200,'Vvedena nepravilnaya scorost');
setcolor(white);
readkey;
outtextxy(250,300,'Nazmite Enter'); cleardevice; goto 23; end;
end;
cleardevice;
POLE;
A[1].X:=1; A[1].Y:=1; A[2].X:=2; A[2].Y:=1;
N:=2;
C:=0;
Key:='d';
repeat
if C=30 then
begin
PAINT(T1, 4);
METKA(T1);
C:=0;
end;
inc©;
if (T1.X=A[N].X) and (T1.Y=A[N].Y) then
begin
inc(N);
C:=30;
A[N]:=T1;
setcolor(Black);
outtextxy(600, 50, S);
str(N-2, S);
setcolor(Yellow);
outtextxy(600, 50, S);
end;
if KeyPressed then
Key:=readkey;
Delay(sp);
SNAKE(A, N, Key, A);
GAMEOVER(A, N, Key);
until Key='q';
cleardevice;
setcolor(RED);
OutTextXY(250, 200, 'IGRA ZAVERSHENA');
setcolor(white);
OutTextXY(270,225,'Vas shet:');
OutTextXY(360,225,S);
OutTextXY(210, 260, 'Hotite sigrat zanovo? (Y/N)');
case readkey of
'y': goto 23;
end;
delay(50000);
end.


М
Теги.. Лопарь

SKVOZNJAK
Цитата(Altair @ 21.06.2006 7:17) *

Гость, а ты будешь пробовать продукт, в котором по словам-же разработчика есть недоработки ?


Есть отмаза smile.gif Практически во всех навороченных биосах есть недоработки. Достаточно залезть на сайт разработчиков материнки и попытаться выбрать. То с температурой баги, то страничный кадр EMS занят, то усб лучше не включать. Адреного пространства явно недостаточно чтобы впихнуть всё желаемое.
Но вот это inc©; явно неправильный код.
inc©;
Исходники нужно оформлять в теги кода, чтобы смайлы и прочее в нём вдруг не появились.

Такс. С самого начала ерунда. Ты пишешь "нажмите на любую кнопку". Лучше писать "клавишу", но поскольку ты используешь readln, то "энтер". После этого включается графический режим, какой writeln? С delay надо разобраться. На быстрых машинах лучше использовать новый crt или патчить имеющийся, соответственно delay(1000) станет как и положено 1 секунда. Яблоко подкрасил, а то бледное, незрелое или наоборот, гнилое smile.gif Приделай паузу.
uses new_CRT, Graph;
type TPoint = record
X, Y: integer;
end;
MAS = array[1..1000] of TPoint;
label 23,24;
var A: MAS;
aa, ag, N, C, sp, speed: integer;
T1: TPoint;
Key: Char;
S: string;

procedure POLE;
begin
moveto(51, 51);
lineto(428, 51);
lineto(428, 428);
lineto(51, 428);
lineto(51, 51);
setcolor(white);
outtextxy(545, 50, 'Schet:');
outtextxy(545, 220, '- Vihod');
outtextxy(545, 120, '- vverh');
outtextxy(545, 140, '- vlevo');
outtextxy(545, 160, '- vniz');
outtextxy(545, 180, '- vpravo');
setcolor(Yellow);
outtextxy(520, 220, '''q''');
outtextxy(520, 120, '''w''');
outtextxy(520, 140, '''a''');
outtextxy(520, 160, '''s''');
outtextxy(520, 180, '''d''');
end;

procedure PAINT(T: TPoint; N: integer);
begin
case N of
1: SetColor(White);
2: SetColor(Black);
3: begin SetColor(Red); for aa:=2 to 7 do Circle(T.X*15-8+52, T.Y*15-8+52, aa); exit; end;
4: Begin SetColor(Black); for aa:=2 to 7 do Circle(T.X*15-8+52, T.Y*15-8+52, aa); exit; end;
end;
Rectangle(T.X*15-15+52, T.Y*15-15+52, T.X*15+52, T.Y*15+52);
end;
procedure GAMEOVER(A: MAS; N: integer; var Key: char);
var I: integer;
begin
if (A[N].X=0) or (A[N].X=26) or (A[N].Y=0) or (A[N].Y=26) then
Key:='q';
for I:=1 to N-1 do
if (A[N].X=A[I].X) and (A[N].Y=A[I].Y) then
Key:='q';
end;

procedure METKA(var T1: TPoint);
begin
T1.X:=Random(25)+1; T1.Y:=Random(25)+1;
Paint(T1, 3);
end;
procedure SNAKE(A: MAS; N: integer; Key: char; var B: MAS);
var T: TPoint;
I, X, Y: integer;
begin
case Key of
'w': begin X:=0; Y:=-1; end;
'a': begin X:=-1; Y:=0; end;
's': begin X:=0; Y:=1; end;
'd': begin X:=1; Y:=0; end;
end;
T:=A[1];
for I:=1 to N-1 do
A[I]:=A[I+1];
A[N].X:=A[N].X+X; A[N].Y:=A[N].Y+Y;
PAINT(T, 2);
for I:=1 to N do
PAINT(A[I], 1);
for I:=1 to N do
B[I]:=A[I];
end;

procedure GrInit;
var Graphdriver, graphmode, errorcode :integer;
Begin GraphDriver:=detect;
initgraph(graphdriver,graphmode,'');
errorcode:=graphresult;
if errorcode<>grok then begin writeln('Oshibka',GraphErrorMsg(ErrorCode));
exit;
end;
end;
begin
writeln(' Dobro pozhalovat v zmeyku! ');
writeln(' Chtobi nachat igru - nazmite lubuy knopku!');
writeln;
writeln;
writeln('Programmu razrabotal');
writeln('Student gruppi PZ-06-1');
writeln('Metelin S.Y.');
readln;
GrInit;
Randomize;
23: cleardevice;
outtextxy(10, 10, 'Vvedite scorost zmeyki (1-3):');
readln(speed);
case speed of
1: sp:=180;
2: sp:=150;
3: sp:=90;
else begin
setcolor(RED);
outtextxy(200,200,'Vvedena nepravilnaya scorost');
setcolor(white);
readkey;
outtextxy(250,300,'Nazmite Enter'); cleardevice; goto 23;
end;
end;
cleardevice;
POLE;
A[1].X:=1; A[1].Y:=1; A[2].X:=2; A[2].Y:=1;
N:=2;
C:=0;
Key:='d';
repeat
if C=30 then
begin
PAINT(T1, 4);
METKA(T1);
C:=0;
end;
inc©;
if (T1.X=A[N].X) and (T1.Y=A[N].Y) then
begin
inc(N);
C:=30;
A[N]:=T1;
setcolor(Black);
outtextxy(600, 50, S);
str(N-2, S);
setcolor(Yellow);
outtextxy(600, 50, S);
end;
if KeyPressed then
Key:=readkey;
Delay(sp);
SNAKE(A, N, Key, A);
GAMEOVER(A, N, Key);
until Key='q';
cleardevice;
setcolor(RED);
OutTextXY(250, 200, 'IGRA ZAVERSHENA');
setcolor(white);
OutTextXY(270,225,'Vas shet:');
OutTextXY(360,225,S);
OutTextXY(210, 260, 'Hotite sigrat zanovo? (Y/N)');
case readkey of
'y': goto 23;
end;
delay(500);
end.

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.