home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / 30TURUTL / CLOCKPAS.PAS < prev    next >
Pascal/Delphi Source File  |  1985-02-18  |  3KB  |  121 lines
  1. { This is a simple clock routine to be used with TURBO PASCAL.
  2.   It demonstrates the use of both TURBO  "intr"  and  "msdos"
  3.   routines.  The actual workings of interrupt routines and dos calls
  4.   are best found in the DOS manual NOT HERE !!! for obivous reasons.
  5.  
  6.   However this segment of code can be altered and used by anyone who knows
  7.   TURBO PASCAL.  I have found it of great use for time/date stamping of
  8.   printed reports from pascal and other screen routines requiring default
  9.   dates etc.
  10.  
  11.         Uploaded on 10/10/84  IBM PC USERS GROUP  MILWAUKEE
  12.  
  13.   Direct comments or questions to me,         JON GRAY
  14.   on the MILWAUKEE IBM PC USERS GROUP RBBS.
  15.  
  16.  
  17.   One Hint: Stay away from the interrupt stuff if you don't know it
  18.             or plan to do a few COLD STARTS...
  19. }
  20.  
  21.  
  22. {$C-    CNTL C  and  CNTL S  off}
  23. program clock (input, output);
  24. type
  25.     regpack = record
  26.        ax,bx,cx,dx,bp,si,ds,es,flags: integer;
  27.     end { record };
  28.  
  29.     timestr = string[11];
  30.     datestr = string[15];
  31.  
  32. function date : datestr;
  33. const
  34.     montharr : array [1..12] of string[3] =
  35.                ('Jan','Feb','Mar','Apr','May',
  36.                 'Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  37.  
  38. var
  39.     recpack:regpack;
  40.     month, day:string[2];
  41.     year:string[4];
  42.     dx, cx, result, tmpmonth:integer;
  43.  
  44. begin
  45.     with recpack do
  46.     begin
  47.       ax:= $2a shl 8;
  48.     end;
  49.     msdos (recpack);
  50.     with recpack do
  51.     begin
  52.       str(cx:4, year);
  53.       str(dx mod 256:2, day);
  54.       str(dx shr 8:2, month);
  55.     end;
  56.     val (month, tmpmonth, result);
  57.     date:= day + '-' + montharr[tmpmonth] + '-' + year
  58. end; { date }
  59. {********************************************************************}
  60. function time : timestr;
  61. var
  62.   recpack:regpack;
  63.   ah, al, ch, cl, dh:byte;
  64.   hour, min, sec, ampm:string[2];
  65.   tmptime, result:integer;
  66.  
  67. begin
  68.   ah := $2c;
  69.   with recpack do
  70.   begin
  71.     ax := ah shl 8 + al;
  72.   end;
  73.   intr($21,recpack);
  74.   with recpack do
  75.   begin
  76.     str(cx shr 8:2, hour);
  77.     str(cx mod 256:2, min);
  78.     str(dx shr 8:2, sec);
  79.   end;
  80.   if (hour > '12') then
  81.     begin
  82.       val (hour, tmptime, result);
  83.       tmptime:= tmptime - 12;
  84.       str (tmptime:2, hour);
  85.       ampm:= 'pm'
  86.     end
  87.   else
  88.     ampm:= 'am';
  89.   if (min[1] = ' ') then
  90.     min[1]:= '0';
  91.   if (sec[1] = ' ') then
  92.     sec[1]:= '0';
  93.   time := hour + ':' + min + ':' + sec + ' ' + ampm;
  94. end; { time }
  95. {********************************************************************}
  96. procedure clock;
  97. var
  98.     oldtime, curtime:string[11];
  99. begin
  100.     clrscr;
  101.     gotoxy (23,12);
  102.     write (date);
  103.     gotoxy (23,15);
  104.     lowvideo;
  105.     writeln ('*****  PRESS ANY KEY TO BEGIN  *****');
  106.     normvideo;
  107.     gotoxy (1,20);
  108.     write ('COMMENTS OR QUESTIONS ?   CONTACT: JON GRAY   IBM PC USERS GROUP - MILWAUKEE');
  109.     repeat
  110.       oldtime:= time;
  111.       repeat
  112.         curtime:= time;
  113.       until (oldtime <> curtime);
  114.       gotoxy (47,12);
  115.       write (time);
  116.     until keypressed;
  117. end; { clock }
  118. {********************************************************************}
  119. begin { main program }
  120.     clock;
  121. end. { main program }*************************