BMP Graphics Unit - Pascal - Forums at ProgrammersHeaven.com

Pascal

Moderators: None (Apply to moderate this forum)

Number of threads: 4095
Number of posts: 14004

With full replies

Topics only

Pascal

Forum Info

This Forum Only

Single Post View Linear View Threaded View f

Printer Friendly

RSS Feed

BMP Graphics Unit Posted by Phat Nat on 17 Aug 2005 at 11:55 PM

This message was edited by Phat Nat at 2005-8-17 23:57:37

Here is the BMP Unit (Sample program below unit). Make sure to name it "SHOW_BMP.PAS" or change the Unit name to match the Save Name:

UNIT Show_Bmp;

INTERFACE

USES Crt;

CONST
     VGA = $A000;

TYPE
    BMPHeaderRec = record
         Identifier     : Array[0..1] Of Char;
         Size           : LongInt;
         Reserved       : LongInt;
         BitMapOffset   : LongInt;
         CheckType      : LongInt;
         Width          : LongInt;
         Height         : LongInt;
         Planes         : Word;
         Bits           : Word;
         Compression    : LongInt;
         ImageSize      : LongInt;
         XPels          : LongInt;
         YPels          : LongInt;
         ColorUsed      : LongInt;
         ColorImportant : LongInt;
    End;

    InfoBlock = record
      Valid     : Boolean;
      Cmp       : ShortInt;
      BMPHeader   : BMPHeaderRec;
    END;

    ColorType = record
      Blue    : Byte;
      Green   : Byte;
      Red     : Byte;
      Index   : Integer;
    END;

    HiColorType = record
      Blue    : Byte;
      Green   : Byte;
      Red     : Byte;
    END;

VAR
   ScreenH              : Integer;
   ScreenW              : Integer;
   BPP                  : Byte;

PROCEDURE Graphix(Mode : Word);
PROCEDURE SetTextMode;
PROCEDURE SetPal(Num : Byte;Red, Green, Blue : Byte);
PROCEDURE GetPal(Num : Byte;VAR Red, Green, Blue : Byte);
PROCEDURE GetPixel(X,Y : Integer;VAR Color : ColorType);
PROCEDURE PutPixel(X,Y : Integer;Color, ClearColor : ColorType; Where : Word);
FUNCTION  GetBMPInfo(Name : String; VAR Info : InfoBlock) : Boolean;
PROCEDURE ShowBMPInfo(Info : InfoBlock);
FUNCTION  ShowBMP(StartX, StartY : Integer; Name : String; DoColors : Boolean; Clear : ColorType; Where : Word) : Boolean;

IMPLEMENTATION

CONST
     Header : array[1..2] Of Char = 'BM';
     PalCount    = 255;
     BI_RGB      = 0;
     BI_RLE8     = 1;
     BI_RLE4     = 2;

VAR
   Colors               : Array[0..255,1..4] Of Byte;
   C                    : Char;
   CA                   : Array[0..7] Of Boolean;
   CA2                  : Array[1..3] Of Byte;
   CurrentMode          : Word;
   CurrentBlock         : Byte;
   Red, Blue, Green     : Byte;
   Temp                 : Byte;
   Temp2                : Array[1..4] Of Byte;
   F                    : File;
   S2                   : Array[1..2] Of Char;
   Junk                 : Array[0..10000] Of Char;
   X, X2, Y, Y2, Z          : Integer;

PROCEDURE Graphix(Mode : Word);
Begin
     ASM
        Cmp Mode, $FF
        Jg @VESA
        Mov Ax, Mode
        INT 10h
        Mov ScreenW, 320
        Mov ScreenH, 200
        Mov BPP, 8
       @MT1:
        Cmp Mode, $11
        Jne @MT2
        Mov ScreenW, 640
        Mov ScreenH, 480
        Mov BPP, 1
       @MT2:
        Cmp Mode, $12
        Jne @MT3
        Mov ScreenW, 640
        Mov ScreenH, 480
        Mov BPP, 4
       @MT3:
        Cmp Mode, $13
        Jne @MT4
        Mov ScreenW, 320
        Mov ScreenH, 200
        Mov BPP, 8
       @MT4:
        Jmp @End
       @VESA:
        Mov Ax, $4F02
        Mov Bx, Mode
        INT 10h
       @VMT01:
        Cmp Mode, $101
        Jne @VMT0F
        Mov ScreenW, 640
        Mov ScreenH, 480
        Mov BPP, 8
       @VMT0F:
        Cmp Mode, $10F
        Jne @VMT10
        Mov ScreenW, 320
        Mov ScreenH, 200
        Mov BPP, 32
       @VMT10:
        Cmp Mode, $110
        Jne @VMT11
        Mov ScreenW, 640
        Mov ScreenH, 480
        Mov BPP, 16
       @VMT11:
        Cmp Mode, $111
        Jne @VMT12
        Mov ScreenW, 640
        Mov ScreenH, 480
        Mov BPP, 16
       @VMT12:
        Cmp Mode, $112
        Jne @VMT15
        Mov ScreenW, 640
        Mov ScreenH, 480
        Mov BPP, 32
       @VMT15:
        Cmp Mode, $115
        Jne @VMT5
        Mov ScreenW, 800
        Mov ScreenH, 600
        Mov BPP, 32
       @VMT5:
       @End:
     End;
     CurrentMode := Mode;
