这是我改编自C语言的程序，程序利用VESA标准，启动SVGA的640*480*256色模式，并采用直接对显存进行传送数据的方法，显示一个256色的BMP文件。(BMP文件请不要用RLE算法压缩，如果BMP文件的长和宽大于648*480，将只显示图像左上角648*480部分 )。


============================
{  256 colors BMP file display demo.
    Uses VESA 640*480*256c SVGA mode.
    Programmed by j.t.chang.
}

Program BMP_256c_demo;
uses  dos ;

Type
    VESA_MODE_INFO = record
        Mode_Attri : word;
        Win_A_Attri: byte;
        Win_B_Attri: byte;
        Win_Gran   : word;
        Win_size   : word;
        Win_A_Seg  : word;
        Win_B_Seg  : word;
        Win_Func_Ptr: Longint;
        Bytes_Ptr_Scanline: word;
        X_Res      : word;
        Y_Res      : word;
        X_Char_Size: word;
        Y_Char_Size: word;
        Num_Of_Planes  : byte;
        Bits_Per_Pixel : byte;
        Num_Of_Banks   : byte;
        Mem_Model      : byte;
        Bank_Size      : word;
     end;

var
    rf    : file;
    flname: string;
    inf   : VESA_MODE_INFO;

Procedure set_VESA_mode(volue:integer);
var
   regs : Registers;
begin
     with regs do
      begin
          ah := $4f;
          al := $02;
          bx := volue;
      end;
     intr($10,regs);
end;

Procedure set_BMP_SVGA_Palette;
Var
    rgb : array[0..1023] of byte;
    pal : array[0..767]  of byte;
    recread : word;
    LP  : integer;
    regs: Registers;

begin
    assign(rf,flname);
    reset(rf,1);
    seek(rf,54);
    blockread(rf,rgb,1024,recread);
    close(rf);
    for LP := 0 to 255 do
      begin
          pal[LP*3] := rgb[LP*4+2] shr 2;
          pal[LP*3+1] := rgb[LP*4+1] shr 2 ;
          pal[LP*3+2] := rgb[LP*4] shr 2;
      end;

    with regs do
      begin
         es := SEG(pal);
         dx := OFS(pal);
         ax := $1012;
         bx := 0;
         cx := 256;
     end;
     intr($10,regs);
end;

procedure select_VESA_page(RW_page:byte; Gran:integer);
var
   regs : Registers;
begin
    with regs do
     begin
        dx := 64 div Gran*RW_page;
        ax := $4f05;
        bx := 0;
     end;
    intr($10,regs);
end;

procedure get_VESA_INFO(volue:integer);
var
    regs : Registers;

begin
    with regs do
       begin
          di := OFS(inf);
          es := SEG(inf);
          ax := $4f01;
          cx := volue;
       end;
    intr($10,regs);
end;


procedure VESA_pix(x,y:longint;color:byte);
var
    i,t1,t2 : word;
    q : ^byte;
    c : byte;
begin
    q := ptr($a000,$0000);
    i := (y*640+x) mod 65536;
    inc(q,i);
    q^ := color;
end;

function pow(x,i:longint):longint;
var
    k    : longint;
    temp : longint;
begin
    temp := 1;
    for k := 1 to i do temp := temp*x;
    pow := temp;
end;

procedure putbmp(x,y:integer; c:integer);
const
    x_line : array[0..5] of integer = (0,255,511,127,383,0);
    y_line : array[0..5] of integer = (0,102,204,307,409,480);
var
   i,j    : longint;
   yy,xx  : longint;
   RW_page:integer;
   BMP_size,BMP_width,BMP_length,BMP_wid : longint;
   buff   : array[0..1024] of byte;
   recread: word;

begin
    RW_page := 0; BMP_size := 0;
    assign(rf,flname);
    reset(rf,1);
    seek(rf,2);
    blockread(rf,buff,4,recread);
    buff[4] := 0;
    i := 0;
    while buff[i]<>0 do
      begin
        BMP_size := BMP_size+pow(256,i)*buff[i];
        i := i+1;
      end;
    seek(rf,$12);
    blockread(rf,buff,4,recread);
    yy := buff[1];
    bmp_width := yy*256+buff[0];
    blockread(rf,buff,4,recread);
    yy := buff[1];
    BMP_length := yy*256+buff[0];
    BMP_wid := (BMP_size-1078) div BMP_length;
    for i := 0 to BMP_length-1 do
    begin
       seek(rf,BMP_size-(i+1)*BMP_wid);
       blockread(rf,buff,BMP_wid,recread);
       yy := i+y;
       for j := 0 to BMP_width-1 do
         begin
            xx := x+j;
            if(yy>=y_line[RW_page])and(yy<y_line[RW_page+1])
               then
            else
               if(yy=y_line[RW_page+1]) and (xx < x_line[RW_page+1])
                   then
                else
                   begin
                      RW_page := (yy*640+xx) div 65536;
                      select_VESA_page(RW_page,c);
                    end;
                    VESA_pix(xx,yy,buff[j]);
              end;
         end;
    close(rf);
end;

procedure read_key;
var
    regs : Registers;
begin
   with regs do
     begin
          ah := 7;
          al := 0;
      end;
   intr($21,regs);
end;

procedure set_vga_mode;
var
    regs : Registers;
begin
    with regs do
        begin
            ah := 0;
            al := 2;
        end;
    intr($10,regs);
end;


BEGIN
     write('Enter a 256 colors BMP file name: ');
     readln(flname);
     set_VESA_mode($101);
     get_VESA_info($101);
     set_BMP_SVGA_Palette;
     putbmp(0,0,inf.WIN_Gran);
     read_key;
     set_vga_mode;
END.
============================