[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]