home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / ifp1s157 / page_05.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-25  |  4.5 KB  |  178 lines
  1. unit page_05;
  2.  
  3. interface
  4.  
  5. uses crt, graph, ifpglobl, ifpcomon, ifpextrn;
  6.  
  7. procedure page05;
  8.  
  9. implementation
  10.  
  11. procedure page05;
  12.   const
  13.     vidmodes: array [$00..$13] of string[36] = (
  14.                 '(40 x 25 b/w text)',
  15.                 '(40 x 25 color text)',
  16.                 '(80 x 25 b/w text)',
  17.                 '(80 x 25 color text)',
  18.                 '(320 x 200 4 colors)',
  19.                 '(320 x 200 4 colors, no color burst)',
  20.                 '(640 x 200 2 colors)',
  21.                 '(MDA text)',
  22.                 '(160 x 200 16 colors)',
  23.                 '(320 x 200 16 colors)',
  24.                 '(640 x 200 4 colors)',
  25.                 '(reserved)',
  26.                 '(reserved)',
  27.                 '(320 x 200 16 colors)',
  28.                 '(640 x 200 16 colors)',
  29.                 '(640 x 350 monochrome)',
  30.                 '(640 x 350 16 colors)',
  31.                 '(640 x 480 2 colors)',
  32.                 '(640 x 480 16 colors)',
  33.                 '(320 x 200 256 colors)');
  34.  
  35.  
  36.   var
  37.     i : byte;
  38.     xbyte : byte;
  39.     xint1 : integer;
  40.     xint2 : integer;
  41.     xword : word;
  42.     mono2: boolean;
  43.  
  44. procedure showdisp(a : string; b : byte);
  45.   const
  46.     dispmons: array [0..$0C] of string[25] = (
  47.                '(none)',
  48.                'MDA + 5151',
  49.                'CGA + 5153/5154',
  50.                '(reserved)',
  51.                'EGA + 5153/5154',
  52.                'EGA 5151',
  53.                'PGA + 5175',
  54.                'VGA + analog monochrome',
  55.                'VGA + analog color',
  56.                '(reserved)',
  57.                'MCGA + digital color',
  58.                'MCGA + digital monochrome',
  59.                'MCGA + analog color');
  60.  
  61. begin
  62.   caption2(a);
  63.   case b of
  64.     $00..$0C: Writeln(dispmons[b]);
  65.     $0D..$FE: Writeln('(reserved)');
  66.     $FF: dontknow
  67.   end;
  68. end; {showdisp}
  69.  
  70. procedure showcolor(a : byte);
  71.   const
  72.     colors: array[black..white] of string[13] = (
  73.              'black', 'blue', 'green', 'cyan', 'red', 'magenta', 'brown',
  74.              'light gray', 'dark gray', 'light blue', 'light green',
  75.              'light cyan', 'light red', 'light magenta', 'yellow', 'white');
  76.  
  77.   begin
  78.   if a <= white then
  79.     Write(colors[a])
  80.   else
  81.     unknown('color', a, 2)
  82.   end; {showcolor}
  83.  
  84.   begin (* procedure page_05 *)
  85.   with regs do
  86.     begin
  87.     AX:=$1A00;
  88.     intr($10, regs);
  89.     if AL = $1A then
  90.       begin
  91.       showdisp('Active video subsystem  ', BL);
  92.       showdisp('Inactive video subsystem', BH)
  93.       end
  94.     end;
  95.   caption2('Initial video mode');
  96.   case equip and $0030 of
  97.     $0000 : writeln('No display');
  98.     $0010 : writeln('40 x 25 color');
  99.     $0020 : writeln('80 x 25 color');
  100.     $0030 : writeln('80 x 25 monochrome')
  101.   end;
  102.   caption2('Current video mode');
  103.   xbyte:=lo(lastmode);
  104.   Write(xbyte, ' ');
  105.   if xbyte <= $13 then
  106.     Writeln(vidmodes[xbyte])
  107.   else
  108.     unknown('video mode', xbyte, 2);
  109.   caption2('Current display page');
  110.   writeln(vidpg);
  111.   caption2('Graphics modes');
  112.   getmoderange(graphdriver, xint1, xint2);
  113.   if graphresult = grok then
  114.     writeln(xint2 + 1 - xint1)
  115.   else
  116.     writeln(0);
  117.   caption2('Video buffer (offset)');
  118.   writeln(hex(memw[BIOSdseg : $004E], 4));
  119.   caption2('Video buffer size (bytes)');
  120.   writeln(memw[BIOSdseg : $004C]);
  121.   caption2('Active display port');
  122.   xword:=memw[BIOSdseg : $0063];
  123.   write('$', hex(xword, 3), ' ');
  124.   if xword = $03B4 then
  125.     writeln('(monochrome)')
  126.   else
  127.      if xword = $03D4 then
  128.        writeln('(color)')
  129.      else
  130.        dontknow;
  131.   caption2('CRT mode register');
  132.   writeln('$', hex(mem[BIOSdseg : $0065], 2));
  133.   caption2('Current palette');
  134.   writeln('$', hex(mem[BIOSdseg : $0066], 2));
  135.   caption2('Colors');
  136.   caption1('·');
  137.   mono2:=mono;
  138.   mono:=false;
  139.   for i:=black to white do
  140.     begin
  141.     textcolor(i);
  142.     write('█')
  143.     end;
  144.   mono:=mono2;
  145.   caption1('·');
  146.   writeln;
  147.   caption2('Current colors');
  148.   if (attrsave and $80) = $80 then
  149.     write('blinking ');
  150.   showcolor(attrsave and $0F);
  151.   write(' on ');
  152.   showcolor(attrsave and $70 shr 4);
  153.   writeln;
  154.   caption2('Text rows');
  155.   writeln(tlength);
  156.   caption2('Text columns');
  157.   writeln(twidth);
  158.   if graphdriver in [EGA, MCGA, VGA] then
  159.     begin
  160.     caption2('Scan lines/character');
  161.     with regs do
  162.       begin
  163.       AX:=$1130;
  164.       BH:=$00;
  165.       intr($10, regs);
  166.       writeln(CX)
  167.       end
  168.     end;
  169.   caption2('Cursor scan lines');
  170.   with regs do
  171.     begin
  172.     AH:=$03;
  173.     BH:=vidpg;
  174.     intr($10, regs);
  175.     writeln(CH, '-', CL)
  176.     end
  177.   end;
  178. end.