Hi everybody,
Many people ask me some source for displaying BMP-, GIF- and PCX files.
I get a message almost every day. So it's beter for me (and you) to post
in on the newsgroup. Everybody can dload it now!
Please dont't email me for this anymore.
GreetZ, Nico.
-------------- BEGIN OF PASCAL SOURCE
-----------------------------------
unit XMisc2;
interface
Type
TByteArray = array[0..0] of byte; {Array of bytes, useful for
typecasting}
TIntArray = array[0..0] of integer; {Array of integers, useful
for typecasting}
TWordArray = array[0..0] of integer; {Array of words, useful for
typecasting}
TCharArray = array[0..0] of char; {Array of chars, useful for
typecasting}
function XIntToStr( n : integer; w : byte ) : string;
{ This function transforms the integer n into a string with with w}
function XCompare( var a, b; l : word ) : boolean;
{ This function compares variables a and b for l bytes and, if equal
it returns TRUE. It returns FALSE otherwise}
function XExists( filename : string ) : boolean;
{ This functions returns TRUE if the file "filename" exists. It
returns false otherwise}
procedure XStrUpCase( var s : string );
{ This procedure makes all the characters in a string uppercase}
implementation
function xinttostr( n : integer; w : byte ) : string;
var
s : string;
begin
str( n:w, s );
xinttostr := s;
end;
function xcompare( var a, b; l : word ) : boolean; assembler;
asm
cld
push ds
lds si, a
les di, b
mov cx, l
repe cmpsb
or cx, cx
jz @@Ok
mov ax, 0
jmp @@Done
@@Ok:
mov ax, 1
@@Done:
pop ds
end;
function xexists( filename : string ) : boolean;
var
f : file;
tmp : boolean;
begin
{$I-}
assign( f, filename );
reset( f );
{$I+}
tmp := ioresult=0;
if tmp then close(f);
xexists := tmp;
end;
procedure xstrupcase( var s : string ); assembler;
asm
les di, s
mov cx, 0
mov cl, es:[di]
inc di
or cl, cl
jz @@Done
@@ChangeChar:
mov al, es:[di]
cmp al, 'a'
jl @@Next
cmp al, 'z'
jg @@Next
sub al, 32
mov es:[di], al
@@Next:
inc di
loop @@ChangeChar
@@Done:
end;
end.
------------------------------GIFVIEWER--------------------------------
unit XGif2;
{ ************************************************
** GIF Decoding and Encoding procedures **
** for Borland/Turbo Pascal 7.0 **
** **
** Written by Tristan Tarrant, 1994 **
** **
** ( Supports GIF87a/GIF89a ) **
************************************************ }
interface
uses
Dos,XMisc2;
const
{ Error constants used in GIF decoder }
GoodRead = 0; { No errors encountered during
encoding/decoding }
BadFile = 1; { Physical problem with the media}
BadRead = 2; { Could not read/interpret part of the file }
UnexpectedEOF = 3; { File too short during decoding}
BadCode = 4; { Code encountered during decoding was not
expected}
BadFirstCode = 5; { The first code was invalid}
NoFile = 6; { Could not open the file for read/write}
BadSymbolSize = 7; { Number of bits not supported}
NoCode = -1;
Type
GifLineProcType = procedure( Var pixels; line, width : integer
);
GifPixelProcType = function : integer;
Var
{ Pointers to custom procedures to deal with lines.
GifOutLineProc
is called with three parameters : an untyped var,
containing
the uncompressed data, and two integer values,
containing the
line number and the width of the line.
GifInPixelProc should instead return a pixels value, -1
if at the
end of the data. }
GifOutLineProc : GifLineProcType;
{ GifOutLineProc is called with an untyped variable containing a row's
worth of pixels. The current line is given in line and the
number of
pixels in a line is given in width}
GifInPixelProc : GifPixelProcType;
{ GifInPixelProc should return a pixel value, -1 if at the end of the
data.
Data should be returned width first (i.e. all pixels in row 0,
then all
pixels in row 1, etc.}
GifPalette : array[0..767] of byte;
{ GifPalette is an array which contains the palette of the last loaded
GIF file}
function LoadGif( f : string ) : integer;
{ This function loads a GIF file f and returns an error code.
It uses the #GIFLineProc# procedure to send the decoded picture
to the application. The palette of the picture is stored in the
global variable #GifPalette#}
function SaveGif( f : string; width, depth, bits : integer; var palette
) : integer;
{ This function saves a GIF file f with using screen size width*depth
and with a color resolution of bits. For a 256 colour image bits
is 8.
Palette contains the palette of the picture that is being saved.
SaveGIF uses #GIFInPixelProc# to get the picture data from the
application.
It returns an error code}
function GifError( ErrorCode : integer ) : string;
{ This function converts an error code returned by SaveGIF into a
string}
Implementation
type
GifHeader =
record
sig : array[1..6] of char;
screenwidth, screendepth : word;
flags, background, aspect : byte;
end;
ImageBlock =
record
left, top, width, depth : word;
flags : byte;
end;
FileInfo =
record
width, depth, bits,
flags, background : integer;
palette : array[1..768] of byte;
end;
ControlBlock =
record
blocksize, flags : byte;
delay : word;
transparentcolour, terminator : byte;
end;
PlainText =
record
blocksize : byte;
left, top, gridwidth, gridheight : word;
cellwidth, cellheight, forecolour, backcolour :
byte;
end;
Application =
record
blocksize : byte;
applstring : array[1..8] of char;
authentication : array[1..3] of char;
end;
const
TableSize = 5003;
{ These values will be masked with the codes output from the
decoder to remove spurious bits }
CodeMask : array[1..13] of word =
( $0000,
$0001, $0003,
$0007, $000F,
$001F, $003F,
$007F, $00FF,
$01FF, $03FF,
$07FF, $0FFF );
LargestCode = 4095;
function UnpackImage( var F : File; bits : integer; Var fi : FileInfo )
: integer;
var
bits2, codesize, codesize2, nextcode, thiscode,
oldtoken, currentcode, oldcode, bitsleft, blocksize,
line, pass, byt, p, q, u : integer;
b : array[0..255] of byte;
linebuffer, firstcodestack, lastcodestack : ^TByteArray;
codestack : ^TIntArray;
const
wordmasktable : array[0..15] of word =
( $0000, $0001, $0003, $0007, $000F, $001F,
$003F, $007F, $00FF, $01FF, $03FF, $07FF,
$0FFF, $1FFF, $3FFF, $7FFF );
inctable : array[0..4] of integer = ( 8, 8, 4, 2, 0 );
starttable : array[0..4] of integer = ( 0, 4, 2, 1, 0 );
begin
pass := 0;
line := 0;
byt := 0;
p := 0;
q := 0;
blocksize := 0;
fillchar( b, 256, 0 );
bitsleft := 8;
if ( bits < 2 ) or ( bits > 8 ) then
begin
UnpackImage := BadSymbolSize;
exit;
end;
bits2 := 1 shl bits;
nextcode := bits2 + 2;
codesize := bits + 1;
codesize2 := 1 shl codesize;
oldcode := NoCode;
oldtoken := NoCode;
getmem( firstcodestack, 4096 );
getmem( lastcodestack, 4096 );
getmem( codestack, 8192 );
getmem( linebuffer, fi.width );
while true do
begin
if bitsleft = 8 then
begin
inc(p);
if p>=q then
begin
blocksize := 0;
blockread( F, blocksize, 1);
if blocksize>0 then
begin
p:=0;
blockread( F, b, blocksize, q );
if q<>blocksize then
begin
freemem( firstcodestack,
4096 );
freemem( lastcodestack,
4096 );
freemem( codestack, 8192
);
freemem( linebuffer,
fi.width );
UnpackImage :=
UnexpectedEOF;
exit;
end;
end else
begin
freemem( firstcodestack, 4096 );
freemem( lastcodestack, 4096 );
freemem( codestack, 8192 );
freemem( linebuffer, fi.width );
UnpackImage := UnexpectedEOF;
exit;
end;
end;
bitsleft := 0;
end;
thiscode := b[p];
currentcode := codesize + bitsleft;
if currentcode <=8 then
begin
b[p] := b[p] shr codesize;
bitsleft := currentcode;
end else
begin
inc(p);
if p>=q then
begin
blocksize := 0;
blockread( F, blocksize, 1);
if blocksize>0 then
begin
p:=0;
blockread( F, b, blocksize, q );
if q<>blocksize then
begin
freemem( firstcodestack,
4096 );
freemem( lastcodestack,
4096 );
freemem( codestack, 8192
);
freemem( linebuffer,
fi.width );
UnpackImage :=
UnexpectedEOF;
exit;
end;
end else
begin
freemem( firstcodestack, 4096 );
freemem( lastcodestack, 4096 );
freemem( codestack, 8192 );
freemem( linebuffer, fi.width );
UnpackImage := UnexpectedEOF;
exit;
end;
end;
thiscode := thiscode or ( b[p] shl (8-bitsleft)
);
if currentcode <= 16 then
begin
bitsleft := currentcode - 8;
b[p] := b[p] shr bitsleft;
end else
begin
inc(p);
if p>=q then
begin
blocksize := 0;
blockread( F, blocksize, 1);
if blocksize>0 then
begin
p:=0;
blockread( F, b,
blocksize, q );
if q<>blocksize then
begin
freemem(
firstcodestack, 4096 );
freemem(
lastcodestack, 4096 );
freemem(
codestack, 8192 );
freemem(
linebuffer, fi.width );
UnpackImage :=
UnexpectedEOF;
exit;
end;
end else
begin
freemem( firstcodestack,
4096 );
freemem( lastcodestack,
4096 );
freemem( codestack, 8192
);
freemem( linebuffer,
fi.width );
UnpackImage :=
UnexpectedEOF;
exit;
end;
end;
thiscode := thiscode or ( b[p] shl
(16-bitsleft) );
bitsleft := currentcode - 16;
b[p] := b[p] shr bitsleft;
end;
end;
thiscode := thiscode and wordmasktable[codesize];
currentcode := thiscode;
if thiscode = bits2+1 then break;
if thiscode > nextcode then
begin
freemem( firstcodestack, 4096 );
freemem( lastcodestack, 4096 );
freemem( codestack, 8192 );
freemem( linebuffer, fi.width );
UnpackImage := BadCode;
exit;
end;
if thiscode = bits2 then
begin
nextcode := bits2+2;
codesize := bits + 1;
codesize2 := 1 shl codesize;
oldtoken := NoCode;
OldCode := NoCode;
continue;
end;
u := 0;
if thiscode = nextcode then
begin
if oldcode = NoCode then
begin
freemem( firstcodestack, 4096 );
freemem( lastcodestack, 4096 );
freemem( codestack, 8192 );
freemem( linebuffer, fi.width );
UnpackImage := BadFirstCode;
exit;
end;
firstcodestack^[u] := oldtoken;
inc( u );
thiscode := oldcode;
end;
while thiscode >= bits2 do
begin
firstcodestack^[u] := lastcodestack^[thiscode];
inc( u );
thiscode := codestack^[thiscode];
end;
oldtoken := thiscode;
while true do
begin
linebuffer^[byt] := thiscode;
inc( byt );
if byt >= fi.width then
begin
GifOutLineProc( linebuffer^, line,
fi.width );
byt := 0;
if fi.flags and $40 = $40 then
begin
line := line + inctable[pass];
if line >= fi.depth then
begin
inc(pass);
line :=
starttable[pass];
end;
end else inc(line);
end;
if u <= 0 then break;
dec( u );
thiscode := firstcodestack^[u];
end;
if (nextcode < 4096) and (oldcode <> NoCode) then
begin
codestack^[nextcode] := oldcode;
lastcodestack^[nextcode] := oldtoken;
inc( nextcode );
if (nextcode >= codesize2) and (codesize < 12)
then
begin
inc( codesize );
codesize2 := 1 shl codesize;
end;
end;
oldcode := currentcode;
end;
freemem( firstcodestack, 4096 );
freemem( lastcodestack, 4096 );
freemem( codestack, 8192 );
freemem( linebuffer, fi.width );
UnpackImage := GoodRead;
end; { UnpackImage }
procedure SkipExtension( Var F : File );
var
pt : PlainText;
cb : ControlBlock;
ap : Application;
i : integer;
a, n, c : byte;
r : word;
begin
blockread( F, c, 1 );
case c of
$01 :
begin
blockread( F, pt, sizeof( PlainText ) );
blockread( F, n, 1 );
while n > 0 do
begin
for i := 0 to n-1 do
blockread( F, a, 1 );
blockread( F, n, 1 );
end;
end;
$F9 :
blockread( F, cb, sizeof( ControlBlock ) );
$FE :
begin
blockread( F, n, 1 );
while n > 0 do
begin
for i:= 0 to n-1 do
blockread( F, a, 1 );
blockread( F, n, 1 );
end;
end;
$FF :
begin
blockread( F, ap, sizeof( Application )
);
blockread( F, n, 1 );
while n > 0 do
begin
for i := 0 to n-1 do
blockread( F, a, 1 );
blockread( F, n, 1 );
end;
end;
else
begin
blockread( F, n, 1 );
for i := 0 to n-1 do
blockread( F, a, 1 );
end;
end;
end; { SkipExtension }
function UnpackGIF( Var F : File ) : integer;
var
gh : GifHeader;
iblk : ImageBlock;
t : longint;
b, c : integer;
r : word;
ch : char;
fi : FileInfo;
begin
blockread( F, gh, SizeOf(GifHeader), r );
if ( gh.sig[1]+gh.sig[2]+gh.sig[3]<>'GIF' ) or (
r<>SizeOf(GifHeader) ) then
begin
UnpackGIF := BadFile;
exit;
end;
fi.width := gh.screenwidth;
fi.depth := gh.screendepth;
fi.bits := gh.flags and $07 + 1;
fi.background := gh.background;
if ( gh.flags and $80 )=$80 then
begin
c:=3*( 1 shl fi.bits );
blockread( F, fi.palette, c, r );
if r<>c then
begin
UnpackGIF := BadRead;
exit;
end;
for b := 0 to 255 do
begin
GIFPalette[b*3] := fi.palette[b*3+1] shr 2;
GIFPalette[b*3+1] := fi.palette[b*3+2] shr 2;
GIFPalette[b*3+2] := fi.palette[b*3+3] shr 2;
end;
end;
blockread( F, ch, 1 );
while ( ch = ',' ) or ( ch = '!' ) or ( ch = #0 ) do
begin
case ch of
',' : begin
blockread( F,
iblk, SizeOf(ImageBlock), r );
if
r<>SizeOf(ImageBlock) then
begin
UnpackGIF
:= BadRead;
Exit;
end;
fi.width :=
iblk.width;
fi.depth :=
iblk.depth;
if ( iblk.flags
and $80 )=$80 then
begin
b :=
3*(1 shl (iblk.flags and $07 + 1));
blockread(
F, fi.palette, b, r );
if r<>b
then
begin
UnpackGIF
:= BadRead;
Exit;
end;
for b :=
0 to 255 do
begin
GIFPalette[b*3]
:= fi.palette[b*3+1] shr 2;
GIFPalette[b*3+1]
:= fi.palette[b*3+2] shr 2;
GIFPalette[b*3+1]
:= fi.palette[b*3+3] shr 2;
end;
end;
if EOF( F ) then
begin
UnpackGIF
:= BadFile;
Exit;
end;
c:=0;
blockread( F, c,
1 );
fi.flags:=iblk.flags;
t :=
UnpackImage( F, c, fi );
UnpackGif:=t;
exit;
end;
'!' : SkipExtension( F );
end;
end;
end; { UnpackGIF }
function LoadGif;
var
D: DirStr;
N: NameStr;
E: ExtStr;
FileHandle : File;
begin
FSplit( F, D, N, E );
if E='' then E:='.GIF';
F := D+N+E;
{$I-}
assign( FileHandle, F );
reset( FileHandle, 1 );
{$I+}
if ioresult = 0 then
LoadGif := UnpackGif( FileHandle )
else
LoadGif := NoFile;
{$I-}
close( FileHandle );
{$I+}
end; { LoadGif }
function WriteScreenDesc( var fp : file; width, depth, bits, background
: integer; var palette ) : integer;
var
gh : GIFHeader;
i : integer;
gifsig : string;
pal : TByteArray absolute palette;
a : byte;
begin
FillChar( gh, sizeof(GIFHeader),0 );
gifsig := 'GIF87a';
move( gifsig[1], gh.sig[1], 6 );
gh.screenwidth := width;
gh.screendepth := depth;
gh.background := background;
gh.aspect := 0;
gh.flags := $80 or ((bits-1) shl 4) or ((bits-1) and $07);
blockwrite( fp, gh, sizeof(GIFHeader) );
for i := 0 to (1 shl bits)*3-1 do
begin
a := pal[i] shl 2;
blockwrite( fp, a, 1 );
end;
WriteScreenDesc := 0;
end;
function WriteImageDesc( var fp : file; left, top, width, depth, bits :
integer ) : integer;
var
ib : ImageBlock;
ch : char;
begin
fillchar( ib, sizeof(ImageBlock), 0 );
ch := ',';
blockwrite( fp, ch, 1 );
ib.left := left;
ib.top := top;
ib.width := width;
ib.depth := depth;
ib.flags := bits-1;
blockwrite( fp, ib, sizeof(ImageBlock) );
WriteImageDesc := 0;
end;
function CompressImage( var fp : file; mincodesize : word ) : integer;
var
prefixcode, suffixchar, hx, d : integer;
codebuffer, newcode : ^TByteArray;
oldcode, currentcode : ^TIntArray;
codesize, clearcode, eofcode, bitoffset,
byteoffset, bitsleft, maxcode, freecode : integer;
procedure InitTable( mincodesize : integer );
var
i : integer;
begin
codesize := mincodesize + 1;
clearcode := 1 shl mincodesize;
eofcode := clearcode+1;
freecode := clearcode+2;
maxcode := 1 shl codesize;
for i := 0 to tablesize-1 do
currentcode^[i] := 0;
end;
procedure Deallocate;
begin
freemem( newcode, tablesize+1 );
freemem( currentcode, (tablesize+1)*2 );
freemem( oldcode, (tablesize+1)*2 );
freemem( codebuffer, 260 );
end;
procedure FlushFile( var fp : file; n : integer );
var
a : byte;
begin
a := n;
blockwrite( fp, a, 1 );
blockwrite( fp, codebuffer^[0], n );
end;
procedure WriteCode( var fp : file; code : integer );
var
temp : longint;
begin
byteoffset := bitoffset shr 3;
bitsleft := bitoffset and 7;
if byteoffset >= 254 then
begin
FlushFile( fp, byteoffset );
codebuffer^[0] := codebuffer^[byteoffset];
bitoffset := bitsleft;
byteoffset := 0;
end;
if bitsleft > 0 then
begin
temp := ( longint(code) shl bitsleft ) or
codebuffer^[byteoffset];
codebuffer^[byteoffset] := temp;
codebuffer^[byteoffset+1] := temp shr 8;
codebuffer^[byteoffset+2] := temp shr 16;
end else
begin
codebuffer^[byteoffset] := code;
codebuffer^[byteoffset+1] := code shr 8;
end;
bitoffset := bitoffset + codesize;
end;
begin
if (mincodesize<2) or (mincodesize>9) then
if mincodesize = 1 then
mincodesize := 2
else
begin
CompressImage := 1;
exit;
end;
getmem( codebuffer, 260 );
getmem( oldcode, (tablesize+1)*2 );
getmem( currentcode, (tablesize+1)*2 );
getmem( newcode, tablesize+1 );
bitoffset := 0;
InitTable( mincodesize );
blockwrite( fp, mincodesize, 1 );
suffixchar := GIFInPixelProc;
if suffixchar < 0 then
begin
CompressImage := 1;
Deallocate;
exit;
end;
prefixcode := suffixchar;
suffixchar := GIFInPixelProc;
while suffixchar>=0 do
begin
hx := (prefixcode xor (suffixchar shl 5)) mod tablesize;
d := 1;
while true do
begin
if currentcode^[hx] = 0 then
begin
writecode( fp, prefixcode );
d := freecode;
if freecode <= largestcode then
begin
oldcode^[hx] := prefixcode;
newcode^[hx] := suffixchar;
currentcode^[hx] := freecode;
inc(freecode);
end;
if d=maxcode then
begin
if codesize<12 then
begin
inc(codesize);
maxcode := maxcode shl
1;
end else
begin
writecode( fp, clearcode
);
InitTable( mincodesize
);
end;
end;
prefixcode := suffixchar;
break;
end;
if (oldcode^[hx] = prefixcode) and (newcode^[hx]
= suffixchar ) then
begin
prefixcode := currentcode^[hx];
break;
end;
hx := hx + d;
d := d + 2;
if hx >= tablesize then hx := hx - tablesize;
end;
suffixchar := GIFInPixelProc;
end;
writecode( fp, prefixcode );
writecode( fp, eofcode );
if bitoffset >0 then FlushFile( fp, (bitoffset+7) div 8 );
FlushFile( fp, 0 );
CompressImage := 0;
Deallocate;
end;
function WriteGif( var fp : file; width, depth, bits : integer; var
palette ) : integer;
var
ch : char;
begin
if WriteScreenDesc( fp, width, depth, bits, 0, palette )>0 then
WriteGIF := 1
else
if WriteImageDesc( fp, 0, 0, width, depth, bits )>0 then
WriteGIF := 2
else
if CompressImage( fp, bits )>0 then
WriteGIF := 3
else
begin
WriteGIF := 0;
ch := ';';
blockwrite( fp, ch, 1 );
end;
end;
function SaveGif( f : string; width, depth, bits : integer; var palette
) : integer;
var
D: DirStr;
N: NameStr;
E: ExtStr;
FileHandle : File;
begin
FSplit( F, D, N, E );
if E='' then E:='.GIF';
F := D+N+E;
{$I-}
assign( FileHandle, F );
rewrite( FileHandle, 1 );
{$I+}
if ioresult = 0 then
SaveGif := WriteGif( FileHandle, width, depth, bits,
palette )
else
SaveGif := NoFile;
{$I-}
close( FileHandle );
{$I+}
end;
function GifError;
begin
case ErrorCode of
GoodRead : GifError := 'Ok';
BadFile : GifError := 'Bad File';
BadRead : GifError := 'Bad Read';
UnexpectedEOF : GifError := 'Unexpected End';
BadCode : GifError := 'Bad LZW Code';
BadFirstCode : GifError := 'Bad First Code';
BadSymbolSize : GifError := 'Bad Symbol Size';
NoFile : GifError := 'File Not Found';
else GifError := 'Unknown';
end;
end; { GifError }
end.
---------------- END OF GIFVIEWER --------------------------------
---------------- BEGIN OF BMPVIEWER -----------------------------
unit XBmp2;
{ ************************************************
** BMP Decoding and Encoding procedures **
** for Borland/Turbo Pascal 7.0 **
** **
** Written by Tristan Tarrant, 1994 **
** **
************************************************ }
interface
uses
Dos, XMisc2;
type
BMPLineProcType = procedure( Var pixels; line, width : integer
);
BMPPixelProcType = function( x, y : integer) : integer;
Var
{ Pointers to custom procedures to deal with lines.
BMPOutLineProc
is called with three parameters : an untyped var,
containing
the uncompressed data, and two integer values,
containing the
line number and the width of the line.
BMPInPixelProc should instead return a pixels value, -1
if at the
end of the data. }
BMPOutLineProc : BMPLineProcType;
{ BMPOutLineProc is called with an untyped variable containing a row's
worth of pixels. The current line is given in line and the
number of
pixels in a line is given in width}
BMPInPixelProc : BMPPixelProcType;
{ BMPInPixelProc should return a pixel value, -1 if at the end of the
data.
Data should be returned width first (i.e. all pixels in row 0,
then all
pixels in row 1, etc.}
BMPPalette : array[0..767] of byte;
{ BMPPalette is an array which contains the palette of the last loaded
BMP file}
function SaveBMP( f : string; width, depth : integer; var palette ) :
boolean;
{ This function saves a BMP file f with using screen size width*depth
and with a color resolution of 8 bits which translates to a 256
colour
image.
Palette contains the palette of the picture that is being saved.
SaveBMP uses #BMPInPixelProc# to get the picture data from the
application.
It returns TRUE if successful, FALSE otherwise}
function LoadBMP( f : string ) : boolean;
{ This function loads a BMP file f and returns TRUE if successful, FALSE
otherwise.
It uses the #BMPLineProc# procedure to send the decoded picture
to the application. The palette of the picture is stored in the
global variable #BMPPalette#}
implementation
type
BMPHeader = record
id : array[1..2] of char;
filesize,
reserved,
headersize,
infoSize,
wid,
hgt : longint;
biPlanes, bits : integer;
biCompression,
biSizeImage,
biXPel{*word*237}eter,
biYPel{*word*237}eter,
biClrUsed,
biClrImportant : longint;
end;
BMPRGB = record
b, g, r, f : byte;
end;
(*function DecodeBMP( var f : file ) : boolean;
var
BMPHead : BMPHeader;
hgt, wid, index : integer;
r, g, b : byte;
ScreenLine : pointer;
col : BMPRGB;
begin
blockread( f, BMPHead, SizeOf( BMPHead ) );
for index:=0 to 255 do
begin
blockread( f, col, SizeOf( BMPRGB ) );
BMPPalette[index*3] := col.r shr 2;
BMPPalette[index*3+1] := col.g shr 2;
BMPPalette[index*3+2] := col.b shr 2;
end;
wid := BMPHead.wid;
if wid mod 4<>0 then wid := wid + 4 - wid mod 4;
GetMem( ScreenLine, wid );
hgt := BMPHead.hgt-1;
for index:=hgt downto 0 do
begin
blockread( f, ScreenLine^, wid );
BMPOutLineProc( ScreenLine^, index, wid );
end;
DecodeBMP := true;
end;*)
function DecodeBMP( var f : file ) : boolean;
var
BMPHead : BMPHeader;
i,Aantal,hgt, wid, index,kl : integer;
(* r, g, b : byte;*)
P,ScreenLine : pointer;
col : BMPRGB;
B2,B1: Byte;
begin
DecodeBMP := False;
blockread( f, BMPHead, SizeOf( BMPHead ) );
Case BMPHead.Bits of
4: kl := 15;
8: kl := 255;
end; { CASE }
for index:=0 to kl do
begin
blockread( f, col, SizeOf( BMPRGB ) );
BMPPalette[index*3] := col.r shr 2;
BMPPalette[index*3+1] := col.g shr 2;
BMPPalette[index*3+2] := col.b shr 2;
end;
wid := BMPHead.wid;
if wid mod 4<>0 then wid := wid + 4 - wid mod 4;
Case kl of
15: Aantal := Wid div 2;
255: Aantal := Wid;
end; { CASE }
GetMem( ScreenLine, Aantal );
If kl = 15 then
GetMem(P,Wid);
hgt := BMPHead.hgt-1;
for index:=hgt downto 0 do
begin
blockread( f, ScreenLine^, Aantal );
Case kl of
15:
Begin
(* ASM
PUSH ES
LES DI,ScreenLine
MOV AL,*)
For i := 0 to Aantal-1 do
Begin
B2 :=
Mem[Seg(ScreenLine^):Ofs(ScreenLine^)+i];
B1 := B2 SHR 4;
B2 := B2 AND $0F;
Mem[Seg(P^):Ofs(P^)+i*2] := B1;
Mem[Seg(P^):Ofs(P^)+i*2+1] := B2;
end; { FOR }
BMPOutLineProc( P^, index, Wid );
end;
255:
BMPOutLineProc( ScreenLine^, index, Aantal );
end; { CASE }
end;
DecodeBMP := true;
end;
function LoadBMP( F : string ) : boolean;
var
D: DirStr;
N: NameStr;
E: ExtStr;
FileHandle : File;
begin
FSplit( F, D, N, E );
if E='' then E:='.BMP';
F := D+N+E;
{$I-}
assign( FileHandle, F );
reset( FileHandle, 1 );
{$I+}
if ioresult = 0 then
LoadBMP := DecodeBMP( FileHandle )
else
LoadBMP := false;
{$I-}
close( FileHandle );
{$I+}
end; { LoadBMP }
function EncodeBMP( var f : file; width, depth : integer; var palette )
: boolean;
var
BMPHead : BMPHeader;
hgt, wid, index, index2 : integer;
r, g, b : byte;
ScreenLine : pointer;
col : BMPRGB;
ThePalette : TByteArray absolute palette;
begin
fillchar( BMPHead, sizeof(BMPHeader),0 );
with BMPHead do
begin
id := 'BP';
headersize := 1078;
filesize := headersize + width*depth;
wid := width;
hgt := depth;
infosize := $28;
bits := 8;
biplanes := 1;
biCompression := 0;
end;
blockwrite( f, BMPHead, SizeOf( BMPHead ) );
for index:=0 to 255 do
begin
col.r := ThePalette[index*3] shl 2;
col.g := ThePalette[index*3+1] shl 2;
col.b := ThePalette[index*3+2] shl 2;
blockwrite( f, col, SizeOf( BMPRGB ) );
end;
wid := width;
if wid mod 4<>0 then wid := wid + 4 - wid mod 4;
GetMem( ScreenLine, wid );
hgt := BMPHead.hgt-1;
for index:=hgt downto 0 do
begin
fillchar( ScreenLine^,wid,0);
for index2 := 0 to width-1 do
TByteArray(ScreenLine^)[index2] :=
BMPInPixelProc(index2,index);
blockwrite( f, ScreenLine^, wid );
end;
EncodeBMP := true;
end;
function SaveBMP( f : string; width, depth : integer; var palette ) :
boolean;
var
D: DirStr;
N: NameStr;
E: ExtStr;
FileHandle : File;
begin
FSplit( F, D, N, E );
if E='' then E:='.BMP';
F := D+N+E;
{$I-}
assign( FileHandle, F );
rewrite( FileHandle, 1 );
{$I+}
if ioresult = 0 then
SaveBMP := EncodeBMP( FileHandle, width, depth, palette
)
else
SaveBMP := false;
{$I-}
close( FileHandle );
{$I+}
end;
end.
------------------ END OF BMPVIEWER ------------------------------------
------------------ BEGIN OF PCXVIEWER ----------------------------------
unit PCX;
(* version 3.1
by Peter Donnelly
1301 Ryan Street
Victoria BC
Canada V8T 4Y8
??
3 May be copied freely. If you make practical use of this unit,
3
3 a contribution of $10 or more would be appreciated.
3
??
This is a unit to read .PCX files and put them in displayable form.
The
actual work of decoding the file and moving the data into memory is
done
in assembler. Version 6 of Turbo Pascal is required for compilation.
The following display modes are supported:
Mode TP GraphMode Resolution Colors
~~~~ ~~~~~~~~~~~~ ~~~~~~~~~~ ~~~~~~
$04 CGAC0 to C3 320 x 200 4
$06 CGAHi 640 x 200 2
$0D --- 320 x 200 16
$0E EGALo/VGALo 640 x 200 16
$10 EGAHi/VGAMed 640 x 350 16
$12 VGAHi 640 x 480 16
$13 --- 320 x 200 256
Mode $13 is supported only for files containing palette information,
i.e. not those produced by versions of Paintbrush earlier than 3.0.
The unit has been optimized for speed rather than flexibility or
compactness. In particular, the routine for displaying 16-color files
(which require the most computation) has been improved and now runs
about 50 percent faster than that in version 2.
It is assumed that the image is the width of and no taller than the
screen, and that you will set the correct display mode. No checking
is done to see that the .PCX file is compatible with the mode you've
set.
You do, however, have to pass in the Turbo GraphDriver as a parameter
for all but 256-color files, so that the data will be interpreted
correctly. (For mode $0D, pass in 'EGA' or 'VGA', and see the comment
on
palettes, below.)
For the CGA formats, the data is put into two buffers on the heap,
from
where it can be moved into the two display memory banks. See SHOWCGA
for
an example. You can of course alter the unit to move the data
directly
into display memory, but there is no great saving in time.
For EGA and VGA formats, the data is written to page 0 of the video
buffer. This can easily be changed by setting "page_addr" to a
different
value. Three different techniques of hiding the image while it is
being
written are demonstrated in SHOWEGA, SHOWVGA, and SHOW256. If for any
reason you don't want to do this, you will want to rewrite the
palette-
interpretation routines as separate procedures so you can set the
palette before decoding the image data.
References:
~~~~~~~~~~
Richard F. Ferraro, "Programmer's Guide to the EGA and VGA Cards"
(Addison-Wesley, 1988).
Richard Wilton, "Programmer's Guide to PC and PS/2 Video Systems"
(Microsoft, 1987).
"Technical Reference Manual [for Paintbrush]" (Zsoft, 1988). The
information in this booklet is also found in a file distributed with
at least some versions of Microsoft/PC Paintbrush.
Software:
~~~~~~~~
Besides the various incarnations of Paintbrush (ZSoft and Microsoft),
the excellent Deluxe Paint II Enhanced (Electronic Arts) can also
create
files in .PCX format. Other graphics programs have conversion
utilities.
*)
{ =======================================================================
INTERFACE
uses DOS, GRAPH;
type RGBrec = record
redval, greenval, blueval: byte;
end;
var pcxfilename: pathstr;
file_error: boolean;
pal: palettetype;
RGBpal: array[0..15] of RGBrec;
RGB256: array[0..255] of RGBrec;
page_addr: word;
bytes_per_line: word;
buff0, buff1: pointer;
{ CGA display memory banks: }
screenbuff0: array[0..7999] of byte absolute $b800:$0000;
screenbuff1: array[0..7999] of byte absolute $b800:$2000;
const page0 = $A000; { EGA/VGA display segment }
procedure SETMODE(mode: byte);
procedure SETREGISTERS(var palrec);
procedure READ_PCX_FILE(gdriver: integer; pfilename: pathstr);
procedure READ_PCX256(pfilename: pathstr);
{========================================================================}
IMPLEMENTATION
var scratch, abuff0, abuff1: pointer;
is_CGA, is_VGA: boolean;
repeatcount: byte;
datalength: word;
columncount, plane, video_index: word;
regs: registers;
const buffsize = 65521; { Largest possible }
{ -------------------------- BIOS calls
--------------------------------- }
{ For modes not supported by the BGI, use SetMode to initialize the
graphics. Since SetRGBPalette won't work if Turbo hasn't done the
graphics initialization itself, use SetRegisters to change the colors
in mode $13. }
procedure SETMODE(mode: byte);
begin
regs.ah:= 0; { BIOS set mode function }
regs.al:= mode; { Display mode }
intr($10, regs); { Call BIOS }
end;
procedure SETREGISTERS(var palrec);
{ Palrec is any string of 768 bytes containing the RGB data. }
begin
regs.ah:= $10; { BIOS color register function }
regs.al:= $12; { Subfunction }
regs.es:= seg(palrec); { Address of palette info. }
regs.dx:= ofs(palrec);
regs.bx:= 0; { First register to change }
regs.cx:= $100; { Number of registers to change }
intr($10, regs); { Call BIOS }
end;
{ ====================== EGA/VGA 16-color files
========================= }
procedure DECODE_16; assembler;
asm
(* Registers used:
AL data byte to be written to video
AH data bytes per scan line
BX end of input buffer
CL number of times data byte is to be written
DL current column in scan line
ES output segment
DI index into output buffer
DS segment of input buffer
SI index into input buffer
BP current color plane
*)
push bp
{ ----------------- Assembler procedure for 16-color files
-------------- }
{ The first section is initialization done on each run through the
input buffer. }
@startproc:
mov bp, plane { plane in BP }
mov es, page_addr { video display segment }
mov di, video_index { index into video segment }
mov ah, byte ptr bytes_per_line { line length in AH }
mov dx, columncount { column counter }
mov bx, datalength { no. of bytes to read }
xor cx, cx { clean up CX for loop counter }
mov cl, repeatcount { count in CX }
push ds { save DS }
lds si, scratch { input buffer pointer in DS:SI }
{ We have to adjust datalength for comparison with SI. TP 6.0 pointers
are
normalized, but the offset can still be 0 or 8. }
add bx, si
cld { clear DF for stosb }
cmp cl, 0 { was last byte a count? }
jne @multi_data { yes, so next is data }
jmp @getbyte { no, so find out what next is }
{ -------------- Procedure to write EGA/VGA image to video
-------------- }
{ The data in the .PCX file is organized by color plane, by line; that
is,
all the data for plane 0 for line 1, then for plane 1, line 1, etc.
Writing the data to display memory is just a matter of masking out the
other planes while one plane is being written to. This is done with
the
map mask register in the sequencer. All the other weird and wonderful
registers in the EGA/VGA do just fine with their default settings,
thank
goodness. }
@writebyte:
stosb { AL into ES:DI, inc DI }
inc dl { increment column }
cmp dl, ah { reached end of scanline? }
je @doneline { yes }
loop @writebyte { no, do another }
jmp @getbyte { or get more data }
@doneline:
shl bp, 1 { shift to next plane }
cmp bp, 8 { done 4 planes? }
jle @setindex { no }
mov bp, 1 { yes, reset plane to 1 but don't reset
index }
jmp @setplane
@setindex:
sub di, dx { reset to start of line }
@setplane:
push ax { save AX }
cli { no interrupts }
mov ax, bp { plane is 1, 2, 4, or 8 }
mov dx, 3C5h { sequencer data register }
out dx, al { mask out 3 planes }
sti { enable interrupts }
pop ax { restore AX }
xor dx, dx { reset column count }
loop @writebyte { do it again, or fetch more data }
{ -------------------- Loop through input buffer
------------------------ }
{ Here's how the data compression system works. Each byte is either
image
data or a count byte that tells how often the next byte is to be
repeated. The byte is image data if it follows a count byte, or if
either of the top 2 bits is clear. Otherwise it is a count byte, with
the count derived from the lower 6 bits. }
@getbyte: { last byte was not a count }
cmp si, bx { end of input buffer? }
je @exit { yes, quit }
lodsb { get a byte from DS:SI into AL, increment
SI }
cmp al, 192 { test high bits }
jb @one_data { not set, it's data to be written once }
{ It's a count byte: }
xor al, 192 { get count from 6 low bits }
mov cl, al { store repeat count }
cmp si, bx { end of input buffer? }
je @exit { yes, quit }
@multi_data:
lodsb { get data byte }
jmp @writebyte { write it CL times }
@one_data:
mov cl, 1 { write byte once }
jmp @writebyte
{ ---------------------- Finished with buffer
--------------------------- }
@exit:
pop ds { restore Turbo's data segment }
mov plane, bp { save status for next run thru buffer }
mov repeatcount, cl
mov columncount, dx
mov video_index, di
pop bp
end; { asm }
{ ===================== CGA 2- and 4-color files
======================== }
procedure DECODE_CGA; assembler;
asm
(* Registers used:
AL data byte to be written to video
AH data bytes per scan line
BX end of input buffer
CL number of times data byte is to be written
DL pointer to current column in screen row
ES output segment; temporarily used for input buffer segment
DI index into output buffer
SI index into input buffer
BP current video bank
*)
push bp
jmp @startproc
{ ------------- Procedure to store CGA image in buffers
----------------- }
@storebyte:
stosb { AL into ES:DI, increment DI }
inc dx { increment column count }
cmp dl, ah { reached end of line? }
je @row_ends { yes }
loop @storebyte { not end of row, do another byte }
ret
@row_ends:
xor bp, 1 { switch banks }
cmp bp, 1 { is bank 1? }
je @bank1 { yes }
mov word ptr abuff1, di { no, save index into bank 1 }
les di, abuff0 { bank 0 pointer into ES:DI }
xor dx, dx { reset column counter }
loop @storebyte
ret
@bank1:
mov word ptr abuff0, di { save index into bank 0 }
les di, abuff1 { bank 1 pointer into ES:DI }
xor dx, dx { reset column counter }
loop @storebyte
ret
{ ---------------- Main assembler procedure for CGA
--------------------- }
{ It's assumed that CGA files will require only one pass through the
input buffer. }
@startproc:
mov bp, 0 { bank in BP }
mov es, word ptr abuff0[2] { segment of bank 0 buffer }
mov di, word ptr abuff0 { offset of buffer }
mov ah, byte ptr bytes_per_line { line length in AH }
mov bx, datalength { no. of bytes to read }
xor cx, cx { clean up CX for loop counter }
xor dx, dx { initialize column counter }
mov si, dx { initialize input index }
cld { clear DF for stosb }
{ -------------------- Loop through input buffer
------------------------ }
@getbyte:
cmp si, bx { end of input buffer? }
je @exit { yes, quit }
push es { save output pointer }
push di
les di, scratch { get input pointer in ES:DI }
add di, si { add current offset }
mov al, [es:di] { get a byte }
inc si { advance input index }
pop di { restore output pointer }
pop es
cmp cl, 0 { was previous byte a count? }
jg @multi_data { yes, this is data }
cmp al, 192 { no, test high bits }
jb @one_data { not set, not a count }
{ It's a count byte: }
xor al, 192 { get count from 6 low bits }
mov cl, al { store repeat count }
jmp @getbyte { go get data byte }
@one_data:
mov cl, 1 { write byte once }
call @storebyte
jmp @getbyte
@multi_data:
call @storebyte { CL already set }
jmp @getbyte
{ ---------------------- Finished with buffer
--------------------------- }
@exit:
pop bp
end; { asm }
{ ============= Main procedure for CGA and 16-color files
=============== }
procedure READ_PCX_FILE(gdriver: integer; pfilename: pathstr);
type ptrrec = record
segm, offs: word;
end;
var entry, gun, pcxcode, mask, colorID: byte;
palbuf: array[0..66] of byte;
pcxfile: file;
begin { READ_PCX_FILE }
is_CGA:= (gdriver = CGA); { 2 or 4 colors }
is_VGA:= (gdriver = VGA); { 16 of 256K possible colors }
{ Otherwise EGA - 16 of 64 possible colors }
assign(pcxfile, pfilename);
{$I-} reset(pcxfile, 1); {$I+}
file_error:= (IOresult <> 0);
if file_error then exit;
{ To minimize disk access and speed things up, we read the file into a
scratchpad on the heap. Large files have to be done in two or more
chunks because of the 64K limit on dynamic memory variables. }
getmem(scratch, buffsize); { Allocate scratchpad }
blockread(pcxfile, scratch^, 128); { Get header into scratchpad
{ The .PCX file has a 128-byte header. Most of it can be ignored if
you're
working with a known format. All we want is the palette information
and
the length of the data line. }
move(scratch^, palbuf, 67);
bytes_per_line:= palbuf[66];
{------------------------ Setup for CGA
---------------------------------}
if is_CGA then
begin
getmem(buff0, 8000); { Allocate memory for output }
getmem(buff1, 8000);
abuff0:= buff0; { Make copies of pointers }
abuff1:= buff1;
end else
{----------------------- Setup for EGA/VGA
------------------------------}
begin
video_index:= 0;
port[$3C4]:= 2; { Index to map mask register }
plane:= 1; { Initialize plane }
port[$3C5]:= plane; { Set sequencer to mask out other planes }
{-------------------- Decipher EGA/VGA palette
--------------------------}
(* The palette information is stored in bytes 16-63 of the header. Each
of
the 16 palette slots is allotted 3 bytes - one for each primary
color.
Any of these bytes can have a value of 0-255.
For the EGA there are just 4 significant settings, since only 64
different colors (4 x 4 x 4) are available. Hence for EGA-format
images
we divide the codes by 64. The absolute color number for the palette
entry is derived by setting one of bits 0-2 and one of bits 3-5 with
the
mask corresponding to the .PCX code byte. (In binary form, the
absolute
color number may be thought of as 00RGBrgb.) This number is then
passed
into Turbo's SetAllPalette procedure.
For the VGA things work differently. Here we must use Turbo's
SetRGBPalette procedure to change the red, green, and blue values in
the
16 active color registers. The registers expect values in the range
0-63
(64 x 64 x 64 = 256K, the number of possible colors), so we divide
the
.PCX codes by 4. A further complication is that by default the
palette
entries point to the color registers corresponding to the standard
EGA
colors, so we must change them to point to registers 0-15 instead (or
else modify registers 0-5, 20, 7, and 56-63). See SHOWVGA.PAS for an
example of how to set the palette and the registers.
Note that the palette works differently for the 200-line 16-color
modes,
$0D and $0E. Because these modes use 4-bit palette entries, only the
default colors are available on the EGA, and their IDs don't
correspond
to those in 350-line mode (e.g. 20 is bright red, not brown).
Attempting
to set the palette with the data from the .PCX header will lead to
odd
results in these modes, and in any case should not be necessary.
*)
for entry:= 0 to 15 do
begin
colorID:= 0;
for gun:= 0 to 2 do
begin
pcxcode:= palbuf[16 + entry * 3 + gun]; { Get primary color
value }
if not is_VGA then
begin { Interpret for EGA }
case (pcxcode div $40) of
0: mask:= $00; { 000000 }
1: mask:= $20; { 100000 }
2: mask:= $04; { 000100 }
3: mask:= $24; { 100100 }
end;
colorID:= colorID or (mask shr gun); { Define two bits }
end { not is_VGA }
else
begin { is_VGA }
with RGBpal[entry] do { Interpret for VGA }
case gun of
0: redval:= pcxcode div 4;
1: greenval:= pcxcode div 4;
2: blueval:= pcxcode div 4;
end;
end; { is_VGA }
end; { gun }
if is_VGA then pal.colors[entry]:= entry
else pal.colors[entry]:= colorID;
end; { entry }
pal.size:= 16;
end; { not is_CGA }
{ ---------------- Read and decode the image data
----------------------- }
repeatcount:= 0; { Initialize assembler vars. }
columncount:= 0;
repeat
blockread(pcxfile, scratch^, buffsize, datalength);
if is_CGA then decode_CGA else decode_16; { Call assembler routine }
until eof(pcxfile);
close(pcxfile);
if not is_CGA then port[$3C5]:= $F; { Reset mask map }
freemem(scratch,buffsize); { Discard scratchpad }
end; { READ_PCX_FILE }
{ ========================= 256-color files
============================= }
procedure DECODE_PCX256; assembler;
(* Registers used:
AL data byte to be written to video
BX end of input buffer
CL number of times data byte is to be written
ES output segment
DI index into output buffer
DS segment of input buffer
SI index into input buffer
*)
asm
mov es, page_addr { video segment }
mov di, video_index { index into video }
xor cx, cx { clean up loop counter }
mov cl, repeatcount { count in CL }
mov bx, datalength { end of input buffer }
push ds { save DS }
lds si, scratch { pointer to input in DS:SI }
add bx, si { adjust datalength - SI may not be 0 }
cld { clear DF }
cmp cl, 0 { was last byte a count? }
jne @multi_data { yes, so next is data }
{ --------------------- Loop through input buffer
----------------------- }
@getbyte: { last byte was not a count }
cmp si, bx { end of input buffer? }
je @exit { yes, quit }
lodsb { get byte into AL, increment SI }
cmp al, 192 { test high bits }
jb @one_data { not set, not a count }
{ It's a count byte }
xor al, 192 { get count from 6 low bits }
mov cl, al { store repeat count }
cmp si, bx { end of input buffer? }
je @exit { yes, quit }
@multi_data:
lodsb { get byte into AL, increment SI }
rep stosb { write byte CX times }
jmp @getbyte
@one_data:
stosb { byte into video }
jmp @getbyte
{ ------------------------- Finished with buffer
------------------------ }
@exit:
pop ds { restore Turbo's data segment }
mov video_index, di { save status for next run thru buffer }
mov repeatcount, cl
end; { asm }
{ ================= Main procedure for 256-color files
================== }
procedure READ_PCX256(pfilename: pathstr);
var x, gun, pcxcode: byte;
pcxfile: file;
palette_start, total_read: longint;
palette_flag: byte;
version: word;
procedure CLEANUP;
begin
close(pcxfile);
freemem(scratch, buffsize);
end;
begin { READ_PCX256 }
assign(pcxfile, pfilename);
{$I-} reset(pcxfile, 1); {$I+}
file_error:= (IOresult <> 0);
if file_error then exit;
getmem(scratch, buffsize); { Allocate scratchpad }
blockread(pcxfile, version, 2); { Read first two bytes }
file_error:= (hi(version) < 5); { No palette info. }
if file_error then
begin
cleanup; exit;
end;
palette_start:= filesize(pcxfile) - 769;
seek(pcxfile, 128); { S{*word*99} file header }
total_read:= 128;
repeatcount:= 0; { Initialize assembler vars.
video_index:= 0;
repeat
blockread(pcxfile, scratch^, buffsize, datalength);
inc(total_read, datalength);
if (total_read > palette_start) then
dec(datalength, total_read - palette_start);
decode_pcx256;
until (eof(pcxfile)) or (total_read>= palette_start);
(* The last 769 btes of the file are palette information, starting with
a
one-byte flag. Each group of three bytes represents the RGB values of
one of the color registers. The values have to be divided by 4 to be
brought within the range 0-63 expected by the registers. *)
seek(pcxfile, palette_start);
blockread(pcxfile, palette_flag, 1);
file_error:= (palette_flag <> 12);
if file_error then
begin
cleanup; exit;
end;
blockread(pcxfile, RGB256, 768); { Get palette info. }
for x:= 0 to 255 do
with RGB256[x] do
begin
redval:= redval shr 2;
greenval:= greenval shr 2;
blueval:= blueval shr 2;
end;
cleanup;
end; { READ_PCX256 }
{ ========================== Initialization
============================= }
BEGIN
page_addr:= page0; { Destination for EGA/VGA data }
END.
----------------- END OF PCXVIEWER
----------------------------------------
So, thats it folks! I'll hope you like the source.
Note: the Savegif and SaveBMP don't work very well. I'm looking for some
sources for writing GIF and others to disk. If you have something like
that, i'll be glad to have it.
GreetZ, Nico.