nongdantangai
18-02-2008, 13:38
Quà năm mới tặng fan Pascal:
Uses Crt,Dos,Graph;
Function Taochuot:Boolean;
Var Rg:Registers;
Begin
Rg.Ax:=0;Intr($33,Rg);
Taochuot:=Rg.Ax <> 0;
End;
Procedure Hienchuot;
Var Rg:Registers;
Begin
Rg.Ax:=1;Intr($33,Rg);
End;
Procedure Anchuot;
Var Rg:Registers;
Begin
Rg.Ax:=2;Intr($33,Rg);
End;
Procedure Chuottrai(Var x,y:Integer;Var Tr:Boolean);
Var Rg:Registers;
Begin
Rg.Ax:=3;Intr($33,Rg);x:=Rg.Cx;y:=Rg.Dx;
Tr:=(Rg.Bx and 1)>0;
End;
Procedure Chuotphai(Var x,y:Integer;Var Ph:Boolean);
Var Rg:Registers;
Begin
Rg.Ax:=3;Intr($33,Rg);x:=Rg.Cx;y:=Rg.Dx;
Ph:=(Rg.Bx And 2)>0;
End;
{*** Doi xau ki tu bieu dien so nguyen thanh so nguyen ***}
Function Gstr(St:String):LongINT;
Var t,i,tg:LongINT;
Begin
If Length(St)>10 Then Writeln(' So qua lon!') Else
Begin
t:=1;tg:=0;
For i:=Length(St) Downto 1 Do
Begin
Case St[i] Of
'0':Tg:=Tg+t*0;
'1':Tg:=Tg+t*1;
'2':Tg:=Tg+t*2;
'3':Tg:=Tg+t*3;
'4':Tg:=TG+t*4;
'5':Tg:=Tg+t*5;
'6':Tg:=Tg+t*6;
'7':Tg:=Tg+t*7;
'8':Tg:=Tg+t*8;
'9':Tg:=Tg+t*9;
'-':Tg:=-Tg;
End;t:=t*10;
End;Gstr:=tg;
End;
End;
{*** Doi so nguyen thanh xau ki tu bieu dien so nguyen ***}
Function Strg(n:Integer):String;
Var i,r,t:Integer;Tg:String;
Begin
r:=n;t:=1;Tg:='';
Repeat
i:=r Mod 10;
Case i Of
0:Tg:='0'+Tg;
1:Tg:='1'+Tg;
2:Tg:='2'+Tg;
3:Tg:='3'+Tg;
4:Tg:='4'+Tg;
5:Tg:='5'+Tg;
6:Tg:='6'+Tg;
7:Tg:='7'+Tg;
8:Tg:='8'+Tg;
9:Tg:='9'+Tg;
End;
r:=r Div 10;
Until r=0;
If n<0 Then Tg:='-'+Tg;
Strg:=Tg;
End;
{*** Dong ho con lac***}
Procedure Conlac(x,y:Integer;l,c,h:Word;g:Real);
Var a,b:Integer;
Begin
If Cos(g)<>0 Then
a:=Round(h*Sin(g)/Cos(g));
Setcolor(c);SetFillStyle(1,c);
Line(x+a,y+h,x+Round(l*Sin(g)),y+Round(l*Cos(g)));
PieSlice(x+Round(l*Sin(g)),y+Round(l*Cos(g)),0,360 ,l Div 30);
End;
Procedure Kimgiay(x,y,r:Integer;g:Real);
Begin
Setcolor(4);SetLineStyle(0,0,1);
Line(x,y,x+Round(r*Sin(g)),y+Round(r*Cos(g)));
End;
Procedure Kimphut(x,y,r:Integer;g:Real);
Begin
SetLineStyle(0,0,3);Setcolor(8);
Line(x,y,x+Round(r*Sin(g)),y+Round(r*Cos(g)));
End;
Procedure Kimgio(x,y,r:Integer;g:Real);
Begin
SetLineStyle(0,0,3);Setcolor(8);
Line(x,y,x+Round(r*Sin(g)),y+Round(r*Cos(g)));
End;
Procedure Vedongho;
Var x,y,a1,b1,a2,b2,i:Integer;g:Real;
Begin
Setcolor(8);Cleardevice;SetBkcolor(3);
x:=Getmaxx Div 2;y:=Getmaxy Div 3;
b1:=100;a1:=80;b2:=80;a2:=64;
SetFillStyle(1,8);PieSlice(x,y,0,360,3);
Setcolor(9);
Arc(x,y,0,360,b1);g:=Pi;SetFillStyle(9,10);
Arc(x,y,0,360,b2);FloodFill(x+b2+5,y,9);
SetTextjustify(1,1);
SetFillStyle(1,14);
For i:=1 To 12 Do
Begin
g:=g-Pi/6;Setcolor(4);
OutTextxy(x+Round(90*Sin(g)),y+Round(90*Cos(g)),St rg(i));
Setcolor(14);
PieSlice(x+Round(80*Sin(g)),y+Round(80*Cos(g)),0,3 60,2);
End;
Setcolor(9);
Ellipse(x,y+b2,0,360,a1+a2+a2 Div 2,b1+b2+b2 Div 2);
Ellipse(x,y+b2,0,360,a1+a2,b1+b2+b2 Div 2-1);
Ellipse(x,y+b2+20,164,376,a1+a2 Div 2,b1+b2);
Arc(x,y,205,335,120);
Ellipse(x,y+b2,210,330,2*a1+a2,b1+b2+b2 Div 2);
Line(x-a2-15,y+b1+b2-18,x+a2+15,y+b1+b2-18);
Ellipse(x,y+b1+b2-18,180,360,a2+15,b1+16);
Ellipse(x,y+b2,215,325,2*a1+2*a2,b1+b2+b2 Div 2);
Arc(x-a1-a2-a2 Div 2-2,y+b1+b2,25,210,19);
Arc(x+a1+a2+a2 Div 2+2,y+b1+b2,329,155,19);
FloodFill(x-a1-a2-a2 Div 2-2,y+b1+b2,9);
FloodFill(x+a1+a2+a2 Div 2+2,y+b1+b2,9);
Arc(x-a1-a2-a2 Div 2-39,y+b1+b2+18,25,210,22);
Arc(x+a1+a2+a2 Div 2+39,y+b1+b2+18,329,155,22);
SetFillStyle(1,2);
FloodFill(x-a1-a2-a2 Div 2-39,y+b1+b2+18,9);
FloodFill(x+a1+a2+a2 Div 2+39,y+b1+b2+18,9);
SetFillStyle(9,9);FloodFill(x+a1+a2,y,9);
FloodFill(x-a1-a2,y,9);
Line(10,y+b1+2*b2+b2 Div 2+2,630,y+b1+2*b2+b2 Div 2+2);
Arc(-1,375,270,365,86);Arc(640,375,175,270,86);
SetFillStyle(9,6);FloodFill(90,390,9);
SetFillStyle(9,12);FloodFill(x+110,y,9);
Setcolor(1);SetFillStyle(1,1);
PieSlice(x,y-120,0,360,10);
Setcolor(9);
Arc(x,y+a2 Div 2,253,288,2*b1+10);
FloodFill(x,y+a2 Div 2+2*b1+15,9);
SetTextStyle(0,0,2);Setcolor(15);
OutTextxy(x,y+a2 Div 2+2*b1+25,'Exit');
SetFillStyle(1,10);FloodFill(x,y+130,9);
SetFillStyle(6,5);Setcolor(9);
PieSlice(-1,-1,270,360,120);
PieSlice(640,-1,180,270,120);
SetFillStyle(1,13);FloodFill(3,200,9);
SetFillStyle(11,12);FloodFill(10,470,9);
SetFillStyle(1,8);FloodFill(x,y+170,9);
End;
Procedure Drgio(x,y,Gio,Phut,Giay,r:Integer);
Var g,g1:Real;
Begin
g:=Pi;g1:=Pi/30;Anchuot;
SetFillStyle(1,3);Setcolor(3);
PieSlice(x,y,0,360,r+2);
SetFillStyle(1,8);Setcolor(8);
PieSlice(x,y,0,360,3);
KimGio(x,y,4*r Div 7,g-Gio*5*g1-(Phut/3)*g1/4);
KimPhut(x,y,3*r Div 4,g-Phut*g1-(Giay/5)*g1/12);
KimGiay(x,y,r,g-Giay*g1);Hienchuot;
End;
Procedure Duarag(g,p,gi:Word);
Var S1,S2,S3:String;
Begin
S1:=Strg(g);If g<10 Then S1:='0'+S1;
S2:=Strg(p);If p<10 Then S2:='0'+S2;
S3:=Strg(gi);If gi<10 Then S3:='0'+S3;
Anchuot;SetFillStyle(1,15);
Bar(279,462,361,479);Setcolor(8);
Rectangle(279,462,361,479);
SetTextStyle(2,0,6);SetTextjustify(1,1);
OutTextxy(320,469,S1+':'+S2+':'+S3);Hienchuot;
End;
Procedure Dongho;
Var x,y,a,b,c,d,r,t:Integer;
Gio,Phut,Giay,Giay1,Mili:Word;
tr:Boolean;
Goc,Goc1,g,g1:Real;
Begin
Taochuot;Goc:=Pi/30;Goc1:=Pi;
a:=Getmaxx Div 2;b:=Getmaxy Div 3;
d:=b+163;t:=1;g:=-Pi/20;g1:=Pi/180;
Vedongho;Hienchuot;
c:=a-55;b:=b-55;r:=55;
Repeat
Giay1:=Giay;Chuottrai(x,y,tr);
GetTime(Gio,Phut,Giay,Mili);
If Giay1<>Giay Then
Begin
g:=-g;g1:=-g1;
Duarag(Gio,Phut,Giay);
Drgio(Getmaxx div 2,Getmaxy div 3,Gio,Phut,Giay,70);
End;
Conlac(Getmaxx Div 2,Getmaxy Div 3,220,3,163,
g+(Mili Div 5)*g1);Delay(100);
Conlac(Getmaxx Div 2,Getmaxy Div 3,220,8,163,
g+(Mili Div 5)*g1);
Until(y>400)And(y<440)And(x>280)And(x<360)And tr;
CloseGraph;
End;
Procedure Khoitao;
Var Gd,gm,er:Integer;
Begin
gd:=0;Initgraph(gd,gm,'');
er:=Graphresult;
If er<>0 Then
Begin
Writeln(' Loi do hoa,ma loi:',er);
Readln;Halt;
End;
End;
BEGIN
Khoitao;Dongho;
END.
Uses Crt,Dos,Graph;
Function Taochuot:Boolean;
Var Rg:Registers;
Begin
Rg.Ax:=0;Intr($33,Rg);
Taochuot:=Rg.Ax <> 0;
End;
Procedure Hienchuot;
Var Rg:Registers;
Begin
Rg.Ax:=1;Intr($33,Rg);
End;
Procedure Anchuot;
Var Rg:Registers;
Begin
Rg.Ax:=2;Intr($33,Rg);
End;
Procedure Chuottrai(Var x,y:Integer;Var Tr:Boolean);
Var Rg:Registers;
Begin
Rg.Ax:=3;Intr($33,Rg);x:=Rg.Cx;y:=Rg.Dx;
Tr:=(Rg.Bx and 1)>0;
End;
Procedure Chuotphai(Var x,y:Integer;Var Ph:Boolean);
Var Rg:Registers;
Begin
Rg.Ax:=3;Intr($33,Rg);x:=Rg.Cx;y:=Rg.Dx;
Ph:=(Rg.Bx And 2)>0;
End;
{*** Doi xau ki tu bieu dien so nguyen thanh so nguyen ***}
Function Gstr(St:String):LongINT;
Var t,i,tg:LongINT;
Begin
If Length(St)>10 Then Writeln(' So qua lon!') Else
Begin
t:=1;tg:=0;
For i:=Length(St) Downto 1 Do
Begin
Case St[i] Of
'0':Tg:=Tg+t*0;
'1':Tg:=Tg+t*1;
'2':Tg:=Tg+t*2;
'3':Tg:=Tg+t*3;
'4':Tg:=TG+t*4;
'5':Tg:=Tg+t*5;
'6':Tg:=Tg+t*6;
'7':Tg:=Tg+t*7;
'8':Tg:=Tg+t*8;
'9':Tg:=Tg+t*9;
'-':Tg:=-Tg;
End;t:=t*10;
End;Gstr:=tg;
End;
End;
{*** Doi so nguyen thanh xau ki tu bieu dien so nguyen ***}
Function Strg(n:Integer):String;
Var i,r,t:Integer;Tg:String;
Begin
r:=n;t:=1;Tg:='';
Repeat
i:=r Mod 10;
Case i Of
0:Tg:='0'+Tg;
1:Tg:='1'+Tg;
2:Tg:='2'+Tg;
3:Tg:='3'+Tg;
4:Tg:='4'+Tg;
5:Tg:='5'+Tg;
6:Tg:='6'+Tg;
7:Tg:='7'+Tg;
8:Tg:='8'+Tg;
9:Tg:='9'+Tg;
End;
r:=r Div 10;
Until r=0;
If n<0 Then Tg:='-'+Tg;
Strg:=Tg;
End;
{*** Dong ho con lac***}
Procedure Conlac(x,y:Integer;l,c,h:Word;g:Real);
Var a,b:Integer;
Begin
If Cos(g)<>0 Then
a:=Round(h*Sin(g)/Cos(g));
Setcolor(c);SetFillStyle(1,c);
Line(x+a,y+h,x+Round(l*Sin(g)),y+Round(l*Cos(g)));
PieSlice(x+Round(l*Sin(g)),y+Round(l*Cos(g)),0,360 ,l Div 30);
End;
Procedure Kimgiay(x,y,r:Integer;g:Real);
Begin
Setcolor(4);SetLineStyle(0,0,1);
Line(x,y,x+Round(r*Sin(g)),y+Round(r*Cos(g)));
End;
Procedure Kimphut(x,y,r:Integer;g:Real);
Begin
SetLineStyle(0,0,3);Setcolor(8);
Line(x,y,x+Round(r*Sin(g)),y+Round(r*Cos(g)));
End;
Procedure Kimgio(x,y,r:Integer;g:Real);
Begin
SetLineStyle(0,0,3);Setcolor(8);
Line(x,y,x+Round(r*Sin(g)),y+Round(r*Cos(g)));
End;
Procedure Vedongho;
Var x,y,a1,b1,a2,b2,i:Integer;g:Real;
Begin
Setcolor(8);Cleardevice;SetBkcolor(3);
x:=Getmaxx Div 2;y:=Getmaxy Div 3;
b1:=100;a1:=80;b2:=80;a2:=64;
SetFillStyle(1,8);PieSlice(x,y,0,360,3);
Setcolor(9);
Arc(x,y,0,360,b1);g:=Pi;SetFillStyle(9,10);
Arc(x,y,0,360,b2);FloodFill(x+b2+5,y,9);
SetTextjustify(1,1);
SetFillStyle(1,14);
For i:=1 To 12 Do
Begin
g:=g-Pi/6;Setcolor(4);
OutTextxy(x+Round(90*Sin(g)),y+Round(90*Cos(g)),St rg(i));
Setcolor(14);
PieSlice(x+Round(80*Sin(g)),y+Round(80*Cos(g)),0,3 60,2);
End;
Setcolor(9);
Ellipse(x,y+b2,0,360,a1+a2+a2 Div 2,b1+b2+b2 Div 2);
Ellipse(x,y+b2,0,360,a1+a2,b1+b2+b2 Div 2-1);
Ellipse(x,y+b2+20,164,376,a1+a2 Div 2,b1+b2);
Arc(x,y,205,335,120);
Ellipse(x,y+b2,210,330,2*a1+a2,b1+b2+b2 Div 2);
Line(x-a2-15,y+b1+b2-18,x+a2+15,y+b1+b2-18);
Ellipse(x,y+b1+b2-18,180,360,a2+15,b1+16);
Ellipse(x,y+b2,215,325,2*a1+2*a2,b1+b2+b2 Div 2);
Arc(x-a1-a2-a2 Div 2-2,y+b1+b2,25,210,19);
Arc(x+a1+a2+a2 Div 2+2,y+b1+b2,329,155,19);
FloodFill(x-a1-a2-a2 Div 2-2,y+b1+b2,9);
FloodFill(x+a1+a2+a2 Div 2+2,y+b1+b2,9);
Arc(x-a1-a2-a2 Div 2-39,y+b1+b2+18,25,210,22);
Arc(x+a1+a2+a2 Div 2+39,y+b1+b2+18,329,155,22);
SetFillStyle(1,2);
FloodFill(x-a1-a2-a2 Div 2-39,y+b1+b2+18,9);
FloodFill(x+a1+a2+a2 Div 2+39,y+b1+b2+18,9);
SetFillStyle(9,9);FloodFill(x+a1+a2,y,9);
FloodFill(x-a1-a2,y,9);
Line(10,y+b1+2*b2+b2 Div 2+2,630,y+b1+2*b2+b2 Div 2+2);
Arc(-1,375,270,365,86);Arc(640,375,175,270,86);
SetFillStyle(9,6);FloodFill(90,390,9);
SetFillStyle(9,12);FloodFill(x+110,y,9);
Setcolor(1);SetFillStyle(1,1);
PieSlice(x,y-120,0,360,10);
Setcolor(9);
Arc(x,y+a2 Div 2,253,288,2*b1+10);
FloodFill(x,y+a2 Div 2+2*b1+15,9);
SetTextStyle(0,0,2);Setcolor(15);
OutTextxy(x,y+a2 Div 2+2*b1+25,'Exit');
SetFillStyle(1,10);FloodFill(x,y+130,9);
SetFillStyle(6,5);Setcolor(9);
PieSlice(-1,-1,270,360,120);
PieSlice(640,-1,180,270,120);
SetFillStyle(1,13);FloodFill(3,200,9);
SetFillStyle(11,12);FloodFill(10,470,9);
SetFillStyle(1,8);FloodFill(x,y+170,9);
End;
Procedure Drgio(x,y,Gio,Phut,Giay,r:Integer);
Var g,g1:Real;
Begin
g:=Pi;g1:=Pi/30;Anchuot;
SetFillStyle(1,3);Setcolor(3);
PieSlice(x,y,0,360,r+2);
SetFillStyle(1,8);Setcolor(8);
PieSlice(x,y,0,360,3);
KimGio(x,y,4*r Div 7,g-Gio*5*g1-(Phut/3)*g1/4);
KimPhut(x,y,3*r Div 4,g-Phut*g1-(Giay/5)*g1/12);
KimGiay(x,y,r,g-Giay*g1);Hienchuot;
End;
Procedure Duarag(g,p,gi:Word);
Var S1,S2,S3:String;
Begin
S1:=Strg(g);If g<10 Then S1:='0'+S1;
S2:=Strg(p);If p<10 Then S2:='0'+S2;
S3:=Strg(gi);If gi<10 Then S3:='0'+S3;
Anchuot;SetFillStyle(1,15);
Bar(279,462,361,479);Setcolor(8);
Rectangle(279,462,361,479);
SetTextStyle(2,0,6);SetTextjustify(1,1);
OutTextxy(320,469,S1+':'+S2+':'+S3);Hienchuot;
End;
Procedure Dongho;
Var x,y,a,b,c,d,r,t:Integer;
Gio,Phut,Giay,Giay1,Mili:Word;
tr:Boolean;
Goc,Goc1,g,g1:Real;
Begin
Taochuot;Goc:=Pi/30;Goc1:=Pi;
a:=Getmaxx Div 2;b:=Getmaxy Div 3;
d:=b+163;t:=1;g:=-Pi/20;g1:=Pi/180;
Vedongho;Hienchuot;
c:=a-55;b:=b-55;r:=55;
Repeat
Giay1:=Giay;Chuottrai(x,y,tr);
GetTime(Gio,Phut,Giay,Mili);
If Giay1<>Giay Then
Begin
g:=-g;g1:=-g1;
Duarag(Gio,Phut,Giay);
Drgio(Getmaxx div 2,Getmaxy div 3,Gio,Phut,Giay,70);
End;
Conlac(Getmaxx Div 2,Getmaxy Div 3,220,3,163,
g+(Mili Div 5)*g1);Delay(100);
Conlac(Getmaxx Div 2,Getmaxy Div 3,220,8,163,
g+(Mili Div 5)*g1);
Until(y>400)And(y<440)And(x>280)And(x<360)And tr;
CloseGraph;
End;
Procedure Khoitao;
Var Gd,gm,er:Integer;
Begin
gd:=0;Initgraph(gd,gm,'');
er:=Graphresult;
If er<>0 Then
Begin
Writeln(' Loi do hoa,ma loi:',er);
Readln;Halt;
End;
End;
BEGIN
Khoitao;Dongho;
END.