Bitmap Reading

How do you send a Bitmap file you just read directly to the screen port for display?
ProfessorAsked:
Who is Participating?
 
nadtConnect With a Mentor Commented:
U can use following code{X,Y - screen coordinates, if x <0 bmp file will be centered on the
screen

file_name - name and path of the bmp file

erro - will return a error condition (0 no error)
if error <0 it's a bmp problem
if error >0 it's a disk error ( dos error codes)

Carlos Rondao
Universidade Catolica Portuguesa
Lisboa
Portugal

Send me a note if you have any comments or problems ...}


uses dos,graph;
var
  grDriver : Integer;
  grMode   : Integer;
  ErrCode  : Integer;
  erro : integer;
const filename = 'c:\download\picture1.bmp';{put filename and path here}
Procedure GetEgaPal(cor :byte ;var pal:byte);assembler;
  asm
   mov bl,cor
   mov ah,$10
   mov al,$07
   int $10
   les DI,pal
   mov ES:[DI],BH
  end;

Procedure SetEgaPal(cor :byte ;pal:byte);assembler;
  asm
   mov bl,cor
   mov bh,pal
   mov ah,$10
   mov al,$00
   int $10
  end;

Procedure SetPal16(Cor,r,g,b : byte);assembler;
 asm
  mov AH,$10
  mov AL,$10
  xor BH,BH
  mov BL,cor
  mov DH,r
  mov CH,g
  mov CL,b
  int $10
 end;
{===================================================}
Procedure GetPal16(Cor:byte;Var r,g,b : byte);assembler;
 asm
  mov AH,$10
  mov AL,$15
  xor BH,BH
  mov BL,cor
  int $10
  les DI,r
  mov ES:[DI],DH
  les DI,g
  mov ES:[DI],CH
  les DI,b
  mov ES:[DI],CL
 end;
Procedure SetAllPal16(var pal ;cor,n:integer);assembler;
 asm
  mov AH,$10
  mov AL,$12
  mov BX,cor
  mov CX,n
  les DX,pal
  int $10
 end;

Procedure EgaDefault;
var i,reg : byte;
    r,g,b : byte;
begin
 for i:=0 to 15 do
  begin
   GetEgaPal(i,reg);
   SetEgaPal(i,i);
   GetPal16(reg,r,g,b);
   SetPal16(i,r,g,b);
  end;
End;


procedure Load_BMP(X,Y:integer;file_name : pathstr;var erro :
integer);
 VAR
   header : array [1..27] of word;
   rgb_struct : array[0..255] of record
                                  b,g,r,cor : byte;
                                 end;
   rgb_triple : array[0..255] of record
                                  b,g,r : byte;
                                 end absolute rgb_struct;
   pal : array[0..255] of record
                            red,green,blue : byte;
                           end;
      F : File;
    i,j : integer;
  locer : integer;
   Xp,Yp,lido,larg,larg1,alt,cores,bufsize,desloc,reloc,grupo :
