Free pascal 游戏,要.pas程序
2个回答
展开全部
Program Clock;
{$THREADING ON}
{$APPTYPE GUI}
Uses Graph, Dos, WinCrt;
Var
H,M,S,S100 : Word;
HH,MM,SS,SS100 : Word;
Y,Mt,D,W : Word;
Gd, Gm : SmallInt;
Function CatchKey(P : Pointer) : Longint;
Begin
While True Do
If ReadKey=#27 Then
Halt(0);
End;
Procedure Date;
Var
St,C : String;
Begin
SetTextStyle(DefaultFont,0,6);
SetColor(White);
GetDate(Y,Mt,D,W);
Str(Y,C);
St:=C+'-';
Str(Mt,C);
If Length(C)=1 Then
St:=St+'0'+C
Else
St:=St+C;
Str(D,C);
If Length(C)=1 Then
St:=St+'-0'+C
Else
St:=St+'-'+C;
OutTextXY(90,30,St);
Case W Of
0 : St:='Sun.';
1 : St:='Mon.';
2 : St:='Tue.';
3 : St:='Wed.';
4 : St:='Thu.';
5 : St:='Fri.';
6 : St:='Sat.';
End;
OutTextXY(230,410,St);
SetColor(Green);
End;
Procedure Cls;
Begin
SetFillStyle(SolidFill, Black);
Bar(100,100,540,380);
SetFillStyle(SolidFill, White);
Bar(120,120,520,360);
SetColor(Black);
Line(290,120,290,360);
Line(350,120,350,360);
SetColor(Green);
OutTextXY(290,200,':');
End;
Procedure ClsH;
Begin
SetFillStyle(SolidFill, White);
Bar(120,120,289,360);
End;
Procedure ClsM;
Begin
SetFillStyle(SolidFill, White);
Bar(351,120,520,360);
End;
Procedure Init;
Var
St,C : String;
Begin
BeginThread(@CatchKey);
SetFillStyle(SolidFill, Green);
FloodFill(0,0,640);
SetTextStyle(DefaultFont,0,10);
Cls;
Date;
SetTextStyle(DefaultFont,0,10);
GetTime(HH,MM,SS,SS100);
Str(HH,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(130,200,St);
Str(MM,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(360,200,St);
SetColor(Black);
Line(120,160,290,160);
Line(120,320,290,320);
Line(350,160,520,160);
Line(350,320,520,320);
SetColor(Green);
End;
Procedure Clock;
Var
St,C : String;
Begin
GetTime(H,M,S,S100);
If M<>MM Then
Begin
ClsM;
Str(MM,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(360,130,St);
Str(M,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(360,280,St);
SetColor(Black);
Line(350,240,520,240);
SetColor(Green);
Delay(1000);
ClsM;
Str(M,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(360,200,St);
SetColor(Black);
Line(350,160,520,160);
Line(350,320,520,320);
SetColor(Green);
End;
If H<>HH Then
Begin
ClsH;
Str(HH,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(130,130,St);
Str(H,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(130,280,St);
SetColor(Black);
Line(120,240,290,240);
SetColor(Green);
Delay(1000);
ClsH;
Str(H,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(130,200,St);
SetColor(Black);
Line(120,160,290,160);
Line(120,320,290,320);
SetColor(Green);
End;
HH:=H;
MM:=M;
SS:=S;
SS100:=S100;
End;
Begin
Gd := d8bit;
Gm := m640x480;
InitGraph(Gd, Gm, '');
Init;
While True Do
Clock;
CloseGraph;
End.
{$THREADING ON}
{$APPTYPE GUI}
Uses Graph, Dos, WinCrt;
Var
H,M,S,S100 : Word;
HH,MM,SS,SS100 : Word;
Y,Mt,D,W : Word;
Gd, Gm : SmallInt;
Function CatchKey(P : Pointer) : Longint;
Begin
While True Do
If ReadKey=#27 Then
Halt(0);
End;
Procedure Date;
Var
St,C : String;
Begin
SetTextStyle(DefaultFont,0,6);
SetColor(White);
GetDate(Y,Mt,D,W);
Str(Y,C);
St:=C+'-';
Str(Mt,C);
If Length(C)=1 Then
St:=St+'0'+C
Else
St:=St+C;
Str(D,C);
If Length(C)=1 Then
St:=St+'-0'+C
Else
St:=St+'-'+C;
OutTextXY(90,30,St);
Case W Of
0 : St:='Sun.';
1 : St:='Mon.';
2 : St:='Tue.';
3 : St:='Wed.';
4 : St:='Thu.';
5 : St:='Fri.';
6 : St:='Sat.';
End;
OutTextXY(230,410,St);
SetColor(Green);
End;
Procedure Cls;
Begin
SetFillStyle(SolidFill, Black);
Bar(100,100,540,380);
SetFillStyle(SolidFill, White);
Bar(120,120,520,360);
SetColor(Black);
Line(290,120,290,360);
Line(350,120,350,360);
SetColor(Green);
OutTextXY(290,200,':');
End;
Procedure ClsH;
Begin
SetFillStyle(SolidFill, White);
Bar(120,120,289,360);
End;
Procedure ClsM;
Begin
SetFillStyle(SolidFill, White);
Bar(351,120,520,360);
End;
Procedure Init;
Var
St,C : String;
Begin
BeginThread(@CatchKey);
SetFillStyle(SolidFill, Green);
FloodFill(0,0,640);
SetTextStyle(DefaultFont,0,10);
Cls;
Date;
SetTextStyle(DefaultFont,0,10);
GetTime(HH,MM,SS,SS100);
Str(HH,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(130,200,St);
Str(MM,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(360,200,St);
SetColor(Black);
Line(120,160,290,160);
Line(120,320,290,320);
Line(350,160,520,160);
Line(350,320,520,320);
SetColor(Green);
End;
Procedure Clock;
Var
St,C : String;
Begin
GetTime(H,M,S,S100);
If M<>MM Then
Begin
ClsM;
Str(MM,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(360,130,St);
Str(M,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(360,280,St);
SetColor(Black);
Line(350,240,520,240);
SetColor(Green);
Delay(1000);
ClsM;
Str(M,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(360,200,St);
SetColor(Black);
Line(350,160,520,160);
Line(350,320,520,320);
SetColor(Green);
End;
If H<>HH Then
Begin
ClsH;
Str(HH,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(130,130,St);
Str(H,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(130,280,St);
SetColor(Black);
Line(120,240,290,240);
SetColor(Green);
Delay(1000);
ClsH;
Str(H,C);
If Length(C)=1 Then
St:='0'+C
Else
St:=C;
OutTextXY(130,200,St);
SetColor(Black);
Line(120,160,290,160);
Line(120,320,290,320);
SetColor(Green);
End;
HH:=H;
MM:=M;
SS:=S;
SS100:=S100;
End;
Begin
Gd := d8bit;
Gm := m640x480;
InitGraph(Gd, Gm, '');
Init;
While True Do
Clock;
CloseGraph;
End.
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询