Í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.