Solved

Bitmap Reading

Posted on 2000-03-05
6
274 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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

A Short Story about the Best File Recovery Software – Acronis True Image 2017
What is Backup? Backup software creates one or more copies of the data on your digital devices in case your original data is lost or damaged. Different backup solutions protect different kinds of data and different combinations of devices. For e…
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…
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

760 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

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now