[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]

    {
      Subj: using brute force to load
    From: randyd@alpha2.csd.uwm.edu (Randall Elton Ding)

    Some have been asking how to load bmp's and such from a file into
    the bgi..  Here is a brute force method for doing that in 16 color
    EGAVGA or HercMono modes.

    There are two programs after this discussion, the first is the bmp
    utility and the second is a program that generates a bmp test pattern
    with the 16 standard colors used by the bmpgetimage example.

    First - if you look at this program, then look in the manual, you will
    find that the manual is dead wrong about the setpalette procedure.

              Declaration:
              procedure SetPalette(ColorNum: Word; Color: Shortint);

              Changes the ColorNum entry in the palette to Color.
    wrong --> SetPalette(0, LightCyan) makes the first color in the
              palette light cyan. ColorNum can range from 0 to 15......

    LightCyan is a constant and is equil to 11 but should be 59, see below.
    The color param used by setpalette proc is RGB defined in this way...

        bits: 0 = high intensity blue
              1 = high intensity green
              2 = high intensity red
              3 = low intensity blue
              4 = low intensity green
              5 = low intensity red
              6 = 0
              7 = 0

    The bmpgetimage procedure below reads the 64 byte pallet from the bmp
    and uses the 2 most sig bits from each BB GG RR 00 entry.
    This conversion is not the greatest but this is a brute force method.

    -------------- begin 1 of 2 programs ---------------
    }
    program bmp2bgi;

    uses graph;

    type
      string80 = string[80];

    { for vga putimage data, each line is repeated 4 times (4 bit planes) }
    { one for each color bit (16 color egavga) }
    { for hercmono, there is only 1 bit plane }
    { the word following the end of the last line
    { must be 00 00 in hercmono to tell BGI that there is only 1 bit plane }
    { for VGA the last word is 0F 00 ($000F) for 16 colors (4 bit planes) }

    { ! must be in graphics mode to call this procedure }
    { does getimage like function on either 2 color or 4 color bmp file }
    { use dw=0 dh=0 to get bmp image from dx,dy to extreme edge }
    { this procedure will load a 2 color bmp as a B&W image into a 16 color
    { 4 bit plan putimage structure provided that the current video mode is }
    { egavga, but will not load a 16 color bmp into a single bit plane }
    { when the current video mode is hercmono }
    { no memory will be allocated if an error occurs (error when errs <> '') }

    procedure bmpgetimage
            (     fn          : string80;    { bmp file name }
              var datapointer : pointer;     { ^ to putimage data }
                  dx,dy,dw,dh : word;        { offset into bmp & requested size }
              var errs        : string80;    { error string, '' if none }
              var palette     : palettetype; { returns converted EGA palette }
              var size        : word);       { returns memory taken by image }
                                             { for caller to release the memory }
                                             { with freemem(datapointer,size); }
      type
        bmpheadtype = record

                 { bit map file header }
                 bftype: word;                   { "BM" or $4D42 }
                 bfsize: longint;                { size of file in bytes }
                 bfreserved1: word;
                 bfreserved2: word;
                 bfoffbits: longint;             { ^ where graphic data begins }

                 { bit map information header }
                 bisize: longint;                { length of this header, $28 }
                 biwidth: longint;               { pixel width }
                 biheight: longint;              { pixel height }
                 biplanes: word;                 { = 1 }
                 bibitcount: word;               { color bits per pixel }
                 bicompression: longint;         { = 0 for no compression }
                 bisizeimage: longint;           { = bfsize - bfoffbits }
                 bixpelspermeter: longint;       { x pixels per meter }
                 biypelspermeter: longint;       { y pixels per meter }
                 biclrused: longint;             { \ I have never seen these }
                 biclrimportant: longint;        { / two used for anything }
               end;
               { A note on windows BMP files.. }
               { At this point in the bmp file, there is allocated }
               { 1 longint for each color, RGB pallet data BB GG RR 00. }
               { For greyscale viewing on color monitor, BB=GG=RR=shade }
               { Number colors = 2^bibitcount, then pixel data follows. }
               { For 16 colors, there are 64 bytes between header and }
               { line data; Data lines are padded out to 32 bit incrimemts }
               { also, bmp data is saved from bottom line up, and left to right }

      label badpalette,badread;

      const
        maxbuf = 65520-1-4;  { -4 for iw and ih words }
        defaultcolors: array[0..15] of byte =
          (0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);

      type buftype = record      { .data includes trailing word for # bitplanes }
                       iw,ih: word;
                       data : array[0..maxbuf] of byte;
                     end;
      var
        f: file;
        bmphead: bmpheadtype;
        buf: ^buftype;
        i,graphics,num,n,byteskip,bw,bw1,startbit: word;
        dbyte,bit,bit1,x,y,loc,loc1,x1: word;
        fs: longint;
        rgbpalette: array[0..15,0..3] of byte;

      begin  { loadbmp }
        errs:= '';
        assign(f,fn);
        {$I-}
        reset(f,1);
        {$I+}
        if ioresult<>0 then begin
          errs:= 'cannot open '+fn;
          exit;
        end;
        blockread(f,bmphead,sizeof(bmphead),num);
        if num < sizeof(bmphead) then begin
          errs:= 'unexpected end of file';
          close(f);
          exit;
        end;
        with bmphead do begin
          if (dw=0) and (biwidth>dx) then dw:= biwidth-dx;
          if (dh=0) and (biheight>dy) then dh:= biheight-dy;
          if (dx+dw>biwidth) or (dy+dh>biheight) or (dw=0) or (dh=0) then begin
            errs:= 'x+width,y+height exceeds bmp bounds';
            close(f);
            exit;
          end;
          fs:= filesize(f);
          if not ((bftype=$4D42) and (fs=bfsize) and (bisizeimage=fs-bfoffbits))
          then begin
            errs:= 'corrupt bmp file or not a bmp';
            close(f);
            exit;
          end;
          if not (bibitcount in [1,4]) then begin
            errs:= 'bmp must be 2 or 16 color';
            close(f);
            exit;
          end;

          graphics:= 0;
          size:= imagesize(dx,dy,dx+dw-1,dy+dh-1);
          if (graphresult=grerror) or (size-4 > maxbuf+1) then begin
            errs:= 'image too large';
            close(f);
            exit;
          end;
          bw1:= dw div 8;
          if dw mod 8 > 0 then bw1:= bw1 + 1;
          if bw1*dh*4+6=size then graphics:= 4;  { figure out what video mode }
          if bw1*dh+6=size then graphics:= 1;    { we are in, 1 or 4 bit planes }
          if graphics=0 then begin               { graphics = # bit planes to }
            errs:= 'internal error';             { save putimage data with }
            close(f);
            exit;
          end;
          if (graphics=1) and (bibitcount>1) then begin
            errs:= 'bmp must be 2 color for present graphics mode';
            close(f);
            exit;
          end;

          getmem(datapointer,size);
          buf:= datapointer;
          n:= 32 div bibitcount;              { pixels per longint }
          bw:= biwidth div n;                 { longint width of one line }
          if biwidth mod n > 0 then bw:= bw + 1;
          bw:= bw * n;                        { line length to nearest 32 pixels }
          n:= n div 4;                        { pixels per byte }
          byteskip:= (dx+dw) div n;
          if (dx+dw) mod n > 0 then byteskip:= byteskip + 1;
          byteskip:= byteskip * n;
          byteskip:= (bw-byteskip) div n;     { bytes to skip at end of line }
          startbit:= dx mod n;                { starting bit position }
          dx:= dx div n;                      { x byte offset into data }
          byteskip:= byteskip + dx;           { add bytes to skip at beginning }
          bw:= bw div n;                      { byte length of line }

          if (graphics=4) and (bibitcount=4) then begin
            {$I-}
            seek(f,bisize+14);
            {$I+}
            if ioresult<>0 then goto badpalette;
            blockread(f,rgbpalette,sizeof(rgbpalette),num);
            if num<>sizeof(rgbpalette) then begin
              badpalette:
              errs:= 'error reading bmp palette';
              close(f);
              freemem(datapointer,size);
              exit;
            end;
            getpalette(palette);
            if palette.size = 16 then for i:= 0 to 15 do begin
              dbyte:= 0;
              if rgbpalette[i,2] and $80 = $80 then dbyte:= dbyte or $04;
              if rgbpalette[i,2] and $40 = $40 then dbyte:= dbyte or $20;
              if rgbpalette[i,1] and $80 = $80 then dbyte:= dbyte or $02;
              if rgbpalette[i,1] and $40 = $40 then dbyte:= dbyte or $10;
              if rgbpalette[i,0] and $80 = $80 then dbyte:= dbyte or $01;
              if rgbpalette[i,0] and $40 = $40 then dbyte:= dbyte or $08;
              palette.colors[i]:= dbyte;
            end;
          end;
          if (graphics=4) and (bibitcount=1) then begin
            getpalette(palette);
            if palette.size = 16 then move(defaultcolors,palette.colors,16);
          end;
          if graphics=1 then getpalette(palette);

          {$I-}
          seek(f,bfoffbits);
          {$I+}
          if (ioresult<>0) or (fs-filepos(f) <> bw*biheight) then begin
            errs:= 'bad bmp file length, doesn''t match image size parameters';
            close(f);
            freemem(datapointer,size);
            exit;
          end;
          {$I-}                        { !! bmp's are saved from bottom up !! }
          seek(f,bfoffbits + (biheight-dh-dy)*bw + dx);
          {$I+}
          if ioresult<>0 then goto badread;
          fillchar(buf^,size,#0);
          buf^.iw:= dw-1;         { bgi putimage data has width & height values }
          buf^.ih:= dh-1;         { stored as width-1, height-1 }
          for y:= dh-1 downto 0 do begin
            bit:= startbit;
            blockread(f,dbyte,1,num);
            if num <> 1 then goto badread;
            loc:= bw1*y*graphics;
            bit1:= $80;
            x1:= 0;
            for x:= 0 to dw-1 do begin
              loc1:= loc+x1;
              if graphics <> bibitcount then dbyte:= (dbyte and $FF) shl 1;
              for i:= 0 to graphics-1 do begin
                if graphics = bibitcount then dbyte:= (dbyte and $FF) shl 1;
                if hi(dbyte)=1 then buf^.data[loc1]:= buf^.data[loc1] or bit1;
                loc1:= loc1+bw1;
              end;
              bit1:= bit1 shr 1;
              if bit1=0 then begin
                bit1:= $80;
                x1:= x1+1;
              end;
              bit:= bit+1;
              if (bit >= n) and (x<dw-1) then begin
                bit:= 0;
                blockread(f,dbyte,1,num);
                if num <> 1 then goto badread;
              end;
            end;
            if (byteskip>0) and (y>0) then begin
              {$I-}
              seek(f,filepos(f)+byteskip);
              {$I+}
              if ioresult<>0 then begin
                badread:
                errs:= 'error reading bmp data';
                close(f);
                freemem(datapointer,size);
                exit;
              end;
            end;
          end;
          close(f);
          loc1:= dh*bw1*graphics;    { set number of bitplanes parameter }
          buf^.data[loc1+1]:= 0;
          if bibitcount = 4 then buf^.data[loc1]:= $F else buf^.data[loc1]:= 0;
        end;
      end;  { bmpgetimage }

    procedure example;
      var
        p: pointer;
        i,x,y,w,h,size: word;
        errs: string80;
        grmode,grdriver,errcode: integer;
        palette,origpalette: palettetype;

      begin
        grdriver:= detect;
        initgraph(grdriver,grmode,'e:\bp\bgi');
        errcode:= graphresult;
        if errcode <> grok then begin
          writeln('Graphics error: ',grapherrormsg (errcode));
          halt(1);
        end;
        x:= 0;   { start reading the bmp data from 0,0 }
        y:= 0;
        w:= 0;   { w=0 means tells bmpgetimage to use maximum width of bmp }
        h:= 0;   { h=0 same here }
        bmpgetimage('d:\windows\winlogo.bmp',p,x,y,w,h,errs,palette,size);
        if errs='' then begin       { test error string for possible error }
          getpalette(origpalette);
          setallpalette(palette);
          putimage(0,0,p^,normalput);
          readln;
          setallpalette(origpalette);
          closegraph;
          freemem(p,size);
        end
        else begin
          closegraph;
          writeln(errs);
          readln;
        end;
      end;

    begin
      example;
    end.

    {
    ------------- end first program, begin second program --------------
    }
    { makes a test pattern bmp file with correct palette, 640x128, 4 bits/pixel }
    program makebmptestpattern;
    type
      bmpheadtype = record

               { bit map file header }
               bftype: word;                   { "BM" or $4D42 }
               bfsize: longint;                { size of file in bytes }
               bfreserved1: word;
               bfreserved2: word;
               bfoffbits: longint;             { ^ where graphic data begins }

               { bit map information header }
               bisize: longint;                { length of this header, $28 }
               biwidth: longint;               { pixel width }
               biheight: longint;              { pixel height }
               biplanes: word;                 { = 1 }
               bibitcount: word;               { color bits per pixel }
               bicompression: longint;         { = 0 for no compression }
               bisizeimage: longint;           { = bfsize - bfoffbits }
               bixpelspermeter: longint;       { x pixels per meter }
               biypelspermeter: longint;       { y pixels per meter }
               biclrused: longint;             { \ I have never seen these }
               biclrimportant: longint;        { / two used for anything }
             end;

    type
      paltype = array[0..15,0..3] of byte;
      bodytype = array[0..127,0..319] of byte;
      buftype = record
                  head: bmpheadtype;
                  pal : paltype;
                  body: bodytype;
                end;
      colorstype = array[0..15] of byte;

    const
      colors: colorstype = (0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);

    var
      f: file;
      buf: ^buftype;
      r,g,b,i,x,y,c: integer;

    begin
      new(buf);
      with buf^,buf^.head do begin
        for i:= 0 to 15 do begin
          r:= 0;  g:= 0;  b:= 0;
          if colors[i] and 1 = 1 then b:= b + 128;
          if colors[i] and 2 = 2 then g:= g + 128;
          if colors[i] and 4 = 4 then r:= r + 128;
          if colors[i] and 8 = 8 then b:= b + 64;
          if colors[i] and 16 = 16 then g:= g + 64;
          if colors[i] and 32 = 32 then r:= r + 64;
          pal[i,0]:= b;
          pal[i,1]:= g;
          pal[i,2]:= r;
          pal[i,3]:= 0;
        end;
        for y:= 0 to 127 do
          for x:= 0 to 319 do begin
            c:= (x div 10) mod 16;
            c:= (c shl 4) + c;
            body[y,x]:= c;
          end;
        bftype:= $4D42;                 { "BM" or $4D42 }
        bfsize:= sizeof(buf^);          { size of file in bytes }
        bfreserved1:= 0;
        bfreserved2:= 0;
        bfoffbits:= 14+40+64;           { where graphic data begins }
        bisize:= 40;                    { length of this header }
        biwidth:= 640;                  { pixel width }
        biheight:= 128;                 { pixel height }
        biplanes:= 1;                   { =1 }
        bibitcount:= 4;                 { color bits per pixel }
        bicompression:= 0;              { =0 for no compression }
        bisizeimage:= bfsize-bfoffbits;
        bixpelspermeter:= 0;
        biypelspermeter:= 0;
        biclrused:= 0;
        biclrimportant:= 0;
      end;
      assign(f,'testpat.bmp');
      rewrite(f,1);
      blockwrite(f,buf^,sizeof(buf^));
      close(f);
    end.

    {
    --------------- end of programs ---------------
    }

[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]