Mega Code Archive
PCX Image wpalette support
<![CDATA[
Title: PCX Image w/palette support
Question: I read the article http://213.208.2.22/articles/article_2565.asp by Maarten de Haan, and I just thought I'd publish my own PCX graphic component which supports palette handling etc. This component does not support saving of PCX images as the one mentioned above, but a little combination of these two, and you'll get a great component! :)
Answer:
Unit PCX;
{
Delphi PCX class
Version 1.0
Last changed February 6, 2001
Copyright EasyWare.org
You can always download the latest version at http://www.easyware.org/
Use at your own risk!
This PCX class is FREE OF CHARGE!
You MAY: use this class in your projects. You may even use this class in your commercial applications free of charge!
You MAY NOT: take credit for this source, and not charge money for this PCX class!
If you change the source, make sure you write a well documented list of your changes, and make sure that you state that this is not the original source!
Please send your updated class together with your list of changes to support@easyware.org for our approval, and to make it available for other Delphi users!
}
Interface
Uses Windows, Classes, Graphics;
Type
TRGB = Record
Red : Byte;
Green : Byte;
Blue : Byte;
End;
TPCX16ColorPalette = Array[0..15] of TRGB;
TPalette = Array[0..255] of TRGB;
TPCXHeader = Record
Manufacturer : Byte; // 10 = ZSoft .pcx
Version : Byte; // Version information
Encoding : Byte; // 1 = .PCX run length encoding
BitsPerPixel : Byte; // Number of bits to represent a pixel (per Plane) - 1, 2, 4, or 8
XMin, YMin : SmallInt; // Image Dimensions: XMin,YMin
XMax, YMax : SmallInt; // Image Dimensions: XMax,YMax
HRes, VRes : SmallInt; // Resolutions in DPI
ColorMap : TPCX16ColorPalette; // Color palette setting
Reserved : Byte; // Should be set to 0
PlaneCount : Byte; // Number of planes
BytesPerLine : SmallInt; // Number of bytes to allocate for a scanline plane. MUST be an EVEN number. Do NOT calculate from Xmax-Xmin.
PalType : SmallInt; // How to interpret palette- 1 = Color/BW, 2 = Grayscale (ignored in PB IV/ IV +)
HorzScreenSize : SmallInt; // Horizontal screen size in pixels. New field found only in PB IV/IV Plus
VertScreenSize : SmallInt; // Vertical screen size in pixels. New field found only in PB IV/IV Plus
Filler : Array[1..54] of Byte; // Reserved...
End;
TPCXBitmap = Class(TBitmap)
Private
PCXHeader : TPCXHeader;
Function ConvertStream(Stream: TStream) : TMemoryStream;
Public
Constructor Create; Override;
Destructor Destroy; Override;
Procedure LoadFromStream(Stream: TStream); Override;
End;
Implementation
Procedure InvalidGraphic(Str: String); Near;
Begin
Raise EInvalidGraphic.Create(Str);
End;
Function TPCXBitmap.ConvertStream(Stream: TStream) : TMemoryStream;
Procedure DecodeRow(DstStream: TMemoryStream);
Var
BytesPerLine, Count : Integer;
Data : Byte;
Begin
BytesPerLine := PCXHeader.BytesPerLine*PCXHeader.PlaneCount;
While (BytesPerLine 0) and (Stream.Position Begin
Stream.Read(Data, 1);
IF (Data = 192) Then
Begin
Count := (Data and 63); { Get Count }
Stream.Read(Data, 1);
While (Count 0) do
Begin
DstStream.Write(Data, 1);
Dec(Count);
Dec(BytesPerLine);
End;
End
Else
Begin
DstStream.Write(Data, 1);
Dec(BytesPerLine);
End;
End;
DstStream.Seek(0, soFromBeginning);
End;
Procedure ConvertRow(RowDataStream, DstStream: TMemoryStream; Palette: TPalette);
Var
BitPos : Byte;
BitBytePos : Longint;
BitPlaneArray : Array[0..7] of Byte;
Function GetBits(BitCount: Byte) : Longint;
Const
BitArray : Array[0..15] of Word = (1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384, 32768);
Var
T, I : Integer;
BPL : Longint;
Begin
Result := 0;
For T := 0 to BitCount-1 do
Begin
IF (BitPos = 8) Then
Begin
BPL := RowDataStream.Size div PCXHeader.PlaneCount;
For I := 0 to PCXHeader.PlaneCount-1 do
Begin
RowDataStream.Seek((I*BPL)+BitBytePos, soFromBeginning);
RowDataStream.Read(BitPlaneArray[I], 1);
End;
BitPos := 0;
Inc(BitBytePos);
End;
For I := 0 to PCXHeader.PlaneCount-1 do
Begin
IF (BitPlaneArray[I] and BitArray[7-BitPos] 0) Then
Begin
Result := Result + BitArray[(T*PCXHeader.PlaneCount)+I];
End;
End;
Inc(BitPos);
End;
End;
Var
I, W : Longint;
R, G, B : Byte;
Col : Byte;
// M : Byte;
Begin
DstStream.Clear;
//
//
IF (PCXHeader.PlaneCount Begin
W := (PCXHeader.XMax-PCXHeader.XMin);
(*
M := W and 7; { Left over bits }
IF (M 0) Then M := $FF shl (8-M) { M = Mask for unseen pixels }
Else M := $FF;
*)
BitPos := 8;
BitBytePos := 0;
For I := 0 to W-1 do
Begin
Col := GetBits(PCXHeader.BitsPerPixel);
DstStream.Write(Palette[Col].Red, 1);
DstStream.Write(Palette[Col].Green, 1);
DstStream.Write(Palette[Col].Blue, 1);
End;
End
Else
IF (PCXHeader.PlaneCount Begin
(*
IF PCXHeader.PlaneCount = 1 Then J := 7
Else J := 3;
T := (PCXHeader.XMax-PCXHeader.XMin+1); { width in pixels }
IF L XMSWidth Then
Begin
L := XMSWidth; { don't overrun screen width }
M := 0;
End;
FillChar(XMSArray^[0], XMSWidth, 0);
L := (PCXHeader.XMax-PCXHeader.XMin+1); { width in pixels }
BSeg := 0;
BOffset := 0;
For T := 0 to L-1 do
Begin
Col := 0;
For J := 0 to PCXHeader.PlaneCount-1 do
Col := Col + GetBit2( T, J ) Shl J;
PutColor( T, Col );
End;
*)
End
Else
IF (PCXHeader.PlaneCount = 1) and (PCXHeader.BitsPerPixel = 8) Then { 256 COLORS }
Begin
W := RowDataStream.Size;
For I := 0 to W-1 do
Begin
RowDataStream.Read(Col, 1);
DstStream.Write(Palette[Col].Red, 1);
DstStream.Write(Palette[Col].Green, 1);
DstStream.Write(Palette[Col].Blue, 1);
End;
End
Else
IF (PCXHeader.PlaneCount = 3) and (PCXHeader.BitsPerPixel = 8) Then { Higher than 256 colors }
Begin
W := RowDataStream.Size div 3;
For I := 0 to W-1 do
Begin
RowDataStream.Seek(I, soFromBeginning);
RowDataStream.Read(R, 1);
RowDataStream.Seek(I+(W*1), soFromBeginning);
RowDataStream.Read(G, 1);
RowDataStream.Seek(I+(W*2), soFromBeginning);
RowDataStream.Read(B, 1);
DstStream.Write(R, 1);
DstStream.Write(G, 1);
DstStream.Write(B, 1);
End;
End;
//
//
DstStream.Seek(0, soFromBeginning);
End;
Procedure ReadPalette(var Palette: TPalette);
Var
Colors : DWord;
TmpPos : DWord;
TmpByte : Byte;
Begin
Colors := (2 shl ((PCXHeader.BitsPerPixel*PCXHeader.PlaneCount)-1));
IF (Colors = 2) Then
Begin
Palette[0].Red := 0;
Palette[0].Green := 0;
Palette[0].Blue := 0;
Palette[1].Red := 255;
Palette[1].Green := 255;
Palette[1].Blue := 255;
End
Else
IF (Colors = 4) Then
Begin
// Not implemented! Need sample files to do this! CGA PCX images isn't to easy to get! :(
(*
Palette[0].Red := 0;
Palette[0].Green := 0;
Palette[0].Blue := 0;
BackGround := PCXHeader.Palette[0] Shr 4;
ForeGround := PCXHeader.Palette[3] Shr 5;
ColorBurst := (ForeGround and 1 = 1); { I don't know how to interpret this one yet... }
Pal := (ForeGround and 2);
Intense := (ForeGround and 4 = 4);
IF Intense Then D := 1.5
Else D := 1;
IF Pal = 2 Then
Begin
{ Cyan }
Palette[1].Red := 0;
Palette[1].Green := Round(255 / d);
Palette[1].Blue := Round(255 / d);
{ magenta }
Palette[2].Red := Round(255 / d);
Palette[2].Green := 0;
Palette[2].Blue := Round(255 / d);
{ white }
Palette[3].Red := Round(255 / d);
Palette[3].Green := Round(255 / d);
Palette[3].Blue := Round(255 / d);
End
Else
Begin
{ Green }
Palette[1].Red := 0;
Palette[1].Green := Round(255 / d);
Palette[1].Blue := 0;
{ Red }
Palette[2].Red := Round(255 / d);
Palette[2].Green := 0;
Palette[2].Blue := 0;
{ Brown }
Palette[3].Red := Round(255 / d);
Palette[3].Green := Round(129 / d);
Palette[3].Blue := 0;
End;
*)
End
Else
IF (Colors = 16) Then
Begin
For Colors := 0 to 15 do Palette[Colors] := PCXHeader.ColorMap[Colors];
End
Else
IF (Colors = 256) Then
Begin
IF (PCXHeader.Version = 5) Then
Begin
TmpPos := Stream.Position;
Stream.Seek(Stream.Size-769, soFromBeginning);
Stream.Read(TmpByte, 1);
IF (TmpByte = 12) Then Stream.Read(Palette, 768);
Stream.Seek(TmpPos, soFromBeginning);
End;
End
Else
Begin
// There is no palette for pictures with more than 256 colors!!!
End;
End;
Var
BitmapFileHeader : TBitmapFileHeader;
BitmapInfoHeader : TBitmapInfoHeader;
PaletteSize : Integer;
BytesPerLine : Longint;
R, G, B : Byte;
X, Y : Longint;
RowData : TMemoryStream;
OutPutData : TMemoryStream;
HeaderSize : Longint;
Palette : TPalette;
Begin
Result := NIL;
Stream.Seek(0, soFromBeginning); // Maybe we shouldn't seek to the start of the stream!!! ?
Stream.Read(PCXHeader, Sizeof(PCXHeader));
IF (PCXHeader.Manufacturer = 10) Then
Begin
PaletteSize := 0;
(*
Case (PCXHeader.BitsPerPixel*PCXHeader.PlaneCount) of
{1..}8 : PaletteSize := 768;
End;
*)
ReadPalette(Palette);
BytesPerLine := (PCXHeader.XMax-PCXHeader.XMin+1)*3;
BytesPerLine := (BytesPerLine+3) div 4 * 4;
HeaderSize := Sizeof(BitmapFileHeader)+Sizeof(BitmapInfoHeader)+PaletteSize;
Result := TMemoryStream.Create;
Try
Result.SetSize(
HeaderSize+
((PCXHeader.YMax-PCXHeader.YMin+1)*BytesPerLine)
);
Except
Result.Free;
Result := NIL;
End;
//
//
IF (Assigned(Result)) Then
Begin
Result.Seek(0, soFromBeginning); // Make sure the position is at the start of the stream!
With BitmapFileHeader do
Begin
bfType := 19778;
bfSize := Result.Size;
bfReserved1 := 0;
bfReserved2 := 0;
bfOffBits := Sizeof(BitmapFileHeader)+Sizeof(BitmapInfoHeader)+PaletteSize;
End;
Result.Write(BitmapFileHeader, Sizeof(BitmapFileHeader));
With BitmapInfoHeader do
Begin
biSize := Sizeof(BitmapInfoHeader);
biWidth := (PCXHeader.XMax-PCXHeader.XMin)+1;
biHeight := (PCXHeader.YMax-PCXHeader.YMin)+1;
biPlanes := 1;
// biBitCount := PCXHeader.BitsPerPixel*PCXHeader.PlaneCount;
biBitCount := 24;
biCompression := BI_RGB;
biSizeImage := ((PCXHeader.YMax-PCXHeader.YMin+1)*BytesPerLine);
biXPelsPerMeter := Round(PCXHeader.HorzScreenSize*2.54);
biYPelsPerMeter := Round(PCXHeader.VertScreenSize*2.54);
// biClrUsed := (PaletteSize div 4);
biClrUsed := 0;
biClrImportant := 0;
End;
Result.Write(BitmapInfoHeader, Sizeof(BitmapInfoHeader));
RowData := TMemoryStream.Create;
OutPutData := TMemoryStream.Create;
For Y := PCXHeader.YMin to PCXHeader.YMax do
Begin
RowData.Clear;
DecodeRow(RowData);
IF (RowData.Size 0) Then
Begin
ConvertRow(RowData, OutputData, Palette);
//
Result.Seek(HeaderSize+((PCXHeader.YMax-Y)*BytesPerLine), soFromBeginning);
For X := PCXHeader.XMin to PCXHeader.XMax do
Begin
OutPutData.Read(R, 1);
OutPutData.Read(G, 1);
OutPutData.Read(B, 1);
Result.Write(B, 1);
Result.Write(G, 1);
Result.Write(R, 1);
End;
// Result.CopyFrom(OutPutData, (PCXHeader.XMax-PCXHeader.XMin+1)*3);
// Byte alignment
X := BytesPerLine - ((PCXHeader.XMax-PCXHeader.XMin+1)*3);
R := 0;
While (X 0) do
Begin
Result.Write(R, 1);
Dec(X);
End;
End;
End;
OutPutData.Free;
RowData.Free;
Result.Seek(0, soFromBeginning); // Make sure the position is at the start of the stream!
End
Else InvalidGraphic('Not enough memory to create PCX bitmap!');
End
Else InvalidGraphic('Not a ZSoft PCX file!');
End;
Procedure TPCXBitmap.LoadFromStream(Stream: TStream);
Var
Image : TMemoryStream;
MemStream : TMemoryStream;
Begin
// Read the file into memory instead, to speed up the reading progress...
MemStream := TMemoryStream.Create;
MemStream.LoadFromStream(Stream);
Image := ConvertStream(MemStream);
IF (Assigned(Image)) Then
Begin
Inherited LoadFromStream(Image);
Image.Free;
End
Else
Begin
Inherited LoadFromStream(MemStream);
End;
MemStream.Free;
End;
Constructor TPCXBitmap.Create;
Begin
Inherited Create;
End;
Destructor TPCXBitmap.Destroy;
Begin
Inherited Destroy;
End;
Begin
TPicture.RegisterFileFormat('PCX', 'PCX Files', TPCXBitmap);
End.
]]>