[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{
As I follow this forum, many requests are made for PCX graphics
file routines. Those that are looking for Read_PCX info can
find it on the ZSoft BBS in a wonderful Pascal example: ShowPCX.
On the other hand, there is next to zilch out there on how to
Write_PCX files. I know.... I searched and searched and couldn't
find a thing! So with a little brute force and a few ZSoft
C language snippets <groan>, I got this together:
PCX_W.Write_PCX (Name:Str80);
given to the public domain and commonweal.
pseudocode:
set 640x480x16 VGAhi graphics mode only for now
getimage 1 row at a time
reorganize the BGI color planes into PCX format order
encode the raw PCX line into a run length limited
compressed PCX line
blockwrite the compressed PCX line to your.PCX file
}
{$R-} {Range checking, turn off when debugged}
unit PCX_W;
{ --------------------- Interface ----------------- }
interface
type
Str80 = string [80];
procedure Write_PCX (Name:Str80);
{ ===================== Implementation ============ }
implementation
uses
Graph;
{-------------- Write_PCX --------------}
procedure Write_PCX (Name:Str80);
const
RED1 = 0;
GREEN1 = 1;
BLUE1 = 2;
type
ArrayPal = array [0..15, RED1..BLUE1] of byte;
const
MAX_WIDTH = 4000; { arbitrary - maximum width (in bytes) of
a PCX image }
INTENSTART = $5;
BLUESTART = $55;
GREENSTART = $A5;
REDSTART = $F5;
type
Pcx_Header = record
{comments from ZSoft ShowPCX pascal example}
Manufacturer: byte; { Always 10 for PCX file }
Version: byte; { 2 - old PCX - no palette (not used
anymore),
3 - no palette,
4 - Microsoft Windows - no palette
(only in old files, new Windows
version uses 3),
5 - with palette }
Encoding: byte; { 1 is PCX, it is possible that we may
add additional encoding methods in the
future }
Bits_per_pixel: byte; { Number of bits to represent a pixel
(per plane) - 1, 2, 4, or 8 }
Xmin: integer; { Image window dimensions (inclusive) }
Ymin: integer; { Xmin, Ymin are usually zero (not always)}
Xmax: integer;
Ymax: integer;
Hdpi: integer; { Resolution of image (dots per inch) }
Vdpi: integer; { Set to scanner resolution - 300 is
default }
ColorMap: ArrayPal;
{ RGB palette data (16 colors or less)
256 color palette is appended to end
of file }
Reserved: byte; { (used to contain video mode)
now it is ignored - just set to zero }
Nplanes: byte; { Number of planes }
Bytes_per_line_per_plane: integer; { Number of bytes to
allocate for a scanline
plane. MUST be an an EVEN
number! Do NOT calculate
from Xmax-Xmin! }
PaletteInfo: integer; { 1 = black & white or color image,
2 = grayscale image - ignored in PB4,
PB4+ palette must also be set to
shades of gray! }
HscreenSize: integer; { added for PC Paintbrush IV Plus
ver 1.0, }
VscreenSize: integer; { PC Paintbrush IV ver 1.02 (and later)}
{ I know it is tempting to use these
fields to determine what video mode
should be used to display the image
- but it is NOT recommended since the
fields will probably just contain
garbage. It is better to have the
user install for the graphics mode he
wants to use... }
Filler: array [74..127] of byte; { Just set to zeros }
end;
Array80 = array [1..80] of byte;
ArrayLnImg = array [1..326] of byte; { 6 extra bytes at
beginng of line that BGI uses for size info}
Line_Array = array [0..MAX_WIDTH] of byte;
ArrayLnPCX = array [1..4] of Array80;
var
PCXName : File;
Header : Pcx_Header; { PCX file header }
ImgLn : ArrayLnImg;
PCXLn : ArrayLnPCX;
RedLn,
BlueLn,
GreenLn,
IntenLn : Array80;
Img : pointer;
{-------------- BuildHeader- -----------}
procedure BuildHeader;
const
PALETTEMAP: ArrayPal=
{ R G B }
(($00, $00, $00), { black }
($00, $00, $AA), { blue }
($00, $AA, $00), { green }
($00, $AA, $AA), { cyan }
($AA, $00, $00), { red }
($AA, $00, $AA), { magenta }
($AA, $55, $00), { brown }
($AA, $AA, $AA), { lightgray }
($55, $55, $55), { darkgray }
($55, $55, $FF), { lightblue }
($55, $FF, $55), { lightgreen }
($55, $FF, $FF), { lightcyan }
($FF, $55, $55), { lightred }
($FF, $55, $FF), { lightmagenta }
($FF, $FF, $55), { yellow }
($FF, $FF, $FF) );{ white }
var
i : word;
begin
with Header do
begin
Manufacturer := 10;
Version := 5;
Encoding := 1;
Bits_per_pixel := 1;
Xmin := 0;
Ymin := 0;
Xmax := 639;
Ymax := 479;
Hdpi := 640;
Vdpi := 480;
ColorMap := PALETTEMAP;
Reserved := 0;
Nplanes := 4; { Red, Green, Blue, Intensity }
Bytes_per_line_per_plane := 80;
PaletteInfo := 1;
HscreenSize := 0;
VscreenSize := 0;
for i := 74 to 127 do
Filler [i] := 0;
end;
end;
{-------------- GetBGIPlane ------------}
procedure GetBGIPlane (Start:word; var Plane:Array80);
var
i : word;
begin
for i:= 1 to Header.Bytes_per_line_per_plane do
Plane [i] := ImgLn [Start +i -1]
end;
{-------------- BuildPCXPlane ----------}
procedure BuildPCXPlane (Start:word; Plane:Array80);
var
i : word;
begin
for i := 1 to Header.Bytes_per_line_per_plane do
PCXLn [Start] [i] := Plane [i];
end;
{-------------- EncPCXLine -------------}
procedure EncPCXLine (PlaneLine : word); { Encode a PCX line }
var
This,
Last,
RunCount : byte;
i,
j : word;
{-------------- EncPut -----------------}
procedure EncPut (Byt, Cnt :byte);
const
COMPRESS_NUM = $C0; { this is the upper two bits that
indicate a count }
var
Holder : byte;
begin
{$I-}
if (Cnt = 1) and (COMPRESS_NUM <> (COMPRESS_NUM and Byt)) then
blockwrite (PCXName, Byt,1) { single occurance }
{good place for file error handler!}
else
begin
Holder := (COMPRESS_NUM or Cnt);
blockwrite (PCXName, Holder, 1); { number of times the
following color
occurs }
blockwrite (PCXName, Byt, 1);
end;
{$I+}
end;
begin
i := 1; { used in PCXLn }
RunCount := 1;
Last := PCXLn [PlaneLine][i];
for j := 1 to Header.Bytes_per_line_per_plane -1 do
begin
inc (i);
This := PCXLn [PlaneLine][i];
if This = Last then
begin
inc (RunCount);
if RunCount = 63 then { reached PCX run length
limited max yet? }
begin
EncPut (Last, RunCount);
RunCount := 0;
end;
end
else
begin
if RunCount >= 1 then
Encput (Last, RunCount);
Last := This;
RunCount := 1;
end;
end;
if RunCount >= 1 then { any left over ? }
Encput (Last, RunCount);
end;
{ - - -W-R-I-T-E-_-P-C-X- - - - - - - - }
const
XMAX = 639;
YMAX = 479;
var
i, j, Size : word;
begin
BuildHeader;
assign (PCXName,Name);
{$I-}
rewrite (PCXName,1);
blockwrite (PCXName,Header,sizeof (Header));
{good place for file error handler!}
{$I+}
setviewport (0,0,XMAX,YMAX, ClipOn);
Size := imagesize (0,0,XMAX,0); { size of a single row }
getmem (Img,Size);
for i := 0 to YMAX do
begin
getimage (0,i,XMAX,i,Img^); { Grab 1 line from the
screen store in Img
buffer }
move (Img^,ImgLn,Size {326});
GetBGIPlane (INTENSTART, IntenLn);
GetBGIPlane (BLUESTART, BlueLn );
GetBGIPlane (GREENSTART, GreenLn);
GetBGIPlane (REDSTART, RedLn );
BuildPCXPlane (1, RedLn );
BuildPCXPlane (2, GreenLn);
BuildPCXPlane (3, BlueLn );
BuildPCXPlane (4, IntenLn); { 320 bytes/line
uncompressed }
for j := 1 to Header.NPlanes do
EncPCXLine (j);
end;
freemem (Img,Size); (* Release the memory *)
{$I-}
close (PCXName); (* Save the Image *)
{$I+}
end;
end {PCX.TPU} .
{ -----------------------Test Program -------------------------- }
program WritePCX;
uses
Graph, PCX_W;
{-------------- DrawHorizBars ----------}
procedure DrawHorizBars;
var
i, Color : word;
begin
cleardevice;
Color := 15;
for i := 0 to 15 do
begin
setfillstyle (solidfill,Color);
bar (0,i*30,639,i*30+30); { 16*30 = 480 }
dec (Color);
end;
end;
{-------------- Main -------------------}
var
NameW : Str80;
Gd,
Gm : integer;
begin
writeln;
if (ParamCount = 0) then { no DOS command line
parameters }
begin
write ('Enter name of PCX picture file to write: ');
readln (NameW);
writeln;
end
else
begin
NameW := paramstr (1); { get filename from DOS
command line }
end;
if (Pos ('.', NameW) = 0) then { make sure the filename
has PCX extension }
NameW := Concat (NameW, '.pcx');
Gd:=VGA;
Gm:=VGAhi; {640x480, 16 colors}
initgraph (Gd,Gm,'..\bgi'); { path to your EGAVGA.BGI }
DrawHorizBars;
readln;
Write_PCX (NameW); { PCX_W.TPU }
closegraph; { Close graphics }
textmode (co80); { back to text mode }
end. { Write_PCX }
{
OK, everybody, I hope this gets you started. I had a lot of
fun setting it up. There are some obvious places that need
optimization... especially the disk intensive blockwrites. If
someone could please figure out holding about 4k or so in pointers
of the encoded PCX file before writing, I'd sure appreciate it!.
(please post for everyone, if you do.)
}
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]