word;
    buf : array[1..10000] of byte;
    pic_point_1,pic_point_2 : byte;
    sign : array[1..2] of char absolute header;
    maxX,maxY : word;
  Begin
   maxX := GetmaxX;
   maxY := GetMaxY;
   assign(f,file_name);
   {$I-}
   reset(f,1);
   {$I+}
   erro := IoResult;
   if erro<>0 THEN exit;
   {$I-}
   blockread(f,header,18,lido);
   erro := IoResult;
   if erro = 0 then
    if sign<>'BM' THEN
       erro := -100;
   IF erro = 0 THEN
    BEGIN
     desloc := header[8]-4;
     if desloc >36 then desloc := 36;
     blockread(f,header[10],desloc,lido);
     erro := IoResult;
    END;
   if erro = 0 THEN
    begin
     reloc := ord(desloc<>8);
     larg := header[10];
     alt := header[11+reloc];
     cores := 1 shl header[13+2*reloc];
     if (alt > maxY) OR (larg>maxX) then
        erro := -101;
    end;
   If erro = 0 THEN
    BEGIN
     if (X<0) OR (Y<0) THEN
       Begin
        X := (maxX-larg) DIV 2;
        Y := (maxY-alt) DIV 2;
       End;
     blockread(f,rgb_struct,header[6]-18-desloc,lido);
     erro := IoResult;
    END;
    IF erro = 0 THEN
     BEGIN
         if cores = 16 THEN
          begin
           larg1 := 8*(larg DIV 8) + 8*ord(larg MOD 8<>0);
           LARG1 := LARG1 div 2;
          end
         else
          begin
           larg1 := 4*(larg DIV 4) + 4*ord(larg MOD 4<>0);
          end;
         if reloc = 1 THEN
          for i := 0 to cores-1 do
           Begin
            pal[i].red := rgb_struct[i].r DIV 4;
            pal[i].green := rgb_struct[i].g DIV 4;
            pal[i].blue := rgb_struct[i].b DIV 4  ;
           end
         else
          for i := 0 to cores-1 do
           Begin
            pal[i].red := rgb_triple[i].r DIV 4;
            pal[i].green := rgb_triple[i].g DIV 4;
            pal[i].blue := rgb_triple[i].b DIV 4  ;
           end;
         EgaDefault;
         setallpal16(Pal,0,cores);
         bufsize := larg1*(10000 DIV larg1);
         lido := bufsize;
         While (lido=bufsize) AND (erro=0) do
          begin
           blockread(f,buf,bufsize,lido);
           erro := IoResult;
           if erro= 0 Then
            IF Cores = 16 THEN
             For j := 1 to lido DIV larg1 do
              For i:=0 to larg-1 do
               Begin
                XP := X+i;
                YP := Y+alt-j;
                pic_point_1 := buf[(j-1)*larg1+ 1 + i DIV 2];
                pic_point_2:=(pic_point_1 SHR 4)*((i+1) MOD 2) +
                 (pic_point_1 AND 15)*((i+2) MOD 2) ;
                putpixel(XP,YP,pic_point_2)
              End
            ELSE
             For j := 1 to lido DIV larg1 do
              For i:=1 to larg do
               Begin
                XP := X+(i-1);
                YP := Y+alt-j;
                pic_point_1 := buf[(j-1)*larg1+i];
                putpixel(XP,YP,pic_point_1);
               end;
           Y := Y - lido DIV larg1;
         end; { while }
    END; { erro = 0 }
    close(f);
    {$I+}
    locer := Ioresult;
    If erro = 0 THEN erro := locer;
 END;
begin
  grDriver := Detect;
  InitGraph(grDriver,grMode,'c:\tp\bgi');
  ErrCode := GraphResult;
  if ErrCode = grOk then
    begin
      Load_BMP(-1,0,filename,erro);
      readln;
      CloseGraph;
    end
  else
    WriteLn('Graphics error:',
            GraphErrorMsg(ErrCode));

end.

This code I have not written myself but found it for u from www.thedigitalfoundry.com/tpp/files/pascal/tp/bmp.pas

still I think that if you are trying to use this code then you may like to give me full points
0
 
Alisher_NCommented:
this is not so easy as you suppose - depends on BMP format (number of colors mainly) and desired screen resolution and colors also, do you want it universal or for particular mode ?
0
 
ProfessorAuthor Commented:
Thank you very much indeed!!
0
Get 10% Off Your First Squarespace Website

Ready to showcase your work, publish content or promote your business online? With Squarespace’s award-winning templates and 24/7 customer service, getting started is simple. Head to Squarespace.com and use offer code ‘EXPERTS’ to get 10% off your first purchase.

 
amgedeldirdiriCommented:
Uses Crt,Dos,Graph;
Type
        ColorValue = Record
                  Rv,Gv,Bv: Byte;
                 End;
    PaletteType = Array [0..255] Of ColorValue;
        Palette = Record
                 Rv : Byte;
               Gv : Byte;
               Bv : Byte;
               Rr : Byte;
                   End;
        BitMapType = Record
               BfType      : Word;
                 BfSize      : LongInt;
                 BfReserved1 : Word;
               BfReserved2 : Word;
               BfOffSetBits: LongInt;
                 Size        : LongInt;
               Width       : LongInt;
               Height      : LongInt;
               Planes      : Word;
               BitCount    : Word;
               Comp        : LongInt;
               iSize        : LongInt;
               xpelspermeter: LongInt;
               ypelspermeter: LongInt;
               ColorsUsed   : LongInt;
               ColorsImportant:LongInt;
                 PalArray       :Array[0..255] of Palette;
                 End;

var
   Bit      : BitMapType;
   i,j,Gd,Gm: Integer;
   P        : PaletteType;
   Width,Hight : Word;

Procedure SetVGAPalette( Tp : PaletteType);
    Var
       Regs: Registers;
  Begin
    With Regs Do
      Begin
        AH:=$10;
        Al:=$12;
        BX:=0;
        CX:=256;
        ES:=Seg(tp);
        DX:=Ofs(tp);
      End;
    Intr($10,Regs);
  End;

