Program GraphDetector;
{$G+}
const
  HS: array [0..15] of Char = '0123456789ABCDEF';
type
   TSVGAMode = record
    Mode:Byte;
    NClearVM, Stdrt, NStdrt, AppFast, LFB, NCVM : Boolean;
    Res : Byte;
   end;
type
  TS = array [0..65500] of Char;
  TW = array [0..32765] of Word;
  TNM = array [1..1024] of Word;
type
   TGeneralSVGAInfoBuffer = record
     VESA_VBE2 : array [0..3] of Char;
     VBEversion : Word;{! BCD}
     ProdIdentStr : ^TS;
     FlagFirst : Byte;
     FlagReserv : array [0..2] of Byte;
     SVGAModeList : ^TW;
     VMSize : Word; {В блоках по 64 Kb}
     InteriorVersion : Word;
     ProdNameStr : ^TS;
     VAdaptNameStr : ^TS;
     VerAdaptStr : ^TS;
     VBE_AFversion : Word;{1 BCD}
     AppFastModesList : ^TW;
     VESAReserv : array [0..215] of Byte;
     VBEDataReserv : array [0..255] of Byte;
   end;
type
   TSVGAModeInfoBuffer = record
     AttribMode : Word;
     WinA_Attr : Byte;
     WinB_Attr : Byte;
     WinGranul : Word;{ Kb}
     WinSize : Word;{ Kb}
     WinA_Seg : Word;
     WinB_Seg : Word;
     TransLockProc : Pointer;
     LogStrSize : Word;{Целых байт}
     Width : Word;{В пикселах или символах}
     Height : Word;{В пикселах или символах}
     SimbolWidth : Byte;{Pix}
     SimbolHeight : Byte;{Pix}
     Planes : Byte;
     BitPerPix : Byte;
     Banks : Byte;
     MemoryModel : Byte;
     BankSize : Byte;
     VideoPages : Byte;
     Reserv1 : Byte;
     BitMaskRed : Byte;
     FirstBitRed : Byte;
     BitMaskGreen : Byte;
     FirstBitGreen : Byte;
     BitMaskBlue : Byte;
     FirstBitBlue : Byte;
     BitMaskReserv : Byte;
     FirstBitReserv : Byte;
     Addition : Byte;
     LFB_Physics : Pointer;
     LFB_Offset : LongInt;
     NoMapLFB : Word;{ Kb}
     Reserv2 : array [0..205] of Byte;
   end;
type
  TFlag = record
    ADC_8bit : Boolean; {Analog-Digital Converter, АЦП, Аналого-цифровой преобр-ль}
    VGAIncompatible : Boolean;
    ADC_RevRayTrace : Boolean;
    VBE_AF_Support : Boolean;
    EnableDirectAccessReq : Boolean;
    AppMouseInd : Boolean;
    AppClipping : Boolean;
    AppBitBlt : Boolean;
  end;
type
  TAttribMode = record
    ModePresent : Boolean;
    PaddInfoPresent : Boolean;{Padding - Дополнительная инф-ция}
    TxBIOSOutpSupport : Boolean;
    ColoredMode : Boolean;
    GraphicsMode : Boolean;
    VGAIncomp : Boolean;
    BankSwitchNotSupp : Boolean;
    LFBNotSupp : Boolean;
    Undef : Boolean;
    EnableDirectAccessRq : Boolean;
    Undef7Bit : Byte;
  end;
type
  TWinAttr = record
    WinPresent : Boolean;
    ReadPermit : Boolean;{Чтение разрешено}
    WritePermit : Boolean;{Запись разрешена}
    OddMent : Byte;{Осаток}
  end;
var
  i, j, k : Word;
  xt, yt : Byte;
  St : String;