End;

PROCEDURE SetTextMode; assembler;
ASM
   Mov Ax, $0003
   INT 10h
   Mov ScreenW, 80
   Mov ScreenH, 25
End;

PROCEDURE SetPal(Num : Byte;Red, Green, Blue : Byte);
Begin
     Port[$3c8] := Num;
     Port[$3c9] := Red;
     Port[$3c9] := Green;
     Port[$3c9] := Blue;
End;

PROCEDURE GetPal(Num : Byte;VAR Red, Green, Blue : Byte);
Begin
     Port[$3c7] := Num;
     Red   := Port[$3c9];
     Green := Port[$3c9];
     Blue  := Port[$3c9];
End;

PROCEDURE SetBlock(X,Y : Integer);
Begin
     Temp := (((LONGINT(Y)*ScreenW*(BPP Shr 3)+X)) Shr 16);
     If CurrentBlock <> Temp Then
     Begin
          ASM
             Mov Ax, $4f05
             Xor Bh, Bh
             Mov Dl, Temp
             Int $10
          END;
          CurrentBlock := Temp;
     End;
End;

PROCEDURE GetPixel(X,Y : Integer;VAR Color : ColorType);
Begin
     If (X < 0) or (Y < 0) or (X >= ScreenW) or (Y >= ScreenH) Then Exit;
     With Color Do
     Begin
       If BPP <= 8 Then
       Begin
         SetBlock(X*(BPP Shr 3),Y);
         Index := Mem[$A000:((X+Y*ScreenW)*(BPP Shr 3)) - Temp Shl 16]
       End
       ELSE
       Begin
         SetBlock(X*(BPP Shr 3),Y);
         Blue  := Mem[$A000:((X+Y*ScreenW)*(BPP Shr 3)+0) - Temp Shl 16];
         SetBlock(X*(BPP Shr 3)+1,Y);
         Green := Mem[$A000:((X+Y*ScreenW)*(BPP Shr 3)+1) - Temp Shl 16];
         SetBlock(X*(BPP Shr 3)+2,Y);
         Red   := Mem[$A000:((X+Y*ScreenW)*(BPP Shr 3)+2) - Temp Shl 16];
         Index := -1;
       End;
     End;
End;

PROCEDURE PutPixel(X,Y : Integer;Color, ClearColor : ColorType; Where : Word);
VAR Z : Byte;
Begin
     If (X < 0) or (Y < 0) or (X >= ScreenW) or (Y >= ScreenH) Then Exit;
     With Color Do
     Begin
       If BPP <= 8 Then
       Begin
         If Color.Index = ClearColor.Index Then Exit;
         Z := BPP Shr 3;
         SetBlock(X*Integer(Z),Y);
         Mem[Where:((X+Y*ScreenW)*Integer(Z)) - (CurrentBlock Shl 16)] := Index;
       End
       ELSE
       If (Color.Red   = ClearColor.Red) AND
          (Color.Green = ClearColor.Green) AND
          (Color.Blue  = ClearColor.Blue) Then Exit
       ELSE
       If Index = -1 Then
       Begin
            Case BPP Of
             16 : Begin
                       SetBlock(X*2,Y);
                       Mem[Where:((X+Y*ScreenW)*2+0) - CurrentBlock Shl 16] :=
                           (Blue Shr 3) AND 31 + ((Green Shr 3) Shl 7) AND 224;
                       SetBlock(X*2+1,Y);
                       Mem[Where:((X+Y*ScreenW)*2+1) - CurrentBlock Shl 16] :=
                           (((Green Shr 3) Shr 2) AND 7) + (((RED Shr 3) Shl 3) AND 248);
                  End;
             24,
             32 : Begin
                       SetBlock(X*(BPP Shr 3)+0,Y);
                       Mem[Where:((X+Y*ScreenW)*(BPP Shr 3)+0) - CurrentBlock Shl 16] := Blue;
                       SetBlock(X*(BPP Shr 3)+1,Y);
                       Mem[Where:((X+Y*ScreenW)*(BPP Shr 3)+1) - CurrentBlock Shl 16] := Green;
                       SetBlock(X*(BPP Shr 3)+2,Y);
                       Mem[Where:((X+Y*ScreenW)*(BPP Shr 3)+2) - CurrentBlock Shl 16] := Red;
                  End;
            End;
       End
       ELSE
       Begin
         Color.Blue  := Colors[Index,1];
         Color.Green := Colors[Index,2];
         Color.Red   := Colors[Index,3];
         SetBlock(X*(BPP Shr 3),Y);
         Mem[Where:((X+Y*ScreenW)*(BPP Shr 3)+0) - CurrentBlock Shl 16] := Blue;
         SetBlock(X*(BPP Shr 3)+1,Y);
         Mem[Where:((X+Y*ScreenW)*(BPP Shr 3)+1) - CurrentBlock Shl 16] := Green;
         SetBlock(X*(BPP Shr 3)+2,Y);
         Mem[Where:((X+Y*ScreenW)*(BPP Shr 3)+2) - CurrentBlock Shl 16] := Red;
       End;
     End;