Procedure Read_BmfHeader;
var
   fh : File Of BitMapType;
Begin
        Assign(fh,ParamStr(1)+'.bmp');
        Reset(fh);
        Read(fh,Bit);
        Close(fh);
        If(Bit.BfType<>19778) Then
        Begin
          Writeln('FORMAT IS NOT RECOGNIZED!');
          halt;
        End;
        Width:=Bit.Width;
        Hight:=Bit.Height;
        For i:= 0 To 255 Do
        Begin
          P[i].Rv:=Bit.PalArray[i].Bv Shr 2;
          P[i].Gv:=Bit.PalArray[i].Gv Shr 2;
          P[i].Bv:=Bit.PalArray[i].Rv Shr 2;
        End;
End;

Procedure DisplayBitMap;
var
     i,j : Integer;
     f : File Of Byte;
     b : Byte;
Begin
     Assign(f,ParamStr(1)+'.bmp');
     Reset(f);
     Seek(f,sizeof(BitMapType));
     For i :=1 To Hight Do
     For j :=1 To Width Do
       Begin
            Read(f,b);
            PutPixel(j,Hight-i,B);
       End;
End;

Procedure DefPal;
Begin
      SetVgaPalette(P);
End;
Procedure OutTxt;
Var
   i:Integer;
Begin
     For i:=1 To 10 Do
     Begin
     SetColor(4);SetTextStyle(1,0,7);
     OutTextXY(60+i,10+i,'AMGAD');
     OutTextXY(20+i,70+i,'ELDIRDIRI');
     OutTextXY(20+i,130+i,'PASCAL');
     OutTextXY(60+i,200+i,'PROGRAM');
     Delay(20);SetColor(1);
     OutTextXY(60,10,'AMGAD');
     OutTextXY(20,70,'ELDIRDIRI');
     OutTextXY(20,130,'PASCAL');
     OutTextXY(60,200,'PROGRAM');
     End;
End;

Begin
      Read_BmfHeader;
      Gd := InstallUserDriver ('Svga256',Nil);
      Gm := 2;
      InitGraph(Gd,Gm,'');
      DefPal;
      DisplayBitMap;
      OutTxt;
      Readln;
      CloseGraph;
End.

0
 
amgedeldirdiriCommented:
Uses Crt,Dos,Graph;
Type
        ColorValue = Record
                  Rv,Gv,Bv: Byte;
                 End;
    PaletteType = Array [0..255] Of ColorValue;
        Palette = Record
                 Rv : Byte;
               Gv : Byte;
               Bv : Byte;
               Rr : Byte;
                   End;
        BitMapType = Record
               BfType      : Word;
                 BfSize      : LongInt;
                 BfReserved1 : Word;
               BfReserved2 : Word;
               BfOffSetBits: LongInt;
                 Size        : LongInt;
               Width       : LongInt;
               Height      : LongInt;
               Planes      : Word;
               BitCount    : Word;
               Comp        : LongInt;
               iSize        : LongInt;
               xpelspermeter: LongInt;
               ypelspermeter: LongInt;
               ColorsUsed   : LongInt;
               ColorsImportant:LongInt;
                 PalArray       :Array[0..255] of Palette;
                 End;

var
   Bit      : BitMapType;
   i,j,Gd,Gm: Integer;
   P        : PaletteType;
   Width,Hight : Word;

Procedure SetVGAPalette( Tp : PaletteType);
    Var
       Regs: Registers;
  Begin
    With Regs Do
      Begin
        AH:=$10;
        Al:=$12;
        BX:=0;
        CX:=256;
        ES:=Seg(tp);
        DX:=Ofs(tp);
      End;
    Intr($10,Regs);
  End;

Procedure Read_BmfHeader;
var
   fh : File Of BitMapType;
Begin
        Assign(fh,ParamStr(1)+'.bmp');
        Reset(fh);
        Read(fh,Bit);
        Close(fh);
        If(Bit.BfType<>19778) Then
        Begin
          Writeln('FORMAT IS NOT RECOGNIZED!');
          halt;
        End;
        Width:=Bit.Width;
        Hight:=Bit.Height;
        For i:= 0 To 255 Do
        Begin
          P[i].Rv:=Bit.PalArray[i].Bv Shr 2;
          P[i].Gv:=Bit.PalArray[i].Gv Shr 2;
          P[i].Bv:=Bit.PalArray[i].Rv Shr 2;
        End;
