azurayoyo
09-03-2007, 11:02 AM
Tui mới tìm thấy cái này trên mạng thấy hay nên post lên đây cho anh em kiểm tra tui cũng đang thử test xem sao mong mọi người cho ý kiến:still_dreaming:
{Q+,R+}
Program bt;
uses crt,graph,dos;
const nmax=150;
fi='keyboard.inp';
dl=9;
cao=330;
ghix=200;
ghiy=240;
b:array[1..8]of string=
('Keyboard ',' Nhac ','Thoi gian ','Tiep tuc ',' Toc do ',' Thoat ','Nang cao ','B.thuong ');
c:array[1..8]of integer=(200,230,260,290,320,350,230,320);
d:array[1..8]of integer=(200,200,200,200,200,200,400,400);
var gd,gm,soo,n,tocdo,tg,x,k:integer;
a:array[1..nmax]of 1..4;
capdo:string;
ch1,ch,trai,phai,tren,duoi:char;
o1,o2,o3,_o1,_o2,_o3,o4,_o4:word;
thoigian,tgian,tong:longint;
per,gre,coo,mis,bad,p,g,p1,g1:integer;
f:text;
_kt:integer;
Procedure khoitao;
begin
clrscr; _kt:=0;
per:=0;gre:=0;coo:=0;mis:=0;bad:=0;
assign(f,fi);
reset(f);
readln(f,tren,duoi,trai,phai);
readln(f,n,p,g);
readln(f,_kt);
close(f);
tocdo:=3000 div n;
gd:=detect;
initgraph(gd,gm,'d:\hoctap\turbo\bin');
end;
Procedure ghifile;
begin
assign(f,fi);
rewrite(f);
writeln(f,tren,duoi,trai,phai);
writeln(f,n,' ',p,' ',g);
writeln(f,_kt);
close(f);
end;
Procedure right(x,y,mau,h:integer);
var i:integer;
begin
if mau=0 then setcolor(5) else setcolor(8);
for i:=dl to dl do circle(x,y,i);
setcolor(h);
moveto(x-7,y-2);
lineto(x+2,y-2);
lineto(x,y-5);
lineto(x+2,y-5);
lineto(x+6,y);
lineto(x+2,y+5);
lineto(x,y+5);
lineto(x+2,y+2);
lineto(x-7,y+2);
lineto(x-7,y-2);
end;
Procedure up(x,y,mau,h:integer);
var i:integer;
begin
if mau=0 then setcolor(5) else setcolor(8);
for i:=dl to dl do circle(x,y,i);
setcolor(h);
moveto(x-2,y+5);
lineto(x-2,y-4);
lineto(x-5,y-1);
lineto(x-5,y-3);
lineto(x,y-8);
lineto(x+5,y-3);
lineto(x+5,y-1);
lineto(x+2,y-4);
lineto(x+2,y+5);
lineto(x-2,y+5);
end;
Procedure down(x,y,mau,h:integer);
var i:integer;
begin
if mau=0 then setcolor(5) else setcolor(8);
for i:=dl to dl do circle(x,y,i);
setcolor(h);
moveto(x-2,y-7);
lineto(x-2,y+1);
lineto(x-5,y-2);
lineto(x-5,y+1);
lineto(x,y+6);
lineto(x+5,y+1);
lineto(x+5,y-2);
lineto(x+2,y+1);
lineto(x+2,y-7);
lineto(x-2,y-7);
end;
Procedure left(x,y,mau,h:integer);
var i:integer;
begin
if mau=0 then setcolor(5) else setcolor(8);
for i:=dl to dl do circle(x,y,i);
setcolor(h);
moveto(x+6,y-2);
lineto(x-1,y-2);
lineto(x+2,y-5);
lineto(x-1,y-5);
lineto(x-6,y);
lineto(x-1,y+5);
lineto(x+2,y+5);
lineto(x-1,y+2);
lineto(x+6,y+2);
lineto(x+6,y-2);
end;
Procedure tao;
var i:integer;
begin
for i:=1 to soo do a[i]:=random(4)+1;
end;
Procedure ve;
var i:integer;
begin
for i:=1 to soo do
case a[i] of
1:right(x+i*20,cao,1,8);
2:up(x+i*20,cao,1,8);
3:left(x+i*20,cao,1,8);
4:down(x+i*20,cao,1,8);
end;
end;
Procedure bat(i,j:integer);
begin
case i of
1:right(x+j*20,cao,0,2);
2:up(x+j*20,cao,0,2);
3:left(x+j*20,cao,0,2);
4:down(x+j*20,cao,0,2);
end;
end;
Procedure td(var i:integer;kt:boolean);
begin
if kt then
begin
bat(a[i],i);
inc(i);
exit;
end ;
ve;i:=1;
end;
Procedure hienbang;
var st:string;
begin
outtextxy(230,230,'Ket thuc');delay(2000);
cleardevice;
outtextxy(230,30,'Bang ket qua');
str(per,st);
outtextxy(130,50, 'Perfect : '+st);
str(gre,st);
outtextxy(130,70, 'Great : '+st);
str(coo,st);
outtextxy(130,90, 'Cool : '+st);
str(bad,st);
outtextxy(130,110,'Bad : '+st);
str(mis,st);
outtextxy(130,130,'Miss : '+st);
line (110,150,450,150);
str(tong,st);
outtextxy(130,170,'Tong diem : '+st);
readln;
halt;
end;
Procedure icon(x,y:integer;st:string;trangthai:integer);
var cd:integer;
begin
cd:=length(st)*4;
if trangthai=1 then
begin
setfillstyle(1,3);
bar(x-cd-3,y-12,x+cd+3,y+12);
setfillstyle(1,8);
bar(x-cd-3,y-12,x+cd+1,y+10);
end
else
begin
setfillstyle(1,3);
bar(x-cd-3,y-12,x+cd+3,y+12);
setfillstyle(1,8);
bar(x-cd-1,y-10,x+cd+3,y+12);
end;
if trangthai=0 then setfillstyle(1,15)else setfillstyle(1,7);
bar(x-cd-1,y-10,x+cd+1,y+10);
if trangthai=0 then setcolor(6) else setcolor(9);
outtextxy(x-(cd+25) div 2,y-3,st);
end;
Procedure nhan;
begin
setcolor(random(14)+1);
outtextxy(90,10,' .. .. .. .... .... .............. ... .. ');
outtextxy(90,20,' .... .. .. ..... .. .............. .... .. ');
outtextxy(90,30,'.. .. .. .. .. .. .. .. .. .. .. ');
outtextxy(90,40,'...... .. .. .. .. .. .. .. ..... .. .. .. ');
outtextxy(90,50,'...... .. .. .. .. .. .. .. .. .. .. .. .. ');
outtextxy(90,60,'.. .. ...... ..... .. .. .. .. .. .. .... ');
outtextxy(90,70,'.. .. .... .... .... .. .. ..... .. ... ');
end;
Procedure menu;
var i,t,j,j1,j2:integer;
begin j:=640; j1:=640;j2:=640;
setcolor(9);
outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*');
for i:=1 to 8 do icon(d[i],c[i],b[i],0);
i:=4;icon(d[i],c[i],b[i],1);
setfillstyle(1,2); bar(0,455,640,475);
repeat
setcolor(9); outtextxy(j,461,'Dang Bao Chung');
outtextxy(j2+440,461,'DT: 037.532.153');
outtextxy(j1+220,461,'11 Tin Lam Son');delay(20);
dec(j);dec(j1); dec(j2);
if j=0 then j:=640;
if j1=-220 then j1:=640-220;
if j2=-440 then j2:=640-440;
setfillstyle(1,2); bar(0,455,640,475);
if keypressed then
begin
ch:=readkey;
if ch in[#72,#80]then
begin
if ch=#72 then
begin
icon(d[i],c[i],b[i],0);
if i<=6 then
begin
dec(i);if i=0 then i:=6;
end else if i=7 then i:=8 else if i=8 then i:=7;
icon(d[i],c[i],b[i],1);
end
else
begin
icon(d[i],c[i],b[i],0);
if i<=6 then
begin
inc(i);if i=7 then i:=1;
end else if i=7 then i:=8 else if i=8 then i:=7;
icon(d[i],c[i],b[i],1);
end
end;
if (ch in[#77,#75])then
begin
if i<=6 then
begin
icon(d[i],c[i],b[i],0);
if _kt=0 then i:=7 else i:=8;
icon(d[i],c[i],b[i],1);
end
else
begin
icon(d[i],c[i],b[i],0);
i:=4;
icon(d[i],c[i],b[i],1);
end
end;
end;
if ch=#13 then
begin ch:='!';
if i=4 then
begin
gettime(_o1,_o2,_o3,_o4);
thoigian:=thoigian+(_o1-o1)*60*60+(_o2-o2)*60+_o3-o3;
cleardevice;
setbkcolor(0);
exit;
end
else
if i=6 then halt
else
if i=1 then
begin
repeat
cleardevice;
outtextxy(250,100,'Keyboard');
outtextxy(200,150,'Phim nhay len ');tren:=readkey;
outtextxy(200,170,'Phim nhay xuong');duoi:=readkey;
outtextxy(200,190,'Phim nhay trai ');trai:=readkey;
outtextxy(200,210,'Phim nhay phai ');phai:=readkey;
until (tren<>duoi)and(tren<>trai)and(tren<>phai)and(trai<>phai)
and(trai<>duoi)and(phai<>duoi);
ghifile;
setcolor(5);
outtextxy(200,280,'Nhan ENTER de ket thuc');
readln;
cleardevice;setcolor(9);
outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*');
icon(300,100,'AUDITION WRITELN BY DANG BAO CHUNG ',0);
for t:=2 to 8 do icon(d[t],c[t],b[t],0);
i:=1;icon(d[i],c[i],b[i],1);
end
else
if i=2 then
begin
cleardevice;
outtextxy(250,100,'Danh muc bai hat');
outtextxy(200,150,'Tuyet yeu thuong ');
outtextxy(200,170,'Aloha');
outtextxy(200,190,'Chinh em ');
outtextxy(200,210,'Toc hat ');
setcolor(5);
outtextxy(200,280,'Day chi la trang tri, sorry');
readln;
cleardevice;
icon(300,100,'AUDITION WRITELN BY DANG BAO CHUNG ',0);
for t:=1 to 8 do icon(d[t],c[t],b[t],0);
i:=2;icon(d[i],c[i],b[i],1);
setcolor(9);
outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*')
end
else
if i=3 then
begin
cleardevice;
outtextxy(250,100,'Thoi gian nhay'); p1:=0;g1:=0;
outtextxy(200,150,'Phut :');read(p1);
outtextxy(200,170,'Giay :');read(g1);
thoigian:=thoigian+(p1-p)*60+g1-g;
p:=p1;g:=g1;
ghifile;
readln;
cleardevice;setcolor(9);
outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*');
icon(300,100,'AUDITION WRITELN BY DANG BAO CHUNG ',0);
for t:=1 to 8 do icon(d[t],c[t],b[t],0);
i:=3;icon(d[i],c[i],b[i],1);
end
else
if i=5 then
begin
cleardevice;
outtextxy(250,100,'Toc do');
outtextxy(200,150,'Hay nhap toc do :');read(n);
tocdo:=3000 div n;
ghifile;
readln;
cleardevice;setcolor(9);
outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*');
icon(300,100,'AUDITION WRITELN BY DANG BAO CHUNG ',0);
for t:=1 to 8 do icon(d[t],c[t],b[t],0);
i:=5;icon(d[i],c[i],b[i],1);
end
else if i=7 then begin _kt:=1;ghifile;end
else if i=8 then begin _kt:=0;ghifile;end;
if i in[7,8]then
begin
setcolor(9);outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*');
setcolor(3);outtextxy(d[7+_kt]-55,c[7+_kt]-3,'*');
end;
end;
if ch=' 'then
begin
if i=7 then begin _kt:=1;ghifile;end
else if i=8 then begin _kt:=0;ghifile;end;
if i in[7,8]then
begin
setcolor(9);outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*');
setcolor(3);outtextxy(d[7+_kt]-55,c[7+_kt]-3,'*');
end;
end;
until ch=#27;
end;
Procedure setup;
var ch:char;
begin
gettime(o1,o2,o3,o4);
cleardevice;
setbkcolor(3);
icon(300,100,'AUDITION WRITELN BY DANG BAO CHUNG ',0);
setcolor(9);
menu;
{repeat
if keypressed then ch:=readkey;
if ch=#27 then
begin
end;
until ch=#27;}
setbkcolor(0);
end;
Procedure choi;
var i,j:integer;st:string;_tg:longint; ch1:char;kt:boolean;
begin
i:=1;
repeat inc(tg);
str(soo,capdo);
setcolor(6);
outtextxy(180,370,'Cap do : '+capdo);
if tg mod 5=0 then nhan;
if tg=40 then begin setfillstyle(1,0);bar(10,200,300,300);end;
setfillstyle(1,8);
bar(170,270,270,280);
setcolor(7);
outtextxy(244,272,'o');
setcolor(3);
circle(k,275,5); inc(k);if k>265 then begin k:=175;inc(tg);end;
if k=262 then kt:=false;
delay(tocdo);
gettime(_o1,_o2,_o3,_o4);
tgian:=_o3+_o2*60+_o1*60*60;
_tg:=thoigian-tgian;
_o3:=_tg div 60; _o4:=_tg mod 60;
setfillstyle(1,0);bar(0,450,80,480);
str(_o3,st);outtextxy(10,450,st+': ');
str(_o4,st);outtextxy(33,450,st);
if tgian>=thoigian then hienbang;
if keypressed then
begin
ch1:=readkey;
if ch1=#61 then
begin
setup;
ve;
for j:=1 to i-1 do
case a[j] of
1:right(x+j*20,cao,0,2);
2:up(x+j*20,cao,0,2);
3:left(x+j*20,cao,0,2);
4:down(x+j*20,cao,0,2);
end;
end;
if ch1 in [#27,trai,' ',phai,tren,duoi]then
begin
ch:=ch1;
if ch=#27 then begin hienbang;readln;halt;end;
if (((a[i]=1)and(ch=phai))or((a[i]=2)and(ch=tren))or
((a[i]=3)and(ch=trai))or((a[i]=4)and(ch=duoi))) then
begin
bat(a[i],i);
inc(i);
end else
if (i<soo+1)and(ch<>' ') then
begin
ve;i:=1;
end else
if ((i<soo+1)and(ch=' '))or((ch=' ')and (i<>soo+1))or
((i=soo+1)and(ch=' ')and(not(k-20 in[210..240])))then
begin
kt:=false;
ve;i:=1;
setfillstyle(1,0);bar(10,250,300,300);
outtextxy(ghix,ghiy,'Miss'); tg:=0;
inc(mis);
bar(x,320,x+300,360);
soo:=soo-3;if soo<=0 then soo:=1;
x:=210-soo*9;tao;ve;
end else
if ch=' ' then
begin
inc(i);tg:=0;
setfillstyle(1,0);bar(10,10,300,300);setcolor(k);
if k-20 in[210..214] then
begin outtextxy(ghix,ghiy,'Bad');inc(bad);tong:=tong+10*soo;end else
if k-20 in[215..218] then
begin outtextxy(ghix,ghiy,'Cool');inc(coo);tong:=tong+20*soo end else
if k-20 in[219..224] then
begin outtextxy(ghix,ghiy,'Great');inc(gre);tong:=tong+30*soo end else
if k-20 in[225..226] then
begin outtextxy(ghix,ghiy,'Perfect');inc(per);tong:=tong+60*soo end else
if k-20 in[227..230] then
begin outtextxy(ghix,ghiy,'Great');inc(gre);tong:=tong+30*soo end else
if k-20 in[231..234] then
begin outtextxy(ghix,ghiy,'Cool');inc(coo);tong:=tong+20*soo end else
if k-20 in[235..239] then
begin outtextxy(ghix,ghiy,'Bad');inc(bad);tong:=tong+10*soo end;
kt:=true;
setcolor(0);
bar(180,365,660,380);
end;
end;
end;
if (k=261)and (not kt)and (_kt=1) then
begin
kt:=false;
ve;i:=1;
setfillstyle(1,0);bar(10,250,300,300);
outtextxy(ghix,ghiy,'Miss'); tg:=0;
inc(mis);
bar(x,320,x+300,360);
setcolor(0);
bar(180,365,660,380);
soo:=soo-3;if soo<=0 then soo:=1;
str(soo,capdo);
setcolor(6);
x:=210-soo*9;tao;ve;
outtextxy(180,370,'Cap do : '+capdo);
end;
until ((i=soo+2)or(ch=#27));
end;
Procedure xuli;
begin
randomize;
soo:=1; gettime(o1,o2,o3,o4);
thoigian:=o3+o2*60+o1*60*60+p*60+g;
repeat
x:=210-soo*9;
tao;
ve;
choi;
if ch=' ' then inc(soo);
if soo>10
then soo:=8;
setfillstyle(1,0);bar(x,320,x+300,360);
until (soo>10)or (ch=#27);
end;
begin
khoitao;
soo:=1;tg:=0;k:=175;tong:=0;
setbkcolor(3);
icon(300,100,'AUDITION WRITELN BY DANG BAO CHUNG ',0);
menu;
xuli;
closegraph;
end.
(nguồn từ manguon)
{Q+,R+}
Program bt;
uses crt,graph,dos;
const nmax=150;
fi='keyboard.inp';
dl=9;
cao=330;
ghix=200;
ghiy=240;
b:array[1..8]of string=
('Keyboard ',' Nhac ','Thoi gian ','Tiep tuc ',' Toc do ',' Thoat ','Nang cao ','B.thuong ');
c:array[1..8]of integer=(200,230,260,290,320,350,230,320);
d:array[1..8]of integer=(200,200,200,200,200,200,400,400);
var gd,gm,soo,n,tocdo,tg,x,k:integer;
a:array[1..nmax]of 1..4;
capdo:string;
ch1,ch,trai,phai,tren,duoi:char;
o1,o2,o3,_o1,_o2,_o3,o4,_o4:word;
thoigian,tgian,tong:longint;
per,gre,coo,mis,bad,p,g,p1,g1:integer;
f:text;
_kt:integer;
Procedure khoitao;
begin
clrscr; _kt:=0;
per:=0;gre:=0;coo:=0;mis:=0;bad:=0;
assign(f,fi);
reset(f);
readln(f,tren,duoi,trai,phai);
readln(f,n,p,g);
readln(f,_kt);
close(f);
tocdo:=3000 div n;
gd:=detect;
initgraph(gd,gm,'d:\hoctap\turbo\bin');
end;
Procedure ghifile;
begin
assign(f,fi);
rewrite(f);
writeln(f,tren,duoi,trai,phai);
writeln(f,n,' ',p,' ',g);
writeln(f,_kt);
close(f);
end;
Procedure right(x,y,mau,h:integer);
var i:integer;
begin
if mau=0 then setcolor(5) else setcolor(8);
for i:=dl to dl do circle(x,y,i);
setcolor(h);
moveto(x-7,y-2);
lineto(x+2,y-2);
lineto(x,y-5);
lineto(x+2,y-5);
lineto(x+6,y);
lineto(x+2,y+5);
lineto(x,y+5);
lineto(x+2,y+2);
lineto(x-7,y+2);
lineto(x-7,y-2);
end;
Procedure up(x,y,mau,h:integer);
var i:integer;
begin
if mau=0 then setcolor(5) else setcolor(8);
for i:=dl to dl do circle(x,y,i);
setcolor(h);
moveto(x-2,y+5);
lineto(x-2,y-4);
lineto(x-5,y-1);
lineto(x-5,y-3);
lineto(x,y-8);
lineto(x+5,y-3);
lineto(x+5,y-1);
lineto(x+2,y-4);
lineto(x+2,y+5);
lineto(x-2,y+5);
end;
Procedure down(x,y,mau,h:integer);
var i:integer;
begin
if mau=0 then setcolor(5) else setcolor(8);
for i:=dl to dl do circle(x,y,i);
setcolor(h);
moveto(x-2,y-7);
lineto(x-2,y+1);
lineto(x-5,y-2);
lineto(x-5,y+1);
lineto(x,y+6);
lineto(x+5,y+1);
lineto(x+5,y-2);
lineto(x+2,y+1);
lineto(x+2,y-7);
lineto(x-2,y-7);
end;
Procedure left(x,y,mau,h:integer);
var i:integer;
begin
if mau=0 then setcolor(5) else setcolor(8);
for i:=dl to dl do circle(x,y,i);
setcolor(h);
moveto(x+6,y-2);
lineto(x-1,y-2);
lineto(x+2,y-5);
lineto(x-1,y-5);
lineto(x-6,y);
lineto(x-1,y+5);
lineto(x+2,y+5);
lineto(x-1,y+2);
lineto(x+6,y+2);
lineto(x+6,y-2);
end;
Procedure tao;
var i:integer;
begin
for i:=1 to soo do a[i]:=random(4)+1;
end;
Procedure ve;
var i:integer;
begin
for i:=1 to soo do
case a[i] of
1:right(x+i*20,cao,1,8);
2:up(x+i*20,cao,1,8);
3:left(x+i*20,cao,1,8);
4:down(x+i*20,cao,1,8);
end;
end;
Procedure bat(i,j:integer);
begin
case i of
1:right(x+j*20,cao,0,2);
2:up(x+j*20,cao,0,2);
3:left(x+j*20,cao,0,2);
4:down(x+j*20,cao,0,2);
end;
end;
Procedure td(var i:integer;kt:boolean);
begin
if kt then
begin
bat(a[i],i);
inc(i);
exit;
end ;
ve;i:=1;
end;
Procedure hienbang;
var st:string;
begin
outtextxy(230,230,'Ket thuc');delay(2000);
cleardevice;
outtextxy(230,30,'Bang ket qua');
str(per,st);
outtextxy(130,50, 'Perfect : '+st);
str(gre,st);
outtextxy(130,70, 'Great : '+st);
str(coo,st);
outtextxy(130,90, 'Cool : '+st);
str(bad,st);
outtextxy(130,110,'Bad : '+st);
str(mis,st);
outtextxy(130,130,'Miss : '+st);
line (110,150,450,150);
str(tong,st);
outtextxy(130,170,'Tong diem : '+st);
readln;
halt;
end;
Procedure icon(x,y:integer;st:string;trangthai:integer);
var cd:integer;
begin
cd:=length(st)*4;
if trangthai=1 then
begin
setfillstyle(1,3);
bar(x-cd-3,y-12,x+cd+3,y+12);
setfillstyle(1,8);
bar(x-cd-3,y-12,x+cd+1,y+10);
end
else
begin
setfillstyle(1,3);
bar(x-cd-3,y-12,x+cd+3,y+12);
setfillstyle(1,8);
bar(x-cd-1,y-10,x+cd+3,y+12);
end;
if trangthai=0 then setfillstyle(1,15)else setfillstyle(1,7);
bar(x-cd-1,y-10,x+cd+1,y+10);
if trangthai=0 then setcolor(6) else setcolor(9);
outtextxy(x-(cd+25) div 2,y-3,st);
end;
Procedure nhan;
begin
setcolor(random(14)+1);
outtextxy(90,10,' .. .. .. .... .... .............. ... .. ');
outtextxy(90,20,' .... .. .. ..... .. .............. .... .. ');
outtextxy(90,30,'.. .. .. .. .. .. .. .. .. .. .. ');
outtextxy(90,40,'...... .. .. .. .. .. .. .. ..... .. .. .. ');
outtextxy(90,50,'...... .. .. .. .. .. .. .. .. .. .. .. .. ');
outtextxy(90,60,'.. .. ...... ..... .. .. .. .. .. .. .... ');
outtextxy(90,70,'.. .. .... .... .... .. .. ..... .. ... ');
end;
Procedure menu;
var i,t,j,j1,j2:integer;
begin j:=640; j1:=640;j2:=640;
setcolor(9);
outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*');
for i:=1 to 8 do icon(d[i],c[i],b[i],0);
i:=4;icon(d[i],c[i],b[i],1);
setfillstyle(1,2); bar(0,455,640,475);
repeat
setcolor(9); outtextxy(j,461,'Dang Bao Chung');
outtextxy(j2+440,461,'DT: 037.532.153');
outtextxy(j1+220,461,'11 Tin Lam Son');delay(20);
dec(j);dec(j1); dec(j2);
if j=0 then j:=640;
if j1=-220 then j1:=640-220;
if j2=-440 then j2:=640-440;
setfillstyle(1,2); bar(0,455,640,475);
if keypressed then
begin
ch:=readkey;
if ch in[#72,#80]then
begin
if ch=#72 then
begin
icon(d[i],c[i],b[i],0);
if i<=6 then
begin
dec(i);if i=0 then i:=6;
end else if i=7 then i:=8 else if i=8 then i:=7;
icon(d[i],c[i],b[i],1);
end
else
begin
icon(d[i],c[i],b[i],0);
if i<=6 then
begin
inc(i);if i=7 then i:=1;
end else if i=7 then i:=8 else if i=8 then i:=7;
icon(d[i],c[i],b[i],1);
end
end;
if (ch in[#77,#75])then
begin
if i<=6 then
begin
icon(d[i],c[i],b[i],0);
if _kt=0 then i:=7 else i:=8;
icon(d[i],c[i],b[i],1);
end
else
begin
icon(d[i],c[i],b[i],0);
i:=4;
icon(d[i],c[i],b[i],1);
end
end;
end;
if ch=#13 then
begin ch:='!';
if i=4 then
begin
gettime(_o1,_o2,_o3,_o4);
thoigian:=thoigian+(_o1-o1)*60*60+(_o2-o2)*60+_o3-o3;
cleardevice;
setbkcolor(0);
exit;
end
else
if i=6 then halt
else
if i=1 then
begin
repeat
cleardevice;
outtextxy(250,100,'Keyboard');
outtextxy(200,150,'Phim nhay len ');tren:=readkey;
outtextxy(200,170,'Phim nhay xuong');duoi:=readkey;
outtextxy(200,190,'Phim nhay trai ');trai:=readkey;
outtextxy(200,210,'Phim nhay phai ');phai:=readkey;
until (tren<>duoi)and(tren<>trai)and(tren<>phai)and(trai<>phai)
and(trai<>duoi)and(phai<>duoi);
ghifile;
setcolor(5);
outtextxy(200,280,'Nhan ENTER de ket thuc');
readln;
cleardevice;setcolor(9);
outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*');
icon(300,100,'AUDITION WRITELN BY DANG BAO CHUNG ',0);
for t:=2 to 8 do icon(d[t],c[t],b[t],0);
i:=1;icon(d[i],c[i],b[i],1);
end
else
if i=2 then
begin
cleardevice;
outtextxy(250,100,'Danh muc bai hat');
outtextxy(200,150,'Tuyet yeu thuong ');
outtextxy(200,170,'Aloha');
outtextxy(200,190,'Chinh em ');
outtextxy(200,210,'Toc hat ');
setcolor(5);
outtextxy(200,280,'Day chi la trang tri, sorry');
readln;
cleardevice;
icon(300,100,'AUDITION WRITELN BY DANG BAO CHUNG ',0);
for t:=1 to 8 do icon(d[t],c[t],b[t],0);
i:=2;icon(d[i],c[i],b[i],1);
setcolor(9);
outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*')
end
else
if i=3 then
begin
cleardevice;
outtextxy(250,100,'Thoi gian nhay'); p1:=0;g1:=0;
outtextxy(200,150,'Phut :');read(p1);
outtextxy(200,170,'Giay :');read(g1);
thoigian:=thoigian+(p1-p)*60+g1-g;
p:=p1;g:=g1;
ghifile;
readln;
cleardevice;setcolor(9);
outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*');
icon(300,100,'AUDITION WRITELN BY DANG BAO CHUNG ',0);
for t:=1 to 8 do icon(d[t],c[t],b[t],0);
i:=3;icon(d[i],c[i],b[i],1);
end
else
if i=5 then
begin
cleardevice;
outtextxy(250,100,'Toc do');
outtextxy(200,150,'Hay nhap toc do :');read(n);
tocdo:=3000 div n;
ghifile;
readln;
cleardevice;setcolor(9);
outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*');
icon(300,100,'AUDITION WRITELN BY DANG BAO CHUNG ',0);
for t:=1 to 8 do icon(d[t],c[t],b[t],0);
i:=5;icon(d[i],c[i],b[i],1);
end
else if i=7 then begin _kt:=1;ghifile;end
else if i=8 then begin _kt:=0;ghifile;end;
if i in[7,8]then
begin
setcolor(9);outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*');
setcolor(3);outtextxy(d[7+_kt]-55,c[7+_kt]-3,'*');
end;
end;
if ch=' 'then
begin
if i=7 then begin _kt:=1;ghifile;end
else if i=8 then begin _kt:=0;ghifile;end;
if i in[7,8]then
begin
setcolor(9);outtextxy(d[8-_kt]-55,c[8-_kt]-3,'*');
setcolor(3);outtextxy(d[7+_kt]-55,c[7+_kt]-3,'*');
end;
end;
until ch=#27;
end;
Procedure setup;
var ch:char;
begin
gettime(o1,o2,o3,o4);
cleardevice;
setbkcolor(3);
icon(300,100,'AUDITION WRITELN BY DANG BAO CHUNG ',0);
setcolor(9);
menu;
{repeat
if keypressed then ch:=readkey;
if ch=#27 then
begin
end;
until ch=#27;}
setbkcolor(0);
end;
Procedure choi;
var i,j:integer;st:string;_tg:longint; ch1:char;kt:boolean;
begin
i:=1;
repeat inc(tg);
str(soo,capdo);
setcolor(6);
outtextxy(180,370,'Cap do : '+capdo);
if tg mod 5=0 then nhan;
if tg=40 then begin setfillstyle(1,0);bar(10,200,300,300);end;
setfillstyle(1,8);
bar(170,270,270,280);
setcolor(7);
outtextxy(244,272,'o');
setcolor(3);
circle(k,275,5); inc(k);if k>265 then begin k:=175;inc(tg);end;
if k=262 then kt:=false;
delay(tocdo);
gettime(_o1,_o2,_o3,_o4);
tgian:=_o3+_o2*60+_o1*60*60;
_tg:=thoigian-tgian;
_o3:=_tg div 60; _o4:=_tg mod 60;
setfillstyle(1,0);bar(0,450,80,480);
str(_o3,st);outtextxy(10,450,st+': ');
str(_o4,st);outtextxy(33,450,st);
if tgian>=thoigian then hienbang;
if keypressed then
begin
ch1:=readkey;
if ch1=#61 then
begin
setup;
ve;
for j:=1 to i-1 do
case a[j] of
1:right(x+j*20,cao,0,2);
2:up(x+j*20,cao,0,2);
3:left(x+j*20,cao,0,2);
4:down(x+j*20,cao,0,2);
end;
end;
if ch1 in [#27,trai,' ',phai,tren,duoi]then
begin
ch:=ch1;
if ch=#27 then begin hienbang;readln;halt;end;
if (((a[i]=1)and(ch=phai))or((a[i]=2)and(ch=tren))or
((a[i]=3)and(ch=trai))or((a[i]=4)and(ch=duoi))) then
begin
bat(a[i],i);
inc(i);
end else
if (i<soo+1)and(ch<>' ') then
begin
ve;i:=1;
end else
if ((i<soo+1)and(ch=' '))or((ch=' ')and (i<>soo+1))or
((i=soo+1)and(ch=' ')and(not(k-20 in[210..240])))then
begin
kt:=false;
ve;i:=1;
setfillstyle(1,0);bar(10,250,300,300);
outtextxy(ghix,ghiy,'Miss'); tg:=0;
inc(mis);
bar(x,320,x+300,360);
soo:=soo-3;if soo<=0 then soo:=1;
x:=210-soo*9;tao;ve;
end else
if ch=' ' then
begin
inc(i);tg:=0;
setfillstyle(1,0);bar(10,10,300,300);setcolor(k);
if k-20 in[210..214] then
begin outtextxy(ghix,ghiy,'Bad');inc(bad);tong:=tong+10*soo;end else
if k-20 in[215..218] then
begin outtextxy(ghix,ghiy,'Cool');inc(coo);tong:=tong+20*soo end else
if k-20 in[219..224] then
begin outtextxy(ghix,ghiy,'Great');inc(gre);tong:=tong+30*soo end else
if k-20 in[225..226] then
begin outtextxy(ghix,ghiy,'Perfect');inc(per);tong:=tong+60*soo end else
if k-20 in[227..230] then
begin outtextxy(ghix,ghiy,'Great');inc(gre);tong:=tong+30*soo end else
if k-20 in[231..234] then
begin outtextxy(ghix,ghiy,'Cool');inc(coo);tong:=tong+20*soo end else
if k-20 in[235..239] then
begin outtextxy(ghix,ghiy,'Bad');inc(bad);tong:=tong+10*soo end;
kt:=true;
setcolor(0);
bar(180,365,660,380);
end;
end;
end;
if (k=261)and (not kt)and (_kt=1) then
begin
kt:=false;
ve;i:=1;
setfillstyle(1,0);bar(10,250,300,300);
outtextxy(ghix,ghiy,'Miss'); tg:=0;
inc(mis);
bar(x,320,x+300,360);
setcolor(0);
bar(180,365,660,380);
soo:=soo-3;if soo<=0 then soo:=1;
str(soo,capdo);
setcolor(6);
x:=210-soo*9;tao;ve;
outtextxy(180,370,'Cap do : '+capdo);
end;
until ((i=soo+2)or(ch=#27));
end;
Procedure xuli;
begin
randomize;
soo:=1; gettime(o1,o2,o3,o4);
thoigian:=o3+o2*60+o1*60*60+p*60+g;
repeat
x:=210-soo*9;
tao;
ve;
choi;
if ch=' ' then inc(soo);
if soo>10
then soo:=8;
setfillstyle(1,0);bar(x,320,x+300,360);
until (soo>10)or (ch=#27);
end;
begin
khoitao;
soo:=1;tg:=0;k:=175;tong:=0;
setbkcolor(3);
icon(300,100,'AUDITION WRITELN BY DANG BAO CHUNG ',0);
menu;
xuli;
closegraph;
end.
(nguồn từ manguon)