home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 07 / tricks / stoppuhr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-22  |  4.7 KB  |  159 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     STOPPUHR.PAS                       *)
  3. (*        Stoppuhren in Turbo Pascal 4.0 und 5.0          *)
  4. (*           (c) 1989  W.Schmidt  &  TOOLBOX              *)
  5. (* ------------------------------------------------------ *)
  6. UNIT Stoppuhr;
  7.  
  8. INTERFACE
  9.  
  10. TYPE Time        = RECORD
  11.                      hour  : WORD;
  12.                      min   : WORD;
  13.                      sec   : WORD;
  14.                      hsec  : WORD;
  15.                    END;
  16.      Chronometer = RECORD
  17.                      status   : BYTE;
  18.                      start    : Time;
  19.                      stop     : Time;
  20.                      duration : REAL;
  21.                    END;
  22.      ChronoPtr   = ^Chronometer ;
  23.  
  24. PROCEDURE NewChronometer(VAR u : ChronoPtr);
  25.                { Erzeugen einer Stoppuhr mit Reset der Uhr }
  26.  
  27. PROCEDURE DisposeChronometer(VAR u : ChronoPtr);
  28.                       { Stoppuhr wird nicht mehr gebraucht }
  29.  
  30. PROCEDURE ResetChronometer(u : ChronoPtr);
  31.                    { Stoppuhr zurücksetzen auf 00:00:00.00 }
  32.  
  33. PROCEDURE StartChronometer(u : ChronoPtr);
  34.    { Stoppuhr starten . Wenn die Uhr vorher nicht mit      }
  35.    { ResetChronometer zurückgesetzt wurde, so wird mit dem }
  36.    { letzten Stand der Uhr weitergemacht.                  }
  37.  
  38. PROCEDURE StopChronometer(u : ChronoPtr);
  39.           { Stoppuhr anhalten ; kein automatischer Reset ! }
  40.  
  41. PROCEDURE ReadChronometer(u : ChronoPtr; VAR dur : REAL);
  42.      { Ablesen der momentanen Zeit in Sekunden . Werte der }
  43.      { Stoppuhr werden nicht beeinflußt . Zeit dur wird in }
  44.      { sec zurückgegeben.                                  }
  45.  
  46. FUNCTION  SecToTime(dur : REAL) : STRING ;
  47.          { Die in Sekunden abgelesene Zeit wird mit dieser }
  48.          { Funktion in die Form  hh:mm:ss.bb gebracht.     }
  49.  
  50. IMPLEMENTATION
  51.  
  52. USES Dos;
  53.  
  54. CONST  inactive = 0 ; created = 1 ; active = 2 ;
  55. VAR    Mitternacht : Time ;
  56.  
  57. PROCEDURE NewChronometer(VAR u : ChronoPtr);
  58. BEGIN
  59.   New(u);
  60.   u^.status := created;
  61.   u^.duration := 0;
  62. END;
  63.  
  64. PROCEDURE DisposeChronometer(VAR u : ChronoPtr);
  65. BEGIN
  66.   IF (u^.status=created) OR (u^.status=active) THEN BEGIN
  67.     u^.status := inactive;
  68.     Dispose(u);
  69.   END ELSE Halt;
  70. END;
  71.  
  72. PROCEDURE ResetChronometer(u : ChronoPtr);
  73. BEGIN
  74.   IF (u^.status=active) OR (u^.status=created) THEN BEGIN
  75.     u^.status := created;
  76.     u^.duration := 0;
  77.     GetTime(u^.start.hour, u^.start.min,
  78.             u^.start.sec,  u^.start.hsec);
  79.     GetTime(u^.stop.hour, u^.stop.min,
  80.             u^.stop.sec,  u^.stop.hsec);
  81.   END ELSE Halt;
  82. END;
  83.  
  84. PROCEDURE StartChronometer(u : ChronoPtr);
  85. BEGIN
  86.   IF (u^.status=active) OR (u^.status=created) THEN BEGIN
  87.     u^.status := active;
  88.     GetTime(u^.start.hour, u^.start.min,
  89.             u^.start.sec,  u^.start.hsec);
  90.   END ELSE Halt;
  91. END;
  92.  
  93. FUNCTION TimeToSec(t : Time) : REAL;
  94. BEGIN
  95.   TimeToSec := (t.hsec + 100.0 * t.sec + 6000.0 * t.min +
  96.                 t.hour * 360000.0) / 100.0;
  97. END;
  98.  
  99. PROCEDURE StopChronometer(u : ChronoPtr);
  100. BEGIN
  101.   IF u^.status=active THEN BEGIN
  102.     GetTime(u^.stop.hour, u^.stop.min,
  103.             u^.stop.sec,  u^.stop.hsec);
  104.     u^.duration := u^.duration + TimeToSec(u^.stop) -
  105.                                  TimeToSec(u^.start);
  106.     IF u^.stop.hour < u^.start.hour THEN
  107.       u^.duration := u^.duration + TimeToSec(Mitternacht);
  108.       u^.status := created ;
  109.       u^.start  := u^.stop;
  110.     END ELSE
  111.       IF u^.status=created THEN BEGIN { nothing } END
  112.                            ELSE Halt ;
  113. END;
  114.  
  115. PROCEDURE ReadChronometer(u : ChronoPtr; VAR dur : REAL);
  116. VAR    t  : Time ;
  117.        dt : REAL ;
  118. BEGIN
  119.   GetTime(t.hour, t.min, t.sec, t.hsec);
  120.   IF u^.status=active THEN  BEGIN
  121.   dur := u^.duration + TimeToSec(t) - TimeToSec(u^.start);
  122.   IF t.hour < u^.start.hour THEN
  123.     dur := dur + TimeToSec(Mitternacht);
  124.   END ELSE
  125.     IF u^.status=created THEN dur := u^.duration
  126.                          ELSE Halt;
  127. END;
  128.  
  129. FUNCTION SecToTime(dur : REAL) : STRING;
  130. VAR    s, hs : STRING;
  131.        i, k  : INTEGER;
  132. BEGIN
  133.   k := Round((dur - Int(dur)) * 100);
  134.   Str(k:2, s);
  135.   IF s[1] = ' ' THEN s[1] := '0';
  136.   IF Length(s) = 3 THEN s := Copy(s, 1, 2);
  137.   s := '.' + s;
  138.   k := Round(Int(dur) + 0.1);
  139.   i := k MOD 60;  Str(i:2, hs);
  140.   IF hs[1] = ' ' THEN hs[1] := '0';
  141.   s := hs + s;  k := k DIV 60;  i := k MOD 60;
  142.   Str(i:2, hs);
  143.   IF hs[1] = ' ' THEN hs[1] := '0';
  144.   s := hs + ':' + s;  k := k DIV 60;  Str(k:2,hs);
  145.   IF hs[1] = ' ' THEN hs[1] := '0';
  146.   s := hs + ':' + s;
  147.   SecToTime := s;
  148. END;
  149.  
  150. BEGIN
  151.   WITH Mitternacht DO BEGIN
  152.     hour := 24;  min := 0;  sec := 0;  hsec := 0;
  153.   END;
  154. END.
  155. (* ------------------------------------------------------ *)
  156. (*              Ende von STOPPUHR.PAS                     *)
  157.  
  158.  
  159.