[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]

    {Still wan't that BMP header info? Well, here's a small BMP shower that
    uses VESA modes (up to 1280x1024, 256 colours). It can only show 4-bit and
    8-bit BMP's, and it's written using Turbo Pascal 6.0. }

    program bmp;

    { Variables }

    var bitmap : record
         bfType          : word;
         bfSize          : longint;
         bfReserved1     : word;
         bfReserved2     : word;
         bfOffBits       : longint;
         biSize          : longint;
         biWidth         : longint;
         biHeight        : longint;
         biPlanes        : word;
         biBitCount      : word;
         biCompression   : longint;
         biSizeImage     : longint;
         biXPelsPerMeter : longint;
         biYPelsPerMeter : longint;
         biClrUsed       : longint;
         biClrImportant  : longint
        end;

        palette : array[0..255] of record B, G, R, alpha : byte end;

        VbeInfoBlock : record
         VbeSignature      : longint;
         VbeVersion        : word;
         OemStringPtr      : pointer;
         Capabilities      : longint;
         VideoModePtr      : pointer;
         TotalMemory       : word;
        { Added for VBE 2.0 }
         OemSoftwareRev    : word;
         OemVendorNamePtr  : pointer;
         OemProductNamePtr : pointer;
         OemProductRevPtr  : pointer;
         Reserved          : array[0..221] of byte;
         OemData           : array[0..255] of byte
        end;

        ModeInfoBlock : record
        { Mandatory information for all VBE revisions }
         ModeAttributes      : word;
         WinAAttributes      : byte;
         WinBAttributes      : byte;
         WinGranularity      : word;
         WinSize             : word;
         WinASegment         : word;
         WinBSegment         : word;
         WinFuncPtr          : pointer;
         BytesPerScanLine    : word;
        { Mandatory information for VBE 1.2 and above }
         XResolution         : word;
         YResolution         : word;
         XCharSize           : byte;
         YCharSize           : byte;
         NumberOfPlanes      : byte;
         BitsPerPixel        : byte;
         NumberOfBanks       : byte;
         MemoryModel         : byte;
         BankSize            : byte;
         NumberOfImagePages  : byte;
         Reserved1           : byte;
        { Direct Color fields (required for direct/6 and YUV/7 memory models) }
         RedMaskSize         : byte;
         RedFieldPosition    : byte;
         GreenMaskSize       : byte;
         GreenFieldPosition  : byte;
         BlueMaskSize        : byte;
         BlueFieldPosition   : byte;
         RsvdMaskSize        : byte;
         RsvdFieldPosition   : byte;
         DirectColorModeInfo : byte;
        { Mandatory information for VBE 2.0 and above }
         PhysBasePtr         : longint;
         OffScreenMemOffset  : longint;
         OffScreenMemSize    : word;
         Reserved2           : array[0..205] of byte
        end;

        bmpfile : file;
        buf : array[0..1279] of byte;

        OldMode, Mode, Window, Segment, Units, Offset : word;
        Size, Address : longint;
        x,y : word;

    { VESA interface }

    function ReturnVBEInfo(var VbeInfoBlockPtr) : word; assembler;
    asm mov ax,4F00h; les di,VbeInfoBlockPtr; int 10h end;

    function ReturnModeInfo(Mode : word; var ModeInfoBlockPtr) : word; assembler;
    asm mov ax,4F01h; mov cx,Mode; les di,ModeInfoBlockPtr; int 10h end;

    function SetVBEMode(Mode : word) : word; assembler;
    asm mov ax,4F02h; mov bx,Mode; int 10h end;

    function ReturnVBEMode : word; assembler;
    asm mov ax,4F03h; int 10h; mov ax,bx end;

    function SetWindow(Window, Units : word) : word; assembler;
    asm mov ax,4F05h; mov bx,Window; mov dx,Units; int 10h end;

    { Palette... }

    procedure SetPalette(First, N : word; var Palette); assembler;
    asm
     pushf
     push ds
     mov al,byte ptr First
     mov dx,3C8h
     out dx,al
     inc dx
     std
     mov cx,N
     lds si,Palette
     add si,2
    @SP:
     lodsb
     shr al,2
     out dx,al
     lodsb
     shr al,2
     out dx,al
     lodsb
     shr al,2
     out dx,al
     add si,7
     loop @SP
     pop ds
     popf
    end;

    begin
    { Open bitmap file }
     if ParamCount = 1 then with bitmap do begin
      assign(bmpfile,ParamStr(1)); reset(bmpfile,1);
      blockread(bmpfile, bitmap, sizeof(bitmap));
      if bfType = $4D42 then begin

    { Show details }
       writeln(#10'Bitmap   : ', ParamStr(1));
       writeln(   ' width   : ',biWidth);
       writeln(   ' height  : ',biHeight);
       writeln(   ' bits    : ',biBitCount);
       if biClrUsed = 0 then biClrUsed := 1 shl biBitCount;
       writeln(   ' colours : ',biClrUsed);
       if ((biBitCount = 4) or (biBitCount = 8)) and (biWidth > 0) and (biHeight >
    0)   and (biWidth <= 1280) and (biHeight <= 1024) then begin
        if biBitCount = 4 then
         biWidth := (biWidth + 7) and $FFF8
        else
         biWidth := (biWidth + 3) and $FFFC;

    { Get VESA interface }
        if ReturnVBEInfo(VbeInfoBlock) = $004F then with VbeInfoBlock do begin
         writeln(#10'VBE version  : ', hi(VbeVersion), '.', lo(VbeVersion), '0');
         case biWidth of
            1.. 640:Mode:=$100; 641.. 800:Mode:=$103;
          801..1024:Mode:=$105;1025..1280:Mode:=$107
         end;
         case biHeight of
              1..400:x :=$100;401.. 480:x :=$101;481..600:x :=$103;
            601..768:x :=$105;769..1024:x :=$107
         end;
         if Mode < x then Mode := x;
         if (ReturnModeInfo(Mode, ModeInfoBlock) = $004F)
         and odd(ModeInfoBlock.ModeAttributes) then with ModeInfoBlock do begin

    { Show details}
          writeln(' mode        : ', Mode, 'd');
          writeln(' granularity : ', WinGranularity,'KB');
          writeln(' window size : ', WinSize,'KB');
          if (WinAAttributes and 4) = 4 then begin
           Window := 0; Segment := WinASegment
          end else begin
           Window := 1; Segment := WinBSegment
          end;
          writeln(' window      : ', chr(ord('A') + window));
          writeln(' segment     : ', Segment, 'd');
          writeln(' bytes/line  : ', BytesPerScanLine);
          Units := WinSize div WinGranularity;
          Size := longint(WinSize) shl 10;
          writeln(#10'Press <Enter> to display bitmap'); readln;
          OldMode := ReturnVBEMode;
          if SetVBEMode(Mode) = $004F then begin

    { Read and set palette }
           blockread(bmpfile, palette, biClrUsed shl 2);
           SetPalette(0,biClrUsed,Palette);

    { Show bitmap}
           for y := pred(biHeight) downto 0 do begin
            Address := longint(y) * BytesPerScanLine;
            SetWindow(Window, Address div Size);
            Offset := Address mod Size;
            if biBitCount = 4 then begin

    { Show 4-bit bitmap }
             blockread(bmpfile, buf, biWidth shr 1);
             for x := pred(biWidth shr 1) downto 0 do begin
              buf[succ(x shl 1)] := buf[x] and $0F;
              buf[x shl 1] := buf[x] shr 4
             end;
             if Offset <= (Size - biWidth) then
              move(buf, mem[Segment:Offset], biWidth)
             else begin
              move(buf, mem[Segment:Offset], Size - Offset);
              SetWindow(Window, succ(Address div Size));
              move(buf, mem[Segment:0], biWidth - Size + Offset)
             end
            end else

    { Show 8-bit bitmap }
             if Offset <= (Size - biWidth) then
              blockread(bmpfile, mem[Segment:Offset], biWidth)
             else begin
              blockread(bmpfile, mem[Segment:Offset], Size - Offset);
              SetWindow(Window, succ(Address div Size));
              blockread(bmpfile, mem[Segment:0], biWidth - Size + Offset)
            end
           end;
           readln; SetVBEMode(OldMode)
          end else writeln('VESA mode could not be set')
         end else writeln('VESA mode not supported in hardware')
        end else writeln('No VESA BIOS found')
       end else writeln('Unable to display bitmap')
      end else writeln('File is not a BMP file');
      close(bmpfile)
     end else writeln('Usage : BMP <filename>.BMP')
    end.

[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]