var
  SVGAMode: TSVGAMode;
  GeneralSVGAInfo : TGeneralSVGAInfoBuffer;
  SVGAModeInfo : TSVGAModeInfoBuffer;
  Flag : TFlag;
  ModeAttr : TAttribMode;
  WinAttr : TWinAttr;
  NM : TNM;
{------------------}
Procedure DecodeSVGAMode(SVGA:Word);
begin
asm
   push ds
   mov bx, seg SVGAMode
   mov ds, bx
   mov bx, offset SVGAMode
   mov ax, word ptr SVGA
   push ax
   and ax, 01111111b
   mov byte ptr [bx], al
   pop ax
   push ax
   and ax, 10000000b
   shr ax, 7
   mov byte ptr [bx+1], al
   pop ax
   push ax
   and ax, 100000000b
   shr ax, 8
   mov byte ptr [bx+2], al
   pop ax
   push ax
   and ax, 1000000000b
   shr ax, 9
   mov byte ptr [bx+3], al
   pop ax
   push ax
   and ax, 10000000000000b
   shr ax, 13
   mov byte ptr [bx+4], al
   pop ax
   push ax
   and ax, 100000000000000b
   shr ax, 14
   mov byte ptr [bx+5], al
   pop ax
   push ax
   and ax, 1000000000000000b
   shr ax, 15
   mov byte ptr [bx+6], al
   pop ax
   push ax
   and ax, 1110000000000b
   shr ax, 10
   mov byte ptr [bx+7], al
   pop ax
   pop ds
end
end;
{------------------}
Function Conv2SVGAMode:Word;{Конвертация в номер видеорежима}
begin
asm
   push ds
   mov bx, seg SVGAMode
   mov ds, bx
   mov bx, offset SVGAMode
   mov ax, 0
   mov al, byte ptr [bx]
   mov dl, byte ptr [bx+1]
   and dl, 1
   shl dx, 7
   or  ax, dx
   mov dl, byte ptr [bx+2]
   and dl, 1
   shl dx, 8
   or  ax, dx
   mov dl, byte ptr [bx+3]
   and dl, 1
   shl dx, 9
   or  ax, dx
   mov dl, byte ptr [bx+4]
   and dl, 1
   shl dx, 13
   or  ax, dx
   mov dl, byte ptr [bx+5]
   and dl, 1
   shl dx, 14
   or  ax, dx
   mov dl, byte ptr [bx+6]
   and dl, 1
   shl dx, 15
   or  ax, dx
   pop ds
end
end;
{------------------}
Function GetGeneralSVGAInfo:Word;Assembler;
asm
   mov ax, 4F00h
   mov bx, seg GeneralSVGAInfo
   mov es, bx
   mov di, offset GeneralSVGAInfo
   int 10h
end;
{------------------}
Function GetSVGAInfo(Mode : Word):Word;Assembler;
asm
   mov ax, 4F01h
   mov bx, seg SVGAModeInfo
   mov es, bx
   mov di, offset SVGAModeInfo
   mov cx, word ptr Mode
   int 10h
end;
{------------------}
Procedure DecodeFlag(Flag_:Byte);
begin
asm
   push ds
   mov bx, seg Flag
   mov ds, bx
   mov bx, offset Flag
   mov al, byte ptr Flag_
   push ax
   and al, 1
   mov byte ptr [bx], al
   pop ax
   push ax
   shr al, 1
   and al, 1
   mov byte ptr [bx+1], al
   pop ax
   push ax
   shr al, 2
   and al, 1
   mov byte ptr [bx+2], al
   pop ax
   push ax
   shr al, 3
   and al, 1
   mov byte ptr [bx+3], al
   pop ax
   push ax
   shr al, 4
   and al, 1
   mov byte ptr [bx+4], al
   pop ax
   push ax
   shr al, 5
   and al, 1
   mov byte ptr [bx+5], al
   pop ax
   push ax
   shr al, 6
   and al, 1
   mov byte ptr [bx+6], al
   pop ax
   push ax
   shr al, 7
   and al, 1
   mov byte ptr [bx+7], al
   pop ax
   pop ds
end
end;
{------------------}
Procedure DecodeAttribMode(Attr : Word);
begin
asm
   push ds
   mov bx, seg ModeAttr
   mov ds, bx
   mov bx, offset ModeAttr
   mov ax, word ptr Attr
   push ax
   and ax, 1
   mov byte ptr [bx], al
   pop ax
   push ax
   shr ax, 1
   and ax, 1
   mov byte ptr [bx+1], al
   pop ax
   push ax
   shr ax, 2
   and ax, 1
   mov byte ptr [bx+2], al
   pop ax
   push ax
   shr ax, 3
   and ax, 1
   mov byte ptr [bx+3], al
   pop ax
   push ax
   shr ax, 4
   and ax, 1
   mov byte ptr [bx+4], al
   pop ax
   push ax
   shr ax, 5
   and ax, 1
   mov byte ptr [bx+5], al
   pop ax
   push ax
   shr ax, 6
   and ax, 1
   mov byte ptr [bx+6], al
   pop ax
   push ax
   shr ax, 7
   and ax, 1
   mov byte ptr [bx+7], al
   pop ax
   push ax
   shr ax, 8
   and ax, 1
   mov byte ptr [bx+8], al
   pop ax
   push ax
   shr ax, 9
   and ax, 1
   mov byte ptr [bx+9], al
   pop ax
   push ax
   shr ax, 10
   mov byte ptr [bx+10], al
   pop ax
   pop ds
