home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / io / io_23 / dos23.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-01-24  |  3.3 KB  |  136 lines
  1. { File = DOS23.PAS
  2.   Procedures to test the video mode, set colors, and perform other
  3.   DOS functions.
  4.   WPM -- 11/25/87
  5.   Converted to Unit, 12/2/87
  6.   Revised: 1/24/88 }
  7.  
  8. { -------------------------------------------------------------------------- }
  9.  
  10. unit dos23 ;
  11. {$v-}
  12. interface
  13.  
  14. uses
  15.     crt, dos, io23unit ;
  16.  
  17. var
  18.   bgcolor,                        { background color }
  19.   txcolor      : integer ;        { text color }
  20.  
  21. function is_mono : boolean ;
  22.   { whether monitor is monochrome or not }
  23. procedure rvson ;
  24.   { turn reverse video on }
  25. procedure rvsoff ;
  26.   { turn reverse video off }
  27. procedure emphon ;
  28.   { turn emphasis on -- if text is dim, make it bright; if bright make it dim }
  29. procedure emphoff ;
  30.   { turn emphasis off }
  31. procedure assigncolors ;
  32.   { change colors on display -- border same as background, but only on CGA }
  33. procedure getdrive (var drive : str1) ;
  34.   { get current drive }
  35. function freespace (drive : str1) : real ;
  36.   { get free space on disk }
  37.  
  38. { ========================================================================== }
  39.  
  40. implementation
  41.  
  42. function is_mono : boolean ;
  43.  
  44.   var
  45.     regs : registers ;
  46.  
  47.   begin
  48.     regs.AX := $0F00 ;
  49.     intr ($10,regs) ;
  50.     is_mono := (regs.AL = 7)
  51.   end ;
  52.  
  53. { --------------------------------------------------------- }
  54.  
  55. procedure rvson ;
  56. { turn reverse video on }
  57.   begin
  58.     textcolor(bgcolor) ;
  59.     textbackground(txcolor)
  60.   end ;
  61.  
  62. procedure rvsoff ;
  63. { turn reverse video off }
  64.   begin
  65.     textcolor(txcolor) ;
  66.     textbackground(bgcolor)
  67.   end ;
  68.  
  69. procedure emphon ;
  70. { turn emphasis on -- if text is dim, make it bright; if bright make it dim }
  71.   begin
  72.     if txcolor in [0..7] then
  73.       textcolor(txcolor + 8)
  74.     else
  75.       textcolor(txcolor - 8)
  76.   end ;
  77.  
  78. procedure emphoff ;
  79. { turn emphasis off }
  80.   begin
  81.       textcolor(txcolor)
  82.   end ;
  83.  
  84. { ------------------------------------------------------------- }
  85.  
  86. procedure assigncolors ;
  87.   { change colors on display -- border same as background, but only on CGA }
  88.   var
  89.     regs : registers ;
  90.  
  91.   begin
  92.     textbackground(bgcolor) ;       { set background color }
  93.     regs.AX := $0B00  ;             { set border on CGA }
  94.     regs.BX := bgcolor and $00FF ;
  95.     intr($10,regs) ;
  96.     textcolor(txcolor)              { set text color }
  97.   end ;  { proc assigncolors }
  98.  
  99. { ------------------------------------------------------------- }
  100.  
  101. procedure getdrive (var drive : str1) ;
  102.   { get current drive }
  103.  
  104.     var regs : registers ;
  105.  
  106.     begin
  107.       with regs do
  108.         begin
  109.           AX := $1900 ;
  110.           msdos(Dos.Registers(regs)) ;
  111.           drive := chr(AL + $41)
  112.         end
  113.     end ; { proc getdrive }
  114.  
  115. { ------------------------------------------------------------- }
  116.  
  117. function freespace (drive : str1) : real ;
  118.   { get free space on disk }
  119.  
  120.   var
  121.     regs : registers ;
  122.  
  123.   begin
  124.     with regs do
  125.       begin
  126.         AH := $36 ;                      { Dos function call }
  127.         DL := ord(drive[1]) - $40 ;      { 01 = A, 02 = B, etc. }
  128.         msdos (regs) ;
  129.         freespace := 1.0 * ax * bx * cx  { mult by 1.0 to get real result }
  130.       end
  131.   end ; { function freespace }
  132.  
  133. end.  { implementation }
  134.  
  135. { ------ EOF DOS23.PAS ---------------------------------------------------- }
  136.