unit mVBE;

interface

uses DPMILib;

 (* VBE info block structure *)
type  TVbeInfo = record
              VbeSignature       : DWord;
              VbeVersion         : Word;
              OemStringPtr       : DWord;
              Capabilities       : DWord;
              VideoModePtr       : DWord;
              TotalMemory        : Word;
              OEMSoftwareRev     : Word;
              OEMVendorNamePtr   : DWord;
              OEMProductNamePtr  : DWord;
              OEMProductRevPtr   : DWord;
              Reserved           : array [0..221] of Byte;
              OEMData            : array [0..255] of Byte;
      end;

      TVbeModeInfo = record
              ModeAttributes     : Word;
              WinAAttributes     : Byte;
              WinBAttributes     : Byte;
              WinGranularity     : Word;
              WinSize            : Word;
              WinASegment        : Word;
              WinBSegment        : Word;
              WinFuncPtr         : Pointer;
              BytesPerScanLine   : Word;
              XResolution        : Word;
              YResolution        : Word;
              XCharSize          : Byte;
              YCharSize          : Byte;
              NumberOfPlanes     : Byte;
              BitsPerPixel       : Byte;
              NumberOfBanks      : Byte;
              MemoryModel        : Byte;
              BankSize           : Byte;
              NumberOfImagePages : Byte;
              Reserved           : Byte;
              RedMaskSize        : Byte;
              RedFieldPosition   : Byte;
              GreenMaskSize      : Byte;
              GreenFieldPosition : Byte;
              BlueMaskSize       : Byte;
              BlueFieldPosition  : Byte;
              RsvdMaskSize       : Byte;
              RsvdFieldPosition  : Byte;
              DirectColorModeInfo: Byte;
              PhysBasePtr        : DWord;
              OffScreenMemOffset : DWord;
              OffScreenMemSize   : Word;
              Reserved2          : Array [0..205] of Byte;
         end;

var VesaError             :Byte;
    Regs                  :TRmRegs;
    VESAInfo              :TVBEInfo;
    VESAModeInfo          :TVBEModeInfo;
    VideoMem,VBE_VideoMem :DWord;

Procedure mVESAInit;
Procedure mInitVESAMode(Mode:Word);
Procedure mSetVESAMode(Mode:Word);
Procedure mSetVGAMode;
Function  mPutVESAMode(X,Y,BPP:Word):Word;
Procedure mVesaErrorMessage;
Procedure mSetVMemory;

implementation

{######################## Инициализация VESA ################################}
Procedure mVESAInit;
Begin
  VesaError:=0;
  ClearRmRegs(Regs);
  Regs.AX:=$4F00;
  Regs.ES:=Buf_16;
  RealModeInt($10,Regs);
  Move(Pointer(Buf_32)^,VESAInfo,256);
  if (Regs.AX<>$004F) or (VESAInfo.VbeSignature<>$41534556) then VesaError=1;
End;

{############## Инициализация графического режима VESA ######################}
Procedure mInitVESAMode(Mode:Word);
Begin
  VesaError:=0;
  ClearRmRegs(Regs);
  Regs.ES:=Buf_16;
  Regs.ax:=$4F01;
  Regs.di:=$0000;
  Regs.cx:=Mode;
  RealModeInt($10,Regs);
  Move(Pointer(Buf_32)^,VESAModeInfo,256);
  if (Regs.AX<>$004F) or (VESAModeInfo.PhysBasePtr=0) then VESAError:=2;
End;

{################# Установка графического режима VESA #######################}
Procedure mSetVESAMode(Mode:Word);
Begin
  VesaError:=0;
  ClearRmRegs(Regs);
  Regs.AX:=$4F02;
  Regs.BX:=Mode;
  RealModeInt($10,Regs);
  if (Regs.AX<>$004F) then VESAError:=3;
End;

{################# Установка стандартного режима EGA ########################}
Procedure mSetVGAMode;
Begin
  ClearRmRegs(Regs);
  Regs.AX:=$0003;
  RealModeInt($10,Regs);
End;

Function  mPutVESAMode(X,Y,BPP:Word):Word;
 var M:Word;
Begin
 For M:=$4100 to $4200 do
  Begin
   mInitVESAMode(M);
    If (VesaModeInfo.XResolution=X) and
       (VesaModeInfo.YResolution=Y) and
       (VesaModeInfo.BitsPerPixel=BPP) and
       (VesaError=0) then mPutVESAMode:=M;
  End;
End;

{##################### Вывод сообщения об ошибке ############################}
Procedure mVesaErrorMessage;
Begin
  mSetVGAMode;
  WriteLn('VesaError:',VesaError);
  Halt(1);
End;

{###################### Узнаем логический адресс ############################}
Procedure mSetVMemory;
var Tmp1,Tmp2   :Word;
Begin
  Vbe_VideoMem:=MapPhysicalToLinear(VESAModeInfo.PhysBasePtr,4096*1024);
  If Vbe_VideoMem=0 then VESAError=4;
  VideoMem:=Vbe_VideoMem;
End;
{############################################################################}
end.