Solved

Bitmap Reading

Posted on 2000-03-05
6
279 Views
Last Modified: 2013-12-03
How do you send a Bitmap file you just read directly to the screen port for display?
0
Comment
Question by:Professor
6 Comments
 
LVL 3

Expert Comment

by:Alisher_N
ID: 2587496
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
 

Accepted Solution

by:
nadt earned 50 total points
ID: 2587950
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
 

Author Comment

by:Professor
ID: 2588787
Thank you very much indeed!!
0
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 

Expert Comment

by:amgedeldirdiri
ID: 2594692
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
 

Expert Comment

by:amgedeldirdiri
ID: 2594751
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
 

Expert Comment

by:amgedeldirdiri
ID: 2594756
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

Featured Post

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There’s a good reason for why it’s called a homepage – it closely resembles that of a physical house and the only real difference is that it’s online. Your website’s homepage is where people come to visit you. It’s the family room of your website wh…
Knowing where your website is hosted is as important as the features you receive, the monthly fee, and the support you receive. Due diligence should be done when choosing your next hosting provider.
This Micro Tutorial will teach you how to censor certain areas of your screen. The example in this video will show a little boy's face being blurred. This will be demonstrated using Adobe Premiere Pro CS6.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

776 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question