Vesa 1.2 (Пример)

program tves_as1; {проверка модуля vesa_as}

uses vesa_as,crt;

var
   LenLineP:word;  {длина строки растра в точках}
   LenLineB:word;  {длина строки растра в байтах}
   MaxLines:word;  {максимальное число строк растра}
   
procedure putpixel(X,Y,Color:word); {вывод точки на экран}
var
   bank,offs:word;
begin
   asm
      xor bx,bx
      mov ax,Y
      mul LenLineB
      add ax,X
      adc dx,bx
      mov bank,dx    {предполагаем (не проверяя), что granularity = 64K}
      mov offs,ax
   end;
   SetVESABank(bank,0);   {вывод осуществляется в окно А}
   Mem[$A000:offs]:=lo(Color);
end;   

Procedure WaitRetrace;  {ожидание вертикального обратного хода луча}
Begin
   While(Port[$3DA]and $08)=0 do;
End;

var
   i,j:word;          {переменные цикла, что ж еще?}
   b1:VesaInfoBlock;  {информационный блок VESA (для 0-й функции)}
   b2:ModeInfoBlock;  {информационный блок видеорежима (для 1-й функции)}
   NBanks:word;       {общее количество банков видеопамяти}
begin
{выясняем наличие VESA и выводим основные параметры}
   if GetVesaInfo(@b1) then begin
      for i := 0 to 3 do write(b1.VesaSignature[i]);
      write(-, Ver -,hi(b1.VESAVersion),-.-,lo(b1.VESAVersion));
      writeln(-, -,b1.TotalMemory*64,-Kb videomemory on board -);
      i := 0;
      while b1.OEMStringPtr^[i]  #0 do begin
         write(b1.OEMStringPtr^[i]);
         inc(i);
      end;
      writeln;
      i := 0;
      writeln(-Modes:-);
      while b1.VideoModePtr^[i]  $FFFF do begin
         write(b1.VideoModePtr^[i],- -); {список видеорежимов}
         inc(i);
      end;
      writeln;
   end else writeln(-Error-);
{получаем характеристики одного из видеорежимов}
   if GetModeInfo($103,@b2) then begin 
      writeln(-Mode 103h, Granularity:-,b2.WinGranularity,-Kb, Window Size:-,
          b2.winsize,-Kb, -,
          b2.XResolution,-x-,
          b2.YResolution,-, -,
          b2.BitsPerPixel,
          - bits per pixel-);
      NBanks := (b1.TotalMemory * 64) div b2.WinGranularity;
   end else writeln(-Error-);
   readkey;
{устанавливаем видеорежим, характеристики которого мы получили}
   if SetVesaMode($103) then begin
      LenLineB := b2.BytesPerScanLine;
{закрашиваем каждый из банков своим цветом}
      for i := 0 to NBanks-1 do begin
         SetVESABank(i,0);
         fillchar(mem[$a000:0],b2.WinGranularity * 512,char(i+1));
         fillchar
            (mem[$a000:
                        b2.WinGranularity * 512],
                        b2.WinGranularity * 512,char(i+1));
               {предполагаем, что сегмент окна А - 0А000h}
      end;
   end else writeln(-Error-);
   readkey;
{поточечно рисуем диагональную многоцветную полосу}
   for i := 0 to 199 do
      for j := 0 to 599 do PutPixel(j+i,j,j);
   readkey;   
   LenLineP := 1024;
{пытаемся изменить логическую длину строки}
   SetVESALenLine(LenLineP,LenLineB,MaxLines);
   readkey;
{снова рисуем полосу}
   for i := 0 to 199 do
      for j := 0 to 1023 do PutPixel(j+i,j,j);
   readkey;
{производим панорамирование ...}
   for i := 0 to (1023-800) do begin
      SetVESAStart(i,0);
      WaitRetrace;
   end;
{... и скроллирование экрана}
   for j := 0 to (1023-600) do begin
      SetVESAStart(i,j);
      WaitRetrace;
   end;
   readkey;
{возвращаем видеоадаптер в текстовый режим}
   asm
      mov ax,3
      int $10
   end;
end.

Сервис VESA

unit vesa_as; {сервис VESA вариант Borland Pascal Real Mode}
Interface

type
   VesaInfoBlock = record
................................{структуру см. в тексте}
   END;
   ModeInfoBlock = record
................................{структуру см. в тексте}
   END;

function GetVESAInfo(Buffer:pointer):boolean; {функция 0, информация о VESA}
function GetModeInfo(Mode:word;Buffer:pointer):boolean; {функция 1, информация о режиме}
function SetVESAMode(Mode:word):boolean; {функция 2, установка видеорежима}
function SetVESABank(Bank,Window:word):boolean; {функция 5, установка банка}
function SetVESALenLine(var PLength,BLength,NLines:word):boolean; 
   {функция 6, установка логической длины линии растра}
function SetVESAStart(XStart,YStart:word):boolean; 
   {функция 7, управление положением экранного окна в видеопамяти}

Implementation

function GetVESAInfo(Buffer:pointer):boolean; {информация о VESA}
var
   RetCode : word;
begin
   asm
      mov ax,$4f00
      les di,Buffer
      int $10
      mov RetCode,ax
   end;
   GetVESAInfo := RetCode = $004F; 
end;

function GetModeInfo(Mode:word;Buffer:pointer):boolean; {информация о режиме}
var
   RetCode : word;
begin
   asm
      mov ax,$4f01
      mov cx,Mode
      les di,Buffer
      int $10
      mov RetCode,ax
   end;
   GetModeInfo := RetCode = $004F; 
end;

function SetVESAMode(Mode:word):boolean;
var RetCode:word;
begin
   asm
      mov ax,$4f02
      mov bx,mode
      int $10
      mov RetCode,ax
   end;
   SetVESAMode := RetCode = $004f;
end;

const NumBank : integer = -1;

function SetVESABank(Bank,Window:word):boolean;
var RetCode:word;
begin
   if Bank = NumBank then
      SetVESABank := TRUE
   else begin
      asm
         mov ax,$4f05
         mov bx,Window
         mov dx,Bank
         int $10
         mov RetCode,ax
      end;
      if RetCode = $004f then begin
         SetVESABank := TRUE;
         NumBank := Bank;
      end
      else SetVESABank := FALSE;
   end;
end;

function SetVESALenLine(var PLength,BLength,NLines:word):boolean;
var RetCode:word;
begin
   asm
      mov ax,$4f06
      les di,Plength
      mov cx,[di]
      xor bx,bx
      int $10
      les di,Plength
      mov [di],cx
      les di,Blength
      mov [di],bx
      les di,Nlines
      mov [di],dx
      mov RetCode,ax
   end;
   SetVESALenLine := RetCode = $004f;
end;

function SetVESAStart(XStart,YStart:word):boolean;
var RetCode:word;
begin
   asm
      mov ax,$4f07
      xor bx,bx
      mov cx,XStart
      mov dx,YStart
      int $10
      mov RetCode,ax
   end;
   SetVESAStart := RetCode = $004f;
end;

end.