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