Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Bitmap Reading

Posted on 2000-03-05
6
Medium Priority
?
285 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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 200 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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 

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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Ever visit a website where you spotted a really cool looking Font, yet couldn't figure out which font family it belonged to, or how to get a copy of it for your own use? This article explains the process of doing exactly that, as well as showing how…
In this article, I’ll show how research, determination, and use of modern technology helped me solve a DNA mystery.
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…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…

715 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