Unit DetectGraphics;

Interface

Function WhatGCard                       : String;
Function WhatGCardNumber                 : Byte;
Function VesaInf (InfoNumber : Byte)     : String;
Function VESAIsVidMode (Mode : Word)     : Boolean;
Function VESAVidModeString (Mode : Word; Z : Byte) : String;
Function GraInf (InfoNumber : Byte)      : String;
Function WhatRamDac                      : String;

Function ScanLinesChar                : Word;
Function ScanLinesCursor              : String;
Function GetFontAddress (FontNumber : Byte) : Pointer;
Function GetPaletteRegister (Color : Byte) : Byte;

Function VideoWaits                   : Word;
Function BiosSpeed                    : Real;
Function DosSpeed                     : Real;

Function TestVertHz                   : Word;
Function TestHorizHz                  : Real;

Function IsDGIS                       : Boolean;

Implementation

Uses Dos, Crt, Graph, DetectGlobal, DetectConstants, DetectBios, DetectTime;

Type { Die folgenden 2 Records werden fr die VESA-Funktionen gebraucht. }

     VESAitype = record
       signature    : array[0..3] of char;
       version      : word;
       OEMnameOfs   : word;
       OEMnameSeg   : word;
       capabilities : array[0..3] of byte;
       modesOfs     : word;
       modesSeg     : word;
       Mem64k       : Word;
       reserved     : array[0..235] of byte;
     end;

     VESAmtype = record
       modeattr   : word;
       winaattr   : byte; { Window A attributes }
       winbattr   : byte; { Window B attributes }
       wingran    : word; { Window Granularity }
       winsize    : word; { Window Size }
       winaseg    : word; { Window A segment }
       winbseg    : word; { Window B segment }
       posOfs     : word; { Offset of Far call to positioning function }
       posSeg     : word; { Segment .. }
       scansize   : word; { Bytes per scan line }
       { Die folgenden Daten sind optional fr VESA-Modes, vorausgesetzt
        bei OEM-Modes }
       pixwidth   : word;
       pixheight  : word;
       charwidth  : byte;
       charheight : byte;
       memplanes  : byte;
       pixelbits  : byte;
       banks      : byte;
       memmodel   : byte;
       banksize   : byte;
       imagepages : byte;
       reserved   : array[0..225] of byte;
     end;


Const CardNumber : Word = 0;

Var ScreenAddr     : Pointer;
    EMS_BASE       : Word;
    ExpandedMem    : Boolean;
    ExtendedMem    : Boolean;
    VESAinfo       : VESAitype;
    VESAmode       : VESAmtype;
    DAC_RS2        : Word;
    DAC_RS3        : Word;

    C              : char;

{ Die folgende Funktion ist nur fr die VESA-Informationen relevant. }

Procedure LoadVESARecords;

Begin
  Regs.AX:=$4F00;
  Regs.ES:=Seg(VESAinfo);
  Regs.DI:=Ofs(VESAinfo);
  Intr($10, regs);
  Regs.AX:=$4F01;
  Regs.CX:=xword1;
  Regs.ES:=Seg(VESAmode);
  Regs.DI:=Ofs(VESAmode);
  Intr($10, regs);
End;


Function WhatGCard;

  Function readROM (seg, ofs: word; length: byte) : string;

  Var x : word;

  Begin
    s:='';
    For x := ofs to ofs + (length - 1) do
      s := s + Chr(Mem[seg:x]);
    readROM:=s
  End;


  Procedure cli;
    Inline($FA);


  Procedure sti;
    Inline($FB);


  function testinx2(pt,rg,msk:word):boolean;   {Gibt True zurck, wenn die
                                                Bits in MSK Les/Schreibbar
                                                sind. }
  var old,nw1,nw2:word;

  begin
    Port[Pt] := Rg;
    old:=Port[pt+1];

    Port[Pt] := Rg;
    Port[Pt+1] := Old And Not Msk;

    Port[Pt] := Rg;
    nw1:=Port[Pt+1] and msk;

    Port[Pt] := Rg;
    Port[Pt+1] := Old Or Msk;

    Port[Pt] := Rg;
    nw2:=Port[Pt+1] and msk;

    Port[Pt] := Rg;
    Port[Pt+1] := Old;

    testinx2:=(nw1=0) and (nw2=msk);
  end;


  function testreg (pt,msk : word) : boolean;   {Gibt True zurck, wenn die
                                                Bits in MSK Les/Schreibbar
                                                sind. }
  var old,nw1,nw2:word;

  begin
    old:=Port[pt];
    Port[Pt] := Old And Not Msk;
    nw1:=Port[Pt] and msk;
    Port[Pt] := Old Or Msk;
    nw2:=Port[Pt] and msk;
    Port[Pt] := Old;
    testreg:=(nw1=0) and (nw2=msk);
  end;


  function rdinx(pt,inx:word):word;       {Liest Register PT mit Index INX}

  var x:word;

  begin
    if pt=$3C0 then x:=Port[$3D0+6];    {If Attribute Register then reset Flip-Flop}
    Port [pt] := inx;
    rdinx:= Port [pt+1];
  end;

  procedure wrinx(pt,inx,val:word);  {Schreibt Val mit Index INX auf Register PT}

  var x:word;

  begin
    if pt=$3C0 then
      begin
        x:=Port[$3D0+6];
        Port[pt] := inx;
        Port[pt+1] := val;
      end
    else
      begin
        Port[pt] := inx;
        Port[pt+1] := val;
      end;
  end;


  procedure setinx(pt,inx,val:word);

  var x : word;

  begin
    x := rdinx (pt, inx);
    wrinx (pt, inx, x or val);
  end;

  procedure modinx(pt,inx,mask,nwv:word);  {In register PT index INX sets
                                            the bits in MASK as in NWV
                                            the other are left unchanged}
  var temp : word;

  begin
    temp := (rdinx (pt, inx) and (not mask)) + (nwv and mask);
    wrinx (pt, inx, temp);
  end;


  Function IsXGA: word;

  Var
    POSport, cardID, tmpw       : word;
    tmp, tmp1, tmp2, tmp3, tmp4 : byte;
    slot                        : byte;
    foundit                     : boolean;

  begin
    isXGA:=0;
    foundit:=false;
    with regs do
      begin
        DX:=$FFFF;
        AX:=$C400;
        Intr($15, regs);
        if (not (Regs.Flags And FCarry=0)) or (DX = -1) then
          Exit;
        posport:=DX;
        slot:=0;
        repeat
          cli;
          if slot = 0 then
            Port[$94]:=$DF
          else
            begin
              AX:=$C401;
              BX:=slot;
              Intr($15, regs)
            end;
          cardID:=PortW[POSport];
          tmp1:=Port[POSport + 2];
          tmp2:=Port[POSport + 3];
          tmp3:=Port[POSport + 4];
          tmp4:=Port[POSport + 5];
          if slot = 0 then
            Port[$94]:=$FF
          else
            begin
              AX:=$C402;
              BX:=slot;
              Intr($15, regs);
            end;
          cli;
          if (cardID >= $8FD8) and (cardID <= $8FDB) then
            begin
              tmpw:=tmp1 and $E;
              POSport:=(tmpw shl 3) + $2100;
              Port[POSport + $A]:=$52;
              tmp:=Port[POSport + $B] and $F;
              if (tmp <> 0) and (tmp <> $F) then
                foundit:=true
              else
                Inc(slot);
            end
          else
            Inc(slot);
        until foundit or (slot > 9);
      end;
    if foundit then
      IsXGA:=POSport;
  End;

  procedure isport2(var regs: registers; var foundit: boolean);

  var
    savebx, saveax: word;
    tmp: byte;

  begin
    with regs do
      begin
        savebx := BX;
        BX := AX;
        Port[DX] := AL;
        AH := AL;
        AL := Port[DX + 1];
        tmp := AH;
        AH := AL;
        AL := tmp;
        saveax := AX;
        AX := BX;
        PortW[DX] := AX;
        Port[DX] := AL;
        AH := AL;
        AL := Port[DX + 1];
        AL := AL and BH;
        foundit := (AL = BH);
        if AL = BH then
          begin
            AL := AH;
            AH := 0;
            Port[DX] := AX;
            Port[DX] := AL;
            AH := AL;
            AL := Port[DX + 1];
            AL := AL and BH;
            foundit := (AL = 0);
          end;
        AX := saveax;
        PortW[DX] := AX;
        BX := savebx;
      end;
  end;



Type cardtype = (none, vesa, standard, paradise, video7, ati, ahead,
                 avance, cirrus, cti, compaq, genoa, s3, trident, tseng,
                 zymos, hualon, mxic, ncr, oak, p2000, realtek, umc,
                 weitek, yamaha);
Const
  trividmons: array[0..7] of string[17] =
               ('MDA', 'CGA', 'EGA', 'Digital multisync', 'VGA', '8514',
                'SuperVGA', 'Analog multisync');

  memnames: array[0..3] of string[4] = ('64K', '128K', '192K', '256K');


Var VGAbuf      : array[$00..$10] of byte;
    paralock1   : Byte;
    paralock2   : byte;
    vgacard     : cardtype;
    vidmem      : word;
    c           : char;
    i           : Word;
    saveattr    : byte;
    savex       : byte;
    savey       : byte;
    foundone    : Boolean;
    foundit     : boolean;
    GraphDriver : Integer;
    GraphMode   : Integer;
    old         : Byte;
    old2        : Byte;
    SubVers     : Word;