End;

FUNCTION GetBMPInfo(Name : String; VAR Info : InfoBlock) : Boolean;
VAR Final : Boolean;
Begin
     GetBMPInfo := False;
     Assign(F, Name);{$I-}Reset(F,1);{$I+}
     If IOResult <> 0 Then Exit;
     BlockRead(F, Info.BMPHeader, SizeOf(Info.BMPHeader));

     Info.Valid := Info.BMPHeader.Identifier = Header;
     Final := Info.Valid;

     Info.Cmp := Info.BMPHeader.Compression;
     If Info.Cmp In[0] Then Final := True;

     Close(F);
     GetBMPInfo := True;
End;

PROCEDURE ShowBMPInfo(Info : InfoBlock);
Begin
     With Info.BMPHeader Do
     Begin
          GotoXY(21, 1);WriteLn('Size        = ',Size);
          GotoXY(21, 2);WriteLn('BitMapOffset= ',BitMapOffset);
          GotoXY(21, 3);WriteLn('Type        = ',CheckType);
          GotoXY(21, 4);WriteLn('Width       = ',Width);
          GotoXY(21, 5);WriteLn('Height      = ',Height);
          GotoXY(21, 6);WriteLn('Bits        = ',ORD(Bits));
          GotoXY(21, 7);WriteLn('Planes      = ',ORD(Planes));
          GotoXY(21, 8);WriteLn('FileSize    = ',ImageSize);
          GotoXY(21, 9);WriteLn('RealSize    = ',Width*Height);
          GotoXY(21,10);WriteLn('XPelsPerMet = ',XPels);
          GotoXY(21,11);WriteLn('YPelsPerMet = ',YPels);
          GotoXY(21,12);WriteLn('Color Used  = ',ColorUsed);
          GotoXY(21,13);WriteLn('Color Imp.  = ',ColorImportant);
     End;
End;

FUNCTION ShowBMP(StartX, StartY : Integer; Name : String; DoColors : Boolean; Clear : ColorType; Where : Word) : Boolean;
VAR
   Info : InfoBlock;
   Color : ColorType;