End;

Procedure DisplayBitMap;
var
     i,j : Integer;
     f : File Of Byte;
     b : Byte;
Begin
     Assign(f,ParamStr(1)+'.bmp');
     Reset(f);
     Seek(f,sizeof(BitMapType));
     For i :=1 To Hight Do
     For j :=1 To Width Do
       Begin
            Read(f,b);
            PutPixel(j,Hight-i,B);
       End;
End;

Procedure DefPal;
Begin
      SetVgaPalette(P);
End;
Procedure OutTxt;
Var
   i:Integer;
Begin
     For i:=1 To 10 Do
     Begin
     SetColor(4);SetTextStyle(1,0,7);
     OutTextXY(60+i,10+i,'AMGAD');
     OutTextXY(20+i,70+i,'ELDIRDIRI');
     OutTextXY(20+i,130+i,'PASCAL');
     OutTextXY(60+i,200+i,'PROGRAM');
     Delay(20);SetColor(1);
     OutTextXY(60,10,'AMGAD');
     OutTextXY(20,70,'ELDIRDIRI');
     OutTextXY(20,130,'PASCAL');
     OutTextXY(60,200,'PROGRAM');
     End;
End;

Begin
      Read_BmfHeader;
      Gd := InstallUserDriver ('Svga256',Nil);
      Gm := 2;
      InitGraph(Gd,Gm,'');
      DefPal;
      DisplayBitMap;
      OutTxt;
      Readln;
      CloseGraph;
End.

0
 
amgedeldirdiriCommented:
Uses Crt,Dos,Graph;
Type
        ColorValue = Record
                  Rv,Gv,Bv: Byte;
                 End;
    PaletteType = Array [0..255] Of ColorValue;
        Palette = Record
                 Rv : Byte;
               Gv : Byte;
               Bv : Byte;
               Rr : Byte;
                   End;
        BitMapType = Record
               BfType      : Word;
                 BfSize      : LongInt;
                 BfReserved1 : Word;
               BfReserved2 : Word;
               BfOffSetBits: LongInt;
                 Size        : LongInt;
               Width       : LongInt;
               Height      : LongInt;
               Planes      : Word;
               BitCount    : Word;
               Comp        : LongInt;
               iSize        : LongInt;
               xpelspermeter: LongInt;
               ypelspermeter: LongInt;
               ColorsUsed   : LongInt;
               ColorsImportant:LongInt;
                 PalArray       :Array[0..255] of Palette;
                 End;

var
   Bit      : BitMapType;
   i,j,Gd,Gm: Integer;
   P        : PaletteType;
   Width,Hight : Word;

Procedure SetVGAPalette( Tp : PaletteType);
    Var
       Regs: Registers;
  Begin
    With Regs Do
      Begin
        AH:=$10;
        Al:=$12;
        BX:=0;
        CX:=256;
        ES:=Seg(tp);
        DX:=Ofs(tp);
      End;
    Intr($10,Regs);
  End;

Procedure Read_BmfHeader;
var
   fh : File Of BitMapType;
Begin
        Assign(fh,ParamStr(1)+'.bmp');
        Reset(fh);
        Read(fh,Bit);
        Close(fh);
        If(Bit.BfType<>19778) Then
        Begin
          Writeln('FORMAT IS NOT RECOGNIZED!');
          halt;
        End;
        Width:=Bit.Width;
        Hight:=Bit.Height;
        For i:= 0 To 255 Do
        Begin
          P[i].Rv:=Bit.PalArray[i].Bv Shr 2;
          P[i].Gv:=Bit.PalArray[i].Gv Shr 2;
          P[i].Bv:=Bit.PalArray[i].Rv Shr 2;
        End;
End;

Procedure DisplayBitMap;
var
     i,j : Integer;
     f : File Of Byte;
     b : Byte;
Begin
     Assign(f,ParamStr(1)+'.bmp');
     Reset(f);
     Seek(f,sizeof(BitMapType));
     For i :=1 To Hight Do
     For j :=1 To Width Do
       Begin
            Read(f,b);
            PutPixel(j,Hight-i,B);
       End;
End;

Procedure DefPal;
Begin
      SetVgaPalette(P);
End;
Begin
      Read_BmfHeader;
      Gd := InstallUserDriver          ('Svga256',Nil);
      Gm := 2;
      InitGraph(Gd,Gm,'');
      DefPal;
      DisplayBitMap;
      Readln;
      CloseGraph;
End.

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.