end
end;
{------------------}
Procedure DecodeWinAttrib(Attr : Byte);
begin
asm
   push ds
   mov bx, seg WinAttr
   mov ds, bx
   mov bx, offset WinAttr
   mov al, byte ptr Attr
   push ax
   shr al, 1
   and al, 1
   mov byte ptr [bx], al
   pop ax
   push ax
   shr al, 2
   and al, 1
   mov byte ptr [bx+1], al
   pop ax
   push ax
   shr al, 3
   and al, 1
   mov byte ptr [bx+2], al
   pop ax
   push ax
   pop dx
   and al, 1
   shr dl, 3
   or al, dl
   mov byte ptr [bx+3], al
   pop ds
end
end;
{------------------}
Function ReadKey : Char;Assembler;
asm
   mov ah, 10h
   int $16
end;
{----------------}
Procedure ResetTimer;Assembler;
asm
    mov      cx, 0
    mov      dx, 1
    mov      ah, $86
    int      $15
    jnc       @1
    mov ah, 83h
    mov al, 1
    int 15h
@1:
end;
{------------------}
Function HexW(X: Word): String;
  {Возвращает 16-ричное написание Х}
var
  S: String;
  k: Byte;
begin
  S := '';
  for k := 3 downto 0 do
   begin
   if (X shr (k*4)) and 15 = 0 then
    if Length(S)=0 then Continue;
    S := S+HS[(X shr (k*4)) and 15];
   end;
  if Length(S) = 0 then S := '0';
  if S=' ' then S := '0';
  HexW := S
end;  {HexW}
{=+=+=+=+=+=+=+=+=+=++=+=+=+=+=+=+}
Procedure Delay(V, W : Word);Assembler;
asm
  @1:
    mov      cx, Word Ptr V
    mov      dx, Word Ptr W
    mov      ah, $86
    int      $15
    jc       @1
end;
{------------------------}
Function KeyPressed : Boolean;Assembler;
asm
 mov ah, $0B
 int $21
end;
{----------------}
Procedure PutCursor(xx, yy : Byte);
begin
 xt := xx;
 yt := yy;
 if xt > 80 then
 begin
  inc(yt);
  xt:=1;
 end;
 if yt > 25 then
 begin
  yt := 1;
  xt := 1;
  if ReadKey=#27 then Halt;
  asm
     mov ax, 3
     int 10h
  end
 end;
 asm
   mov ah, 2
   mov dh, Byte Ptr yt
   mov dl, Byte Ptr xt
   dec dh
   dec dl
   mov bh, 0
   int $10
 end;
end;
{------------------------}
Procedure PutChr(C:Char);
begin
 asm
   mov ah, $09
   mov bh, 0
   mov bl, 00000111b
   mov al, Byte ptr C
   mov cx, 1
   int $10
 end;
PutCursor(xt+1, yt);
end;
{---------------------}
Procedure Wrt(S:String);
var
  i : Byte;
begin
  for i := 1 to Byte(S[0]) do
   PutChr(S[i]);
end;
{------------------------}
Procedure NL;
begin
 PutCursor(1, yt+1);
end;
{------------------------}
Procedure WrtLn(S:String);
begin
 Wrt(S);
 NL;
end;
{------------------}
Procedure ModeInfo(Mode_ : Word);
var
  i : Word;