Begin
     If GetBMPInfo(Name,Info) = False Then
     Begin
          ShowBMP := False;
          Exit;
     End
     ELSE ShowBMP := True;
     Assign(F, Name);Reset(F,1);
     BlockRead(F, Info.BMPHeader, SizeOf(Info.BMPHeader));

     Reset(F,1);
     BlockRead(F, Junk, 14);
     BlockRead(F, Junk, Info.BMPHeader.CheckType);
     With Info.BMPHeader Do
     If Bits = 1 Then
     Begin
        For X := 0 to 1 Do
            Begin
                 BlockRead(F, Colors[X], 4);
                 SetPal(X*63, Colors[X,3]*63 DIV 255, Colors[X,2]*63 DIV 255, Colors[X,1]*63 DIV 255);
            End;
        Reset(F,1);
        BlockRead(F, Junk, BitMapOffset);
        Z := Width SHR 3;
          While Z MOD(4) <> 0 Do Inc(Z);
        For Y := 0 to Height-1 Do
            Begin
                 BlockRead(F, Junk, Z);
                 For X := 0 to Z-1 Do
                     Mem[Where:StartX+X+(StartY+Height-Y)*80] := ORD(Junk[X]);
            End;
     End;

     With Info.BMPHeader Do
     If Bits = 4 Then
     Begin
        For X := 0 to 15 Do
            Begin
                 BlockRead(F, Colors[X], 4);
                 SetPal(X, Colors[X,3]*63 DIV 255, Colors[X,2]*63 DIV 255, Colors[X,1]*63 DIV 255);
            End;
        Reset(F,1);
        BlockRead(F, Junk, BitMapOffset);
        Z := Width SHR 1;
          While Z MOD(4) <> 0 Do Inc(Z);
        For Y := 0 to Height-1 Do
            Begin
                 BlockRead(F, Junk, Z);
                 For X := 0 to (Width SHR 1)-1 Do
                     Begin
                          Mem[Where:StartX+X*2+0+(StartY+Height-Y)*ScreenW] := ORD(Junk[X]) SHR 4;
                          Mem[Where:StartX+X*2+1+(StartY+Height-Y)*ScreenW] := ORD(Junk[X]) AND 15;
                     End;
            End;
     End;

     With Info.BMPHeader Do
     If (Bits = 8) Then
     Begin
        BlockRead(F, Colors[0], (PalCount+1)*4);
        If DoColors Then
        For X := 0 to PalCount Do
            SetPal(X, Colors[X,3]*62 DIV 255, Colors[X,2]*63 DIV 255, Colors[X,1]*63 DIV 255);
        Reset(F,1);
        BlockRead(F, Junk, BitMapOffset);
        Z := (Width*Bits) SHR 3;
          While Z MOD(4) <> 0 Do Inc(Z);
        For Y := Height-1 downto 0 Do
            Begin
            BlockRead(F, Junk, Width);
            For X := 0 to Width-1 do
                Begin
                     Color.Index := ORD(Junk[X]);
                     PutPixel(StartX+X,StartY+Y,Color,Clear,Where);
{                     Mem[Where:StartX+(StartY+Height-Y)*ScreenW+(X)] := ORD(C);}
                End;
            For X := 1 to Z-Width Do BlockRead(F, C, 1);
{            If KeyPressed Then
               Begin
                    While KeyPressed Do ReadKey;
                    Break;
               End;}
            End;
     End;

     With Info.BMPHeader Do
     If (Bits = 24) or (Bits = 32) Then
     Begin
        If CurrentMode <= $109 Then
           For X := 0 to PalCount Do
               SetPal(X, X*63 DIV 255, X*63 DIV 255, X*63 DIV 255);
        Reset(F,1);
        BlockRead(F, Junk, BitMapOffset);
        Z := (Width*Bits) SHR 3;
          While Z MOD(4) <> 0 Do Inc(Z);
        Color.Index := -1; Bits := (Bits shr 3);
        For Y := Height-1 downto 0 Do
            Begin
                 BlockRead(F, Junk, Z);
                 For X := 0 to Width-1 do
                     Begin
                          If BPP <= 8 Then
                             Color.Index := Ord(Junk[X*(BPP shr 3)])
                          ELSE
                          Begin
                               Color.Blue  := Ord(Junk[X*Bits+0]);
                               Color.Green := Ord(Junk[X*Bits+1]);
                               Color.Red   := Ord(Junk[X*Bits+2]);
                          End;
                          PutPixel(StartX+X,StartY+Y,Color,Clear,Where);
                     End;
                 If KeyPressed Then Begin While KeyPressed Do ReadKey; Break; End;
            End;
     End;
     Close(F);
End;

End.

Here is a sample program to load a 320x200 8-bit (256 color) BMP. If you need a different BMP/screen resolution post here, but it gets more complicated. This assumes that you are starting in Text Mode and will put you into Mode $13 (320x200x256) and return you to text mode when done. Also, it assumes that you have a BMP in the same directory called "TEST.BMP":

PROGRAM TestBMP;
USES Crt,Show_BMP;
VAR
   ClearColor : ColorType;
   Loaded : Boolean;
Begin
     Graphix($13);
     { $13 = 320x200 8-bit (256 Color) Mode }
     ClearColor.Index := -1;
     { No Clear Color. Set this between 0 & 255 to make a see-through color }
     Loaded := ShowBMP(0,0,'TEST.BMP',True,ClearColor,VGA);
     { Returns True if BMP Loaded, False otherwise.
       First # is the starting Left position.    _/ Used to move a smaller
       Second # is the starting Top position.     \ BMP to middle of screen.
       Bitmap Name & Directory (NO long dir/filenames!)
       True/False = Used for loading the BMP Palette or not.
       ClearColor = of COLORTYPE. Index is used to display clear color.
       OUTPUT. In this case to VGA screen. Useful for sending to a Virtual Screen
     }
     If NOT(Loaded) Then     { If it didn't manage to load the BMP...}
     Begin
          DirectVideo := False;
          { Allow Writeln to write to the VGA screen }
          WriteLn('Failed to Load BMP!');
     End;
     Readkey;
     SetTextMode;
     { Close down graphics and return to text mode }
End.

I think I've explained most stuff.
If you are running this from a program already in a graphics mode, try to Set SCREENW to the Screen Width and SCREENH to the screen height (eg. 320 & 200) and the Bits Per Pixel BPP := 8; (8-bits per pixel), then just remove the Graphix(); line and the TextMode; lines.

Anything else, just post back.

Phat Nat

Pascal

Recent Jobs