Írjunk grafikus analóg órát megjelenítő programot. Mutassa a másodperceket,
napokat, legyen digitális része is, és másodpercenként „ketyegő” hangot adjon.
Program Rolex;
Uses NewDelay, Crt, CrtPlus, Graph, Dos;
Type Datum= Record
Ev, Ho, Nap, NapNev: Word;
End;
Ido= Record
Ora,
Perc, MPerc, SzMPerc: Word;
End;
Var RDatum, UDatum: Datum;
RIdo, UIdo: Ido;
Ws, S: String;
Xm, Ym, Xk, Yk:
Integer;
Var Start: Boolean;
Procedure GrInit(Gi: Integer);
Var Gd, Gm: Integer;
Begin
DetectGraph(Gd, Gm);
Gm:= Gi;
InitGraph(Gd,Gm,'C:\Tp\Bgi');
Xm:= GetMaxX; Ym:= GetMaxY;
Xk:= Xm Div 2; Yk:=
Ym Div 2;
End;
Procedure Kep;
Var I:
Integer;
Begin
SetRGBPalette(0,20,40,63); {Világoskék}
SetFillStyle(1,0); Bar(0,0,Xm,Ym);
SetRGBPalette(1,0,0,0); {Fekete}
SetColor(1);
SetLineStyle(0,0,2);
Circle(Xk,Yk,Yk-2);
Line(Xk - Yk,
Round(0.44*Ym),Xk - Yk, Round(0.56*Ym));
Line(Xk + Yk,
Round(0.44*Ym),Xk + Yk, Round(0.56*Ym));
Line(Xk - Round(0.42*Ym),
0, Xk - Yk, Round(0.44*Ym));
Line(Xk + Round(0.42*Ym),
0, Xk + Yk, Round(0.44*Ym));
Line(Xk - Round(0.42*Ym),
Ym, Xk - Yk, Round(0.56*Ym));
Line(Xk + Round(0.42*Ym),
Ym, Xk + Yk, Round(0.56*Ym));
Line(Xk - Round(0.42*Ym),
0, Xk + Round(0.42*Ym), 0);
Line(Xk - Round(0.42*Ym),
Ym, Xk + Round(0.42*Ym), Ym);
SetLineStyle(0,0,1);
Circle(Xk, Yk,
Round(0.44*Ym));
Circle(Xk, Yk,
Round(0.42*Ym));
SetRGBPalette(2,63,48,0); {Óarany}
SetColor(2);
SetFillStyle(1,2);
FloodFill(Xk - Round(0.45*Ym),
Yk, 1);
SetRGBPalette(3,63,63,0); {Citromsárga}
SetColor(3);
SetFillStyle(1,3);
FloodFill(Xk - Round(0.43*Ym),
Yk, 1);
SetRGBPalette(4,0,0,30); {Sötétkék}
SetColor(4);
SetFillStyle(1,4);
FloodFill(Xk, Yk,
1);
SetRGBPalette(5,63,63,63); {Fehér}
SetColor(5);
Circle(Xk, Yk,
Round(0.4*Ym));
SetRGBPalette(7,55,55,55); {Világosszürke}
SetColor(7);
SetFillStyle(1,7);
FloodFill(Xk - Round(0.41*Ym),
3, 1);
SetColor(3);
SetLineStyle(0,0,1);
For I:= 1 To 180 Do
Line(Xk + Round(0.44*(Ym+2)*Cos(2*i*pi/180)),
Yk + Round(0.44*(Ym+2)*Sin(2*i*pi/180)),
Xk + Round(0.50*(Ym-8)*Cos(2*i*pi/180)),
Yk + Round(0.50*(Ym-8)*Sin(2*i*pi/180)));
SetColor(5);
SetLineStyle(0,0,1);
For I:= 1 To 60 Do
Line(Xk + Round(0.40*(Ym+3)*Cos(6*i*pi/180)),
Yk + Round(0.40*(Ym+3)*Sin(6*i*pi/180)),
Xk + Round(0.42*(Ym-3)*Cos(6*i*pi/180)),
Yk + Round(0.42*(Ym-3)*Sin(6*i*pi/180)));
SetLineStyle(0,0,3);
For I:= 1 To 12 Do
Line(Xk + Round(0.33*(Ym+3)*Cos(30*i*pi/180)),
Yk + Round(0.33*(Ym+3)*Sin(30*i*pi/180)),
Xk + Round(0.40*(Ym-3)*Cos(30*i*pi/180)),
Yk + Round(0.40*(Ym-3)*Sin(30*i*pi/180)));
SetColor(1);
SetLineStyle(0,0,3);
Line(Round(0.65*Xm), Round(0.45*Ym), Round(0.65*Xm), Round(0.55*Ym));
Line(Round(0.75*Xm), Round(0.45*Ym), Round(0.75*Xm), Round(0.55*Ym));
Ellipse(Round(0.7*Xm),Round(0.535*Ym),60,120,Round(0.1*Xm),Round(0.1*Ym));
Ellipse(Round(0.7*Xm),Round(0.465*Ym),240,300,Round(0.1*Xm),Round(0.1*Ym));
SetFillStyle(1,0);
FloodFill(Round(0.7*Xm), Yk,1);
SetColor(5); {Szövegek}
SetTextStyle(0,0,3);
OutTextXY(Round(0.41*Xm), Round(0.33*Ym), 'ROLEX');
SetTextStyle(0,0,1);
OutTextXY(Round(0.445*Xm), Round(0.40*Ym), 'IC-QUARTZ');
OutTextXY(Round(0.36*Xm), Round(0.66*Ym), 'Created by Turbo-Pascal');
OutTextXY(Round(0.408*Xm), Round(0.70*Ym), 'GM Software Inc.');
SetLineStyle(0,0,1); SetColor(2); Circle(Xk, Yk,
Round(0.01*Ym));
{Nap}
SetColor(1);
Str(UDatum.Nap,ws);
If Length(Ws)=1 Then Ws:='0'+Ws;
SetTextStyle(0,0,4); OutTextXY(Round(0.65*Xm),Round(0.475*Ym), Ws);
End;
Procedure Ora;
Begin
RDatum:=UDatum; With UDatum Do GetDate(Ev, Ho,
Nap, NapNev);
RIdo:=UIdo; With UIdo Do GetTime(Ora, Perc, MPerc,
SzMPerc);
If UIdo.MPerc<>RIdo.MPerc
Then With UIdo Do
Begin
SetColor(6);
If Not
Start Then {Analóg}
With RIdo Do
Begin
SetLineStyle(0,0,1);
Line(Xk - Round(0.06*Ym*Sin(MPerc*6*Pi/180)),
Yk + Round(0.06*Ym*Cos(MPerc*6*Pi/180)),
Xk + Round(0.40*Ym*Sin(MPerc*6*Pi/180)),
Yk - Round(0.40*Ym*Cos(MPerc*6*Pi/180)));
SetLineStyle(0,0,3);
Line(Xk, Yk,
Xk + Round(0.32*Ym*Sin((Perc*6+MPerc/10)*Pi/180)),
Yk
- Round(0.32*Ym*Cos((Perc*6+MPerc/10)*Pi/180)));
SetLineStyle(0,0,3);
Line(Xk, Yk,
Xk + Round(0.24*Ym*Sin((Ora*30+Perc/2)*Pi/180)),
Yk
- Round(0.24*Ym*Cos((Ora*30+Perc/2)*Pi/180)));
End
Else Start:= False;
With UIdo Do
Begin
SetLineStyle(0,0,1);
Line(Xk - Round(0.06*Ym*Sin(MPerc*6*Pi/180)),
Yk + Round(0.06*Ym*Cos(MPerc*6*Pi/180)),
Xk + Round(0.40*Ym*Sin(MPerc*6*Pi/180)),
Yk - Round(0.40*Ym*Cos(MPerc*6*Pi/180)));
SetLineStyle(0,0,3);
Line(Xk ,Yk,
Xk + Round(0.32*Ym*Sin((Perc*6+MPerc/10)*Pi/180)),
Yk
- Round(0.32*Ym*Cos((Perc*6+MPerc/10)*Pi/180)));
SetLineStyle(0,0,3);
Line(Xk, Yk,
Xk + Round(0.24*Ym*Sin((Ora*30+Perc/2)*Pi/180)),
Yk
- Round(0.24*Ym*Cos((Ora*30+Perc/2)*Pi/180)));
SetFillStyle(0,1);
Bar(Round(0.66*Xm), Round(0.474*Ym),
Round(0.73*Xm), Round(0.52*Ym));
SetColor(1);
Str(UDatum.Nap,ws);
If Length(Ws)=1 Then Ws:='0'+Ws;
SetTextStyle(0,0,4);
OutTextXY(Round(0.65*Xm),Round(0.475*Ym), Ws);
End;
{Digitális}
S:=''; Str(Ora,
Ws); If Ora<10 Then Ws:='0'+Ws; S:=Ws+':';
Str(Perc, Ws); If Perc<10 Then Ws:='0'+Ws;
S:=S+WS+':';
Str(MPerc, WS); If MPerc<10 Then Ws:='0'+Ws;
S:=S+WS;
SetColor(0);
Bar(Round(0.39*Xm), Round(0.74*Ym), Round(0.61*Xm), Round(0.79*Ym));
Setcolor(4); SetTextStyle(0,0,2);
OutTextXY(Round(0.403*Xm),Round(0.75*Ym), S);
SetColor(6); Sound(6000);delay(5);Nosound;
End;
End;
Begin
With UDatum Do GetDate(Ev,
Ho, Nap, NapNev);
With UIdo Do GetTime(Ora,
Perc, MPerc, SzMPerc);
GrInit(2);
Kep; SetWriteMode(XORPut);Start:= True;
Repeat Ora Until Keypressed;
End.