begin
  WrtLn('#####   Информация о режиме '+HexW(Mode_)+'h:   ##### ');
  DecodeSVGAMode(Mode_);
  with SVGAMode do
  begin
    WrtLn('Режим SVGA: '+HexW(Mode)+'h');
    WrtLn('Резерв: '+HexW(Res)+'h');
      if NClearVM then
       WrtLn('---> Видеопамять не очищается, если остальные - нули')
      else
       WrtLn('---> При установке режима видеопамять очищается');
      if Stdrt then
       WrtLn('---> Стандартный VBE SVGA-режим')
      else
       WrtLn('---> Нестандартный VBE SVGA-режим');
      if NStdrt then
       WrtLn('---> Нестандартный SVGA-режим')
      else
       WrtLn('---> Стандартный SVGA-режим');
      if AppFast then
       WrtLn('---> Использует аппаратное ускорение')
      else
       WrtLn('---> Не использует аппаратное ускорение');
      if LFB then
       WrtLn('---> Использует LFB')
      else
       WrtLn('---> Не использует LFB');
      if NCVM then
       WrtLn('---> При установке режима видеопамять очищается')
      else
       WrtLn('---> При установке режима видеопамять не очищается');
  end;
  GetSVGAInfo(Mode_);
  with SVGAModeInfo do
  begin
    DecodeAttribMode(AttribMode);
    with ModeAttr do
    begin
      if ModePresent then
        WrtLn('---> Режим присутствует')
      else
        WrtLn('---> Режим отсутствует');
      if PaddInfoPresent then
        WrtLn('---> Дополнительная информация присутствует')
      else
        WrtLn('---> Дополнительная информация отсутствует');
      if TxBIOSOutpSupport then
        WrtLn('---> Поддерживается вывод текста на экран средствами BIOS')
      else
        WrtLn('---> Вывод текста на экран средствами BIOS не поддерживается');
      if ColoredMode then
        WrtLn('---> Режим цветной')
      else
        WrtLn('---> Режим чёрно-белый');
      if GraphicsMode then
        WrtLn('---> Режим графический')
      else
        WrtLn('---> Режим текстовый');
      if VGAIncomp then
        WrtLn('---> Несовместим с VGA')
      else
        WrtLn('---> Совместим с VGA');
      if BankSwitchNotSupp then
        WrtLn('---> Не поддерживается переключение банков')
      else
        WrtLn('---> Переключение банков поддерживается');
      if LFBNotSupp then
        WrtLn('---> Не поддерживается LFB')
      else
        WrtLn('---> LFB поддерживается');
      if UnDef then
        WrtLn('---> Неопределённый бит равен 1')
      else
        WrtLn('---> Неопределённый бит равен 0');
      if EnableDirectAccessRq then
        WrtLn('---> Требуется вызов EnableDirectAccess перед переключением банков')
      else
        WrtLn('---> Вызов EnableDirectAccess перед переключением банков не требуется');
    Wrt('Семь неопределённых бит равны: ');
    WrtLn(HexW(Undef7Bit));
    end;
  DecodeWinAttrib(WinA_Attr);
  WrtLn('^^^ ^^ Окно A ^^ ^^^');
  with WinAttr do
  begin
    if WinPresent then
      WrtLn('---> Окно существует')
    else
      WrtLn('---> Окна нет');
    if ReadPermit then
      WrtLn('---> Чтение из окна разрешено')
    else
      WrtLn('---> Чтение из окна запрещено');
    if WritePermit then
      WrtLn('---> Запись в окно разрешена')
    else
      WrtLn('---> Запись в окно запрещена');
    Wrt('Остаток равен: ');
    WrtLn(HexW(OddMent));
  end;
  DecodeWinAttrib(WinB_Attr);
  WrtLn('^^^ ^^ Окно B ^^ ^^^');
  with WinAttr do
  begin
    if WinPresent then
      WrtLn('---> Окно существует')
    else
      WrtLn('---> Окна нет');
    if ReadPermit then
      WrtLn('---> Чтение из окна разрешено')
    else
      WrtLn('---> Чтение из окна запрещено');
    if WritePermit then
      WrtLn('---> Запись в окно разрешена')
    else
      WrtLn('---> Запись в окно запрещена');
    Wrt('Остаток равен: ');
    WrtLn(HexW(OddMent));
  end;
  Str(WinGranul, St);
  WrtLn('Гранулярность окна - '+St+' Kb');
  Str(WinSize, St);
  WrtLn('Размер окна - '+St+' Kb');
  WrtLn('Сегментный адрес окна A: '+HexW(WinA_Seg)+'h');
  WrtLn('Сегментный адрес окна B: '+HexW(WinB_Seg)+'h');
  Wrt('Адрес процедуры перемещения окна: ');
  WrtLn(HexW(Seg(TransLockProc^))+'h:'+HexW(Ofs(TransLockProc^))+'h');
  Str(LogStrSize, St);
  WrtLn('В логической строке '+St+' целых байт');
  Str(Width, St);
  WrtLn('Ширина в пикселах или символах: '+ St);
  Str(Height, St);
  WrtLn('Высота в пикселах или символах: '+ St);
  Str(SimbolWidth, St);
  WrtLn('Ширина символов в пикселах: '+ St);
  Str(SimbolHeight, St);
  WrtLn('Высота символов в пикселах: '+ St);
  Str(Planes, St);
  WrtLn('Число плоскостей памяти: '+ St);
  Str(BitPerPix, St);
  WrtLn('Число бит на пиксел: '+ St);
  Str(Banks, St);
  WrtLn('Число банков: '+ St);
   Wrt('Модель памяти('+HexW(MemoryModel)+'h): ');
   case MemoryModel of
    $00:WrtLn('ТЕКСТ');
    $01:WrtLn('CGA-графика');
    $02:WrtLn('HGC-графика');
    $03:WrtLn('EGA-графика(16 цветов)');
    $04:WrtLn('VGA-графика(256 цветов в одной плоскости)');
    $05:WrtLn('Режим X (256 цветов в разных плоскостях)');
    $06:WrtLn('RGB(15-битный или выше)');
    $07:WrtLn('YUV');
    $08..$0F:WrtLn('VESA');
    $10..$FF:WrtLn('Нестандартная модель');
   end;
  Str(BankSize, St);
  WrtLn('Размер банка: '+St+' Kb');
  Str(VideoPages, St);
  WrtLn('Число видеостраниц: '+St);
  WrtLn('Значение зарезервированного байта: '+HexW(Reserv1)+'h');
  WrtLn('Битовая маска красной компоненты: '+HexW(BitMaskRed)+'h');
  Str(FirstBitRed, St);
  WrtLn('Первый бит красной компоненты: '+St);
  WrtLn('Битовая маска зелёной компоненты: '+HexW(BitMaskGreen)+'h');
  Str(FirstBitGreen, St);
  WrtLn('Первый бит зелёной компоненты: '+St);
  WrtLn('Битовая маска синей компоненты: '+HexW(BitMaskBlue)+'h');
  Str(FirstBitBlue, St);
  WrtLn('Первый бит синей компоненты: '+St);
  WrtLn('Битовая маска зарезервированной компоненты: '+HexW(BitMaskReserv)+'h');
  Str(FirstBitReserv, St);
  WrtLn('Первый бит зарезервированной компоненты: '+St);
   case Addition and 1 of
    1:WrtLn('Поддерживается перепрограммирование цветов (п/ф 09h)');
    0:WrtLn('Перепрограммирование цветов не поддерживается');
   end;
   case Addition and 2 of
    0:WrtLn('Приложение не может использовать биты в зарезервированной компоненте');
    1:WrtLn('Приложение может использовать биты в зарезервированной компоненте');
   end;
  WrtLn('Дополнительное поле^^^: '+HexW(Addition)+'h');
  Wrt('Физический адрес начала LFB: ');
  WrtLn(HexW(Seg(LFB_Physics^))+'h:'+HexW(Ofs(LFB_Physics^))+'h');
  Wrt('Смещение от начала LFB до первого байта на экране: ');
  WrtLn(HexW(Hi(LFB_Offset))+'|'+HexW(Lo(LFB_Offset)));
  Str(NoMapLFB, St);
  WrtLn('Размер памяти в LFB, не отображающийся на экране: '+St+' Kb');
    WrtLn('РЕЗЕРВ: ');
    for j := 0 to 12 do
    begin
    for i := 1 to 16 do Wrt(HexW(Reserv2[16*j+i-1])+' ');
    WrtLn('')
    end;
    WrtLn('---CHAR---  "РЕЗЕРВ" ---CHAR--- ');
    for i := 0 to 205 do Wrt(Char(Reserv2[i])+' ');
    WrtLn('');
    WrtLn('----- конец "РЕЗЕРВ" -------- ');
    WrtLn('================================================');
  end;
