home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / WCTUNITS.ZIP / MISC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-07-31  |  3.0 KB  |  131 lines
  1. unit misc;
  2.  
  3. { Written by William C. Thompson }
  4.  
  5. { This unit does a few miscellaneous things }
  6.  
  7. interface
  8. uses
  9.   crt,dos;
  10.  
  11. var
  12.   startingtime, endingtime: real;
  13.  
  14. function inttostr(i:longint):string;
  15. function realtostr(r:real;width,prec:byte):string;
  16. function fileexists(fn : string; attr : word) : boolean;
  17. function isdigit(c:char):boolean;
  18. function datetoday(m,d,y: word):byte;
  19. function printerstatus:byte;
  20. function printerokay:boolean;
  21. procedure starttimer;
  22. function elapsedtime:real;
  23. procedure unpackseconds(t: real; var hour,min,sec,sec100: word);
  24.  
  25. implementation
  26.  
  27. function inttostr(i:longint):string;
  28. var s: string;
  29. begin
  30.   str(i,s);
  31.   inttostr:=s
  32. end;
  33.  
  34. function realtostr(r:real;width,prec:byte):string;
  35. var s: string;
  36. begin
  37.   str(r:width:prec,s);
  38.   realtostr:=s
  39. end;
  40.  
  41. function fileexists(fn:string; attr:word):boolean;
  42. { attr=archive ($20) / directory ($10) }
  43. var
  44.   sr : searchrec;
  45. begin
  46.   findfirst(fn,attr,sr);
  47.   fileexists := doserror = 0;
  48. end;
  49.  
  50. function isdigit(c:char):boolean;
  51. { returns TRUE if c is a digit }
  52. begin
  53.   isdigit:=c in ['0'..'9']
  54. end;
  55.  
  56. function datetoday(m,d,y: word):byte;
  57. { returns day of week for the appropriate month, day, and year
  58.   0 = Sunday
  59.   1 = Monday
  60.   ...
  61.   6 = Saturday }
  62. var
  63.   z: byte;
  64. begin
  65.   z:=y-ord(m<3);
  66.   datetoday:=(23*m div 9+d+4+y+(z div 4)-(z div 100)+
  67.      (z div 400)-2*ord(m>=3)) mod 7
  68. end;
  69.  
  70. function printerstatus:byte;
  71. { Returns the actual status of the printer
  72.   Definition of status byte bits: (1 & 2 are not used)
  73.   Bit -- 7 ---  ---- 6 ----  -- 5 ---  -- 4 ---  -- 3 --  --- 0 ---
  74.       Not Busy  Acknowledge  No Paper  Selected  I/O Err. Timed-out }
  75. var
  76.   regs : registers;
  77. begin
  78.   with regs do begin
  79.     ah:=2;
  80.     dx:=0;
  81.     intr($17,regs);
  82.     printerstatus:=ah;
  83.     end;
  84. end;
  85.  
  86. function printerokay:boolean;
  87. { Returns TRUE if the printer is selected, then printer has paper and no
  88.   I/O or time out error has occurred. }
  89. var
  90.   n: byte;
  91. begin
  92.   n:=printerstatus;
  93.   if ((n and $10)<>0) and ((n and $29)=0) then printerokay:=true
  94.      { selected set & no paper, i/o error, timed-out not set }
  95.   else printerokay := false;
  96. end;
  97.  
  98. procedure starttimer;
  99. { This procedure sets the starting time (in seconds) }
  100. var
  101.   h,m,s,s100: word;
  102. begin
  103.   gettime(h,m,s,s100);
  104.   startingtime:=h*3600+m*60+s+s100/100;
  105. end;
  106.  
  107. function elapsedtime:real;
  108. { This function returns the elapsed time since the timer was started.
  109.   It also sets ending time to the current time (in seconds) }
  110. var
  111.   h,m,s,s100: word;
  112. begin
  113.   gettime(h,m,s,s100);
  114.   endingtime:=h*3600+m*60+s+s100/100;
  115.   if endingtime>startingtime then elapsedtime:=endingtime-startingtime
  116.   else elapsedtime:=86400-startingtime+endingtime
  117. end;
  118.  
  119. procedure unpackseconds(t: real; var hour,min,sec,sec100: word);
  120. { This procedure converts a time in seconds to something more
  121.   meaningful. }
  122. begin
  123.   sec100:=round(frac(t)*100);
  124.   sec:=trunc(t) mod 60;
  125.   hour:=trunc(t) div 60;
  126.   min:=hour mod 60;
  127.   hour:=hour div 60
  128. end;
  129.  
  130. end.
  131.