uses Crt;
const
Digits : array[0..$F] of Char = '0123456789ABCDEF';
function HexW(W : Word) : string;
{-Return hex string for word}
begin
HexW[0] := #4;
HexW[1] := Digits[hi(W) shr 4];
HexW[2] := Digits[hi(W) and $F];
HexW[3] := Digits[lo(W) shr 4];
HexW[4] := Digits[lo(W) and $F];
end;
function Trim(S : string) : string;
{-Return a string with leading and trailing
white space removed}
var
I : Word;
SLen : Byte absolute S;
begin
while (SLen > 0) and (S[SLen] <= ' ') do
Dec(SLen);
I := 1;
while (I <= SLen) and (S[I] <= ' ') do
Inc(I);
Dec(I);
if I > 0 then
Delete(S, 1, I);
Trim := S;
end;
function LeftPadCh(S : string; Ch : Char; Len : Byte) : string;
{-Return a string left-padded to length len
with ch}
var
o : string;
SLen : Byte absolute S;
begin
if Length(S) >= Len then
LeftPadCh := S
else if SLen < 255 then begin
o[0] := Chr(Len);
Move(S[1], o[Succ(Word(Len))-SLen],
SLen);
FillChar(o[1], Len-SLen, Ch);
LeftPadCh := o;
end;
end;
function LeftPad(S : string; Len : Byte) : string;
{-Return a string left-padded to length len
with blanks}
begin
LeftPad := LeftPadCh(S, ' ', Len);
end;
function PadCh(S : string; Ch : Char; Len : Byte) : string;
{-Return a string right-padded to length len
with ch}
var
o : string;
SLen : Byte absolute S;
begin
if Length(S) >= Len then
PadCh := S
else begin
o[0] := Chr(Len);
Move(S[1], o[1], SLen);
if SLen < 255 then
FillChar(o[Succ(SLen)],
Len-SLen, Ch);
PadCh := o;
end;
end;
function Pad(S : string; Len : Byte) : string;
{-Return a string right-padded to length len
with blanks}
begin
Pad := PadCh(S, ' ', Len);
end;
function Long2Str(L : LongInt) : string;
{-Convert a long/word/integer/byte/shortint
to a string}
var
S : string;
begin
Str(L, S);
Long2Str := S;
end;
type
PWordArray = ^TWordArray;
TWordArray = array [0..256] of Word;
TVESARec = record
Sig: array [0..3] of Char;
uVersion: Byte;
lVersion: Byte;
Manufacturer: Pointer;
Flag: LongInt;
Modes: PWordArray;
Padding: array [19..256] of Byte;
end;
TModeRec = record
ModeFlag: Word;
WindowFlags: array [0..1] of Byte;
Gran: Word;
WindowSize: Word;
Window1Seg,Window2Seg: Word;
VisiblePtr: Pointer;
BytesPerLine: Word;
{Optional: Byte;}
XRes,YRes: Word;
CharWidth,CharHeight: Byte;
NumBitplanes: Byte;
BitsPerPixel: Byte;
MemBlocks: Byte;
MemModel: Byte;
MemBlockSize: Byte;
padd: array [1..300] of Byte;
end;
function IsVESAInstalled (var VESARec: TVESARec): Boolean; assembler;
asm
mov ax,4F00h
les di,VESARec
int 10h
end;
function GetModeInfo (mode: Word; var ModeRec: TModeRec): Boolean;
assembler;
asm
mov ax,4F01h
mov cx,[mode]
les di,ModeRec
int 10h
end;
procedure DisplayString (x,y: Byte; s: String);
var
i: Byte;
c: Char;
begin
for i := 1 to Length (s) do
begin
c := s [i];
GotoXY (x,y);
asm
mov ah,09h
mov al,[c]
mov bh,0
mov bl,01h
mov cx,1
int 10h
end;
Inc (x);
end;
end;
procedure SetDisplayStart (x,y: Word);
begin
asm
mov ax,4F07h
mov bh,0
mov bl,0
mov cx,[x]
mov dx,[y]
int 10h
end;
end;
var
i: Integer;
VESARec: TVESARec;
ModeRec: TModeRec;
num: Word;
ii: Byte;
mode: String;
x,y: Integer;
begin
if IsVESAInstalled (VESARec) then
begin
repeat
ClrScr;
i := 0;
while VESARec.Modes^ [i] <> $FFFF
do
begin
Write (Pad (HexW (VESARec.Modes^
[i]),8));
GetModeInfo (VESARec.Modes^
[i], ModeRec);
with ModeRec do
Writeln
(LeftPad (Long2Str (XRes)+'x'+Long2Str (YRes),9),' ',BitsPerPixel:2,' ',MemModel:2,'
',Gran);
Inc (i);
end;
Writeln;
Write ('Enter video mode: ');
Readln (mode);
mode := Trim (mode);
if mode <> '' then
begin
num := 0;
ii := 0;
for i := Length (mode)
downto 1 do
begin
num := num
+ ((Ord (mode [i]) - Ord ('0')) shl ii);
Inc (ii,4);
end;
if GetModeInfo (num,
ModeRec) then
begin
ClrScr;
with ModeRec
do
begin
Writeln ('Information for mode ',HexW (num),'h - ',XRes,'x',YRes,' ',BitsPerPixel,'bit
color');
Writeln;
Write ('Can this mode be used with the attached monitor?
');
if ModeFlag and 1 = 1 then Writeln ('Yes') else Writeln ('No');
Write ('Are the BIOS text functions supported in this mode? ');
if ModeFlag and 4 = 4 then Writeln ('Yes') else Writeln ('No');
Write ('Monochrome or colour?
');
if ModeFlag and 8 = 8 then Writeln ('Colour') else Writeln ('Monochrome');
Write ('Mode type
');
if ModeFlag and 16 = 16 then Writeln ('Graphic') else Writeln ('Text');
Writeln;
Writeln ('Access window information:');
for i := 0 to 1 do
begin
Write (' ',i,' ');
if WindowFlags [i] and 1 = 1 then Write ('Available') else Write ('Not
Available');
Write (',');
if WindowFlags [i] and 2 = 2 then Write ('Read Access') else Write ('No
Read Access');
Write (',');
if WindowFlags [i] and 4 = 4 then Write ('Write Access') else Write ('No
Write Access');
Writeln;
end;
Writeln;
Writeln ('Granularity
',Gran,'k');
Writeln ('Size of the two access windows
',WindowSize,'k');
Writeln ('Segment address of first access window
',HexW (Window1Seg),'h');
Writeln ('Segment address of second access window
',HexW (Window2Seg),'h');
Writeln ('Number of bytes required for each pixel line
',BytesPerLine);
Writeln ('Width of character matrix in pixels
',CharWidth);
Writeln ('Height of character matrix in pixels
',CharHeight);
Writeln ('Number of bitplanes
',NumBitPlanes);
Writeln ('Number of bits per screen pixel
',BitsPerPixel);
Writeln ('Number of memory blocks
',MemBlocks);
Writeln ('Memory model
',MemModel);
Writeln ('Size of memory blocks
',MemBlockSize);
end;
end
else Writeln ('Invalid
mode');
Writeln;
Write ('Press any key...');
Readln;
end;
until Trim (mode) = '';
asm
{ set mode to 101h - 640x480x256
on my PC }
mov ax,4F02h
mov bx,101h
int 10h
{ Address vid RAM and write first
64k (first bank) }
mov ax,0A000h
{ vid RAM is at A000:0000 so set segment address }
mov es,ax
xor di,di
{ set offset - DI=0000 (xor di,di = mov di,0}
cld
{ clear direction flag }
mov cx,0FFFFh
{ FFFF bytes - 65536 }
mov al,7
{ color - 7 }
rep stosb
{ store color in FFFF successive bytes starting }
{ at ES:DI - A000:0000 }
{ Switch bank }
mov ax,4F05h
mov bh,0
mov bl,0 { Access window }
mov dx,1 { Bank 1 }
int 10h
{ Address vid RAM and write second
64k }
mov ax,0A000h
mov es,ax
xor di,di
cld
mov cx,0FFFFh
mov al,2
rep stosb
{ Switch bank }
mov ax,4F05h
mov bh,0
mov bl,0 { Access window }
mov dx,2 { Bank 2 }
int 10h
{ Address vid RAM and write second
64k }
mov ax,0A000h
mov es,ax
xor di,di
cld
mov cx,0FFFFh
mov al,3
rep stosb
{ Switch bank }
mov ax,4F05h
mov bh,0
mov bl,0 { Access window }
mov dx,3 { Bank 3 }
int 10h
{ Address vid RAM and write second
64k }
mov ax,0A000h
mov es,ax
xor di,di
cld
mov cx,0FFFFh-6144
mov al,4
rep stosb
end;
i := 1;
repeat
while i <= 400 do
begin
SetDisplayStart (0,i);
Inc (i,3);
end;
while i >= 0 do
begin
SetDisplayStart (0,i);
Dec (i,3);
end;
i := 0;
until KeyPressed;
Readln;
asm
mov ax,0003h
int 10h
end;
end
else Writeln ('VESA is not installed.');
end.
Get your own Free Homepage