end;
{------------------------}
begin
  asm
     mov ax, 3
     int 10h
  end;
  xt := 1;
  yt := 1;
  WrtLn('-=-=-=-=-=-=-=-=-=-==========================-=-=-=-=-=-=-=-=-=-=--=');
  WrtLn('               Получение общей SVGA информации...');
  WrtLn('-=-=-=-=-=-=-=-=-=-==========================-=-=-=-=-=-=-=-=-=-=--=');
  GeneralSVGAInfo.VESA_VBE2:='VBE2';
  k := GetGeneralSVGAInfo;
  with GeneralSVGAInfo do
  begin
    if k = $004F then WrtLn('Данные получены!')
      else
      begin
        WrtLn('Произошла ОШИБКА!');
        if Lo(k) <> $004F then WrtLn('Функция не поддерживается.');
        if Hi(k) = 1 then WrtLn('Данные не получены.');
        Halt;
      end;
    Wrt('Заголовок: ');
    WrtLn(VESA_VBE2);
    WrtLn('Версия: '+HexW(Hi(VBEversion))+'.'+ HexW(Lo(VBEversion)));
    Wrt('Внутренняя версия данной реализации VBE: ');
    St :=HexW(InteriorVersion shr 8)+'.'+HexW(InteriorVersion and $00FF);
    WrtLn(St);
    WrtLn('Версия: VBE/AF: '+HexW(Hi(VBE_AFversion))+'.'+ HexW(Lo(VBE_AFversion)));
    WrtLn('Адрес строки производителя: '+HexW(Seg(ProdIdentStr^))+':'+HexW(Ofs(ProdIdentStr^)));
    Wrt('Адрес строки с названием производителя: ');
    Wrt(HexW(Seg(ProdNameStr^))+':');
    WrtLn(HexW(Ofs(ProdNameStr^)));
    Wrt('Адрес строки с названием адаптера: ');
    Wrt(HexW(Seg(VAdaptNameStr^))+':');
    WrtLn(HexW(Ofs(VAdaptNameStr^)));
    Wrt('Адрес строки с версией адаптера: ');
    Wrt(HexW(Seg(VerAdaptStr^))+':');
    WrtLn(HexW(Ofs(VerAdaptStr^)));
    Wrt('Адрес списка доступных режимов: ');
    Wrt(HexW(Seg(SVGAModeList^))+':');
    WrtLn(HexW(Ofs(SVGAModeList^)));
    Wrt('Адрес списка режимов,');
    Wrt('  поддерживающих аппаратное ускорение: ');
    Wrt(HexW(Seg(AppFastModesList^))+':');
    WrtLn(HexW(Ofs(AppFastModesList^)));
    WrtLn('Значение флага: '+HexW(FlagFirst));
    WrtLn('>>> Поля флага означают: ');
    DecodeFlag(FlagFirst);
    with Flag do
    begin
      if ADC_8Bit then
       WrtLn('---> АЦП поддерживает 8-битовые цветовые компоненты')
      else
       WrtLn('---> АЦП не поддерживает 8-битовые цветовые компоненты');
      if VGAIncompatible then
       WrtLn('---> Видеоадаптер несовместим с VGA')
      else
       WrtLn('---> Видеоадаптер совместим с VGA');
      if ADC_RevRayTrace then
       WrtLn('---> АЦП можно программировать только при обратном ходе луча')
      else
       WrtLn('---> АЦП можно программировать НЕ только при обратном ходе луча');
      if VBE_AF_Support then
       WrtLn('---> Поддерживается спецификация аппаратного ускорения графики')
      else
       WrtLn('---> Спецификация аппаратного ускорения графики не поддерживается');
      if EnableDirectAccessReq then
       WrtLn('---> Требуется вызов EnableDirectAccess перед использованием LFB')
      else
       WrtLn('---> Вызов EnableDirectAccess перед использованием LFB не требуется');
      if AppMouseInd then
       WrtLn('---> Поддерживается аппаратный указатель мыши')
      else
       WrtLn('---> Аппаратный указатель мыши не поддерживается');
      if AppClipping then
       WrtLn('---> Поддерживается аппаратный clipping')
      else
       WrtLn('---> Аппаратный clipping не поддерживается');
      if AppBitBlt then
       WrtLn('---> Поддерживается аппаратный BitBlt')
      else
       WrtLn('---> Аппаратный BitBlt не поддерживается');
    end;
    Wrt('Поля - резервы флагов(байты): ');
    for i := 0 to 2 do
     Wrt('"'+HexW(FlagReserv[i])+'"  ');
    WrtLn('');
    Wrt('Размер ВИДЕОпамяти: ');
    Str(VMSize, St);
    Wrt(St+' * 64 Kb = ');
    Str(VMSize*64, St);
    WrtLn(St+ ' Kb');
    Wrt('Производитель: ');
    i := 0;
    While (ProdIdentStr^[i] <> #0) and (i<100) do
    begin
      Wrt(ProdIdentStr^[i]);
      inc(i);
    end;
    if ProdIdentStr^[0]=#0 then Wrt('{ Информация отсутствует }');
    WrtLn('');
    Wrt('Название производителя: ');
    i := 0;
    While (ProdNameStr^[i] <> #0) and (i<100) do
    begin
      Wrt(ProdNameStr^[i]);
      inc(i);
    end;
    if ProdNameStr^[0]=#0 then Wrt('{ Информация отсутствует }');
    WrtLn('');
    Wrt('Название адаптера: ');
    i := 0;
    While (VAdaptNameStr^[i] <> #0) and (i<100) do
    begin
      Wrt(VAdaptNameStr^[i]);
      inc(i);
    end;
    if VAdaptNameStr^[0]=#0 then Wrt('{ Информация отсутствует }');
    WrtLn('');
    Wrt('Версия адаптера: ');
    i := 0;
    While (VerAdaptStr^[i] <> #0) and (i<100) do
    begin
      Wrt(VerAdaptStr^[i]);
      inc(i);
    end;
    if VerAdaptStr^[0]=#0 then Wrt('{ Информация отсутствует }');
    WrtLn('');
    WrtLn('VESA резерв: ');
    for j := 0 to 26 do
    begin
    for i := 1 to 16 do Wrt(HexW(VESAReserv[16*j+i-1])+' ');
    WrtLn('')
    end;
    WrtLn('---CHAR---  "VESA резерв" ---CHAR--- ');
    for i := 0 to 215 do Wrt(Char(VESAReserv[i])+' ');
    WrtLn('');
    WrtLn('----- конец "VESA резерв" -------- ');
    WrtLn('================================================');
    WrtLn('Резерв данных VBE: ');
    for j := 0 to 15 do
    begin
    for i := 1 to 16 do Wrt(HexW(VBEDataReserv[16*j+i-1])+' ');
    WrtLn('')
    end;
    WrtLn('---CHAR---  "Резерв данных VBE" ---CHAR--- ');
    for i := 0 to 216 do Wrt(Char(VBEDataReserv[i])+' ');
    WrtLn('');
    WrtLn('----- конец "Резерв данных VBE" -------- ');
    WrtLn('++++++++++++++++ Список доступных режимов ++++++++++++++++');
    i := 0;
    While (SVGAModeList^[i] <> $FFFF)  do
    begin
      Wrt(HexW(SVGAModeList^[i])+'h ');
      inc(i);
    end;
    if SVGAModeList^[0]=$FFFF then Wrt('[] { Список пуст } []')
    else
    begin
     Str(i, St);
     WrtLn('Всего доступно режимов: '+St);
    end;
    WrtLn('');
    WrtLn('<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>');
    WrtLn('+++++ Список режимов, поддерживающих аппаратное ускорение +++++');
    i := 0;
    While (AppFastModesList^[i] <> $FFFF)  do
    begin
      Wrt(HexW(AppFastModesList^[i])+'h ');
      inc(i);
    end;
    if AppFastModesList^[0]=$FFFF then Wrt('[] { Список пуст } []');
    WrtLn('');
    WrtLn('<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>');
    i := 0;
    While (SVGAModeList^[i] <> $FFFF)  do
    begin
      NM[i+1]:=SVGAModeList^[i];
      inc(i);
    end;
      NM[i+1]:=SVGAModeList^[i];
    i := 1;
    While (NM[i] <> $FFFF)  do
    begin
      ModeInfo(NM[i]);
      inc(i);
    end;
    WrtLn('');
  end;
  While ReadKey<>#27 do
  begin
    Wrt('Введите номер режима о котором хотите узнать информацию:');
    ReadLn(NM[1]);
    WrtLn('');
    ModeInfo(NM[1]);
  end;
end.

Назад