home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 05 / tricks / uhr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-27  |  8.3 KB  |  334 lines
  1. (* ------------------------------------------------------ *)
  2. (*                       UHR.PAS                          *)
  3. (*           Analoguhr in Turbo-Pascal 4.0                *)
  4. (*          (c) 1989 Michael Thom  & TOOLBOX              *)
  5. (* ------------------------------------------------------ *)
  6. {$R+,S+,I+,D+,F+,V+,B+,N-,L+ }
  7. {$M 16384,0,24576 }
  8.  
  9. UNIT Uhr;
  10.  
  11. INTERFACE USES Crt, Dos, Graph;
  12.  
  13. PROCEDURE _Uhr;
  14. PROCEDURE NotAus;
  15.  
  16. IMPLEMENTATION
  17.  
  18. CONST
  19.   Radius               =  80;
  20.   RadiusZurueckZeigerS = -6;
  21.   RadiusZurueckZeigerM = -10;
  22.   RadiusZurueckZeigerH = -8;
  23.   BreiteZeigerM        =  14;
  24.   BreiteZeigerH        =  16;
  25.  
  26. VAR
  27.   Original,  Grafik    : POINTER;
  28.   ch                   : CHAR;
  29.   WinkelZeigerS,
  30.   WinkelZeigerM,
  31.   WinkelZeigerH,
  32.   MitteX, MitteY,
  33.   Gr, Mo, std, min     : INTEGER;
  34.   Std1, Min1,
  35.   Sek1, Hun1,
  36.   Std2, Min2,
  37.   sek2, hun2,
  38.   AspX, AspY, gross    : WORD;
  39.   Zaehler              : REAL;
  40.   AlarmGesetzt         : BOOLEAN;
  41.  
  42. {$F+}
  43. Procedure CgaDriver; EXTERNAL;
  44. {$L CGA.OBJ}
  45. {$F-}
  46.  
  47. PROCEDURE Fehler;
  48. BEGIN
  49.   WriteLn('Es ist ein Fehler aufgetreten: ', GraphResult);
  50.   Halt(0);
  51. END;
  52.  
  53. PROCEDURE Adressermittlung;
  54. BEGIN
  55.   IF RegisterBGIdriver(Addr(CgaDriver)) < 0 THEN Fehler;
  56. END;
  57.  
  58. PROCEDURE ZaehleZeitZu;
  59. BEGIN
  60.   IF std1 > 24 THEN Std1 := Std1 - 24;
  61.   Inc(Sek1);
  62.   IF Sek1 > 59 THEN BEGIN
  63.     Inc(Min1);
  64.     Sek1 := 0;
  65.     IF Min1 > 59 THEN BEGIN
  66.       Inc(Std1);
  67.       Min1 := 0;
  68.     END;
  69.   END;
  70. END;
  71.  
  72. {$F+}
  73. PROCEDURE Verzweigung; INTERRUPT;
  74. BEGIN
  75.   Zaehler := Zaehler + 1.000033333;
  76.                       { Zeitausgleich für Bearbeitungszeit }
  77. END;
  78. {$F-}
  79.  
  80. {$F+}
  81. PROCEDURE ZeitVergleich; INTERRUPT;
  82. VAR  i : INTEGER;
  83. BEGIN
  84.   IF Zaehler > 18.2 THEN BEGIN
  85.     ZaehleZeitZu;
  86.     Zaehler := Zaehler - 18.2;
  87.   END;
  88.   IF (std2 = std1) AND (min2 = min1) THEN BEGIN
  89.     GotoXY(50,1);
  90.     Write('Die Alarmzeit ist erreicht !!!');
  91.     SetIntVec($1c, Original);
  92.     FOR i := 1 TO 4 DO BEGIN
  93.       Sound(440); Delay(100);
  94.       Sound(880); Delay(100);
  95.     END;
  96.     NoSound;
  97.   END;
  98.   Zaehler := Zaehler + 1.000033333;
  99. END;
  100. {$F-}
  101.  
  102. FUNCTION Rad(Grad : INTEGER) : REAL;
  103. BEGIN
  104.   Rad := Grad * PI / 180;
  105. END;
  106.  
  107. PROCEDURE ZeigerPunkt(VAR x1,   y1     : INTEGER;
  108.                           Grad, Radius : INTEGER);
  109. BEGIN
  110.   x1 := Round(MitteX + (Radius/AspX*AspY)*
  111.                                          COS(RAD(Grad-90)));
  112.   y1 := Round(MitteY + Radius*SIN(RAD(Grad-90)));
  113. END;
  114.  
  115. PROCEDURE UhrenRahmen;
  116. VAR i, x1, y1, x2, y2 : INTEGER;
  117. BEGIN
  118.   ClearViewPort;
  119.   SetLineStyle(SolidLn, 0, ThickWidth);
  120.   FOR i := 1 TO 60 DO BEGIN
  121.     ZeigerPunkt(x1, y1, i*6, Radius + 3);
  122.     ZeigerPunkt(x2, y2, i*6, Radius - 3);
  123.     Line(x1, y1, x2, y2);
  124.   END;
  125.   FOR i := 0 TO 11 DO BEGIN
  126.     ZeigerPunkt(x1, y1, i*30, Radius - 3);
  127.     ZeigerPunkt(x2, y2, i*30, Radius - 13);
  128.     Line(x1, y1, x2, y2);
  129.   END;
  130.   OutTextXY( 15, 10, 'T O O L B O X');
  131.   OutTextXY(450, 10, 'A n a l o g u h r');
  132.   OutTextXY( 15,175, 'F 1 = SystemZeit setzen');
  133.   OutTextXY( 15,185, 'F 2 = AlarmZeit setzen');
  134.   OutTextXY(450,175, 'F10 = Ende mit  Alarm');
  135.   OutTextXY(450,185, 'ESC = Ende ohne Alarm');
  136.   SetLineStyle(SolidLn, 0, ThickWidth);
  137. END;
  138.  
  139. PROCEDURE ZeichneZeigerS(Grad : INTEGER);
  140. VAR x1, x2, y1, y2 : INTEGER;
  141. BEGIN
  142.   SetColor(Black);
  143.   ZeigerPunkt(x1, y1, Grad-6, Radius-20);
  144.   ZeigerPunkt(x2, y2, Grad-6, RadiusZurueckZeigerS);
  145.   Line(x1, y1, x2, y2);
  146.   SetColor(Yellow);
  147.   ZeigerPunkt(x1, y1, Grad, Radius-20);
  148.   ZeigerPunkt(x2, y2, Grad, RadiusZurueckZeigerS);
  149.   Line(x1, y1, x2, y2);
  150. END;
  151.  
  152. PROCEDURE ZeichneZeigerM(Grad : INTEGER);
  153. VAR x1, x2, x3, y1, y2, y3 : INTEGER;
  154. BEGIN
  155.   IF sek1 < 1 THEN BEGIN
  156.     SetColor(Black);
  157.     ZeigerPunkt(x1, y1, Grad-6-BreiteZeigerM,
  158.                         RadiusZurueckZeigerM);
  159.     ZeigerPunkt(x2, y2, Grad-6, Radius-20);
  160.     ZeigerPunkt(x3, y3, Grad-6 + BreiteZeigerM,
  161.                                  RadiusZurueckZeigerM);
  162.     Line(x1, y1, x2, y2);  Line(x2, y2, x3, y3);
  163.     Line(x3, y3, x1, y1);
  164.   END;
  165.   SetColor(Yellow);
  166.   ZeigerPunkt(x1, y1, Grad-BreiteZeigerM,
  167.                       RadiusZurueckZeigerM);
  168.   ZeigerPunkt(x2, y2, Grad, Radius-20);
  169.   ZeigerPunkt(x3, y3, Grad + BreiteZeigerM,
  170.                              RadiusZurueckZeigerM);
  171.   Line(x1, y1, x2, y2);  Line(x2, y2, x3, y3);
  172.   Line(x3, y3, x1, y1);
  173. END;
  174.  
  175. PROCEDURE ZeichneZeigerH(Grad : INTEGER);
  176. VAR x1, x2, x3, y1, y2, y3 : INTEGER;
  177. BEGIN
  178.   IF sek1 < 1 THEN BEGIN
  179.     IF min1 DIV 5 IN [0..11] THEN BEGIN
  180.       SetColor(Black);
  181.       ZeigerPunkt(x1, y1, Grad-3-BreiteZeigerH,
  182.                           RadiusZurueckZeigerH);
  183.       ZeigerPunkt(x2, y2, Grad-3, Radius-35);
  184.       ZeigerPunkt(x3, y3, Grad-3 + BreiteZeigerH,
  185.                                    RadiusZurueckZeigerH);
  186.       Line(x1, y1, x2, y2);  Line(x2, y2, x3, y3);
  187.       Line(x3, y3, x1, y1);
  188.     END;
  189.   END;
  190.   SetColor(Yellow);
  191.   ZeigerPunkt(x1, y1, Grad - BreiteZeigerH,
  192.                              RadiusZurueckZeigerH);
  193.   ZeigerPunkt(x2, y2, Grad, Radius-35);
  194.   ZeigerPunkt(x3, y3, Grad + BreiteZeigerH,
  195.                              RadiusZurueckZeigerH);
  196.   Line(x1, y1, x2, y2);  Line(x2, y2, x3, y3);
  197.   Line(x3, y3, x1, y1);
  198. END;
  199.  
  200. PROCEDURE ZeitAnzeige;
  201. VAR i : INTEGER;
  202. BEGIN
  203.   WinkelZeigerS := sek1*6;
  204.   WinkelZeigerM := min1*6;
  205.   WinkelZeigerH := std1*30 + (WinkelZeigerM DIV 12);
  206.   ZeichneZeigerS(WinkelZeigerS);
  207.   ZeichneZeigerH(WinkelZeigerH);
  208.   ZeichneZeigerM(WinkelZeigerM);
  209.   ZaehleZeitZu;
  210.   IF (std2 = std1) AND (min2 = min1) THEN BEGIN
  211.     GotoXY(50,1);
  212.     Write('Die Alarmzeit ist erreicht !!!');
  213.     FOR i := 1 TO 4 DO BEGIN
  214.       Sound(440);  Delay(100);
  215.       Sound(880);  Delay(100);
  216.     END;
  217.     NoSound;
  218.   END;
  219. END;
  220.  
  221. PROCEDURE BSsichern;
  222. BEGIN
  223.   gross := ImageSize(0, 0, MitteX*2 + 1, MitteY*2 + 1);
  224.   GetMem(Grafik, gross);
  225.   GetImage(0, 0, MitteX*2 + 1, MitteY*2 + 1, Grafik^);
  226. END;
  227.  
  228. PROCEDURE BSwiederherstellen;
  229. BEGIN
  230.   ClrScr; UhrenRahmen;
  231.   PutImage(0, 0, Grafik^, NormalPut);
  232. END;
  233.  
  234. PROCEDURE Uhrzeitsetzen;
  235. BEGIN
  236.   std := -1;  min := -1;
  237.   GotoXY(10,3);  Write('Neue Uhrzeit eingeben :');
  238.   GotoXY(10,5);  Write('Stunde : ');
  239.   REPEAT
  240.     GoToXY(20,5);  Read(std);
  241.   UNTIL std > -1;
  242.   GoToXY(30,5);  Write('Minute : ');
  243.   REPEAT
  244.     GotoXY(40,5);  ReadLn(min);
  245.   UNTIL min > -1;
  246.   std1 := std;  min1 := min;
  247.   sek1 := 0;    hun1 := 0;
  248.   SetTime(std1, min1, sek1, hun1);
  249.   Zaehler := 18.21;
  250. END;
  251.  
  252. PROCEDURE Alarmzeitsetzen;
  253. BEGIN
  254.   std := -1;  min := -1;
  255.   GotoXY(10,3);  Write('Die Alarmzeit eingeben :');
  256.   GoToXY(10,5);  Write('Stunde : ');
  257.   REPEAT
  258.     GoToXY(22,5);  Read(std);
  259.   UNTIL std > -1;
  260.   GoToXY(32,5);  Write('Minute : ');
  261.   REPEAT
  262.     GotoXY(42,5);  ReadLn(min);
  263.   UNTIL min > -1;
  264.   std2 := std;  min2 := min;
  265.   sek2 := 0;    Hun2 := 0;
  266.   AlarmGesetzt := TRUE;
  267. END;
  268.  
  269. PROCEDURE _Uhr;
  270. BEGIN
  271.   UhrenRahmen;
  272.   BSsichern;
  273.   REPEAT
  274.     REPEAT
  275.       IF Zaehler > 18.2 THEN BEGIN
  276.         Zeitanzeige;
  277.         Zaehler := Zaehler - 18.2;
  278.       END;
  279.     UNTIL KeyPressed;
  280.     ch := ReadKey;
  281.     IF ch = #0 THEN BEGIN
  282.       ch := ReadKey;
  283.       IF ch = #59 THEN BEGIN
  284.         ClearViewPort;
  285.         UhrZeitSetzen;
  286.         BSwiederherstellen;
  287.       END;
  288.       IF ch = #60 THEN BEGIN
  289.         ClearViewPort;
  290.         AlarmZeitSetzen;
  291.         BSwiederherstellen;
  292.       END;
  293.       IF (ch = #68) AND AlarmGesetzt THEN BEGIN
  294.         ClearViewPort;
  295.         CloseGraph;
  296.         RestoreCrtMode;
  297.         SetIntVec($1C, Addr(ZeitVergleich));
  298.         Ch := #27;
  299.       End;
  300.     End;
  301.   UNTIL ch = #27;
  302.   IF NOT AlarmGesetzt THEN SetIntVec($1C, Original);
  303.   FreeMem(Grafik, gross);
  304.   CloseGraph;
  305.   RestoreCrtMode;
  306. END;
  307.  
  308. PROCEDURE NotAus;
  309. BEGIN
  310.   SetIntVec($1C, Original);
  311. END;
  312.  
  313. BEGIN
  314.   Adressermittlung;
  315.   AlarmGesetzt := FALSE;
  316.   Zaehler := 18.21;
  317.   Gr := Detect;
  318.   InitGraph(Gr, Mo, '');
  319.   DirectVideo := FALSE;
  320.   GetAspectRatio(AspX, AspY);
  321.   SetColor(Yellow);
  322.   SetGraphMode(CGAHi);
  323.   SetViewPort(0, 0, GetMaxX, GetMaxY, TRUE);
  324.   SetLineStyle(SolidLn, 0, ThickWidth);
  325.   SetTextStyle(DefaultFont, HorizDir, 1);
  326.   MitteX := GetMaxX DIV 2;
  327.   MitteY := GetMaxY DIV 2;
  328.   GetTime(Std1, Min1, Sek1, Hun1);
  329.   GetIntVec($1C, Original);
  330.   SetIntVec($1C, Addr(Verzweigung));
  331. END.
  332. (* ------------------------------------------------------ *)
  333. (*                 Ende von UHR.PAS                       *)
  334.