NFSDrifter
New Member
Pascal, nói đến chương trình lập trình này thì bít bao là bạn trẻ lớp 11 đều đau khổ, hay luôn căng thẳng với những bài tập khô khan. Vậy sao ko giải trí bằng chính pascal. Một điều có thể lạ với mọi người nhưng lại wen thuộc với dân pascal. một trò chơi pascal điển hình là Audition. Nghe thì có thể là vô lý nhưng đây là điều bạn có thể làm trong pascal.:yoyo52:
Bắt đầu nhé:
Uses crt;
const
bpm=178;
leng=180;
var
scoreplus:longint;
clock:longint absolute $0000:$046C;
time,score,start:longint;
npf,ngr,nco,nb,nm:longint;
dem,perfectx,rythm,l,j,i,lv:longint;
c:char;
deldance,press:boolean;
misses:integer;
s,s1:string;
f:set of 1..10;
{ ================================================== ============= }
procedure hd;
begin
clrscr;
i:=10;
gotoxy(17,i);
textcolor(red); writeln('WELL COME TO AUDITION, WAS WRITTEN BY PASCAN');
inc(i);
gotoxy(2,i);
textcolor(white); writeln('Ban nhan phim ',#24,' ',#25,' ',#26,' ',#27 ,' theo hien thi cua man hinh');
inc(i);
gotoxy(2,i); writeln('Nhan khoang trang de ghi diem khi con tro vao o trung tam');
inc(i);
gotoxy(2,i); write('De vao che do');
textcolor(5); write(' DEL ');
textcolor(white); writeln('(So diem tang len nhieu hon) ban nhan phim Delete');
inc(i);
gotoxy(2,i); writeln('Khi do phim do xuat hien ban phai nhay nguoc lai voi hien thi');
inc(i);
gotoxy(2,i); write('De ket thuc chuong trinh ban hay nhan phim ');
textcolor(yellow); writeln('q');
textcolor(white);
readln;
clrscr;
end;
{ ================================================== ============= }
procedure finish;
var q:byte; cont:boolean;
begin
gotoxy(15,10); writeln('FINISH MOVE');
gotoxy(34,12);
s1:=s;
f:=[];
repeat
cont:=true;
q:=random(9)+1;
if not (q in f) then
begin
f:=f+[q]; delete(s1,q,1);
cont:=false;
case ord(s[q]) of
24: insert(chr(25),s1,q);
25: insert(chr(24),s1,q);
26: insert(chr(27),s1,q);
27: insert(chr(26),s1,q);
end;
end;
until not cont;
for q:=1 to lv do
begin
if q in f then textcolor(red) else textcolor(lightgray);
write(s1[q]);
end;
end;
{ ================================================== ============= }
procedure clear;
begin
textcolor(0);
gotoxy(33,12); writeln('-----------------------------');
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure perfect;
begin
misses:=0;
inc(npf);
inc(perfectx);
textcolor(lightred);
gotoxy(34,10);
if perfectx<=0 then
begin
scoreplus:=150*(lv+1)*4+ord(lv>1)*lv*lv*lv*lv;
writeln('PERFECT');
end else
begin
scoreplus:=250*(lv+1)*perfectx*4+ord(lv>1)*lv*lv*l v*lv;
writeln('PERFECT X ',perfectx);
end;
if lv =10 then score:=score+30000;
textcolor(lightgray);
clear;
end;
{ ================================================== ============= }
procedure great;
begin
misses:=0;
inc(ngr);
perfectx:=-1;
textcolor(green); gotoxy(34,10); writeln('GREAT');
scoreplus:=150*(lv+1)*3+ord(lv>1)*lv*lv*lv;
if lv=10 then score:=score+28000;
clear;
end;
{ ================================================== ============= }
procedure cool;
begin
misses:=0;
inc(nco);
perfectx:=-1;
textcolor(blue); gotoxy(34,10); writeln('COOL');
scoreplus:=150*(lv+1)*2+ord(lv>1)*lv*lv;
if lv =10 then score:=score+25000;
clear;
end;
{ ================================================== ============= }
procedure bad;
begin
misses:=0;
inc(nb);
perfectx:=-1;
textcolor(red);
gotoxy(34,10);
writeln('BAD');
scoreplus:=150*(lv+1)+ord(lv>1)*lv;
if lv =10 then score:=score+22500;
clear;
end;
{ ================================================== ============= }
procedure create;
begin
textcolor(blue); gotoxy(43,13); writeln('C');
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure remove;
begin
textcolor(0); gotoxy(43,13); writeln('C');
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure again;
var q:byte;
begin
j:=1;
gotoxy(34,12); textcolor(lightgray);
if ((not deldance) or (lv<6)) and ( not (lv=10) ) then writeln(s)
else
for q:=1 to lv do
begin
if q in f then textcolor(red) else textcolor(lightgray);
write(s1[q]);
end;
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure miss;
begin
if misses<>3 then inc(nm);
misses:=3;
textcolor(red); gotoxy(34,10); write('MISS');
textcolor(lightgray);
perfectx:=-1;
clear;
scoreplus:=0;
end;
{ ================================================== ============= }
procedure replace(var j:longint; x:longint);
begin
textcolor(green); gotoxy(j+33,12); write(chr(x));
textcolor(lightgray);
inc(j);
end;
{ ================================================== ============= }
procedure perform;
var p,q:byte; cont:boolean;
begin
s1:=s;
f:=[];
for p:=1 to 3 do
repeat
cont:=true;
q:=random(lv-1)+1;
if not (q in f) then
begin
f:=f+[q]; delete(s1,q,1);
cont:=false;
case ord(s[q]) of
24: insert(chr(25),s1,q);
25: insert(chr(24),s1,q);
26: insert(chr(27),s1,q);
27: insert(chr(26),s1,q);
end;
end;
until not cont;
for q:=1 to lv do
begin
if q in f then textcolor(red) else textcolor(lightgray);
write(s1[q]);
end;
end;
{ ================================================== ============= }
procedure timeout;
var o:longint;
begin
o:=(clock-start) div 18;
gotoxy(19,16);
if (leng-o) mod 60 <10 then writeln((leng-o) div 60,':0',(leng-o) mod 60:1)
else
writeln((leng-o) div 60,':',(leng-o) mod 60);
end;
{ ================================================== ============= }
procedure screen;
var p:byte;
begin
textcolor(lightblue);
gotoxy(15,11); writeln('{ }');
gotoxy(40,11); writeln('°±ÛÛÛÛÛ±°');
textcolor(white);
gotoxy( (time*41 div rythm) +15,11);writeln('Û');
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure count;
var x:integer;
begin
x:=time*123 div rythm +3;
if (j>lv) and (misses=1) then
begin
case x of
90
erfect;
87..89,91..93erfect;
81..86,94..99:cool;
78..80,100..102:bad;
else miss;
end; { end case }
if deldance and (lv>5) then scoreplus:=(scoreplus*3) div 2;
score:=score+scoreplus;
end else
if (misses<>0) and (misses<>3) then
begin
misses:=2;
miss;
end;
end;
{ ================================================== ============= }
procedure main;
begin
score:=0;
deldance:=false;
lv:=1;
time:=0;
rythm:=9000 div bpm;
randomize;
textcolor(lightgray); gotoxy(24,16); writeln('(',bpm:3,' bpm)');
dem:=0;
repeat
screen;
timeout;
textcolor(0); gotoxy(49,14); writeln('----------------------');
textcolor(lightgray); gotoxy(49,14); writeln(score);
if (time mod rythm=0) then
begin
misses:=1;
time:=0;
if lv=10 then
begin
lv:=6;
dem:=0;
end else
if (dem = (lv div 2 +trunc(sqrt(lv))) ) then
begin
dem:=0;
inc(lv);
end;
s:='';
j:=1;
textcolor(0); gotoxy(15,10); writeln('---------------------------------------');
textcolor(lightgray); gotoxy(34,12);
for i:=1 to lv do s:=s+chr(random(4)+24);
if deldance and (lv >5) and (lv<10) then perform else writeln(s);
if lv= 10 then finish;
if lv < 10 then
begin
gotoxy(15,10);
writeln('Level ',lv);
inc(dem);
end;
end;
if keypressed then c:=readkey else c:=#0;
if (ord(c )=72) and (ord(s[j])=24) then replace(j,24) else
if (ord(c )=80) and (ord(s[j])=25) then replace(j,25) else
if (ord(c )=77) and (ord(s[j])=26) then replace(j,26) else
if (ord(c )=75) and (ord(s[j])=27) then replace(j,27) else
if (ord(c )=83) then deldance:= not deldance else
if (ord(c )=32) then count else
if (c<>#0) and (j<=length(s)) then again;
if deldance then create else remove;
delay(90);
inc(time);
if (time*41 div rythm +1> 34) and ((j<=lv) or (misses=1)) and (misses<>0) then miss;
until (c='q') or (clock-start>leng*18);
end;
{ ================================================== ============= }
begin
clrscr;
npf:=0;
ngr:=0;
nco:=0;
nb:=0;
nm:=0;
hd;
start:=clock;
perfectx:=-1;
clrscr;
textcolor(lightgray);
main;
gotoxy(10,18);
writeln('Perfect Great Cool Bad Miss Score');
gotoxy(13,19);
writeln(npf:2,' ',ngr:2,' ',nco:2,' ',nb:2,' ',nm:2,' ',score:8);
readln;
end.
Bạn có thể đánh lai toàn bộ để nhớ và thuộc bài. Nếu lưởi wá thì copy rồi page vào.:yoyo52:
Nguồn NIE Network
Bắt đầu nhé:
Uses crt;
const
bpm=178;
leng=180;
var
scoreplus:longint;
clock:longint absolute $0000:$046C;
time,score,start:longint;
npf,ngr,nco,nb,nm:longint;
dem,perfectx,rythm,l,j,i,lv:longint;
c:char;
deldance,press:boolean;
misses:integer;
s,s1:string;
f:set of 1..10;
{ ================================================== ============= }
procedure hd;
begin
clrscr;
i:=10;
gotoxy(17,i);
textcolor(red); writeln('WELL COME TO AUDITION, WAS WRITTEN BY PASCAN');
inc(i);
gotoxy(2,i);
textcolor(white); writeln('Ban nhan phim ',#24,' ',#25,' ',#26,' ',#27 ,' theo hien thi cua man hinh');
inc(i);
gotoxy(2,i); writeln('Nhan khoang trang de ghi diem khi con tro vao o trung tam');
inc(i);
gotoxy(2,i); write('De vao che do');
textcolor(5); write(' DEL ');
textcolor(white); writeln('(So diem tang len nhieu hon) ban nhan phim Delete');
inc(i);
gotoxy(2,i); writeln('Khi do phim do xuat hien ban phai nhay nguoc lai voi hien thi');
inc(i);
gotoxy(2,i); write('De ket thuc chuong trinh ban hay nhan phim ');
textcolor(yellow); writeln('q');
textcolor(white);
readln;
clrscr;
end;
{ ================================================== ============= }
procedure finish;
var q:byte; cont:boolean;
begin
gotoxy(15,10); writeln('FINISH MOVE');
gotoxy(34,12);
s1:=s;
f:=[];
repeat
cont:=true;
q:=random(9)+1;
if not (q in f) then
begin
f:=f+[q]; delete(s1,q,1);
cont:=false;
case ord(s[q]) of
24: insert(chr(25),s1,q);
25: insert(chr(24),s1,q);
26: insert(chr(27),s1,q);
27: insert(chr(26),s1,q);
end;
end;
until not cont;
for q:=1 to lv do
begin
if q in f then textcolor(red) else textcolor(lightgray);
write(s1[q]);
end;
end;
{ ================================================== ============= }
procedure clear;
begin
textcolor(0);
gotoxy(33,12); writeln('-----------------------------');
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure perfect;
begin
misses:=0;
inc(npf);
inc(perfectx);
textcolor(lightred);
gotoxy(34,10);
if perfectx<=0 then
begin
scoreplus:=150*(lv+1)*4+ord(lv>1)*lv*lv*lv*lv;
writeln('PERFECT');
end else
begin
scoreplus:=250*(lv+1)*perfectx*4+ord(lv>1)*lv*lv*l v*lv;
writeln('PERFECT X ',perfectx);
end;
if lv =10 then score:=score+30000;
textcolor(lightgray);
clear;
end;
{ ================================================== ============= }
procedure great;
begin
misses:=0;
inc(ngr);
perfectx:=-1;
textcolor(green); gotoxy(34,10); writeln('GREAT');
scoreplus:=150*(lv+1)*3+ord(lv>1)*lv*lv*lv;
if lv=10 then score:=score+28000;
clear;
end;
{ ================================================== ============= }
procedure cool;
begin
misses:=0;
inc(nco);
perfectx:=-1;
textcolor(blue); gotoxy(34,10); writeln('COOL');
scoreplus:=150*(lv+1)*2+ord(lv>1)*lv*lv;
if lv =10 then score:=score+25000;
clear;
end;
{ ================================================== ============= }
procedure bad;
begin
misses:=0;
inc(nb);
perfectx:=-1;
textcolor(red);
gotoxy(34,10);
writeln('BAD');
scoreplus:=150*(lv+1)+ord(lv>1)*lv;
if lv =10 then score:=score+22500;
clear;
end;
{ ================================================== ============= }
procedure create;
begin
textcolor(blue); gotoxy(43,13); writeln('C');
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure remove;
begin
textcolor(0); gotoxy(43,13); writeln('C');
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure again;
var q:byte;
begin
j:=1;
gotoxy(34,12); textcolor(lightgray);
if ((not deldance) or (lv<6)) and ( not (lv=10) ) then writeln(s)
else
for q:=1 to lv do
begin
if q in f then textcolor(red) else textcolor(lightgray);
write(s1[q]);
end;
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure miss;
begin
if misses<>3 then inc(nm);
misses:=3;
textcolor(red); gotoxy(34,10); write('MISS');
textcolor(lightgray);
perfectx:=-1;
clear;
scoreplus:=0;
end;
{ ================================================== ============= }
procedure replace(var j:longint; x:longint);
begin
textcolor(green); gotoxy(j+33,12); write(chr(x));
textcolor(lightgray);
inc(j);
end;
{ ================================================== ============= }
procedure perform;
var p,q:byte; cont:boolean;
begin
s1:=s;
f:=[];
for p:=1 to 3 do
repeat
cont:=true;
q:=random(lv-1)+1;
if not (q in f) then
begin
f:=f+[q]; delete(s1,q,1);
cont:=false;
case ord(s[q]) of
24: insert(chr(25),s1,q);
25: insert(chr(24),s1,q);
26: insert(chr(27),s1,q);
27: insert(chr(26),s1,q);
end;
end;
until not cont;
for q:=1 to lv do
begin
if q in f then textcolor(red) else textcolor(lightgray);
write(s1[q]);
end;
end;
{ ================================================== ============= }
procedure timeout;
var o:longint;
begin
o:=(clock-start) div 18;
gotoxy(19,16);
if (leng-o) mod 60 <10 then writeln((leng-o) div 60,':0',(leng-o) mod 60:1)
else
writeln((leng-o) div 60,':',(leng-o) mod 60);
end;
{ ================================================== ============= }
procedure screen;
var p:byte;
begin
textcolor(lightblue);
gotoxy(15,11); writeln('{ }');
gotoxy(40,11); writeln('°±ÛÛÛÛÛ±°');
textcolor(white);
gotoxy( (time*41 div rythm) +15,11);writeln('Û');
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure count;
var x:integer;
begin
x:=time*123 div rythm +3;
if (j>lv) and (misses=1) then
begin
case x of
90
erfect;87..89,91..93
erfect;81..86,94..99:cool;
78..80,100..102:bad;
else miss;
end; { end case }
if deldance and (lv>5) then scoreplus:=(scoreplus*3) div 2;
score:=score+scoreplus;
end else
if (misses<>0) and (misses<>3) then
begin
misses:=2;
miss;
end;
end;
{ ================================================== ============= }
procedure main;
begin
score:=0;
deldance:=false;
lv:=1;
time:=0;
rythm:=9000 div bpm;
randomize;
textcolor(lightgray); gotoxy(24,16); writeln('(',bpm:3,' bpm)');
dem:=0;
repeat
screen;
timeout;
textcolor(0); gotoxy(49,14); writeln('----------------------');
textcolor(lightgray); gotoxy(49,14); writeln(score);
if (time mod rythm=0) then
begin
misses:=1;
time:=0;
if lv=10 then
begin
lv:=6;
dem:=0;
end else
if (dem = (lv div 2 +trunc(sqrt(lv))) ) then
begin
dem:=0;
inc(lv);
end;
s:='';
j:=1;
textcolor(0); gotoxy(15,10); writeln('---------------------------------------');
textcolor(lightgray); gotoxy(34,12);
for i:=1 to lv do s:=s+chr(random(4)+24);
if deldance and (lv >5) and (lv<10) then perform else writeln(s);
if lv= 10 then finish;
if lv < 10 then
begin
gotoxy(15,10);
writeln('Level ',lv);
inc(dem);
end;
end;
if keypressed then c:=readkey else c:=#0;
if (ord(c )=72) and (ord(s[j])=24) then replace(j,24) else
if (ord(c )=80) and (ord(s[j])=25) then replace(j,25) else
if (ord(c )=77) and (ord(s[j])=26) then replace(j,26) else
if (ord(c )=75) and (ord(s[j])=27) then replace(j,27) else
if (ord(c )=83) then deldance:= not deldance else
if (ord(c )=32) then count else
if (c<>#0) and (j<=length(s)) then again;
if deldance then create else remove;
delay(90);
inc(time);
if (time*41 div rythm +1> 34) and ((j<=lv) or (misses=1)) and (misses<>0) then miss;
until (c='q') or (clock-start>leng*18);
end;
{ ================================================== ============= }
begin
clrscr;
npf:=0;
ngr:=0;
nco:=0;
nb:=0;
nm:=0;
hd;
start:=clock;
perfectx:=-1;
clrscr;
textcolor(lightgray);
main;
gotoxy(10,18);
writeln('Perfect Great Cool Bad Miss Score');
gotoxy(13,19);
writeln(npf:2,' ',ngr:2,' ',nco:2,' ',nb:2,' ',nm:2,' ',score:8);
readln;
end.
Bạn có thể đánh lai toàn bộ để nhớ và thuộc bài. Nếu lưởi wá thì copy rồi page vào.:yoyo52:
Nguồn NIE Network
