home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 06 / grdlagen / pctime.inc < prev    next >
Encoding:
Text File  |  1989-03-23  |  1.9 KB  |  77 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    PCTIME.INC                          *)
  3. (* ------------------------------------------------------ *)
  4. TYPE TimeStringType = String[15];
  5.      Registers      = RECORD CASE INTEGER OF
  6.                         1 : (ax, bx, cx, dx, bp, si,
  7.                              di, ds, es, flags : INTEGER);
  8.                         2 : (al, ah, bl, bh, cl, ch,
  9.                              dl, dh            : BYTE);
  10.                       END;
  11.  
  12. VAR regs8088     : Registers;
  13.     Stunden      : integer;
  14.     Minuten      : integer;
  15.     Sekunden     : integer;
  16.     Sekundenrest : integer;
  17.  
  18. PROCEDURE ResetTime;
  19. BEGIN
  20.   WITH regs8088 DO BEGIN
  21.     ax := $2C00;
  22.     MsDos(regs8088);
  23.     Stunden      := ch;   Minuten      := cl;
  24.     Sekunden     := dh;   Sekundenrest := dl;
  25.   END;
  26. END;
  27.  
  28. PROCEDURE TimeInString(VAR t : TimeStringType);
  29. VAR a : STRING[2];  h, m, s, r : INTEGER;
  30. BEGIN
  31.   WITH regs8088 DO BEGIN
  32.     ax := $2C00 ;
  33.     MsDos(regs8088) ;
  34.     h := ch - Stunden;
  35.     m := cl - Minuten;
  36.     s := dh - Sekunden;
  37.     r := dl - Sekundenrest;
  38.     IF r < 0 THEN BEGIN
  39.       r := r + 100;  s := Pred(s);
  40.     END;
  41.     IF s < 0 THEN BEGIN
  42.       s := s + 60;  m := Pred(m);
  43.     END;
  44.     IF m < 0 THEN BEGIN
  45.       m := m + 60;  h := Pred(h);
  46.     END;
  47.     Str(s + r/100:6:2, t);  t := t + 's ';
  48.     IF (m > 0) OR (h > 0) THEN BEGIN
  49.       Str(m:2, a);  t := a + 'm ' + t;
  50.     END;
  51.     IF h > 0 THEN BEGIN
  52.       Str(h:2, a);  t := a + 'h ' + t;
  53.     END;
  54.   END;
  55. END;
  56.  
  57. FUNCTION TimeStr : TimeStringType;
  58. VAR t : TimeStringType;
  59. BEGIN
  60.   TimeInString(t);
  61.   TimeStr := t;
  62. END;
  63.  
  64. PROCEDURE WriteTime;
  65. BEGIN
  66.   Write(TimeStr);
  67. END;
  68.  
  69. PROCEDURE WriteLnTime;
  70. BEGIN
  71.   WriteLn(TimeStr);
  72. END;
  73.  
  74. (* var i,anz     : integer;
  75.     x1, x2, z : real; *)
  76. (* ------------------------------------------------------ *)
  77. (*                  Ende von PCTIME.INC                   *)