Program plne pracuje s hodinami počítača

{ STOPKY.PAS                                   Copyright (c) Pishta }
{ Program plne pracuje s hodinami pocitaca. Umoznuje nasledovne     }
{ operacie: Hodiny, Stopky, Ulozenie casov                          }
{ Pre ulozene casy pouziva disk konkretne adresar c:\casy           }
{                                                                   }
{ Datum:23.04.2008                             http://www.trsek.com }
 
PROGRAM HODINY_A_STOPKY;
USES GRAPH,CRT;
TYPE CASF=RECORD
      CAS_MENO:STRING;
      END;
     CASYF=FILE OF CASF;
 
TYPE
POLE1=ARRAY[0..59] OF INTEGER;
POLE2=ARRAY[0..59] OF INTEGER;
POLE3=ARRAY[0..59] OF INTEGER;
POLE4=ARRAY[0..59] OF INTEGER;
POLE_STOPKY=ARRAY[0..59] OF STRING;
 
VAR GD,GM:INTEGER;
    P1:POLE1; P2:POLE2; P3:POLE3; P4:POLE4; P_S:POLE_STOPKY;
    S,M,H,A,B,C:INTEGER;
    ME:CHAR;
    CAS:CASF;
    CASY:CASYF;
 
PROCEDURE INICIALIZACIA;
BEGIN
DETECTGRAPH(GD,GM);
INITGRAPH(GD,GM,'');
END;
 
PROCEDURE BODY_SEKUNDY(VAR P1F:POLE1;VAR P2F:POLE2;VAR P3F:POLE3;VAR P4F:POLE4;VAR P_SF:POLE_STOPKY);
VAR U2:REAL;
    I,U:INTEGER;
    J:STRING;
BEGIN
U:=-6;
FOR I:=0 TO 59 DO
 BEGIN
  U:=U+6;
  U2:=U; U2:=(U2/180)*(22/7);
  P1F[I]:=TRUNC(SIN(U2)*194)+512;
  P2F[I]:=384-TRUNC(COS(U2)*194);
  P3F[I]:=TRUNC(SIN(U2)*170)+512;
  P4F[I]:=384-TRUNC(COS(U2)*170);
  STR(I,J);
  IF I<10 THEN INSERT('0',J,1);
  P_SF[I]:=J;
 END;
END;
 
PROCEDURE UVOD;
BEGIN
SETTEXTSTYLE(0,0,3); SETCOLOR(10);
OUTTEXTXY(330,350,'HODINY A STOPKY');
SETTEXTSTYLE(0,0,1);
SETCOLOR(14); OUTTEXTXY(833,695,'Copyright by');
SETCOLOR(12); OUTTEXTXY(935,695,' Pishta');
REPEAT
SETCOLOR(0);
OUTTEXTXY(390,390,'Prepnite sa do textoveho okna!');
TEXTCOLOR(0);GOTOXY(21,14);WRITELN('Pokracujte stlacenim lubovolneho klavesu');
DELAY(500);
SETCOLOR(11);
OUTTEXTXY(390,390,'Prepnite sa do textoveho okna!');
TEXTCOLOR(10);GOTOXY(21,14);WRITELN('Pokracujte stlacenim lubovolneho klavesu');
DELAY(500);
TEXTCOLOR(14); GOTOXY(32,12);WRITELN('Copyright by ');
TEXTCOLOR(12); GOTOXY(44,12);WRITELN(' Pishta');
UNTIL KEYPRESSED;
CLRSCR; CLEARDEVICE;
READKEY;
END;
 
PROCEDURE MENU;
BEGIN
GOTOXY(40,8); TEXTCOLOR(10); WRITE('MENU');
GOTOXY(32,9); TEXTCOLOR(14); WRITE('--------------------');
GOTOXY(39,11); TEXTCOLOR(12); WRITE('H');TEXTCOLOR(15); GOTOXY(40,11); WRITE('odiny');
GOTOXY(39,13); TEXTCOLOR(12); WRITE('S'); TEXTCOLOR(15); GOTOXY(40,13);  WRITE('topky');
GOTOXY(36,15); TEXTCOLOR(12); WRITE('U'); TEXTCOLOR(15); GOTOXY(37,15); WRITE('lozene casy');
GOTOXY(39,17); TEXTCOLOR(12); WRITE('K'); TEXTCOLOR(15); GOTOXY(40,17); WRITE('oniec');
GOTOXY(32,18); TEXTCOLOR(14); WRITE('--------------------');
GOTOXY(32,20); TEXTCOLOR(10); WRITE('ZADAJ SVOJU VOLBU: ');
GOTOXY(51,20); TEXTCOLOR(12); READLN(ME);
END;
 
PROCEDURE CIFERNIK(P1F:POLE1; P2F:POLE2; P3F:POLE3; P4F:POLE4);
VAR I:INTEGER;
BEGIN
FOR I:=0 TO 59 DO
 BEGIN
 SETCOLOR(14); SETLINESTYLE(0,0,1); SETTEXTSTYLE(0,0,1); SETFILLSTYLE(1,12);
  PUTPIXEL(P1F[I],P2F[I],11);
  IF I=5 THEN BEGIN FILLELLIPSE(P1F[I],P2F[I],3,3); SETCOLOR(4); OUTTEXTXY(P3F[I],P4F[I],'1'); END;
  IF I=10 THEN BEGIN FILLELLIPSE(P1F[I],P2F[I],3,3); SETCOLOR(4); OUTTEXTXY(P3F[I],P4F[I],'2'); END;
  IF I=15 THEN BEGIN FILLELLIPSE(P1F[I],P2F[I],5,5); SETCOLOR(4); OUTTEXTXY(P3F[I],P4F[I]-3,'3'); END;
  IF I=20 THEN BEGIN FILLELLIPSE(P1F[I],P2F[I],3,3); SETCOLOR(4); OUTTEXTXY(P3F[I],P4F[I],'4'); END;
  IF I=25 THEN BEGIN FILLELLIPSE(P1F[I],P2F[I],3,3); SETCOLOR(4); OUTTEXTXY(P3F[I],P4F[I],'5'); END;
  IF I=30 THEN BEGIN FILLELLIPSE(P1F[I],P2F[I],5,5); SETCOLOR(4); OUTTEXTXY(P3F[I]-3,P4F[I],'6'); END;
  IF I=35 THEN BEGIN FILLELLIPSE(P1F[I],P2F[I],3,3); SETCOLOR(4); OUTTEXTXY(P3F[I]-3,P4F[I],'7'); END;
  IF I=40 THEN BEGIN FILLELLIPSE(P1F[I],P2F[I],3,3); SETCOLOR(4); OUTTEXTXY(P3F[I]-3,P4F[I],'8'); END;
  IF I=45 THEN BEGIN FILLELLIPSE(P1F[I],P2F[I],5,5); SETCOLOR(4); OUTTEXTXY(P3F[I]-3,P4F[I]-3,'9'); END;
  IF I=50 THEN BEGIN FILLELLIPSE(P1F[I],P2F[I],3,3); SETCOLOR(4); OUTTEXTXY(P3F[I]-3,P4F[I],'10'); END;
  IF I=55 THEN BEGIN FILLELLIPSE(P1F[I],P2F[I],3,3); SETCOLOR(4); OUTTEXTXY(P3F[I]-3,P4F[I],'11'); END;
  IF I=0 THEN BEGIN FILLELLIPSE(P1F[I],P2F[I],5,5); SETCOLOR(4); OUTTEXTXY(P3F[I]-7,P4F[I]-5,'12'); END;
 END;
 {STRED A OKOLO} FILLELLIPSE(512,384,10,10);
END;
 
PROCEDURE RUCICKY(P1F:POLE1; P2F:POLE2; P3F:POLE3; P4F:POLE4);
BEGIN
{SEKUNDOVA}
 SETLINESTYLE(0,0,1);
 MOVETO(512,384); SETCOLOR(11); LINETO(P1F[S],P2F[S]);
 DELAY(1000);
 MOVETO(512,384); SETCOLOR(0); LINETO(P1F[S],P2F[S]);
{HODINOVA}
 SETLINESTYLE(0,0,3);
 MOVETO(512,384); SETCOLOR(2); LINETO(P3F[H],P4F[H]);
 MOVETO(512,384); SETCOLOR(0); LINETO(P3F[H-1],P4F[H-1]);
 {MINUTOVA}
 SETLINESTYLE(0,0,3);
 MOVETO(512,384); SETCOLOR(2); LINETO(P1F[M],P2F[M]);
 MOVETO(512,384); SETCOLOR(0); LINETO(P1F[M-1],P2F[M-1]);
 {HODINOVA ABY JU MINUTOVA NEPREKRYVALA}
 SETLINESTYLE(0,0,3);
 MOVETO(512,384); SETCOLOR(2); LINETO(P3F[H],P4F[H]);
END;
 
PROCEDURE OTAZKA_A_POHYB;
BEGIN
GOTOXY(32,9);TEXTCOLOR(14);WRITE('KOLKO JE HODIN: '); TEXTCOLOR(10);READ(A);
GOTOXY(32,11);TEXTCOLOR(14);WRITE('KOLKO JE MINUT: '); TEXTCOLOR(10);READ(B); CLRSCR;
M:=B;
IF (A=1) OR (A=13) THEN C:=5; IF (A=2) OR (A=14) THEN C:=10; IF (A=3) OR (A=15) THEN C:=15;
IF (A=4) OR (A=16) THEN C:=20; IF (A=5) OR (A=17) THEN C:=25; IF (A=6) OR (A=18) THEN C:=30;
IF (A=7) OR (A=19) THEN C:=35; IF (A=8) OR (A=20) THEN C:=40; IF (A=9) OR (A=21) THEN C:=45;
IF (A=10) OR (A=22) THEN C:=50; IF (A=11) OR (A=23) THEN C:=55; IF (A=12) OR (A=0) THEN C:=0;
{POSUNUTIE HODINOVEJ RUCICKY}
IF M<12 THEN H:=C;
IF (M>=12) AND (M<24) THEN H:=C+1;
IF (M>=24) AND (M<36) THEN H:=C+2;
IF (M>=36) AND (M<48) THEN H:=C+3;
IF (M>=48) THEN H:=C+4;
REPEAT
BEGIN
FOR S:=0 TO 59 DO
 BEGIN
  RUCICKY(P1,P2,P3,P4);
  CIFERNIK(P1,P2,P3,P4);
  IF S=58 THEN
   BEGIN
     M:=M+1;
      IF M=12 THEN H:=H+1;
      IF M=24 THEN H:=H+1;
      IF M=36 THEN H:=H+1;
      IF M=48 THEN H:=H+1;
      IF M=60 THEN BEGIN  H:=H+1; M:=0;  END;
      IF (M=0) AND (H=60) THEN H:=0;
      {VYMAZANIE RUCICIEK PRED DVANASTKOU}
      IF M=0 THEN BEGIN SETLINESTYLE(0,0,3); SETCOLOR(0); MOVETO(512,384); LINETO(P1[59],P2[59]);
                                                          MOVETO(512,384); LINETO(P3[59],P4[59]); END;
   END;
 END;
END;
UNTIL S=69;
END;
 
PROCEDURE STOPKY(P_SF:POLE_STOPKY);
VAR
  S,M,H,ST:INTEGER;
  E:CHAR;
  MENO:STRING;
BEGIN
RESET(CASY);
WHILE NOT EOF(CASY) DO READ(CASY,CAS); {ZABRANI PREPISU CASOV}
TEXTCOLOR(10); GOTOXY(33,12); WRITE('ZADAJ MENO: ');    {VASE MENO}
TEXTCOLOR(15);  READ(MENO); CLRSCR;
{MENU}TEXTCOLOR(10);
 GOTOXY(35,12);WRITELN('Start:');
 GOTOXY(35,13);WRITELN('Stop:');
 GOTOXY(35,14);WRITELN('Uloz:');
 GOTOXY(35,15);WRITELN('Vynuluj:');
 TEXTCOLOR(14); GOTOXY(30,16);WRITELN('--------------------');
 TEXTCOLOR(12); GOTOXY(35,17);WRITELN('Koniec:');
 TEXTCOLOR(11);
 GOTOXY(44,12);WRITELN('1');
 GOTOXY(44,13);WRITELN('2');
 GOTOXY(44,14);WRITELN('3');
 GOTOXY(44,15);WRITELN('0');
 GOTOXY(44,17);WRITELN('K');
{MENU} TEXTCOLOR(14); GOTOXY(30,18);WRITELN('--------------------');
 SETTEXTSTYLE(0,0,10); S:=0;M:=0;H:=0;ST:=0;
 SETCOLOR(11); OUTTEXTXY(545,320,':');
 SETCOLOR(11); OUTTEXTXY(345,320,':');
 SETCOLOR(3); OUTTEXTXY(600,320,P_SF[S]);
 SETCOLOR(3); OUTTEXTXY(400,320,P_SF[M]);
 SETCOLOR(3); OUTTEXTXY(200,320,P_SF[H]);
 {STOTINY}
 SETTEXTSTYLE(0,0,5);SETCOLOR(3); OUTTEXTXY(760,355,P_SF[ST]);
REPEAT  BEGIN
 IF KEYPRESSED THEN BEGIN
 E:=READKEY;
 SETTEXTSTYLE(0,0,5);SETCOLOR(3); OUTTEXTXY(760,355,P_SF[ST]);{STOTINY A SEKUNDY-ABY ICH NEVYMAZALO ZASTAVENIE STOPIEK}
 SETTEXTSTYLE(0,0,10);SETCOLOR(3); OUTTEXTXY(600,320,P_SF[S]);
 END;
 CASE E OF
 '1':
 BEGIN
 SETTEXTSTYLE(0,0,10);SETCOLOR(3); OUTTEXTXY(600,320,P_SF[S]);
 SETTEXTSTYLE(0,0,10);SETCOLOR(3); OUTTEXTXY(400,320,P_SF[M]);
 SETTEXTSTYLE(0,0,10);SETCOLOR(3); OUTTEXTXY(200,320,P_SF[H]);
     SETTEXTSTYLE(0,0,10);SETCOLOR(0); OUTTEXTXY(545,320,':');
     SETTEXTSTYLE(0,0,10);SETCOLOR(0); OUTTEXTXY(345,320,':');
          {STOTINY}
          SETTEXTSTYLE(0,0,5);SETCOLOR(3); OUTTEXTXY(760,355,P_SF[ST]);
          DELAY(100);
          SETTEXTSTYLE(0,0,5);SETCOLOR(0); OUTTEXTXY(760,355,P_SF[ST]);
          {STOTINY}
     SETTEXTSTYLE(0,0,10);SETCOLOR(11); OUTTEXTXY(545,320,':');
     SETTEXTSTYLE(0,0,10);SETCOLOR(11); OUTTEXTXY(345,320,':');
  ST:=ST+1;
 IF ST=9 THEN BEGIN ST:=0;
 SETTEXTSTYLE(0,0,10);SETCOLOR(0); OUTTEXTXY(600,320,P_SF[S]);
 S:=S+1;
 SETTEXTSTYLE(0,0,10);SETCOLOR(3); OUTTEXTXY(600,320,P_SF[S]); END;
 IF S=59 THEN BEGIN
 SETTEXTSTYLE(0,0,10);SETCOLOR(0); OUTTEXTXY(600,320,P_SF[S]); S:=0; {VYNULOVANIE SEKUND}
 SETTEXTSTYLE(0,0,10);SETCOLOR(0); OUTTEXTXY(400,320,P_SF[M]);
 M:=M+1;
 SETTEXTSTYLE(0,0,10);SETCOLOR(3); OUTTEXTXY(400,320,P_SF[M]); END;
 IF M=59 THEN BEGIN
 SETTEXTSTYLE(0,0,10);SETCOLOR(0); OUTTEXTXY(400,320,P_SF[M]); M:=0; {VYNULOVANIE MINUT}
 SETTEXTSTYLE(0,0,10);SETCOLOR(0); OUTTEXTXY(200,320,P_SF[H]);
 H:=H+1;
 SETTEXTSTYLE(0,0,10);SETCOLOR(3); OUTTEXTXY(200,320,P_SF[H]); END;
 END;
 '2': BEGIN {ZASTAVENIE} END;
 '3': BEGIN
 CAS.CAS_MENO:=CONCAT(MENO,'   ',P_SF[H],':',P_SF[M],':',P_SF[S],':',P_SF[ST]);
 END;
 '0': BEGIN
    SETTEXTSTYLE(0,0,10);SETCOLOR(0); OUTTEXTXY(600,320,P_SF[S]); S:=0; SETCOLOR(3); OUTTEXTXY(600,320,P_SF[S]);
    SETTEXTSTYLE(0,0,10);SETCOLOR(0); OUTTEXTXY(400,320,P_SF[M]); M:=0; SETCOLOR(3); OUTTEXTXY(400,320,P_SF[M]);
    SETTEXTSTYLE(0,0,10);SETCOLOR(0); OUTTEXTXY(200,320,P_SF[H]); H:=0; SETCOLOR(3); OUTTEXTXY(200,320,P_SF[H]);
 END; END;
 END; UNTIL E='K';
CLRSCR; CLEARDEVICE; WRITE(CASY,CAS); CLOSE(CASY);  {ULOZENIE DO SUBORU A JEHO ZATOVERNE}
END;
 
PROCEDURE ULOZENE;
VAR X:INTEGER;
BEGIN
X:=0;
RESET(CASY);
WHILE NOT EOF(CASY) DO
BEGIN
X:=X+1;
READ(CASY,CAS);
TEXTCOLOR(10);
WRITELN(CAS.CAS_MENO);
TEXTCOLOR(14);
WRITELN('-------------------');
END;
IF X=0 THEN BEGIN
GOTOXY(23,12);
TEXTCOLOR(14); WRITE('V SUBORE SA NENACHADZAJU ZIADNE CASY!');
END;
CLOSE(CASY);
READKEY;
CLRSCR;
END;
 
PROCEDURE KONIEC;
BEGIN
TEXTCOLOR(14); GOTOXY(32,12);WRITELN('Copyright by ');
TEXTCOLOR(12); GOTOXY(44,12);WRITELN(' Pishta');
TEXTCOLOR(14);GOTOXY(37,14);WRITELN('Dovidenia');
END;
 
BEGIN
ASSIGN(CASY, 'C:\CASY');
INICIALIZACIA;
BODY_SEKUNDY(P1,P2,P3,P4,P_S);
UVOD;
MENU;
 
IF (ME='H') OR  (ME='h') THEN BEGIN
CLRSCR; CLEARDEVICE;
CIFERNIK(P1,P2,P3,P4);
OTAZKA_A_POHYB;
END;
 
IF (ME='S') OR  (ME='s') THEN BEGIN
CLRSCR; CLEARDEVICE;
STOPKY(P_S);
KONIEC;
DELAY(3000);
EXIT;
END;
 
IF (ME='U') OR  (ME='u') THEN BEGIN
CLRSCR; CLEARDEVICE;
ULOZENE;
KONIEC;
DELAY(3000);
EXIT;
END;
 
IF (ME='K') OR  (ME='k') THEN BEGIN
CLRSCR; CLEARDEVICE;
KONIEC;
DELAY(3000);
EXIT;
END;
REPEAT UNTIL KEYPRESSED;
END.