Begin
  vgacard:=none;
  vidmem:=0;
  EndString := 'n/a';
  DAC_RS2 := 0;
  DAC_RS3 := 0;

  DetectGraph(GraphDriver, GraphMode);

  Case graphdriver of
    CGA : Begin
            EndString := 'CGA';
            CardNumber := 1;
          End;
    MCGA : Begin
             EndString := 'MCGA';
             CardNumber := 2;
           End;
    EGA :  Begin
             EndString := 'EGA color';
             Regs.AH:=$12;
             Regs.BL:=$10;
             intr($10, regs);
             If Regs.BL < 4 then
             EndString := EndString + memnames[Regs.BL] + ' (BIOS)';
             CardNumber := 3;
           End;
    EGAmono : Begin
                EndString := 'EGA mono';
                Regs.AH:=$12;
                Regs.BL:=$10;
                Intr($10, regs);
                If Regs.BL < 4 then
                EndString := EndString + memnames[Regs.BL] + ' (BIOS)';
                CardNumber := 3;
              End;
    hercmono : begin
                 EndString := 'Hercules oder MDA';
                 CardNumber := 4;
               end;
    IBM8514 : begin
                EndString := 'IBM 8514';
                CardNumber := 5;
              end;
    ATT400 : begin
               EndString := 'AT&T 400';
               CardNumber := 6;
             end;
    VGA : begin
            xword1:=isXGA;

            if xword1 > 0 then
              if Port[xword1] and 1 = 1 then
                Begin
                  EndString := 'XGA '
                End
              else
                Begin
                  EndString := 'VGA, XGA';
                End
              else
                Begin
                  EndString := 'VGA';
                End;

            vidmem:=0;
            CardNumber := 8;
            vgacard:=standard;

            if vgacard = standard then
              begin
                {Video 7}
                if Port[$3CC] and 1 = 1 then
                  xword1:=$3D0
                else
                  xword1:=$3B0;
                Port[xword1 + 4]:=$C;
                i:=Port[xword1 + 5];
                Port[xword1 + 5]:=$55;
                xbyte:=Port[xword1 + 5];
                Port[xword1 + 4]:=$1F;
                xbyte2:=Port[xword1 + 5];
                Port[xword1 + 4]:=$C;
                Port[xword1 + 5]:=i;

                if xbyte2 = $55 xor $EA then
                  begin
                    vgacard:=video7;
                    CardNumber := 9;
                    EndString := EndString + ', Video 7, ';
                    port[$3C4]:=$8E;
                    xbyte:=Port[$3C5];
                    case xbyte of
                      $80..$FF: EndString := EndString + 'Vega VGA';
                      $70..$7F: with regs do
                              begin
                                AX:=$6F07;
                                Intr($10, regs);
                                if (AH and $80) = $80 then
                                  EndString := EndString + 'VRAM'
                                else
                                  EndString := EndString + 'FastWrite';
                              end;
                      $50..$59: EndString := EndString + 'VGA Version 5';
                      $40..$49: EndString := EndString + '1024i';
                    else
                      EndString := EndString + 'unbekannt';
                    end;

                    SubVers := (rdinx ($3C4, $8F) shl 8) + rdinx ($3C4, $8E);
                    case SubVers of
                      $8000..$FFFF : EndString := EndString + ', VEGA VGA Chipsatz';
                      $7000..$70FF : EndString := EndString + ', HT208 Version 1-3';
                      $7140..$714F : EndString := EndString + ', HT208 rev A';
                      $7151        : EndString := EndString + ', HT208 rev B';
                      $7152        : EndString := EndString + ', HT208 rev CD';
                      $7760        : EndString := EndString + ', HT216 rev BC';
                      $7763        : EndString := EndString + ', HT216 rev D';
                      $7764        : EndString := EndString + ', HT216 rev E';
                      $7765        : EndString := EndString + ', HT216 rev F';
                    End;

                    Port[$3C4]:=$FF;
                    xbyte:=Port[$3C5];
                    with Regs do
                      begin
                        AX:=$6F07;
                        Intr($10, regs);
                        if AL = $6F then
                          begin
                            Vidmem:=256 * (AH and $7F);
                            {Memory type};
                               if AH and $80 = $80 then
                                 EndString := EndString + 'VRAM'
                               else
                                 EndString := EndString + 'DRAM';
                           end
                        else
                           vidmem:=256;
                        end;
                      end;
                    end;

            if vgacard = standard then
              begin
                {AHEAD};
                S := ReadROM($C000, $25, 5);
                If S = 'AHEAD' Then
                  Begin
                    VgaCard := Ahead;
                    CardNumber := 25;

                    Port [$3CE] := $F;
                    xByte := Port [$3CF];

                    Port [$3CE] := $F;
                    Port [$3CF] := 0;

                    If Not TestInx2 ($3CE,$C,$FB) Then
                      Begin
                        Port[$3CE] := $F;
                        Port[$3CF] := $20;

                        If TestInx2 ($3CE,$C,$FB) Then
                          Begin
                            Case Port[$3CF] And $F Of
                              0 : Begin
                                    EndString := EndString + ', Ahead A ';
                                  End;
                              1 : Begin
                                    EndString := EndString + ', Ahead B ';
                                  End;
                            End;
                          End;
                        Port[$3CE] := $F;
                        Port[$3CF] := xByte;

                        Port[$3CE] := $1F;
                        xByte := Port[$3CF];
                        If (xByte And 1 = 0) And (xByte And 2 = 0) Then VidMem := 256
                          Else If (xByte And 1 = 1) And (xByte And 2 = 2) Then VidMem := 1024;
                      End;
                  End;
              End;

            if vgacard = standard then
              begin
                {Genoa};
                s:=readROM($C000, MemW[$C000:$37], 4);
                if (s[1] = #$77) and (Copy(s, 3, 2) = #$99#$66) then
                  begin
                    vgacard:=genoa;
                    CardNumber := 10;
                    EndString := Endstring + ', Genoa ';
                    Case Ord(s[2]) of
                      $33: EndString := Endstring + '5100/5200 (Tseng ET3000 Basis)';
                      $55: EndString := Endstring + '5300/5400 (Tseng ET3000 Basis)';
                      $22: EndString := Endstring + '6100';
                      $00: EndString := Endstring + '6200/6300';
                      $11: EndString := Endstring + '6400/6600';
                    Else
                      EndString := Endstring + 'unbekannter Chip';
                    End;

                    if (s[2] = #$33) or (s[2] = #$55) then
                      Begin
                        CardNumber := 11;
                      End;
                 end
              end;

            if vgacard = standard then
              begin
                { Cirrus 1 };

                { Test for Cirrus 54xx }
                old := rdinx ($3C4, 6);
                wrinx ($3C4, 6, 0);
                if rdinx ($3C4, 6) = $F then
                  begin
                    wrinx ($3c4, 6, $12);
                    if (rdinx ($3C4, 6) = $12) and testinx2 ($3C4, $1E, $3F) then
                      begin
                        SubVers := rdinx ($3d4, $27);
                        if testinx2 ($3CE,9, $ff) then
                          case SubVers of
                            $88 : EndString := Endstring + ', Cirrus CL-GD5402';
                            $89 : EndString := Endstring + ', Cirrus CL-GD5402 r1';
                            $8A : EndString := Endstring + ', Cirrus CL-GD5420';
                            $8B : EndString := Endstring + ', Cirrus CL-GD5420 r1';
                            $8C..$8F : EndString := Endstring + ', Cirrus CL-GD5422';
                            $90..$93 : EndString := Endstring + ', Cirrus CL-GD5426';
                            $94..$97 : EndString := Endstring + ', Cirrus CL-GD5424';
                            $98..$9B : EndString := Endstring + ', Cirrus CL-GD5428';
                            $A4..$A7 : EndString := Endstring + ', Cirrus CL-GD543x';
                          else
                            EndString := EndString + ', unbekannter Cirrus CL-GD54';
                          end
                        else
                          if testinx2 ($3C4, $19, $ff) then
                            case SubVers shr 6 of
                              0 : EndString := Endstring + ', Cirrus CL-GD6205';
                              1 : EndString := Endstring + ', Cirrus CL-GD6235';
                              2 : EndString := Endstring + ', Cirrus CL-GD6215';
                              3 : EndString := Endstring + ', Cirrus CL-GD6225';
                            end
                        else
                          EndString := EndString + 'Cirrus AVGA2 (5402)';
                        vgacard := cirrus;
                        cardnumber := 12;
                      end;
                  end
                else
                  wrinx($3C4,6,old);
              End;


            if vgacard = standard then
              begin
                { Cirrus 2 }

                { Test fr 64xx }

                old := rdinx ($3CE, $A);
                wrinx ($3CE, $A, $CE);

                if rdinx ($3CE, $A) = 0 then
                  begin
                    wrinx ($3CE, $A, $EC);
                    if rdinx ($3CE, $A) = 1 then
                      begin
                        SubVers := rdinx ($3CE, $AA);
                        case SubVers shr 4 of
                          4 : EndString := EndString + ', Cirrus CL-GD6440';
                          5 : EndString := EndString + ', Cirrus CL-GD6412';
                          6 : EndString := EndString + ', Cirrus CL-GD5410';
                          7 : EndString := EndString + ', Cirrus CL-GD6420';
                          8 : EndString := EndString + ', Cirrus CL-GD6410';
                        else
                          EndString := EndString +  ', unbekannter Cirrus CL-GD64'
                        end;
                        vgacard := cirrus;
                        cardnumber := 12;
                        xByte := rdinx ($3CE, $BB);
                        If (xByte And $40 = 0) And (xByte And $80 = 0) Then VidMem := 256
                          Else If (xByte And $40 = 0) And (xByte And $80 = $80) Then VidMem := 512
                          Else If (xByte And $40 = $40) And (xByte And $80 = 0) Then VidMem := 768
                          Else If (xByte And $40 = $40) And (xByte And $80 = $80) Then VidMem := 1024;
                      end;
                  end;
                wrinx($3CE,$A,old);
              End;

            if vgacard = standard then
              begin
                { Cirrus 3 }

                { Now test for 5/600 }

                xByte := rdinx ($3C4, 6);
                old := rdinx ($03D4, $C);
                Port[$03D4+1] := 0;
                SubVers := rdinx ($3d4, $1F);
                wrinx ($3C4, 6, (SubVers shl 4) + (SubVers shr 4));
                if Port[$3C5] = 0 then
                  begin
                    Port[$3C5] := SubVers;
                    if Port [$3C5] = 1 then
                      case SubVers of
                        $EC : EndString := EndString + ', Cirrus 510/520';
                        $CA : EndString := EndString + ', Cirrus 610/620';
                        $EA : EndString := EndString + ', Cirrus Video7 OEM';
                      else
                        EndString := EndString + ', unbekannte Cirrus';
                      end;
                      vgacard := cirrus;
                      cardnumber := 12;
                  end;
                wrinx ($03D4, $C, old);
                wrinx ($3C4, 6, xByte);
              End;

            if vgacard = standard then
              begin
                { CTI };
                Port[$46E8]:=$1E;
                xbyte:=Port[$104];
                Port[$46E8]:=$E;
                if xbyte = $A5 then
                  with regs do
                    begin
                      AH:=$5F;
                      AL:=0;
                      Intr($10, regs);
                      If al = $5f Then
                        Begin
                          Case bl SHR 4 Of
                            0 : EndString := EndString + 'Chips&Technologies 82c451';
                            1 : EndString := EndString + 'Chips&Technologies 82c452';
                            2 : EndString := EndString + 'Chips&Technologies 82c455';
                            3 : EndString := EndString + 'Chips&Technologies 82c453';
                            4 : EndString := EndString + 'Chips&Technologies 82c450';
                            5 : EndString := EndString + 'Chips&Technologies 82c456';
                            6 : EndString := EndString + 'Chips&Technologies 82c457';
                            7 : EndString := EndString + 'Chips&Technologies F65520';
                            8 : EndString := EndString + 'Chips&Technologies F65530';
                            9 : EndString := EndString + 'Chips&Technologies F65510';
                          End;
                          vgacard:=CTI;
                          CardNumber := 13;

                          case BH of
                            0: vidmem:=256;
                            1: vidmem:=512;
                            2: vidmem:=1024;
                          else
                            vidmem:=0;
                          end;

                          { Chip revision };
                          EndString := EndString + 'Rev : ' + StrFnByte(xbyte and $0F);

                          { micro-channel };
                          If (CX and 2) = 2 Then EndString := Endstring + ', MCA';

                          { DAC size };
                          if CX and 1 = 1 then
                            EndString := EndString + ', 8-Bit DAC'
                          else
                            EndString := EndString + ', 6-Bit DAC';
                        End;
                    end;
              end;

            if vgacard = standard then
              begin
                { Trident };

                wrinx ($3C4, $B, 0);    {Force old_mode_registers}
                SubVers := Port[$3C5];      {Read chip ID and switch to new_mode_registers}
                old := rdinx ($3C4, $E);
                Port[$3C5] := 0;
                xByte := Port[$3C5] And $F;
                Port [$3C5] := old;

                if xByte=2 then
                  begin
                    vgacard := trident;
                    cardnumber := 15;
                    Port[$3C5] := old xor 2;
                    case SubVers of
                      1       : Begin EndString := EndString + ', Trident TR8800BR'; Dec(CardNumber) End;
                      2       : Begin EndString := EndString + ', Trident TR8800CS'; Dec(CardNumber) End;
                      3       : EndString := EndString + ', Trident TR8900';
                      4,$13   : EndString := EndString + ', Trident TR8900C';
                      $23     : EndString := EndString + ', Trident TR9000';
                      $33     : EndString := EndString + ', Trident TR8900CL oder D';
                      $43     : EndString := EndString + ', Trident TR9000i';
                      $53     : EndString := EndString + ', Trident TR8900CXr';
                      $63     : EndString := EndString + ', Trident LCD9100B';
                      $83     : EndString := EndString + ', Trident LX8200';
                      $93     : EndString := EndString + ', Trident TVGA9200CXi';
                      $A3     : EndString := EndString + ', Trident LCD9320';
                      $73,$F3 : EndString := EndString + ', Trident GUI9420';
                    end;
                    case SubVers Of
                      1..4, $13, $23, $43 : Begin
                                              xByte2 := RdInx ($3d4, $1f);
                                              Case xByte And 3 Of
                                                0 : VidMem := 256;
                                                1 : VidMem := 512;
                                                2 : VidMem := 768;
                                                3 : VidMem := 1024;
                                              End;
                                            End;
                      $73, $F3, $33, $53 : Begin
                                             xByte2 := RdInx ($3d4, $1f);
                                             Case xByte And 7 Of
                                               0,4 : VidMem := 256;
                                               1,5 : VidMem := 512;
                                               2,6 : VidMem := 768;
                                               3   : VidMem := 1024;
                                               7   : VidMem := 2048;
                                             End;
                                           End;
                    End;
                  end
                else if (SubVers = 1) and testinx2 ($3C4, $E, 6) Then
                  Begin
                    vgacard := Trident;
                    CardNumber := 14;
                    EndString := EndString + 'Trident TVGA 8800BR';
                  End;

                IF vgacard = Trident Then
                  Begin
                    with regs do
                      begin
                        AX:=$7000;
                        BX:=0;
                        Intr($10, regs);
                        if AL = $70 then
                          begin
                            { Everex Card };
                            CardNumber := 16;
                            DX:=(DX and $FFF0) shr 4;
                            case DX of
                              $678: EndString := EndString + ', Everex Viewpoint';
                              $236: EndString := EndString + ', Everex Ultragraphics II';
                              $620: EndString := EndString + ', Everex Vision VGA';
                              $673: EndString := EndString + ', Everex EVGA'
                            Else
                              EndString := EndString + ', unbekannte Everex';
                            end; {case}
                            vidmem:=((CH shr 6) * 256) + 256;
                            {'Monitor' };
                            if CL < 8 then
                              EndString := EndString + ', Monitor '+ trividmons[CL]
                            else
                              EndString := EndString + 'Monitor Unbekannt - ' + StrFnByte(CL);
                            end
                    End;
                  end;
              end;

            if vgacard = standard then
              begin
                { Tseng };
                xbyte:=tsengCK;
                if xbyte = 1 then
                  begin
                    CardNumber := 17;
                    EndString := EndString + ', Tseng ET ';
                    if Port[$3CC] and 1 = 1 then
                      xword:=$3D0
                    else
                      xword:=$3B0;

                    Port[xword + 4]:=$33;
                    xbyte:=Port[xword + 5];
                    Port[xword + 5]:=xbyte xor $F;
                    xbyte2:=Port[xword + 5];
                    Port[xword + 5]:=xbyte;

                    Port[$3BF] := 3;
                    Port[$3D8] := $A0;
                    if testreg ($3CB, $33) then
                      case rdinx ($217A, $EC) shr 4 of
                        0 : Begin CardNumber := 18; EndString := EndString + '4000W32' End;
                        3 : Begin CardNumber := 18; EndString := EndString + '4000W32i' End;
                        2 : Begin CardNumber := 18; EndString := EndString + '4000W32p' End;
                      end
                    Else
                      if xbyte2 = xbyte xor $F then
                        begin
                          EndString := EndString + '4000';

                          CardNumber := 18;
                          Port[$3BF]:=3;
                          Port[$3D8]:=$A0;
                          with regs do
                            begin
                              AX:=$10F1;
                              BL:=0;
                              Intr($10, regs);
                              if BL <> 0 then
                                EndString := EndString + ' mit HiColor RAMDAC';
                            end;
                          Port[xword + 4]:=$37;
                          xbyte:=Port[xword + 5];
                          if xbyte and 8 = 0 then
                            vidmem:=256
                          else
                            case xbyte and 3 of
                              0,1: vidmem:=256;
                              2: vidmem:=512;
                              3: vidmem:=1024;
                            end;
                        end
                      else
                        Begin
                          EndString := EndString + '3000';
                          cardnumber := 17;
                        End;

                Port[xword + 4]:=$36;
                xbyte:=Port[xword + 5];

                { Memory type };
                if xbyte and $80 = $80 then
                  EndString := EndString + ', VRAM'
                else
                  EndString := EndString + ', DRAM';

                Port[$3C4]:=7;
                xbyte:=Port[$3C5];
                End;
              end;

            if vgacard = standard then
              begin
                { ZyMOS };
                if zymosCK = 2 then
                  begin
                    EndString := EndString + ', ZyMOS';
                    vgacard := zymos;
                    CardNumber := 19;
                  end;
              end;

            if vgacard = standard then
              begin
                { Oak }
                if testinx2 ($3DE, $D, $38) then
                  begin
                    vgacard := oak;
                    cardnumber := 32;

                    if testinx2 ($3DE, $23, $1F) then
                      Begin
                        if (rdinx ($3DE, 0) and 2) = 0 then EndString := EndString + 'OAK OTI-087'
                          else EndString := EndString + 'OAK OTI-083';

                        case rdinx ($3DE, 2) and 6 of
                          0 : vidmem := 256;
                          2 : vidmem := 512;
                          4 : vidmem := 1024;
                          6 : vidmem := 2048;
                        end;
                      End
                    Else
                      Begin
                        case Port[$3DE] div 32 of
                          0 : EndString := EndString + 'OAK OTI037C';
                          2 : EndString := EndString + 'OAK OTI-067';
                          5 : EndString := EndString + 'OAK OTI-077';
                          7 : EndString := EndString + 'OAK OTI-057';
                        Else
                          EndString := EndString + 'unbekannte OAK';
                        end;

                        case rdinx($3de,13) shr 6 of
                          2    : vidmem := 512;
                          1, 3 : vidmem := 1024;
                        end;
                      End;
                  end;
              end;

            if vgacard = standard then
              with regs do
                begin
                  { ATI }
                  s := readROM($C000, $31, 9);
                  if s = '761295520' then
                    begin
                      VgaCard := ati;
                      CardNumber := 20;
                      EndString := EndString + ', ATI ';
                      C := Chr(Mem[$C000:$43]);
                      case c of
                        '1' : Begin
                                CardNumber := 21;
                                EndString := EndString + '18800';
                              End;
                        '2' : Begin
                                CardNumber := 21;
                                EndString := EndString + '18800-1';
                              End;
                        '3' : Begin
                                CardNumber := 26;
                                EndString := EndString + '28800-2';
                              End;
                        '4' : Begin
                                CardNumber := 26;
                                EndString := EndString + '28800-4';
                              End;
                        '5' : Begin
                                CardNumber := 26;
                                EndString := EndString + '28800-5';
                              End;
                        '6' : Begin
                                CardNumber := 26;
                                EndString := EndString + '28800-6';
                              End;
                        'a' : Begin
                                CardNumber := 26;
                                EndString := EndString + '68800';
                              End;
                      end;

                      { Board }
                      s := ReadROM ($C000, $40, 2);
                      if s = '31' then
                        EndString := EndString + 'VGAWonder';
                      if s = '32' then
                        EndString := EndString + 'EGAWonder 800+';
                      if s = '22' then
                        EndString := EndString + 'EGAWonder';
                      s := ReadROM ($C000, $41, 1);
                      if s = '3' then
                        EndString := EndString + 'Basic-16';

                      { Revision }
                      EndString := EndString + 'Bios : ' + StrFnByte(Mem[$C000:$4C]) + '.' + StrFnByte (Mem[$C000:$4D]);
                    end;
                End;

            if vgacard = standard then
              begin
                { Paradise }

                old := rdinx ($3CE, $F);
                setinx ($3CE,$F,$17);   {Lock registers}
                if not testinx2 ($3CE, 9, $7F) then
                  begin
                    modinx ($3CE, $F, $17, 5);      {Unlock again}
                    if testinx2 ($3CE, 9, $7F) then
                      begin
                        old2 := rdinx ($3D4, $29);
                        modinx ($3d4, $29, $8F, $85);  {Unlock WD90Cxx registers}
                        if not testinx2 ($3D0, $2B, $ff) then
                          Begin
                            EndString := EndString + ', Paradise PVGA1A';
                            vgacard := paradise;
                            cardnumber := 22;
                          End
                        else
                          begin
                            wrinx ($3C4, 6, $48);
                            if not testinx2 ($3C4, 7, $F0) then
                              Begin
                                EndString := EndString +  ', Western Digital WD90C00';
                                vgacard := paradise;
                                cardnumber := 22;
                              End
                            else if not testinx2 ($3C4, $10, $ff) then
                                begin
                                  vgacard := paradise;
                                  cardnumber := 22;
                                  if testinx2 ($3D0,$31,$68) then  EndString := EndString + ', Western Digital WD90C22'
                                    else if testinx2 ($3D0,$31,$90) then EndString := EndString + ', Western Digital WD90C20A'
                                      else EndString := EndString + ', Western Digital WD90C20';
                                  wrinx ($3d4, $34, $A6);
                                  if (rdinx ($3d4, $32) and $20) <> 0 then wrinx ($3d4, $34, 0);
                                end
                              else if testinx2 ($3C4, $14, $F) then
                                begin
                                  vgacard := paradise;
                                  cardnumber := 22;
                                  SubVers := (rdinx ($3D0, $36) shl 8) + rdinx ($3D0, $37);
                                  case SubVers of
                                    $3234 : EndString := EndString + ', Western Digital WD90C24';
                                    $3236 : EndString := EndString + ', Western Digital WD90C26';
                                    $3330 : EndString := EndString + ', Western Digital WD90C30';
                                    $3331 : EndString := EndString + ', Western Digital WD90C31';
                                    $3333 : EndString := EndString + ', Western Digital WD90C33';
                                  else
                                    EndString := EndString + ', unbekannte Paradise';
                                  end;
                                end
                              else if not testinx2 ($3C4, $10, 4) then
                                Begin
                                  EndString := EndString + ', Western Digital WD90C10';
                                  vgacard := paradise;
                                  cardnumber := 22;
                                End
                              else
                                Begin
                                  EndString := EndString + ', Western Digital WD90C11';
                                  vgacard := paradise;
                                  cardnumber := 22;
                                End;
                          end;
                        wrinx ($3d4, $29, old2);
                      end;
                    wrinx ($3CE, $F, old);
                  End;


                  if vgacard = paradise Then
                    Begin
                      Port[$3CE]:=$0B;
                      for xbyte:=1 to 2 do;
                      xbyte:=Port[$3CF];
                      vidmem:=word(64) * (xbyte shr 4);

                      { Video }
                      If (xbyte and 4) = 0 Then EndString := EndString +
                        ', 8-Bit-Video' Else EndString := EndString +
                        ', 16-Bit-Video';

                      { ROM };
                      If (xbyte and 2) = 0 Then EndString := EndString +
                        ', 8-Bit-ROM' Else EndString := EndString +
                        ', 16-Bit-ROM';

                      { Frequencies are };
                      Port[$3CE]:=$0F;
                      xbyte:=Port[$3CF];
                      if (xbyte and $80) = $80 then
                        EndString := Endstring + 'Multi-Sync'
                      Else
                        EndString := EndString + 'fixed-sync';
                      Port[xword + 4]:=$29;
                      Port[xword + 5]:=paralock2;
                      Port[$3CE]:=$F;
                      Port[$3CF]:=paralock1;
                    End;
              end;


            if vgacard = standard Then
              Begin
                { Avance Logic }
                Port[$3D4] := $1A;
                xByte := Port[$3D5];

                {Disable Extensions}
                Port[$3D4] := $1A;
                If xByte And $10 = $10 Then Port[$3D5] := xByte Or $10
                  Else Port[$3D5] := xByte;

                if not testinx2 ($3d4, $19, $ff) then
                  begin
                    {Enable Extensions}
                    If xByte And $10 = $10 Then Port[$3D5] := xByte Else Port[$3D5] := xByte Or $10;

                    if testinx2($3d4, $19, $ff) and testinx2($3d4, $1A, $3F) then
                      Begin
                        vgacard := avance;
                        cardnumber := 27;
                        EndString := EndString + ', Avance Logic AL2101';
                        Port[$3D4] := $1E;
                        xByte2 := Port[$3D5];
                        If (xByte2 And 1 = 0) And (xByte2 And 2 = 0) Then VidMem := 256
                          Else If (xByte2 And 1 = 0) And (xByte2 And 2 = 2) Then VidMem := 512
                          Else If (xByte2 And 1 = 1) And (xByte2 And 2 = 0) Then VidMem := 1024
                          Else If (xByte2 And 1 = 1) And (xByte2 And 2 = 2) Then VidMem := 2048;
                      End;
                  end;
                Port[$3d4] := $1A;
                Port[$3D5] := xByte;
              End;

            if vgacard = standard then
              begin
                { Compaq }
                old := rdinx ($3CE, $F);
                wrinx ($3CE, $F, 0);
                if not testinx2 ($3CE,$45, $ff) then
                  begin
                    wrinx ($3CE, $F, 5);
                    if testinx2 ($3CE,$45, $ff) then
                      begin
                        SubVers := rdinx ($3CE, $C) shr 3;
                        case SubVers of
                          3   : EndString := EndString + ', Compaq IVGS';
                          5   : EndString := EndString + ', Compaq AVGA';
                          6   : EndString := EndString + ', Compaq QVision 1024';
                          $E  : if (rdinx($3CE,$56) and 4) > 0 then EndString := EndString + ', Compaq QVision 1280'
                                else EndString := EndString + ', Compaq QVision 1024';
                          $10 : EndString := EndString + ', Compaq AVPort';
                        else
                          EndString := EndString + ', unbekannte Compaq';
                        end;
                        if (rdinx ($3CE, $C) and $B8) = $30 then  {QVision}
                          begin
                            wrinx ($3CE, $F, $F);
                            case rdinx ($3CE, $54) of
                              0 : vidmem := 1024;  {QV1024 fix}
                              2 : vidmem := 512;
                              4 : vidmem := 1024;
                              8 : vidmem := 2048;
                            end;
                            DAC_RS2:=$8000;
                            DAC_RS3:=$1000;
                          end
                        else
                          begin
                            regs.ax := $BF03;
                            regs.bx := 0;
                            regs.cx := 0;

                            Intr($10, Regs);
                            if (regs.ch and 64) = 0 then vidmem := 512;
                          end;

                        CardNumber := 28;
                        vgacard := compaq;
                      end;
                  end;
                wrinx ($3CE, $F, old);
              End;

            if vgacard = standard Then
              Begin
                { MXIC }
                old := rdinx ($3C4, $A7);
                wrinx ($3C4, $A7, 0);     {Disable extensions}
                if not testinx2 ($3C4, $C5, $ff) then
                  begin
                    wrinx ($3C4, $A7, $87);
                    if testinx2 ($3C4,$C5, $ff) then
                      Begin
                        vgacard := mxic;
                        cardnumber := 30;
                        if (rdinx ($3C4, $26) and 1) = 0 then EndString := EndString + ', MXIC MX86010'
                          else EndString := EndString + ', MXIC MX86000';
                      End;
                  end;
                wrinx ($3C4, $A7, old);
              End;


            if vgacard = standard Then
              Begin
                { NCR VGA }
                if testinx2 ($3C4, 5, 5) then
                  begin
                    wrinx ($3C4, 5, 0);   {Lock extensions}
                    if not testinx2 ($3C4, $10, $ff) then
                      begin
                        wrinx ($3C4, 5, 1);
                        if testinx2 ($3C4, $10, $ff) then
                          Begin
                            vgacard := ncr;
                            cardnumber := 31;
                            case rdinx ($3C4, 8) div 16 of
                              0     : EndString := EndString + ', NCR 77C22';
                              1     : EndString := EndString + ', NCR 77C21';
                              2     : EndString := EndString + ', NCR 77C22E';
                              8..15 : EndString := EndString + ', NCR 77C22E+';
                            end;
                          End;
                      end;
                  end;
              End;

            if vgacard = standard Then
              Begin
                { Primus 2000 }
                if testinx2 ($3CE, $3D, $3F) and testreg ($3D6, $1F) and testreg ($3D7, $1F) then
                  Begin
                    vgacard := p2000;
                    cardnumber := 33;
                    EndString := EndString + ', Primus 2000';
                  End;
              End;


            if vgacard = standard Then
              Begin
                { Realtek }
                if testinx2 ($3D0, $1F, $3F) And testreg ($3D6,$F) and testreg ($3D7,$F) then
                  Begin
                    vgacard := realtek;
                    cardnumber := 34;
                    case rdinx ($3D0, $1A) shr 6 of
                      0 : EndString := EndString + ', Realtek RT3103';
                      1 : EndString := EndString + ', Realtek RT31030/RT3105';
                      2 : EndString := EndString + ', Realtek RT3106';
                    end;
                    Regs.AX := $5F02;
                    Intr ($10, Regs);
                    If Regs.AH = 0 Then
                      Case Regs.AL Of
                        0 : VidMem := 256;
                        1 : VidMem := 512;
                        2 : VidMem := 768;
                        3 : VidMem := 1024;
                      End;
                  End;
              End;

            if vgacard = standard Then
              Begin
                { UMC 85c408 }
                old := Port[$3BF];
                Port[$3BF] := 3;
                if not testinx2 ($3C4, 6, $ff) then
                  begin
                    Port[$3BF] := $AC;
                    if testinx2 ($3C4, 6, $ff) then
                      Begin
                        vgacard := umc;
                        cardnumber := 35;
                        EndString := EndString + ', UMC 85c408';
                        Port[$3C4] := 7;
                        Case (Port[$3C5] And 192) Shr 6 Of
                          0    : VidMem := 256;
                          1    : VidMem := 512;
                          2..3 : VidMem := 1024;
                        End;
                      End
                  end;
                Port[$3BF] := old;
              End;

            if vgacard = standard Then
              Begin
                { Weitek }

                old := rdinx ($3C4, $11);
                Port[$3C4+1] := old;
                Port[$3C4+1] := old;
                Port[$3C4+1] := Port[$3C4+1] or $20;
                if not testinx2 ($3C4, $12, $ff) then
                  begin
                    xByte := rdinx ($3C4, $11);
                    Port[$3C4+1] := old;
                    Port[$3C4+1] := old;
                    Port[$3C4+1] := Port[$3C4+1] and $DF;
                    if testinx2 ($3C4, $12, $ff) and testreg ($3CD, $FF) then
                      begin
                        EndString := EndString + ', Weitek';
                        vgacard := Weitek;
                        cardnumber := 36;
                      end;
                  end;
                wrinx ($3C4, $11, old);
              End;

            if vgacard = standard Then
              Begin
                { Yamaha 6388 }
                if testinx2 ($3d4,$7c,$7c) then
                  Begin
                    EndString := EndString + ', Yamaha 6388';
                    vgacard := yamaha;
                    cardnumber := 37;
                  End;
              End;

            if vgacard = standard Then
              Begin
                { S3 }
                Port[$03D4] := $38; { disable extensions }
                Port[$03D5] := $00;

                if not testinx2 ($03D4,$35,$FF) then
                  begin
                    Port[$03D4] := $38;
                    Port[$03D5] := $48;
                    if testinx2($03D4,$35,$F) then
                      begin
                        { Es ist eine S3 }
                        CardNumber := 23;
                        EndString := EndString + ', S3 ';
                        vgacard := s3;

                        Port [$3D4] := $30;
                        xByte := Port [$3D5];
                        Case xByte Of
                          $81      : EndString := EndString + '86c911';
                          $82      : EndString := EndString + '86c911A oder 86c924';
                          $90      : EndString := EndString + '86c928 C';
                          $91      : EndString := EndString + '86c928 D';
                          $94, $95 : EndString := EndString + '86c928 E';
                          $A0      : EndString := EndString + '86c801/5 A oder B';
                          $A2..$A4 : EndString := EndString + '86c801/5 C';
                          $A5      : EndString := EndString + '86c801/5 D';
                          $B0      : EndString := EndString + '86c928 PCI';
                          $E1      : EndString := EndString + '86c868/86c968 PCI';
                        Else
                          EndString := EndString + 'unbekannt';
                        end;

                        If xByte > $90 Then CardNumber := 24;
                        If xByte > 4 Then
                          Begin
                            Port [$3D4] := $36;
                            xByte := Port[$3D5];
                            If(xByte And $20 = $20) Then VidMem := 512
                              Else If (xByte And Not $40 = $40) And
                              (xByte And Not $80 = $80) Then VidMem := 4096
                              Else If (xByte And Not $40 = $40) And
                              (xByte And $80 = $80) Then VidMem := 3072
                              Else If (xByte And $40 = $40) And
                              (xByte And Not $80 = $80) Then VidMem := 2048
                              Else If (xByte And $40 = $40) And
                              (xByte And $80 = $80) Then VidMem := 1024;
                          End
                        Else
                          Begin
                            Port [$3D4] := $36;
                            If Port[$3D5] And $20 = $20 Then VidMem := 512
                              Else VidMem := 1024;
                          End;
                      end;
                  end;
              End;

            if vgacard = standard Then
              Begin
                { Hualon HM86304 }
                if testinx2 ($3C4,$E7,$ff) and testinx2($3C4,$EE,$ff) then
                  begin
                    CardNumber := 29;
                    vgacard := hualon;
                    EndString := EndString + ', Hualon HM86304';
                    If RdInx ($3C4, $E7) And $10 = $10 Then VidMem := 512
                      Else VidMem := 256;
                  end;
              End;

            if vgacard = standard then
              begin
                EndString := Endstring + ', unbekannter Chipsatz';
              end;

            If VesaInf (1) = 'ja' Then EndString := EndString + ', VESA';

          end;
    PC3270 : begin
               EndString := '3270 PC';
               CardNumber := 7;
             end
  Else
    Begin
      EndString := 'unbekannte Grafikkarte';
      CardNumber := 0;
    End;
  End; {case}

  If VidMem <> 0 Then EndString := EndString + ', ' + StrFnWord(VidMem) +
    'kb Video Memory';

  If (VidMem <> 0) And (VesaInf (1) = 'ja') Then
    Begin
      LoadVESARecords;
      EndString := EndString + ', ' + StrFnWord (VesaInfo.Mem64k * 64) + 'kb Video Memory (VESA)';
    End;

  If VidMem = 0 Then
    Begin
      Regs.AH := $12;
      Regs.BL := $10;
      Intr ($10, Regs);
      { Memory }
      If Regs.BL < 4 Then
        Case Regs.BL Of
          0   : VidMem := 64;
          1   : VidMem := 128;
          2   : VidMem := 192;
          3   : VidMem := 256;
        Else
          VidMem := 0;
        End;
      If VidMem <> 0 Then EndString := EndString + ', ' + StrFnWord(VidMem) +
        'kb Video Memory (BIOS)';
    End;

  WhatGCard := EndString;
End;


Function WhatGCardNumber;

Begin
  WhatGCard;
  WhatGCardNumber := CardNumber;
End;


Function VesaInf;

  Function IsVesa : Boolean;

  Begin
    Regs.AX:=$4F00;
    Regs.ES:=Seg(VESAinfo);
    Regs.DI:=Ofs(VESAinfo);
    Intr($10, regs);
    If (Regs.AL = $4F) and (Regs.AH = 0) and (VESAinfo.signature =
    'VESA') then IsVesa := True Else IsVesa := False;
  End;

Begin
  Case InfoNumber Of
    1 : Begin
          { ist installiert ? }
          If IsVesa = True Then VesaInf := 'ja' else VesaInf := 'nein';
        End;
    2 : Begin
          { Version }
          LoadVESARecords;
          VesaInf := StrFnWord (Hi(VesaInfo.Version))+'.'+StrFnWord (Lo(VesaInfo.Version));
        End;
    3 : Begin
          { OEM Id }
          LoadVESARecords;
          s := '';
          c := Chr(Mem[VesaInfo.OemNameSeg:VesaInfo.OemNameOfs]);
          xword2 := VesaInfo.OemNameOfs;
          While c <> #0 Do
            Begin
              s := s + c;
              Inc(Xword2);
              C:=Chr(Mem[VesaInfo.OemNameSeg:xword2])
            End;
          If s = '761295520' then
            VesaInf := 'ATI'
          Else
            VesaInf := s;
        End;
  End;
End;


Function VESAIsVidMode;

Begin
  If VesaInf (1) = 'ja' Then
    Begin
      LoadVESARecords;
      xword2:=VESAinfo.modesSeg;
      xword3:=VESAinfo.modesOfs;
      xBool := False;
      with VESAmode do
        while MemW[xword2:xword3] <> $FFFF do
          begin
            If (MemW[xword2:xword3] = Mode) Then xBool := True;
            Inc(xword3, 2);
           end;
      VESAIsVidMode := xBool;
    End
  Else
    VesaIsVidMode := False;
End;


Function VESAVidModeString;

Begin
  If VesaInf (1) = 'ja' Then
    Begin
      If VesaIsVidMode (Mode) Then
        Begin
          Regs.AX := $4F01;
          Regs.CX := Mode;
          Regs.ES := Seg(VESAmode);
          Regs.DI := Ofs(VESAmode);
          Intr ($10, Regs);
          If Not Regs.AL = $4F Then
            VesaVidModeString := 'VESA-Funktion nicht untersttzt'
          Else
            Begin
              If Vesamode.ModeAttr And 1 = 1 Then
                Begin
                  S := '';
                  If Vesamode.ModeAttr And $10 = $10 Then S := S + 'Grafik, '
                    Else S := S + 'Text, ';

                  If Vesamode.ModeAttr And 8 = 8 Then S := S + 'Farbe, '
                    Else S := S + 'Monochrom, ';

                  If Vesamode.ModeAttr And 4 = 4 Then S := S + 'BIOS, '
                    Else S := S + 'k. BIOS, ';
                  S := S + 'Char : ' + StrFnWord (Vesamode.CharWidth) + 'x' + StrFnWord (Vesamode.CharHeight) + ', ';
                  If Z = 46 Then S := S + #13#10;
                  S := S + 'Aufl”sung : ' + StrFnWord (Vesamode.PixWidth) + 'x' + StrFnWord (Vesamode.PixHeight) + ', ';
                  S := S + 'Planes : ' + StrFnWord (Vesamode.MemPlanes) + ', ';
                  S := S + 'Farbtiefe : ' + StrFnByte (Vesamode.Pixelbits) + ', ';
                  If Z = 46 Then S := S + #13#10;
                  S := S + 'Memory-Modell : ';
                  Case Vesamode.Memmodel Of
                    0 : S := S + 'Text';
                    1 : S := S + 'CGA Grafik';
                    2 : S := S + 'HGC Grafik';
                    3 : S := S + '16-Farben (EGA) Grafik';
                    4 : S := S + 'Packed Pixel Grafik';
                    5 : S := S + '"Sequ 256" (non-chain 4) Grafik';
                    6 : S := S + 'Direct color (HiColor, 24-bit color)';
                    7 : S := S + 'YUV bzw. YIQ (luminance-chrominance)';
                  End;

                  VesaVidModeString := S;
                End
              Else
                VesaVidModeString := 'VESA-Mode nicht untersttzt';
            End;
        End
      Else
        VesaVidModeString := 'VESA-Mode nicht implementiert';
    End
  Else
    VesaVidModeString := 'VESA-Interface nicht vorhanden';
End;


Function WhatRamDac;

  Procedure cli;
    Inline($FA);

  Procedure sti;
    Inline($FB);

  procedure dac2comm;   {switches DAC to command register}

  var x : word;

  begin
    x := Port[$3C8];    {clear old state}
    x := Port[$3C6];
    x := Port[$3C6];
    x := Port[$3C6];    {Read $3C6 4 times.}
    x := Port[$3C6];
  end;


  procedure dac2pel;  {switches DAC back to normal mode}

  var x : word;

  begin
    x := Port[$3C8];
  end;

  function trigdac:word;  {Reads $3C6 4 times}

  var x : word;

  begin
    x := Port[$3c6];
    x := Port[$3c6];
    x := Port[$3c6];
    trigdac := Port[$3c6];
  end;



  function getdaccomm:word;

  begin
    if DAC_RS2 <> 0 then getdaccomm := Port[$3C6+DAC_RS2] else
      begin
        dac2comm;
        getdaccomm:= Port[$3C6];
        dac2pel;
      end;
  end;


  function testdac : string;

  var
    x          : word;
    y          : word;
    z          : word;
    v          : word;
    oldcomm    : word;
    oldpel     : word;
    dac8       : boolean;
    dac8now    : boolean;
    notcomm    : word;
    daccomm    : word;

  type
    pel = record
            index : byte;
            red   : byte;
            green : byte;
            blue  : byte;
          end;

    procedure readpelreg (index : word; var p : pel);

    begin
      p.index := index;
      cli;
      Port[$3C7] := index;
      p.red  := Port[$3C9];
      p.blue := Port[$3C9];
      p.green:= Port[$3C9];
      sti;
    end;


    procedure writepelreg (var p : pel);

    begin
      cli;
      Port[$3C8] := p.index;
      Port[$3C9] := p.red;
      Port[$3C9] := p.blue;
      Port[$3C9] := p.green;
      sti;
    end;


    function setcomm (cmd : word) : word;

    begin
      dac2comm;
      Port[$3c6] := cmd;
      dac2comm;
      setcomm := Port[$3c6];
    end;


    procedure waitforretrace;

    begin
      repeat until (Port[$3D4+6] and 8) = 0;
      repeat until (Port[$3D4+6] and 8) > 0;    {Wait until we're in retrace}
    end;


    function dacis8bit : boolean;

    var
      pel2 : word;
      x    : word;
      v    : word;
      pel1 : pel;

    begin
      pel2 := Port[$3C8];
      readpelreg (255, pel1);
      v := pel1.red;
      pel1.red := 255;
      writepelreg (pel1);
      readpelreg (255, pel1);
      x := pel1.red;
      pel1.red := v;
      writepelreg (pel1);
      Port[$3C8] := pel2;
      dacis8bit := (x = 255);
    End;


    function testdacbit (bit : word) : boolean;

    begin
      dac2pel;
      Port[$3C6] := oldpel and (bit xor $FF);
      dac2comm;
      cli;
      Port[$3C6] := oldcomm or bit;
      v := Port[$3C6];
      Port[$3C6] := v and (bit xor $FF);
      sti;
      testdacbit := (v and bit) <> 0;
    end;

  begin
    daccomm := getdaccomm;
    EndString := 'Normal';
    dac2comm;
    oldcomm := Port[$3C6];
    dac2pel;
    oldpel := Port[$3c6];

    dac2comm;
    Port[$3c6] := 0;
    dac8 := dacis8bit;
    dac2pel;

    notcomm := oldcomm xor 255;
    Port[$3c6] := notcomm;
    dac2comm;
    v := Port[$3c6];
    if v <> notcomm then
      if (setcomm ($E0) and $e0) <> $e0 then
        begin           {Bits 5-7 of command register NOT writable.}
          dac2pel;
          x := Port[$3C6];
          repeat
            y := x;         {wait for the same value twice}
            x := Port[$3C6];
          until (x = y);
          z := x;
          dac2comm;
          if daccomm <> $8E then
            begin                 {If command register=$8e, we've got an SS24}
              y := 8;
              repeat
                x := Port[$3C6];
                dec (y);
              until (x = $8E) or (y = 0);
            end
          else
            x := daccomm;
          if x = $8e then EndString := 'SS24'
            else EndString := 'Sierra SC11486';
          dac2pel;
        end
      else
        begin
          if (setcomm($60) and $E0) = 0 then
            begin
              if (setcomm (2) and 2) > 0 then EndString := 'AT&T 20c490'
                else EndString := 'AT&T 20c493';
            end
          else
            begin
              x := setcomm (oldcomm);
              if Port[$3c6] = notcomm then
                begin
                  if setcomm ($FF) <> $ff then EndString := 'Acumos ADAC1'
                    else
                      begin
                        dac8now := dacis8bit;
                        dac2comm;
                        Port[$3C6] := (oldcomm or 2) and $FE;
                        dac8now := dacis8bit;
                        if dac8now then
                          if dacis8bit then EndString := 'AT&T 20c491'
                            else EndString := 'Cirrus 24bit DAC'
                        else EndString := 'AT&T 20c492';
                      end;
                end
              else
                begin
                  if trigdac = notcomm then EndString := 'Cirrus 24bit DAC' else
                    begin
                      dac2pel;
                      Port[$3c6] := $FF;
                      case trigdac of
                        $44 : EndString := 'MUSIC ??';
                        $82 : EndString := 'MUSIC MU9C4910';
                        $8e : EndString := 'Diamond SS2410';
                      else
                        if testdacbit ($10) then EndString := 'Sierra 16m'
                          else if testdacbit (4) then EndString := 'Unknown DAC #9'
                            else EndString := 'Sierra 32k/64k';
                      end;
                    end;
            end;
        end;
      end;
      dac2comm;
      Port[$3c6] := oldcomm;

    dac2pel;
    Port[$3c6] := oldpel;

    if (EndString='Normal') and (DAC_RS2 <> 0) and (DAC_RS3 <> 0) then
      begin
        oldpel := Port[$3C6];
        oldcomm:= Port[$3C6+DAC_RS2];
        Port[$3C6+DAC_RS2] := oldpel xor $FF;
        if (Port[$3C6] = oldpel) and (Port[$3C6+DAC_RS2] = (oldpel xor $FF)) then
          EndString := 'Brooktree Bt484';

        Port[$3C6+DAC_RS2] := oldcomm;
        Port[$3C6] := oldpel;
      end;

    if EndString = 'Normal' then
      begin
        WaitforRetrace;
        Port[$3C8] := 222;
        Port[$3C9] := $43;
        Port[$3C9] := $45;
        Port[$3C9] := $47;    {Write 'CEGEDSUN' + mode to DAC index 222}
        Port[$3C8] := 222;
        Port[$3C9] := $45;
        Port[$3C9] := $44;
        Port[$3C9] := $53;
        Port[$3C8] := 222;
        Port[$3C9] := 55;
        Port[$3C9] := $4E;
        Port[$3C9] := 13;     {Should be in CEG mode now}
        Port[$3C6] := 255;
        x := (Port[$3c6] shr 4) and 7;
        if x < 7 then
          begin
            EndString := 'Edsun CEG rev. ' + chr (x + 48);
            WaitforRetrace;
            Port[$3C8] := 223;
            Port[$3C9] := 0;    {Back in normal dac mode}
          end;

	Regs.AX := $10F1;
        Intr ($10, Regs);
        If Regs.AL = $10 Then
          Begin
            Case Regs.BL Of
              0 : EndString := 'Normaler VGA-DAC';
              1 : EndString := 'Sierra SC1148x Hicolor DAC';
              2 : EndString := 'Sierra Mark2 (15 Bit) oder Mark3 (15/16 Bit) DAC';
              3 : EndString := 'ATT20c490/1/2 (15/16/24 Bit)';
              4 : EndString := 'AcuMos ADAC1 (15/16/24 Bit)';
              5 : EndString := 'Unbekannter 15/16/24 Bit DAC';
              6 : EndString := 'Interner Cirrus 15/16/24 Bit DAC';
              7 : EndString := 'Diamond SS2410 (15/24 Bit)';
              8 : EndString := 'Unbekannter 15/16/24 Bit DAC';
              8 : EndString := 'Unbekannter 15/16/24 Bit DAC';
            Else
              EndString := 'Hicolor DAC';
            End;
          End;


      TestDac := EndString;
      end;
    end;


Begin
  WhatGCard; { Fr RS2 und RS3 }
  WhatRamDac := TestDac;
End;


Function GraInf;

Type tStateBuff = Record
       StaticFunc     : Pointer;
       VidMode        : Byte;
       Columns        : Word;
       LengthRegenBuf : Word;
       StartAdrLRB    : Word; { Stard-Adresse Length Regen Buffer }
       CursorPos0     : Word;
       CursorPos1     : Word;
       CursorPos2     : Word;
       CursorPos3     : Word;
       CursorPos4     : Word;
       CursorPos5     : Word;
       CursorPos6     : Word;
       CursorPos7     : Word;
       CursorType     : Word;
       ActivePage     : Byte;
       CRTCPortAdr    : Word;
       CurSet3_8      : Byte;
       CurSet3_9      : Byte;
       Rows           : Byte;
       BytesChar      : Word;
       CombCode       : Byte;
       DCCAlternate   : Byte;
       ColorsCurMode  : Word;
       PagesCurMode   : Byte;
       ScanLines      : Byte; {1,2,3,4 = 200, 350, 400, 480}
       PrimCharBlok   : Byte;
       SecCharBlock   : Byte;
       MiscFlags      : Byte;
         { bit 0 all modes on all displays on
		    1 gray summing on
		    2 monochrome display attached
		    3 default palette loading disabled
		    4 cursor emulation enabled
		    5 0 = intensity; 1 = blinking
		    6 PS/2 P70 plasma display (without 9-dot wide font) active
		    7 reserved }
       Reserved       : Array [0..2] Of Byte;
       AvailVidMem    : Byte;
         { 00 = 64k
           01 = 128k
           02 = 192k
           03 = 256k }
       SPtrStateFlags : Byte;
         {Bit 0 512 character set active
              1 dynamic save area present
	      2 alpha font override active
	      3 graphics font override active
	      4 palette override active
	      5 DCC override active
	      6 reserved
  	      7 reserved}
       Reserved2 : Array [0..12] Of Byte;
     End;


     pStaticFunc = ^tStaticFunc;
     tStaticFunc = Record
       ModesSupp1 : Byte; { Bit 0-7 repr„sentieren Mode 0-7 }
       ModesSupp2 : Byte; { Bit 0-7 repr„sentieren Mode 8-F }
       ModesSupp3 : Byte; { Bit 0-3 repr„sentieren Mode 10-13 Rest reserv. }
       Reserved   : Array [0..3] Of Byte;
       ScanLSupp  : Byte; { Bit 0-2 repr„sentieren Scan Lines 200,350,400 }
       AvailTBM   : Byte; { insgesamt verfgbare Zeichen in Text-Modes }
       MaxTBM     : Byte; { maximal vrfgbare aktive Zeichen in  T-Modes }
       MiscFlags1 : Byte;
         {bit 0 all modes on all displays function supported
	      1 gray summing function supported
	      2 character font loading function supported
	      3 default palette loading enable/disable supported
	      4 cursor emulation function supported
	      5 EGA palette present
	      6 color palette present
	      7 color paging function supported}
       MiscFlags2 : Byte;
         {bit 0 light pen supported
	      1 save/restore state function 1Ch supported
	      2 intensity blinking function supported
	      3 Display Combination Code supported
	      4-7 reserved}
       Reserved2   : Word;
       SavePtrFl  : Byte;
         {bit 0 512 character set supported
	      1 dynamic save area supported
	      2 alpha font override supported
	      3 graphics font override supported
	      4 palette override supported
	      5 DCC extension supported
	      6 reserved
	      7 reserved}
       Reserved3   : Byte;
     End;

     pConfig3270PC = ^tConfig3270PC;
     tConfig3270PC = Record
       XAspect   : Byte;
       YAspect   : Byte;
       MonType   : Byte;
         { 00h = 5151 (mono) or 5272 (color)
           01h = 3295
           02h = 5151 or 5272 with XGA (???) graphics adapter
           03h = 5279 with 3270PC G adapter
           04h = 5379 model C01 with 3270PC GX adapter
           05h = 5379 model M01 with 3270PC GX adapter
           07h = non-3270PC with 3270 Workstation Program
           FFh = 3270PC Control Program not loaded }
       Reserved1  : Byte;
       AdapterId  : Byte;
         { 00h = 5151/5272 adapter
           04h = 5151/5272 with XGA adapter
           30h = 3295 or 3270PC G/GX adapter }
       Reserved2  : Byte;
       FuncFlags1 : Byte;
         { bit 7: mono text, 1 page
               6: color text, 1 page
               5: color text, 4 pages
               4: CGA color graphics
               3: 720x350 two-color graphics
               2: 360x350 four-color graphics
               1: 720x350 eight-color graphics }
       FuncFlags2 : Byte;
         { Bit 6 : GPI graphics supported }
       SegCPL    : Word;
       Reserved3 : Array [0..9] Of Byte;
     End;

     pCPL3270PC = ^tCPL3270PC; { Control Program Level Table }
     tCPL3270PC = Record
       Version    : Word;
         { 02xxh = 3270PC Control Program v2.xx
           03xxh = 3270PC Control Program v3.xx
           04xxh = 3270 Workstation Program v1.xx }
       Id         : Byte;
       Descriptor : String[27]
     End;

Const NA       : String[3]  = 'n/a';
      PC3270NA : String[28] = 'Kontrollprogramm nicht aktiv';
      FG       : String[19] = 'Falsche Grafikkarte';
      Yes      : String[2]  = '[X]';
      No       : String[4]  = '[-]';

      atividmons: array[0..15] of string[25] =
               ('EGA', 'Analog monochrom', 'TTL monochrom', 'Analog Farbe',
                'RGB Farbe', 'Multisync oder kompatibel', 'unbekannt',
                'PS/2 8514 oder kompatibel', 'Seiko 1430', 'MultiSync 2A',
                'Tatung OmniScan', 'NEC 3D oder kompatibel', 'TVM 3M',
                'NEC MultiSync XL/+/4D/5D', 'TVM 2A', 'TVM 3A');

Var StateBuff    : tStateBuff;
    StaticFunc   : pStaticFunc;
    Config3270PC : pConfig3270PC;
    CPL3270PC    : pCPL3270PC;
    String40     : String[40];

    Function d8or16bit (b: boolean) : Byte;

    Begin
      If b then
        d8or16Bit := 8
      Else
        d8or16Bit := 16;
    End;


    Function Byte2Bit (B : Byte) : String;

    Begin
      S := '';
      If B And 1 = 1 Then S := S + 'X' Else S := S + '-';
      If B And 2 = 1 Then S := S + 'X' Else S := S + '-';
      If B And 4 = 1 Then S := S + 'X' Else S := S + '-';
      If B And 8 = 1 Then S := S + 'X' Else S := S + '-';
      If B And $10 = 1 Then S := S + 'X' Else S := S + '-';
      If B And $20 = 1 Then S := S + 'X' Else S := S + '-';
      If B And $30 = 1 Then S := S + 'X' Else S := S + '-';
      If B And $40 = 1 Then S := S + 'X' Else S := S + '-';
    End;


    Function StateSupp : Boolean;

    Begin
      Regs.AH := $1B;
      Regs.BX := $0000;
      Regs.ES := Seg (StateBuff);
      Regs.DI := Ofs (StateBuff);
      If Regs.AL = $1B Then StateSupp := True Else StateSupp := False;
    End;


Begin
  WhatGCard;
  Case InfoNumber Of
    1   : If (CardNumber = 20) Or (CardNumber = 21) Then
             Begin
               { ATI-revision }
               GraInf := StrFnByte (Mem[$C000:$0043]);
             End
           Else
             GraInf := FG;

    2   : Begin
            { EGA Sicherung des Buffers bei Mode-Wechsel }
            If (CardNumber = 4) Or  (CardNumber >= 8) Then
              Begin
                xbyte:=mem[$0040 : $0087];
                If xbyte and $80 = $80 Then GraInf := Yes
                  Else GraInf := No;
              End
            Else
              GraInf := FG;
          End;
    3   : Begin
            { ist EGA aktiv ? };
            If (CardNumber = 4) Or  (CardNumber >= 8) Then
              Begin
                xbyte:=mem[$0040 : $0087];
                If xbyte and $08 = $00 Then GraInf := Yes
                  Else GraInf := No;
              End
            Else
              GraInf := FG;

          End;
    4   : Begin
            { EGA Warten auf Bildschirm-Zugriff ? };
            If (CardNumber = 4) Or  (CardNumber >= 8) Then
              Begin
                xbyte:=mem[$0040 : $0087];
                If xbyte and $04 = $04 Then GraInf := Yes
                  Else GraInf := No;
              End
            Else
              GraInf := FG;
          End;
    5   : Begin
            { EGA CGA-Cursor Emulation ? };
            If (CardNumber = 4) Or  (CardNumber >= 8) Then
              Begin
                xbyte:=mem[$0040 : $0087];
                If xbyte and $01 = $00 Then GraInf := Yes
                  Else GraInf := No;
              End
            Else
              GraInf := FG;
          End;
    6   : Begin
            { EGA Save area }
            If (CardNumber = 4) Or  (CardNumber >= 8) Then
              Begin
                xword1:=memw[$0040 : $00AA];
                xword2:=memw[$0040 : $00A8];
                GraInf := Hex (xword1, 4) + ':' + Hex (xword2, 4);
              End
            Else
              GraInf := FG;
          End;
    7   : Begin
            { EGA Video parameter table }
            If (CardNumber = 4) Or  (CardNumber >= 8) Then
              Begin
                GraInf := hex (memw[memw[$0040 : $00AA] :
                  memw[$0040 : $00A8] +  2],4) + ':' + hex
                    (memw[memw[$0040 : $00AA] : memw[$0040 : $00A8] ],4);
              End
            Else
              GraInf := FG;
          End;
    8   : Begin
            { EGA Dynamic save area }
            If (CardNumber = 4) Or  (CardNumber >= 8) Then
              Begin
                xword1:=memw[memw[$0040 : $00AA] : memw[$0040 : $00A8] + 6];
                xword2:=memw[memw[$0040 : $00AA] : memw[$0040 : $00A8] + 4];
                if (xword1 > $0000) or (xword2 > $0000) then
                  begin
                    GraInf := hex (xword1, 4) + ':' + hex (xword2, 4);
                  end
                else
                  GraInf := NA;
              End
            Else
              GraInf := FG;
          End;
    9   : Begin
            { EGA Auxiliary character generator }
            If (CardNumber = 4) Or  (CardNumber >= 8) Then
              Begin
                xword1:=memw[memw[$0040 : $00AA] : memw[$0040 : $00A8] + 10];
                xword2:=memw[memw[$0040 : $00AA] : memw[$0040 : $00A8] +  8];
                If (xword1 > $0000) or (xword2 > $0000 ) Then
                  Begin
                    GraInf := hex (xword1, 4) + ':' + hex (xword2,4);
                  End
                Else
                  Grainf := NA;
              End
            Else
              GraInf := FG;
          End;
    10  : Begin
            { EGA Graphics mode auxiliary table }
            If (CardNumber = 4) Or  (CardNumber >= 8) Then
              Begin
                xword1:=memw[memw[$0040 : $00AA] : memw[$0040 : $00A8] + 14];
                xword2:=memw[memw[$0040 : $00AA] : memw[$0040 : $00A8] + 12];
                if (xword1 > $0000) or (xword2 > $0000) then
                  Grainf := hex (xword1, 4) + ':' + hex (xword2, 4)
                else
                  GraInf := NA;
              End
            Else
              GraInf := FG;
          End;
    11  : Begin
            { Video 7 Memory }
            If CardNumber = 9 Then
              Begin
                Port[$3C4]:=$FF;
                xbyte:=Port[$3C5];
                GraInf := StrFnByte(d8or16bit((xbyte and 1) = 0));
              end
            Else
              GraInf := FG;
          End;
    12  : Begin
            { Video 7 I/O }
            If CardNumber = 9 Then
              Begin
                Port[$3C4]:=$FF;
                xbyte:=Port[$3C5];
                GraInf := StrFnByte(d8or16bit((xbyte and 2) = 0));
              end
            Else
              GraInf := FG;
          End;
    13  : Begin
            { Video 7 BIOS }
            If CardNumber = 9 Then
              Begin
                Port[$3C4]:=$FF;
                xbyte:=Port[$3C5];
                GraInf := StrFnByte(d8or16bit((xbyte and 8) = 0));
              end
            Else
              GraInf := FG;
          End;
    14  : Begin
            { Video 7 FastWrite }
            If CardNumber = 9 Then
              Begin
                Port[$3C4]:=$FF;
                xbyte:=Port[$3C5];
                GraInf := StrFnByte(d8or16bit((xbyte and 4) = 0));
              end
            Else
              GraInf := FG;
          End;
    15 : Begin
           {Genoa BUS}
           If CardNumber = 10 Then
             Begin
               Port[$3C4]:=5;
               xbyte:=Port[$3C5];
               if (xbyte and 1) = 1 then
                 GraInf := 'PC'
               else
                 GraInf := 'MCA';
             End
           Else
             GraInf := FG;
         End;
    16 : Begin
           {Genoa Video Width}
           If CardNumber = 10 Then
             Begin
               Port[$3C4]:=5;
               xbyte:=Port[$3C5];
               GraInf := StrFnByte(d8or16bit((xbyte and 2) = 2));
             End
           Else
             GraInf := FG;
         End;
    17 : Begin
           {Genoa BiosWidth}
           If CardNumber = 10 Then
             Begin
               Port[$3C4]:=5;
               xbyte:=Port[$3C5];
               Grainf := StrFnByte(d8or16bit((xbyte and 4) = 4));
             End
           Else
             GraInf := FG;
         End;
    18 : Begin
           {Genoa I/O Ports bei}
           If CardNumber = 10 Then
             Begin
               Port[$3C4]:=5;
               xbyte:=Port[$3C5];
               if (xbyte and $10) = $10 then
                 GraInf := '3xxh'
               else
                 GraInf := '2xxh';
             End
           Else
             GraInf := FG;
         End;
    19 : Begin
           {Genoa Bios GrӇe }
           If CardNumber = 10 Then
             Begin
               Port[$3C4]:=5;
               xbyte:=Port[$3C5];
               case (xbyte and $60) shr 5 of
                 0, 3: GraInf := '24K';
                 1: GraInf := '30K';
                 2: GraInf := '32K';
               end;
             End
           Else
             GraInf := FG;
         End;
    20 : Begin
           {Genoa Monitor-Typ}
           If CardNumber = 10 Then
             Begin
               Port[$3C4]:=7;
               xbyte:=Port[$3C5];
               if (xbyte and $20) = $20 then
                 GraInf := 'TTL Digital'
               else
                 GraInf := 'Analog';
             End
           Else
             GraInf := FG;
         End;
    21 : Begin
           {Genoa Chipset auf}
           If CardNumber = 10 Then
             Begin
               Port[$3C4]:=7;
               xbyte:=Port[$3C5];
               if (xbyte and 8) = 8 then
                 GraInf := 'Motherboard'
               else
                 GraInf := 'Adapter Karte';
             End
           Else
             GraInf := FG;
         End;
    22 : Begin
           {Genoa Fast-Scroll}
           If CardNumber = 10 Then
             Begin
               Port[$3C4]:=$10;
               xbyte:=Port[$3C5];
               If (xbyte and 1) = 1 Then GraInf := Yes Else GraInf := No;
             End
           Else
             GraInf := FG;
         End;
    23 : Begin
           {Genoa Fast-Address}
           If CardNumber = 10 Then
             Begin
               Port[$3C4]:=$10;
               xbyte:=Port[$3C5];
               If (xbyte and 2) = 2 Then GraInf := Yes Else GraInf := No;

             End
           Else
             GraInf := FG;
         End;
    24 : Begin
           {Genoa Fast-Write}
           If CardNumber = 10 Then
             Begin
               Port[$3C4]:=$10;
               xbyte:=Port[$3C5];
               If (xbyte and $40) = $40 Then GraInf := Yes Else GraInf := No;
             End
           Else
             GraInf := FG;
         End;
    25 : Begin
           {Genoa 70hz vertical Retrace}
           If CardNumber = 10 Then
             Begin
               Port[$3C4]:=8;
               xbyte:=Port[$3C5];
               If (xbyte and $10) = $10 Then GraInf := Yes Else GraInf := No;
             End
           Else
             GraInf := FG;
         End;
    26 : Begin
           {Interlaced}
           If CardNumber = 10 Then
             Begin
               xword1:=MemW[$40:$63];
               Port[xword1]:=$2F;
               xbyte:=Port[xword1 + 1];
               If (xbyte and 1) = 1 Then GraInf := Yes Else GraInf := No;
             End
           Else
             GraInf := FG;
         End;
    27 : Begin
           {Bios - Trident 8900/Everex}
           If (CardNumber = 15) Or (CardNumber = 16) Then
             Begin
               Port[$3C4]:=$F;
               xbyte:=Port[$3C5];
               If (xbyte and $80) = 0 Then GraInf := '8 Bit-Bios'
                 Else GraInf := '16 Bit-Bios';
             End
           Else
             GraInf := FG;
         End;
    28 : Begin
           {Interlaced - Trident 8900/Everex}
           If (CardNumber = 15) Or (CardNumber = 16) Then
             Begin
               Port[$3C4]:=$1E;
               xbyte:=Port[$3C5];
               If (xbyte and $20) = $20 Then GraInf := Yes Else
                 GraInf := No;
             End
           Else
             GraInf := FG;
         End;
    29 : Begin
           { Tseng ET ROM }
           If (CardNumber = 17) Or (CardNumber = 18) Then
             Begin
               Case CardNumber Of
                 17 : Begin
                        Port[xword + 4]:=$33;
                        xbyte:=Port[xword + 5];
                      End;
                 18 : Begin
                        Port[xword + 4]:=$37;
                        xbyte:=Port[xword + 5];
                      End;
               End;
               If (xbyte and $10) = 0 Then GraInf := '8 Bit ROM' Else
                 GraInf := '16 Bit ROM';
             End
           Else
             GraInf := FG;
         End;
    30 : Begin
           { Tseng ET Video 8/16 }
           If CardNumber = 17 Then
             Begin
               if Port[$3CC] and 1 = 1 then
                 xword:=$3D0
               else
                 xword:=$3B0;
               Port[xword + 4]:=$36;
               xbyte:=Port[xword + 5];
               If (xbyte and $40) = 0 Then GraInf := '8 Bit Video' Else
                 GraInf := '16 Bit Video';
             End
           Else
             GraInf := FG;
         End;
    31 : Begin
           { TSENG ET I/O }
           If CardNumber = 17 Then
             Begin
               if Port[$3CC] and 1 = 1 then
                 xword:=$3D0
               else
                 xword:=$3B0;
               Port[xword + 4]:=$36;
               xbyte:=Port[xword + 5];

               If (xbyte and $80) = 0 Then GraInf := '8 Bit I/O' Else
                 GraInf := '16 Bit I/O';
             End
           Else
             GraInf := FG;
         End;
    32 : Begin
           { TSENG ET Compatibility };
           If CardNumber = 17 Then
             Begin
               if Port[$3CC] and 1 = 1 then
                 xword:=$3D0
               else
                 xword:=$3B0;
               Port[xword + 4]:=$37;
               xbyte:=Port[xword + 5];

               If xbyte and $80 = $80 then
                 GraInf := 'VGA'
               else
                 GraInf := 'EGA';
             End
           Else
             GraInf := FG;
         End;
    33 : Begin
           { TSENG ET ROM address }
           If CardNumber = 17 Then
             Begin
               if Port[$3CC] and 1 = 1 then
                 xword:=$3D0
               else
                 xword:=$3B0;
               Port[xword + 4]:=$37;
               xbyte:=Port[xword + 5];

               if xbyte and $20 = 0 then
                 if xbyte and 8 = 0 then
                   GraInf := 'C000-C3FF'
                 else
                   GraInf := 'abgew„hlt'
               else
                 if xbyte and 8 = 0 then
                   GraInf := 'C000-C5FF und C680 - C7FF'
                 else
                   GraInf := 'C000-C7FF';
             End
           Else
             GraInf := FG;
         End;

    34 : Begin
           { ATI mouse port }
           If (CardNumber = 20) Or (CardNumber = 21) Or (CardNumber = 26) Then
             Begin
               xbyte:=Mem[$C000:$42];
               If (xbyte and 2) = 2 Then GraInf := Yes Else GraInf := No;
             End
           Else
             GraInf := FG;
         End;
    35 : Begin
           { ATI programmable video clock }
           If (CardNumber = 20) Or (CardNumber = 21) Or (CardNumber = 26) Then
             Begin
               xbyte:=Mem[$C000:$42];
               If (xbyte and $10) = $10 Then GraInf := Yes Else GraInf := No;
             End
           Else
             GraInf := FG;
         End;
    36 : Begin
           { ATI monitor }
           If (CardNumber = 20) Or (CardNumber = 21) Or (CardNumber = 26) Then
             Begin
               xword1:=MemW[$C000:$10];
               xbyte:=ATIinfo($BB, xword1);
               GraInf := atividmons[xbyte and $0F];
             End
           Else
             GraInf := FG;
         End;
    37 : Begin
           { ATI 18800+ 70Hz non-interlace }
           If (CardNumber = 21) Or (CardNumber = 26) Then
             Begin
               xbyte:=Mem[$C000:$44];
               If (xbyte and 1) = 1 Then GraInf := Yes Else GraInf := No;
             End
           Else
             GraInf := FG;
         End;
    38 : Begin
           { ATI 18800+ Korean chars }
           If (CardNumber = 21) Or (CardNumber = 26) Then
             Begin
               xbyte:=Mem[$C000:$44];
               If (xbyte and 2) = 2 Then GraInf := Yes Else GraInf := No;
             End
           Else
             GraInf := FG;
         End;
    39 : Begin
           { ATI 18800+ Memory clock }
           If (CardNumber = 21) Or (CardNumber = 26) Then
             Begin
               xbyte:=Mem[$C000:$44];
               if (xbyte and 4 = 4) then
                 GraInf := '45MHz'
               else
                 GraInf := '40MHz';
             End
           Else
             GraInf := FG;
         End;
    40 : Begin
           { ATI 18800+ Zero wait state }
           If (CardNumber = 21) Or (CardNumber = 26) Then
             Begin
               xbyte:=Mem[$C000:$44];
               If (xbyte and 8) = 8 Then GraInf := Yes Else GraInf := No;
             End
           Else
             GraInf := FG;
        End;
   41 : Begin
           { ATI 18800+ Paged ROM's }
           If (CardNumber = 21) Or (CardNumber = 26) Then
             Begin
               xbyte:=Mem[$C000:$44];
               If (xbyte and $10) = $10 Then GraInf := Yes Else GraInf := No;
             End
           Else
             GraInf := FG;
        End;
   42 : Begin
           { ATI 18800+ 8514/A }
           If (CardNumber = 21) Or (CardNumber = 26) Then
             Begin
               xbyte:=Mem[$C000:$44];
               If (xbyte and $40) <> $40 Then GraInf := Yes Else GraInf := No;
             End
           Else
             GraInf := FG;
        End;
   43 : Begin
           { Standard VGA Color Page }
           If CardNumber >= 8 Then
             Begin
               Regs.AX:=$101A;
               Intr ($10, Regs);
               GraInf := hex(Regs.BH, 2) + 'h';
             End
           Else
             GraInf := FG;
        End;
   44 : Begin
           { Standard VGA Paging Mode }
           If CardNumber >= 8 Then
             Begin
               Regs.AX:=$101A;
               Intr ($10, Regs);
               Case Regs.BL Of
                 $00 : GraInf := '4 Seiten von 64 Registern';
                 $01 : GraInf := '16 Seiten von 16 Registern';
               Else
                 GraInf := 'Unbekannter Modus' + Hex(Regs.BL, 2);
               End;
             End
           Else
             GraInf := FG;
        End;
   45 : Begin
          { MCGA/VGA Video Mode }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := StrFnByte (StateBuff.VidMode);
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   46 : Begin
          { MCGA/VGA Length Regenerate Buffer }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := StrFnWord (StateBuff.LengthRegenBuf);
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   47 : Begin
          { MCGA/VGA Start Address Regenerate Buffer }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := Hex (StateBuff.StartAdrLRB, 4);
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   48 : Begin
          { MCGA/VGA Cursor Position Page 0 }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := StrFnWord (StateBuff.CursorPos0);
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   49 : Begin
          { MCGA/VGA Cursor Position Page 1 }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                   GraInf := StrFnWord (StateBuff.CursorPos1);
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   50 : Begin
          { MCGA/VGA Cursor Position Page 2 }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                   GraInf := StrFnWord (StateBuff.CursorPos2);
                End
              Else
                GraInf := NA;

            End
          Else
            GraInf := FG;
        End;
   51 : Begin
          { MCGA/VGA Cursor Position Page 3 }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                   GraInf := StrFnWord (StateBuff.CursorPos3);
                End
              Else
                GraInf := NA;

            End
          Else
            GraInf := FG;
        End;
   52 : Begin
          { MCGA/VGA Cursor Position Page 4 }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                   GraInf := StrFnWord (StateBuff.CursorPos4);
                End
              Else
                GraInf := NA;

            End
          Else
            GraInf := FG;
        End;
   53 : Begin
          { MCGA/VGA Cursor Position Page 5 }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := StrFnWord (StateBuff.CursorPos5);
                End
              Else
                GraInf := NA;

            End
          Else
            GraInf := FG;
        End;
   54 : Begin
          { MCGA/VGA Cursor Position Page 6 }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := StrFnWord (StateBuff.CursorPos6);
                End
              Else
                GraInf := NA;

            End
          Else
            GraInf := FG;
        End;
   55 : Begin
          { MCGA/VGA Cursor Position Page 7 }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := StrFnWord (StateBuff.CursorPos7);
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   56 : Begin
          { MCGA/VGA CursorType }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := StrFnWord (StateBuff.CursorType);
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   57 : Begin
          { MCGA/VGA Active Video Page }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := StrFnByte (StateBuff.ActivePage);
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   58 : Begin
          { MCGA/VGA Bytes/Char }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := StrFnWord (StateBuff.BytesChar);
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   59 : Begin
          { MCGA/VGA Combination Code }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := Hex (StateBuff.CombCode,2) + 'h';
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   60 : Begin
          { MCGA/VGA Colors in Current Mode }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := StrFnWord (StateBuff.ColorsCurMode);
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   61 : Begin
          { MCGA/VGA Pages in Current Mode }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  GraInf := StrFnByte (StateBuff.PagesCurMode);
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   62 : Begin
          { MCGA/VGA Scanlines }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  Case StateBuff.ScanLines Of
                    1 : GraInf := '200';
                    2 : GraInf := '350';
                    3 : GraInf := '400';
                    4 : GraInf := '480';
                  End;
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   63 : Begin
          { MCGA/VGA Default Palette Loading Disabled ? }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  If (StateBuff.MiscFlags And 4) = 1 Then GraInf := Yes
                    Else GraInf := No;
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   64 : Begin
          { MCGA/VGA Cursor Emulation Enabled ? }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                If (StateBuff.MiscFlags And 8) = 1 Then GraInf := Yes
                    Else GraInf := No;
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   65 : Begin
          { MCGA/VGA PS/2 Plasma Display active ? }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  If (StateBuff.MiscFlags And $20) = 1 Then GraInf := Yes
                      Else GraInf := No;
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   66 : Begin
          { MCGA/VGA Welche Modi sind auf dieser Grafikkarte m”glich ? (9-13h) }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  StaticFunc := StateBuff.StaticFunc;
                  GraInf := Byte2Bit (StaticFunc^.ModesSupp1) +
                    Byte2Bit (StaticFunc^.ModesSupp2) +
                      Byte2Bit (StaticFunc^.ModesSupp3);
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   67 : Begin
          { MCGA/VGA Character Font Loading Function Supported }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  StaticFunc := StateBuff.StaticFunc;
                  If (StaticFunc^.MiscFlags1 And 4) = 1 Then GraInf := Yes
                    Else GraInf := No;
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   68 : Begin
          { MCGA/VGA Default Palette Loading Enable/Disable Supported }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  StaticFunc := StateBuff.StaticFunc;
                  If (StaticFunc^.MiscFlags1 And 8) = 1 Then GraInf := Yes
                    Else GraInf := No;
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   69 : Begin
          { MCGA/VGA Cursor Emulation Function Supported }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  StaticFunc := StateBuff.StaticFunc;
                  If (StaticFunc^.MiscFlags1 And $10) = 1 Then GraInf := Yes
                    Else GraInf := No;
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   70 : Begin
          { MCGA/VGA Color Paging Function supported }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  StaticFunc := StateBuff.StaticFunc;
                  If (StaticFunc^.MiscFlags1 And $40) = 1 Then GraInf := Yes
                    Else GraInf := No;
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   71 : Begin
          { MCGA/VGA Light Pen supported }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  StaticFunc := StateBuff.StaticFunc;
                  If (StaticFunc^.MiscFlags2 And 1) = 1 Then GraInf := Yes
                    Else GraInf := No;
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   72 : Begin
          { MCGA/VGA 512 Character Set supported }
          If (CardNumber = 2) Or (CardNumber >= 8) Then
            Begin
              If StateSupp Then
                Begin
                  StaticFunc := StateBuff.StaticFunc;
                  If (StaticFunc^.SavePtrFl And 1) = 1 Then GraInf := Yes
                    Else GraInf := No;
                End
              Else
                GraInf := NA;
            End
          Else
            GraInf := FG;
        End;
   73 : Begin
          { IBM 3270 PC X Aspect Ratio }
          If CardNumber = 7 Then
            Begin
              Regs.AX := $3000;
              Regs.CX := $0000;
              Regs.DX := $0000;
              Intr ($10, Regs);
              If (Regs.CX > 0) Or (Regs.DX > 0) Then
                Begin
                  Config3270PC := Ptr (Regs.CX, Regs.DX);
                  GraInf := StrFnByte (Config3270PC^.XAspect);
                End
              Else
                GraInf := 'Kontrollprogramm nicht aktiv';
            End
          Else
            GraInf := FG;
        End;
   74 : Begin
          { IBM 3270 PC Y Aspect Ratio }
          If CardNumber = 7 Then
            Begin
              Regs.AX := $3000;
              Regs.CX := $0000;
              Regs.DX := $0000;
              Intr ($10, Regs);
              If (Regs.CX > 0) Or (Regs.DX > 0) Then
                Begin
                  Config3270PC := Ptr (Regs.CX, Regs.DX);
                  GraInf := StrFnByte (Config3270PC^.YAspect) ;
                End
              Else
                GraInf := PC3270NA;
            End
          Else
            GraInf := FG;
        End;
   75 : Begin
          { IBM 3270 PC Monitor Typ }
          If CardNumber = 7 Then
            Begin
              Regs.AX := $3000;
              Regs.CX := $0000;
              Regs.DX := $0000;
              Intr ($10, Regs);
              If (Regs.CX > 0) Or (Regs.DX > 0) Then
                Begin
                  Config3270PC := Ptr (Regs.CX, Regs.DX);
                  Case Config3270PC^.MonType Of
                    $00 : GraInf := '5151 (mono) oder 5272 (farbe)';
                    $01 : GraInf := '3295';
                    $02 : GraInf := '5151 oder 5272 nit XGA Grafikkarte';
                    $03 : GraInf := '5279 mit 3270PC G-Adapter';
                    $04 : GraInf := '5379 Mod. C01 mit 3270PC GX-Adapter';
                    $05 : GraInf := '5379 Mod. M01 mit 3270PC GX-Adapter';
                    $06 : GraInf := 'kein 3270PC mit 3270 Workstation Programm';
                    $FF : GraInf := '3270PC Kontrollprogramm nicht geladen';
                  Else
                    GraInf := 'Unbekannter Monitor';
                  End;
                End
              Else
                GraInf := PC3270NA;
            End
          Else
            GraInf := FG;
        End;
   76 : Begin
          { IBM 3270 PC Adapter ID }
          If CardNumber = 7 Then
            Begin
              Regs.AX := $3000;
              Regs.CX := $0000;
              Regs.DX := $0000;
              Intr ($10, Regs);
              If (Regs.CX > 0) Or (Regs.DX > 0) Then
                Begin
                  Config3270PC := Ptr (Regs.CX, Regs.DX);
                  Case Config3270PC^.AdapterId Of
                    $00 : GraInf := '5151/5272 Adapter';
                    $04 : GraInf := '5151/5272 mit XGA Adapter';
                    $30 : GraInf := '3295 oder 3270PC G/GX Adapter';
                  Else
                    GraInf := 'Unbekannter Adapter';
                  End;
                End
              Else
                GraInf := PC3270NA;
            End
          Else
            GraInf := FG;
        End;
   77 : Begin
          { IBM 3270 PC untersttzte Modi }
          If CardNumber = 7 Then
            Begin
              Regs.AX := $3000;
              Regs.CX := $0000;
              Regs.DX := $0000;
              Intr ($10, Regs);
              If (Regs.CX > 0) Or (Regs.DX > 0) Then
                Begin
                  Config3270PC := Ptr (Regs.CX, Regs.DX);
                  GraInf := Byte2Bit (Config3270PC^.FuncFlags1);
                End
              Else
                GraInf := PC3270NA;
            End
          Else
            GraInf := FG;
        End;
   78 : Begin
          { IBM 3270 PC GPI Graphics Support }
          If CardNumber = 7 Then
            Begin
              Regs.AX := $3000;
              Regs.CX := $0000;
              Regs.DX := $0000;
              Intr ($10, Regs);
              If (Regs.CX > 0) Or (Regs.DX > 0) Then
                Begin
                  Config3270PC := Ptr (Regs.CX, Regs.DX);
                  If (Config3270PC^.FuncFlags2 And $20) = 1 Then
                    GraInf := Yes Else GraInf := No;
                End
              Else
                GraInf := PC3270NA;
            End
          Else
            GraInf := FG;
        End;
   79 : Begin
          { IBM 3270 PC Kontrollprogramm-Version }
          If CardNumber = 7 Then
            Begin
              Regs.AX := $3000;
              Regs.CX := $0000;
              Regs.DX := $0000;
              Intr ($10, Regs);
              If (Regs.CX > 0) Or (Regs.DX > 0) Then
                Begin
                  Config3270PC := Ptr (Regs.CX, Regs.DX);
                  CPL3270PC := Ptr (Config3270PC^.SegCPL, 0);
                  Case Hi (CPL3270PC^.Version) Of
                    $01 : GraInf := '3270PC Control Program v1.' +
                                     ZeroPad (Lo (CPL3270PC^.Version));
                    $02 : GraInf := '3270PC Control Program v2.' +
                                     ZeroPad (Lo (CPL3270PC^.Version));
                    $03 : GraInf := '3270PC Control Program v3.' +
                                     ZeroPad (Lo (CPL3270PC^.Version));
                    $04 : GraInf := '3270PC Workstation Program v1.' +
                                     ZeroPad (Lo (CPL3270PC^.Version));
                  End;
                End
              Else
                GraInf := PC3270NA;
            End
          Else
            GraInf := FG;
        End;
   80 : Begin
          { IBM 3270 PC Control Program Id String }
          If CardNumber = 7 Then
            Begin
              Regs.AX := $3000;
              Regs.CX := $0000;
              Regs.DX := $0000;
              Intr ($10, Regs);
              If (Regs.CX > 0) Or (Regs.DX > 0) Then
                Begin
                  Config3270PC := Ptr (Regs.CX, Regs.DX);
                  CPL3270PC := Ptr (Config3270PC^.SegCPL, 0);
                  GraInf := CPL3270PC^.Descriptor;
                End
              Else
                GraInf := PC3270NA;
            End
          Else
            GraInf := FG;
        End;
   81 : Begin
          { S3 Diamond Stealth Check }
          If (CardNumber = 23) Or (CardNumber = 24) Then
            Begin
              Regs.AX := $1DAA;
              Regs.BX := $FDEC;
              Intr ($10, Regs);
              If Regs.AL = 1 Then
                Begin
                  EndString := 'Diamond Stealth VRAM mit ';
                  Case Regs.AH Of
                    $00 : EndString := EndString + 'Standard VGA DAC';
                    $11 : EndString := EndString + 'Highcolor DAC';
                    $23 : EndString := EndString + 'SS2410 DAC';
                    $33 : EndString := EndString + 'HighColor DAC ohne RS2';
                    $43 : EndString := EndString + 'HighColor DAC mit RS2';
                  Else
                    EndString := EndString + 'unbekanntem DAC';
                  End;
                End
              Else If Regs.AL = 2 Then
                Begin
                  EndString := 'Diamond Stealth 24 mit ';
                  Case Regs.AH Of
                    $00 : EndString := EndString + 'Standard VGA DAC';
                    $11 : EndString := EndString + 'Highcolor DAC';
                    $23 : EndString := EndString + 'SS2410 DAC';
                    $33 : EndString := EndString + 'HighColor DAC ohne RS2';
                    $43 : EndString := EndString + 'HighColor DAC mit RS2';
                  Else
                    EndString := EndString + 'unbekanntem DAC';
                  End;
                End
              Else
                GraInf := 'keine Diamond Stealth';
            End
          Else
            GraInf := FG;
        End;
   82 : Begin
          { S3 MEMCS16 8/16 }
          If (CardNumber = 24) Then
            Begin
              Port[$03D4] := $3A;
              If (Port[$03D5] And $80 = $80) Then GraInf := '16 - Bit MEMCS16'
                Else GraInf := '8 - Bit MEMCS16';
            End
          Else
            GraInf := FG;
        End;
   83 : Begin
          { S3 Fast Write Buffer }
          If (CardNumber = 24) Then
            Begin
              Port[$03D4] := $40;
              If (Port[$03D5] And 8 = 8) Then GraInf := 'Fast Write Buffer ist an'
                Else GraInf := 'Fast Write Buffer ist aus';
            End
          Else
            GraInf := FG;
        End;
   84 : Begin
          { S3 Zero Waitstate (EISA^) }
          If (CardNumber = 24) Then
            Begin
              Port[$03D4] := $40;
              If (Port[$03D5] And $40 = $40) Then GraInf := '[-]'
                Else GraInf := '[X]';
            End
          Else
            GraInf := FG;
        End;
   85 : Begin
          { AHEAD A/B 8 Fonts }
          If (CardNumber = 25) Then
            Begin
              Port [$3CE] := $C;
              xByte := Port[$3CF];
              If (xByte And 1 = 0) And (xByte And 2 = 2) Then GraInf := '[X]'
                Else GraInf := '[-]';
            End
          Else
            GraInf := FG;
        End;
   86 : Begin
          { AHEAD A/B High Speed Sequencer eingeschaltet }
          If (CardNumber = 25) Then
            Begin
              Port [$3CE] := $C;
              If Port[$3CF] And 8 = 8 Then GraInf := '[X]'
                Else GraInf := '[-]';
            End
          Else
            GraInf := FG;
        End;
   87 : Begin
          { AHEAD A/B 16 Bit Memory eingeshaltet }
          If (CardNumber = 25) Then
            Begin
              Port [$3CE] := $C;
              If Port[$3CF] And $10 = $10 Then GraInf := '[X]'
                Else GraInf := '[-]';
            End
          Else
            GraInf := FG;
        End;
   88 : Begin
          { AHEAD A/B Emulation Mode }
          If (CardNumber = 25) Then
            Begin
              Port [$3CE] := $C;
              xByte := Port[$3CF];
              If (xByte And $40 = 0) And (xByte And $40 = 0) Then GraInf := 'VGA'
                Else If (xByte And $40 = 0) And (xByte And $40 = $40) Then GraInf := 'EGA'
                Else If (xByte And $40 = $40) And (xByte And $40 = 0) Then GraInf := 'Hercules'
                Else If (xByte And $40 = $40) And (xByte And $40 = $40) Then GraInf := 'CGA';
            End
          Else
            GraInf := FG;
        End;
   89 : Begin
          { AHEAD A/B 24/32 KB BIOS }
          If (CardNumber = 25) Then
            Begin
              Port [$3CE] := $1F;
              If Port[$3CF] And 4 = 4 Then GraInf := '32k'
                Else GraInf := '24k';
            End
          Else
            GraInf := FG;
        End;
   90 : Begin
          { AHEAD A/B 8/16 Bit BIOS }
          If (CardNumber = 25) Then
            Begin
              Port [$3CE] := $1F;
              If Port[$3CF] And 8 = 8 Then GraInf := '16-Bit BIOS'
                Else GraInf := '8-Bit BIOS';
            End
          Else
            GraInf := FG;
        End;
   91 : Begin
          { ATI 28800+ True Color DAC Enabled }
          If (CardNumber = 26) Then
            Begin
              xWord := MemW[$C000:$0010];
              Port[xWord] := $A7;
              xByte := Port[xWord+1];
              If (xByte And 2 = 2) And (xByte And 8 = 8) Then GraInf := Yes
                Else GraInf := No;
            End
          Else
            GraInf := FG;
        End;
   92 : Begin
          { Avance Logic Al2101 MAximale horizontale Frequenz}
          If (CardNumber = 27) Then
            Begin
              Port[$3D4] := $1E;
              xByte := Port[$3D5];
              If (xByte And $40 = 0) And (xByte And $80 = 0) Then GraInf := '38 khz'
                Else If (xByte And $40 = 0) And (xByte And $80 = $80) Then GraInf := '48 khz'
                Else If (xByte And $40 = $40) And (xByte And $80 = 0) Then GraInf := '56 khz'
                Else If (xByte And $40 = $40) And (xByte And $80 = $80) Then GraInf := '64 khz';
            End
          Else
            GraInf := FG;
        End;
   93 : Begin
          { Avance Logic Al2101 Emulation }
          If (CardNumber = 27) Then
            Begin
              Port[$3D4] := $1F;
              xByte := Port[$3D5];
              If (xByte And 1 = 0) And (xByte And 2 = 0) Then GraInf := 'VGA'
                Else If (xByte And 1 = 0) And (xByte And 2 = 2) Then GraInf := 'EGA'
                Else If (xByte And 1 = 1) And (xByte And 2 = 0) Then GraInf := 'CGA'
                Else If (xByte And 1 = 1) And (xByte And 2 = 2) Then GraInf := 'MDA';

            End
          Else
            GraInf := FG;
        End;
   94 : Begin
          { Cirrus Ist ein Cirrus BIOS installiert ? }
          If (CardNumber = 12) Then
            Begin
              S := Chr(MEM[$C000:$0006]) + Chr (Mem[$C000:$0007]);
              If S = 'CL' Then GraInf := Yes Else GraInf := No;
            End
          Else
            GraInf := FG;
        End;
   95 : Begin
          { Cirrus BIOS / Version }
          If (CardNumber = 12) And (GraInf (94) = Yes) Then
            Begin
              Regs.AH := $12;
              Regs.BL := $81;
              Intr ($10, Regs);
              GraInf := StrFnByte (Regs.AH) + '.' + StrFnByte (Regs.AL);
            End
          Else
            GraInf := FG;
        End;
   96 : Begin
          { Cirrus BIOS / Memory }
          If (CardNumber = 12) And (GraInf (94) = Yes) Then
            Begin
              Regs.AH := $12;
              Regs.BL := $85;
              Intr ($10, Regs);
              GraInf := StrFnWord (Regs.AL*64) + 'kb';
            End
          Else
            GraInf := FG;
        End;
   97 : Begin
          { Cirrus BIOS / Monitortyp und ID vom 15Pin Connector }
          If (CardNumber = 12) And (GraInf (94) = Yes) Then
            Begin
              Regs.AH := $12;
              Regs.BL := $A1;
              Intr ($10, Regs);
              Case Regs.BH Of
                $00..$08 : GraInf := 'reserviert (' + StrFnByte (Regs.BH) + ')';
                $09 : GraInf := 'IBM 8604/8507';
                $0A : GraInf := 'IBM 8514';
                $0B : GraInf := 'IBM 8515';
                $0D : GraInf := 'IBM 8503';
                $0E : GraInf := 'IBM 8512/8513';
                $0F : GraInf := 'kein Monitor';
              Else
                GraInf := 'unbekannt (' + StrFnByte (Regs.BH) + ')';
              End;
            End
          Else
            GraInf := FG;
        End;
   98 : Begin
          { Compaq Monitortyp }
          If (CardNumber = 28) Then
            Begin
              Port [$3CE] := $50;
              xByte := Port[$3CF];
              Case (xByte Shr 1) Shl 4 Of
                $00 : GraInf := 'Compaq Interner Monitor';
                $02 : GraInf := 'Compaq 16" Advanced Graphics Farbmonitor';
                $03 : GraInf := 'Compaq 1024 Farbmonitor';
                $04 : GraInf := 'QVision 200 (20") Farbmonitor';
                $05 : GraInf := 'Compaq SVGA Color Monitor';
                $06 : GraInf := 'QVision 150 (15") oder Compaq 151 FS Farbmonitor';
                $0E : GraInf := 'Compaq 14" VGA Monitor (31.5 kHz)';
              Else
                GraInf := 'unbekannter Monitor';
              End;
            End
          Else
            GraInf := FG;
        End;
   99 : Begin
          { Everex BIOS Version }
          If (CardNumber = 16) Then
            Begin
              Regs.AX := $7000;
              Regs.BX := $0000;
              Intr ($10, Regs);
              GraInf := BCDWordToString (Regs.DI);
            End
          Else
            GraInf := FG;
        End;
   100 : Begin
           { RealTek Emulationsmodus }
           If (CardNumber = 34) Then
             Begin
               Port[$3D4] := $1F;
               xByte := Port[$3D5];
               If (xByte And 1 = 0) And (xByte And 2 = 0) Then GraInf := 'VGA'
                 Else If (xByte And 1 = 0) And (xByte And 2 = 2) Then GraInf := 'EGA'
                 Else If (xByte And 1 = 1) And (xByte And 2 = 0) Then GraInf := 'CGA'
                 Else If (xByte And 1 = 1) And (xByte And 2 = 2) Then GraInf := 'MDA';

             End
           Else
             GraInf := FG;
         End;
   101 : Begin
           { Yamaha Clock-Set }
           If (CardNumber = 37) Then
             Begin
               xByte := Port[$3C2];
               Case (xByte And 12) Shr 2 Of
                 0 : GraInf := 'CLK0 (norm. 25.175 Mhz)';
                 1 : GraInf := 'CLK1 (norm. 28.322 Mhz)';
                 2 : GraInf := 'CLK2 (norm. extern)';
                 3 : GraInf := 'CLK3 (norm. panel Clock)';
               End;
             End
           Else
             GraInf := FG;
         End;
   102 : Begin
           { Video Clock-Set }
           If (CardNumber = 9) Then
             Begin
               Port[$3C4] := $A4;
               xByte := Port[$3C5];
               Case (xByte And 28) Shr 2 Of
                 0 : GraInf := '25.175 Mhz';
                 1 : GraInf := '28.322 Mhz';
                 2 : GraInf := '30.000 Mhz';
                 3 : GraInf := '32.514 Mhz';
                 4 : GraInf := '34.000 Mhz';
                 5 : GraInf := '36.000 Mhz';
                 6 : GraInf := '38.000 Mhz';
                 7 : GraInf := '40.000 Mhz';
               End;
             End
           Else
             GraInf := FG;
         End;
   103 : Begin
           { Video Clock-Source }
           If (CardNumber = 9) Then
             Begin
               Port[$3C4] := $F8;
               xByte := Port[$3C5];
               Case (xByte And 224) Shr 5 Of
                 0 : GraInf := '25.175 Mhz';
                 1 : GraInf := '28.322 Mhz';
                 2 : GraInf := '30.000 Mhz';
                 3 : GraInf := '32.514 Mhz';
                 4 : GraInf := '34.000 Mhz';
                 5 : GraInf := '36.000 Mhz';
                 6 : GraInf := '38.000 Mhz';
                 7 : GraInf := '40.000 Mhz';
               End;
             End
           Else
             GraInf := FG;
         End;
   104 : Begin
           { RealTek Bios-String }
           If (CardNumber = 34) Then
             Begin
               Regs.AX := $5F01;
               Regs.ES := Seg (String40);
               Regs.DI := Ofs (String40);
               For xByte2 := 1 To 40 Do String40[xByte2] := #0;
               Intr ($10, Regs);
               String40[0] := Chr(40);
               If Regs.AH = 0 Then
                 GraInf := Copy (String40,1,Pos(String40,#0))
               Else
                 GraInf := 'Vom Bios nicht untersttzt';
             End
           Else
             GraInf := FG;
         End;
  Else
    GraInf := 'Informationsnummer nicht bekannt'
  End;
End;


Function ScanLinesChar;

Begin
  Regs.AX := $1130;
  Regs.BH := $00;
  Intr ($10, regs);
  ScanLinesChar := Regs.CX
End;


Function ScanLinesCursor;

Var S2 : String;
    P : pBiosRecord;

Begin
  P := GetBiosRecord;
  Regs.AH := $03;
  Regs.BH := P^.ScreenPage;
  Intr ($10, Regs);
  Str (Regs.Ch, S);
  Str (Regs.Cl, S2);
  ScanLinesCursor := S + '-' + S2;
End;


Function GetFontAddress (FontNumber : Byte) : Pointer;

Begin
  If FontNumber = 1 Then
    Begin
      GetFontAddress := Ptr (Longint (MemW [0:$1F*4]), Longint (MemW [0:$1F*4+2]));
    End
  Else
    Begin
      Regs.AX := $1130;
      Regs.BH := FontNumber;
      Intr ($10, Regs);
      GetFontAddress := Ptr (Regs.BP, Regs.ES);
    End;
End;


Function GetPaletteRegister;

Var VGABuf : Array [$00..$10] Of Byte;

Begin
  Regs.AX := $1009;
  Regs.ES := Seg (VGABuf);
  Regs.DX := Ofs (VGABuf);
  Intr ($10, Regs);
  For xByte := $00 To $0F Do
    If xByte = Color Then
      GetPaletteRegister := VGABuf [xByte];
End;


Procedure PreSpeedTest;

Var
    MonochromMode : Boolean;
    EMM_Name      : String[8];
    Dummy         : Byte;
    Typ           : Byte;

Begin
  Regs.AH := $0F;                       { get screen status }
  Intr ($10, Regs);                     { BIOS video interupt }
  MonoChromMode := (Regs.AL = 7);
  IF MonoChromMode THEN
      ScreenAddr := Ptr ($B000,0000)
   ELSE
      ScreenAddr := Ptr ($B800,0000);

  EMM_Name := '        ';
  Regs.AH := $35;
  Regs.AL := $67;
  Intr ($21, Regs);
  Move (Mem [Regs.ES:$0A], EMM_Name[1], 8);
  ExpandedMem := (EMM_Name = 'EMMXXXX0');

  If ExpandedMem Then
    Begin
      EMS_Base := 0;
      Regs.AH := $41;
      Intr ($67, Regs);
      EMS_Base := Regs.BX;
    End
  Else
    EMS_Base := 0;

  Typ := Mem [$FFFF:$000E];
  Regs.AH := $88;
  Intr ($15, Regs);
  ExtendedMem := (((Regs.Flags AND FCarry) = 0) AND (Regs.AX <> 0));
  IF ExtendedMem THEN
    Begin
    End
  ELSE IF (Typ = $FC) OR ((Typ >= $F5) AND (Typ <= $F8)) THEN BEGIN
      Port [$70] := $30;
      Dummy := Port [$71];
      Port [$70] := $31;
      ExtendedMem := (Port [$71] * 256 + Dummy) > 0;
  END;
End;


Function VideoWaits;

Type Processor = (NA, i88, i86, iC88, iC86, V20, V30, i188, i186, i286, i386,
                  i386sx, ct386, ct386sx, p486dlc, p486slc, rapidcad, i486,
                  i486sx, Pentium, NexGen, Cyrix);

Const
   AAM_Time : Array [i88 .. Cyrix] Of Integer =
              (77, 77, 77, 77, 15, 15, 19, 19, 16, 17, 17, 16, 16,
              17, 17, 15, 15, 15, 18, 18, 17);

   FillTime :   Array [i88 .. Cyrix] Of Integer =
                (10, 10, 10, 10, 4, 4, 9, 9, 3, 5, 5, 5, 5,
                4, 4, 4, 4, 4, 1, 1, 1);

Var MoveBuffer    : Pointer;
    ScreenWaits   : Word;
    FillTakte     : Real;
    CPU           : Processor;

Begin
  PreSpeedTest;
  GetMem (MoveBuffer, 20000);

  SpeedTest (Word (0) { BildSchirm }, Word(ExtendedMem), Word(ExpandedMem),
             MoveBuffer, Ptr (EMS_Base, 0), ScreenAddr, Result);

  CPU := Processor (Result.CPUType);
  TempFreq   := 200 * AAM_Time [CPU] * ClockFreq / Result.AAMTime;
  FillTakte  := Result.ScreenFillTime * TempFreq / (ClockFreq * 5000);
  ScreenWaits:= Trunc (FillTakte - FillTime [CPU] + 0.1);
  VideoWaits := ScreenWaits;

  FreeMem (MoveBuffer, 20000);
End;


Function BiosSpeed;

Var MoveBuffer  : Pointer;

Begin
  PreSpeedTest;
  GetMem (MoveBuffer, 20000);

  SpeedTest (Word (0) { BildSchirm }, Word(ExtendedMem), Word(ExpandedMem),
             MoveBuffer, Ptr (EMS_Base, 0), ScreenAddr, Result);

  BiosSpeed := 20 * ClockFreq / Result.BiosWriteTime;

  FreeMem (MoveBuffer, 20000);
End;


Function DosSpeed;

Var MoveBuffer  : Pointer;

Begin
  PreSpeedTest;
  GetMem (MoveBuffer, 20000);

  SpeedTest (Word (0) { BildSchirm }, Word(ExtendedMem), Word(ExpandedMem),
             MoveBuffer, Ptr (EMS_Base, 0), ScreenAddr, Result);

  DosSpeed := 20 * ClockFreq / Result.DosWriteTime;

  FreeMem (MoveBuffer, 20000);
End;


Function TestVertHz;

Var I         : Word;
    Start     : Word;
    EndTimer  : Word;
    Integ     : Integer;
    ConvStr   : String;

Begin
  Start := Clock;
  Asm
    mov cx, 0
    mov dx,3dah
  @1: in al,dx
    test al,8
    jz @1
  @2: in al,dx
    test al,8
    jnz @2
    inc cx
    cmp cx,150
    jnz @1
  End;
  EndTimer := Clock-Start;
  Str (1000/(EndTimer/150):3:0, ConvStr); { Mir viel einfach kein besserer }
  Val (ConvStr, EndTimer, Integ); { Weg ein, um einen 2stelligen Wert zu   }
  TestVertHz := EndTimer; { bekommen. (mit Nachkommastellen ist es ungenau)    }
End;


Function TestHorizHz;

Var I         : Word;
    Start     : Word;
    EndTimer  : Word;

Begin
  Start := Clock;
  Asm
    mov cx, 20000
    mov dx,3dah
  @1: in al,dx
    test al,1
    jz @1
  @2: in al,dx
    test al,1
    jnz @2
    loop @1
  End;
  EndTimer := Clock-Start;
  TestHorizHz := 1000/(EndTimer/20000)/1000;
End;


Function IsDGIS : Boolean;

Var A : ^String;

Begin
  GetMem (A, SizeOf (A^));
  Regs.AX := $6A00;
  Regs.BX := 0;
  Regs.CX := 0;
  Regs.DX := 200;
  Regs.ES := PtrRec(A).Seg;
  Regs.DI := PtrRec(A).Ofs;
  Intr ($10, Regs);
  ISDGIS := (Regs.CX <> 0);
  FreeMem (A, SizeOf (A^));
End;


Begin
End.