1 Bài toán tháp Hà Nội Fri Jul 02, 2010 8:41 pm
chipcoiga
Admin
Ai Thích Thì Chạy Thử Nhé!
--
https://a2vdo.forum.st/
program thaphanoi;
Uses crt, dos, tienich, videoram, cursor;
type coc=1..3;
hotkey = set of char;
Const Xcot:array[coc]of byte =(17,41,65);
kitu=#220; SpeedMenu=200;
Max=11; Speed_hieu_ung=30;
MinSpeed=3; MaxSpeed=200; StepSpeed=3;
Tencoc:array[coc]of char = ( '1' , '2' , '3' );
Var i,j:integer;
DK : array[coc, 0..max] of byte;
docao : array[coc]of byte;
timedelay, Ycot, maudia, sodia : integer;
tucot ,toicot : coc;
gio, phut, giay, per, sec : word;
time : integer;
Y_thongbao, nhap_gi : byte;
hangmenu, dongho, chay_menu : string;
st_nhap, st_hdn : string;
so_nhap : integer;
{st_dieukhien st_huongdannhap }
BamPhim, ch : char;
pos_menu, solan :word;
Dung, tamdung, co_nhap, nguoidung, restart:boolean;
dieukhien, dk_thoat : boolean;
{************** Khoi tao gia tri ban dau *****************}
Procedure gan_gia_tri;
Begin solan:=0; timedelay:=MinSpeed*10;
maudia:=5; sodia:=5;
Ycot:=11+sodia; tamdung:=false; dung:=false; restart:=false;
gettime(gio,phut,giay,per); sec:=giay;
co_nhap:=false; dieukhien:=false; nhap_gi:=0; nguoidung:=false;
Y_thongbao:=Ycot-sodia-2;
hangmenu:=' '+'Phim tat: (B)at dau, (D)ung, (T)am dung, (N)hanh hon,'
+'(C)ham hon, Chon so (L)uong dia, Chon (M)au dia, (R)estart,'
+' Tu cha(y), Dieu (k)hien, Nguoi Dun(g) Di Chuyen ' ;
chay_menu:=copy(hangmenu,1,72);
pos_menu:=length(chay_menu)+1;
End;
procedure in_dia(c:coc); Forward; {khai bao thu tuc nay truoc viet lenh sau}
procedure chaydongho; Forward;
{ Phan Giao Dien }
procedure hienthi;
var i,j,k,l:byte;
Begin
i:=39; j:=41; k:=12; l:=12; tcl(9);tbg(1);
repeat
tonen(i,j,k,l,trang);
i:=i-3; j:=j+3;
k:=k-1; l:=l+1;
if k<=1 then k:=1;
if l>=25 then l:=25;
delay(speed_hieu_ung);
until (i<1)or(j>80)or (keypressed);
tonen(1,80,1,25,trang);
End;
procedure hangtren_hangduoi;
const TenThu:array[0..6]of string[12]= (' Chu nhat',' Thu hai',
' Thu ba',' Thu tu',' Thu nam',' Thu sau',' Thu bay');
Function chu(so:word):string;
var s:string;
begin
str(so,s); chu:=s;
end;
Var nam,thang,ngay,thu:word;
st,hd:string;
i:byte;
Begin getdate(nam,thang,ngay,thu);
st:=TenThu[thu]+', ngay '+chu(ngay)+' thang '+chu(thang)+' nam '+chu(nam);
for i:=length(st) to 80 do st:=st+' ';
hd:=' TG: Pham Thanh Binh - Khoa CNTT - DHCT ';
tbg(4);tonen(1,2,1,25,trang); tonen(1,80,1,1,trang);
tonen(79,80,1,25,trang); tonen(1,80,25,25,trang);
tcl(15);
for i:=1 to 78 do
begin
gotoxy(i,1);write(st[i]);
gotoxy(78-i,25);write(hd[78-i]);
delay(speed_hieu_ung div 5);
end;
chaydongho;
End;
procedure gioithieu;
Begin
tcl(10); tbg(1);
gotoxy(30,2);write('TRO CHOI THAP HA NOI');
tcl(7);
gotoxy(4,3);write('Noi dung : Chuyen n dia tu cot ',tencoc[1],' sang cot ',tencoc[2],' dung cot ',tencoc[3],
' lam cot trung gian');
gotoxy(4,4);write('Theo qui tac : - Moi lan chi chuyen 1 dia va la dia tren cung');
gotoxy(4,5);write(' - Dia lon luon nam duoi dia nho');
end;
Procedure khong_gian_dia;
var i:byte;
Begin i:=6; tbg(0);
repeat tonen(i-1,i,Ycot-sodia-4,Ycot+1,trang);
delay(speed_hieu_ung div 2); i:=i+2;
until i>76;
tcl(15); kengang(5,76,Ycot+1,don);{ke 1 duong ngang 1 net}
For i:=1 to 3 do
Begin gotoxy(Xcot[i]-2,Ycot+1);write('Cot ',tencoc[i]); end;{ghi ten 3 cot}
End;
procedure batdau;
Begin
hienthi; hangtren_hangduoi; gioithieu; khong_gian_dia;
end;
{ Het phan giao dien }
{***************** Thoat chuong trinh *****************}
Procedure thoat;
var ch:char;
i:byte;
Begin
inputscr(scr);
tonen(20,60,8,12,trang+nen7+mau15);
kekhung(20,60,8,12,kep+nen7+mau15);
setcl(22,62,13,13,; setcl(61,62,9,13,;
tbg(7);tcl(15);
td(25,10);write('Ban muon thoat chuong trinh. (Y/N)');
normalcursor;
repeat ch:=upcase(readkey); until ch in ['Y','N',#27];
if ch='Y' then
begin
tbg(0);tcl(7);
For i:=1 to 24 do
begin
td(1,i);
writeln('':80);
delay(speed_hieu_ung);
end;
cls; halt;
end;
hidecursor; outputscr(scr);
end;
{ *********** Xu li nhap *****************}
Procedure nhap;
Begin
If bamphim in ['0'..'9'] then
begin
if length(st_nhap)>=2 then delete(St_nhap,1,1);
st_nhap:=st_nhap + bamphim;
tbg(0);tcl(7); gotoxy(5, Y_thongbao-1);
write(st_hdn,st_nhap:2);
end;
if bamphim=#8 then
begin
if length(st_nhap)>=1 then delete(st_nhap,length(st_nhap),1);
tbg(0);tcl(7); gotoxy(5,Y_thongbao-1); write(st_hdn,st_nhap:2);
end;
End;
{ *********** Tao & write string gio:phut: giay *************}
procedure chaydongho;
var st,st1,st3:string[2];
begin
str(phut,st); if length(st)<2 then st :='0'+st;
str(giay,st1);if length(st1)<2 then st1:='0'+st1;
str(gio,st3); if length(st3)<2 then st3:='0'+st3;
textcolor(15); tbg(4);
gotoxy(71,1);write(st3,':',st,':',st1,' ');
end;
{************ Hien dong trang thai ***************************}
Procedure Dongtrangthai;
Begin
gotoxy(5,Ycot+2);tbg(1);tcl(7);
write('Dia:',sodia:2,' - Mau:',maudia:2,' - Toc do:',Timedelay:4);
write(' - So lan di chuyen:',solan:4,' - Dieu khien:',dieukhien:5);
End;
{************** Xu li menu **************************}
Procedure Xulimenu(bamphim:char);
Begin
Restart:=false;
if bamphim='T' then
begin
if tamdung then tamdung:=false else tamdung:=true;
if tamdung then
begin
gotoxy(35,Y_thongbao); tcl(9); tbg(0);
write('Bam phim T de hoat dong tiep');
end
else
begin
gotoxy(35,Y_thongbao); tcl(9); tbg(0);
write(' ');
end;
end;
if bamphim=#27 then
begin
if (co_nhap)and(nhap_gi<>3) then
begin co_nhap:=false; st_nhap:='';
if dieukhien then
begin nhap_gi:=3;co_nhap:=true;end
else
begin
tbg(0);tcl(maudia); gotoxy(5,Y_thongbao-1); write('':72);
end;
end else thoat;
end;
If tamdung=false then
Begin
Case bamphim of
'B': if dung then begin dung:=false; dk_thoat:=true; end;
'N': Begin timedelay:=timedelay-StepSpeed;{nhanh hon}
If timedelay End;
'C': Begin timedelay:=timedelay+StepSpeed; {cham hon}
If TimeDelay>MaxSpeed then TimeDelay:=MaxSpeed;
End;
'L','M','K': begin co_nhap:=true; st_nhap:='';
tbg(0);tcl(maudia); gotoxy(5,Y_thongbao-1); write('':72);
case bamphim of
'L': nhap_gi:=1; {nhap so luong }
'M': nhap_gi:=2; { nhap mau }
'K': begin dieukhien:=true; nhap_gi:=3; end;
{ nhap tucot -> toicot }
end;
end;
'G': begin
nguoidung:=true;
dung:=true;
dieukhien:=true;
end;
'Y': begin
dieukhien:=false; co_nhap:=false;
tbg(0);tcl(maudia); gotoxy(5,Y_thongbao-1); write('':72);
if nguoidung then
begin
nguoidung:=False; dung:=true;
end;
end;
'R':begin restart:=true; dung:=true; end;
#13: begin
val(st_nhap, so_nhap ,i); co_nhap:=false; st_nhap:='';
case nhap_gi of
1: begin
if (so_nhap in[1..11])and(so_nhap<>sodia)then
begin dk_thoat:=true;
dung:=true;
sodia:=so_nhap;
Ycot:=11+sodia; Y_thongbao:=Ycot-sodia-2;
batdau; solan:=0;
gotoxy(35,Y_thongbao);
tbg(0);tcl(10);write('Bam phim B de bat dau chay');
end;
end;
2: if so_nhap in[1..15]then
begin
maudia:=so_nhap;
setcl( 5, 75, Ycot-sodia-1, Ycot,maudia);
end;
3: if dieukhien then co_nhap:=true;
end; {of CASE}
if dieukhien or nguoidung then
begin
co_nhap:=true; nhap_gi:=3;
end;
if co_nhap=False then
begin
tbg(0);tcl(maudia); gotoxy(5,Y_thongbao-1); write('':72);
end;
dongtrangthai;
end;{of #13}
end; {case bamphim}
if co_nhap then
begin
case nhap_gi of
1:st_hdn:='Nhap so luong dia (1 - 11) : N = ';
2:st_hdn:='Nhap mau dia (1 - 15) : ';
3:st_hdn:='Di chuyen dia :(vi du tu cot 1 den cot 2 nhap vao la 12) : ';
else st_hdn:='';
end;
tbg(0);tcl(7); gotoxy(5,Y_thongbao-1); write(st_hdn,st_nhap:2);
nhap;
end;
End;{ if tamdung=false}
if bamphim='D' then dung:=true;
End;
{*************** Xu li toc do chay chuong trinh ************}
Procedure trangthaicho;
Begin
time:=time+1; delay(1); if time>1000 then time:=1;
gettime(gio,phut,giay,per);
If sec<>giay then {chay dong ho}
begin
sec:=giay; chaydongho;
end;
If time mod SpeedMenu =0 then { chay menu }
begin
chay_menu:=chay_menu + hangmenu[pos_menu];
delete(chay_menu,1,1);
if pos_menu>=length(hangmenu)then pos_menu:=1 else inc(pos_menu);
gotoxy(5,Y_thongbao-2);tbg(0);tcl(15);write(chay_menu);
end;
End;
{**************** Thu tuc lam cham tac dung giong Delay ***************}
Procedure lamcham(timedelay:integer; Bo_chuc_nang:hotkey);
Begin
dk_thoat:=false;
repeat
repeat trangthaicho; until keypressed or (time mod timedelay =0 );
bamphim:=#0;
if keypressed then
begin
bamphim:=upcase(readkey);
If not(bamphim in Bo_chuc_nang)then xulimenu(bamphim);
dongtrangthai;
end;
until ( (time mod timedelay=0)or dk_thoat or(dieukhien and(time mod timedelay=0))
) and (tamdung=false)or dung;
End;
{*********************************************************************}
Procedure In_dia(c:coc);
var i,j,x,y:byte;
Begin
For i:=1 to 3 do
For J:=0 to sodia do dk[i,j]:=0;
Ycot:=11+sodia;
tbg(0);tcl(maudia);
tonen(5,75,Ycot-sodia-2,Ycot,trang);
For i:=1 to sodia do
begin delay(Speed_hieu_ung);
gotoxy( Xcot[c] - ((2*i+1)div 2) , Ycot-sodia+i);
For j:=1 to 2*i+1 do write(kitu);
dk[c,sodia-i+1]:=2*i+1;
end;
for i:=1 to 3 do docao[i]:=0;
docao[c]:=sodia;
End;
{*************** Thu tuc in hoac xoa 1 dia tai toa do X,Y**************}
Procedure hien(c: coc ; X,Y: byte; kitu:char);
Var i:byte;
Begin tcl(maudia);tbg(0);
gotoxy( X - (DK[ c,docao[c] ]div 2) , Y );
For i:=1 to dk[c,docao[c]] do write(kitu);
End;
{*************** Phan Di Chuyen Dia ******************}
Procedure len( C ,c2 : coc);
Var i,j,y:byte;
Begin
y:=Ycot - sodia - 1; {Y la hang tren cung can di chuyen len}
i:=Ycot-docao[c];
hien(c ,Xcot[c],i+1 , ' '); {Xoa dia tren cot}
For j:=i downto y do
begin
hien(c,Xcot[c],j,kitu); lamcham(TimeDelay,[]); hien(c, Xcot[c],j, ' ');
if dung then exit;
end;
End;
Procedure xuong( c2,C : coc);
Var i,y1,y2:byte;
Begin
y1:=Ycot - sodia - 1;{y1 la hang tren (hang bat dau)}
y2:=Ycot-docao[c]; {y2 la hang duoi}
For i:=y1 to y2 do
begin
hien(c2,Xcot[c],i,kitu); lamcham(TimeDelay,[]); hien(c2,Xcot[c], i, ' ');
if dung then exit;
end;
hien(c2,Xcot[c],i,kitu);
End;
Procedure Xoa(X,Y:byte);
Var I:byte;
Begin gotoxy(X,Y); tbg(0); write(' '); End;
Procedure Phai(c1,c2: coc);
Var i,y:byte;
Begin
y:=Ycot - sodia - 1;
Xoa(Xcot[c1]-(dk[c1,docao[c1]]div 2),y);
i:=Xcot[c1];
Repeat
i:=i+2;
hien(c1,i,y,kitu);
lamcham(TimeDelay,[]);
Xoa(i-(dk[c1,docao[c1]]div 2),y);
if dung then exit;
until i>=Xcot[c2];
hien(c1,Xcot[c2],y,kitu);
End;
Procedure Trai(c1,c2: coc);
Var i,y:byte;
Begin
y:=Ycot - sodia - 1;
i:=Xcot[c1];
Repeat
hien(c1,i,y,kitu);
lamcham(TimeDelay,[]);
Xoa(i+(dk[c1,docao[c1]]div 2)-1,y);
i:=i-2;
if dung then exit;
until i<=Xcot[c2];
hien(c1,Xcot[c2],y,kitu);
End;
{**************** Het Phan Di Chuyen Dia ******************}
Procedure DICHCHUYEN(Ndia:byte; cot1,cot2,cot3:coc);
Begin
if dung then exit;
If ndia=1 then
Begin
if dieukhien then
Begin
tbg(0);tcl(7);td(5,Y_thongbao-1);
write('Di chuyen dia :(vi du tu cot 1 den cot 2 nhap vao la 12) : ');
repeat
repeat trangthaicho; Until keypressed;
if keypressed then bamphim:=upcase(readkey);
if (bamphim=#13)and(nhap_gi=3)and(length(st_nhap)>=2) then
begin val(st_nhap[1],tucot,i);
val(St_nhap[2],toicot,i);
gotoxy(25,Y_thongbao);tbg(0);tcl(1);write(' ');
{xoa dong chu di chuyen sai}
if (tucot<>cot1)or(toicot<>cot2)then
begin
gotoxy(25,Y_thongbao);tbg(0);tcl(10);
write('Ban di chuyen sai');
end;
end;
xulimenu(bamphim); dongtrangthai;
until (bamphim='Y')or( (tucot=cot1)and(toicot=cot2)and(bamphim=#13) )
or (dieukhien=false)or dung;
tbg(0);tcl(7);td(5,Y_thongbao-1); write('':70);
{Xoa cau nhap dia}
if dung then exit;
End;{Dieukhien}
inc(solan);
len(cot1,cot2);
if cot2>cot1 then phai(cot1,cot2)else trai(cot1,cot2);
lamcham(TimeDelay,[]); lamcham(TimeDelay,[]);
xuong(cot1,cot2);
inc(docao[cot2]); {tang do cao cot toi}
DK[cot2,docao[cot2]]:=DK[cot1,docao[cot1]];
dk[cot1,docao[cot1]]:=0;
dec(docao[cot1]);
dongtrangthai;
end {n=1}
Else
Begin
DICHCHUYEN(Ndia-1, cot1, cot3, cot2);
DICHCHUYEN(1 , cot1, cot2, cot3);
DICHCHUYEN(Ndia-1, cot3, cot2, cot1);
End;
End;
Procedure NguoiDungDiChuyen;
var hople:boolean;
Begin
Repeat
If dung then exit;
tbg(0);tcl(7);td(5,Ycot-sodia-3);
write('Di chuyen dia :(vi du tu cot 1 den cot 2 nhap vao la 12) : ');
gotoxy(30,Ycot-sodia-2);tbg(0); tcl(10);
write(' ');
Repeat
hople:=false;
Repeat
trangthaicho;
If keypressed then
Begin
bamphim:=upcase(readkey);
If bamphim in ['L','M','Y','R','D',#27,#13,#8,'0'..'9'] then
Begin
if (bamphim=#13)and(nhap_gi=3)and(length(st_nhap)>=2) then
Begin
val(st_nhap[1],tucot,i);
val(St_nhap[2],toicot,i);
if (tucot<>toicot)and(docao[tucot]>0)
and ( (DK[ toicot,docao[toicot] ] > dk[ tucot,docao[tucot] ])
and(docao[toicot]>0)
)
then hople:=true;
gotoxy(30,Ycot-sodia-2);tbg(0); tcl(10);
write(' ');
If not hople then
begin
gotoxy(30,Ycot-sodia-2);tbg(0); tcl(10);
write('Di chuyen khong hop le');
end;
End;
xulimenu(bamphim);
dongtrangthai;
End;
End;{keypressed}
Until hople or dung or dk_thoat or (bamphim in['Y']);
gotoxy(30,Ycot-sodia-2);tbg(0); tcl(10);
write(' ');
if dung then exit;
dk_thoat:=false;
Until hople;
inc(solan);
len(tucot,toicot);
if tucot>toicot then trai(tucot,toicot)else phai(tucot,toicot);
lamcham(TimeDelay,[]); lamcham(TimeDelay,[]);
xuong(tucot,toicot);
inc(docao[toicot]);
DK[toicot,docao[toicot]]:=DK[tucot,docao[tucot]];
dk[tucot,docao[tucot]]:=0;
dec(docao[tucot]);
dongtrangthai;
Until dung or (bamphim in ['Y']);
End;
{ Chuong trinh chinh }
Begin
textmode(co80);clrscr; delay(1500); hidecursor;
gan_gia_tri;
batdau; tcl(5);
Repeat
dongtrangthai; dung:=false; in_dia(1);
If (not restart)and(not dieukhien)and(not nguoidung) then
Begin
gotoxy(35,Ycot-sodia + sodia div 2);
tbg(0);tcl(10);write('Bam phim B de bat dau chay');
Repeat
trangthaicho;
if keypressed then
begin
bamphim:=upcase(readkey);
if bamphim in['M','G','L','N','C','K','Y',#27,'0'..'9',#13,#8]then
xulimenu(bamphim);
dongtrangthai;
end;
until (bamphim in['B','K','G'])or(dung) ;
gotoxy(35,Ycot-sodia + sodia div 2);
tbg(0);tcl(10);write(' ');
{Xoa cau bam phim B}
End;
restart:=false;
If nguoidung then nguoidungdichuyen else Dichchuyen(sodia,1,2,3);
solan:=0;
if not dung then
begin
gotoxy(25,Ycot-sodia-1 );
tbg(0);tcl(10);write('Di chuyen xong bam phim bat ky de chay lai');
repeat trangthaicho; until keypressed;
if keypressed then ch:=readkey;
if ch=#27 then thoat;
gotoxy(25,Ycot-sodia -1);
tbg(0);tcl(10);write(' ');
tbg(0);tcl(maudia); gotoxy(5,Ycot-sodia-3); write(' ':72);
end;
Until False;
End.
--
https://a2vdo.forum.st/