Mega Code Archive
Pcximage
<![CDATA[
Import / export PCX under Delphi (5.0)
////////////////////////////////////////////////////////////////////////
// //
// TPCXImage //
// ========= //
// //
// Completed: the 10th of August 2001 //
// Author: M. de Haan //
// Email: M.deHaan@inn.nl //
// Tested: under W95 SP1 //
// Version: 1.0 //
// ------------------------------------------------------------------ //
// Update: the 14th of August 2001 to version 1.1 //
// Reason: Added version check //
// Added comment info on version //
// Changed PCX header ID check //
// ------------------------------------------------------------------ //
// Update: the 19th of August 2001 to version 2.0 //
// Reason: Warning from Delphi about using abstract methods, //
// caused by not implementing ALL TGraphic methods //
// (Thanks goes to R.P. Sterkenburg for his diagnostic) //
// Added: SaveToClipboardFormat //
// LoadFromClipboardFormat //
// GetEmpty //
// ------------------------------------------------------------------ //
// Update: the 13th of October 2001 to version 2.1 //
// Reason: strange errors, read errors, EExternalException, IDE //
// hanging, Delphi hanging, Debugger haning, windows //
// hanging, keyboard locked, and so on //
// Changed: Assign procedure //
// ------------------------------------------------------------------ //
// //
// The PCX image file format is copyrighted by: //
// ZSoft, PC Paintbrush, PC Paintbrush plus //
// Trademarks: NA //
// Royalty fees: NONE //
// //
// The author can not be held responsable for using this software //
// //
// Known issues //
// ------------ //
// 1. Only tested with PCX images version 3.0 (1991) //
// (24 bit images support) //
// //
// 2. No palette support //
// //
// 3. Uncompressed files are not supported //
// //
// 4. AssignTo is NOT tested //
// //
// 5. GetEmpty is NOT tested //
// //
// 6. SaveToClipboardFormat is NOT tested //
// //
// 7. LoadFromClipboardFormat is NOT tested //
// //
// 8. The image will ALWAYS be stored as a 24 bit pcx image //
// //
////////////////////////////////////////////////////////////////////////
Unit
PCXImage;
Interface
Uses
Windows,
SysUtils,
Classes,
Graphics;
Const
WIDTH_OUT_OF_RANGE = 'Illegal width entry in PCX file header';
HEIGHT_OUT_OF_RANGE = 'Illegal height entry in PCX file header';
FILE_FORMAT_ERROR = 'Invalid file format';
VERSION_ERROR = 'Only PC Paintbrush (plus) V3.0 and higher' +
' are supported';
FORMAT_ERROR = 'Illegal identification byte in PCX file' +
' header';
PALETTE_ERROR = 'Invalid palette found';
ASSIGN_ERROR = 'Can only Assign a TBitmap or a TPicture';
ASSIGNTO_ERROR = 'Can only AssignTo a TBitmap';
PCXIMAGE_EMPTY = 'The PCX image is empty';
BITMAP_EMPTY = 'The bitmap is empty';
INPUT_FILE_TOO_LARGE = 'The input file is too large to be read';
IMAGE_WIDTH_TOO_LARGE = 'Width of PCX image too large to handle';
// added 19/08/2001
CLIPBOARD_LOAD_ERROR = 'Loading from clipboard failed';
// added 19/08/2001
CLIPBOARD_SAVE_ERROR = 'Saving to clipboard failed';
// added 14/10/2001
PCX_WIDTH_ERROR = 'Unexpected line width in PCX data';
PCX_HEIGHT_ERROR = 'More PCX data found than expected';
PCXIMAGE_TOO_LARGE = 'PCX image too large';
// added 19/08/2001
Var
CF_PCX : Word;
////////////////////////////////////////////////////////////////////////
// //
// PCXHeader //
// //
////////////////////////////////////////////////////////////////////////
Type
ColorRecord = packed Record
R,G,B : Byte;
End; // of Record
Type
TPCXImageHeader = packed Record
fID : Byte;
fVersion : Byte;
fCompressed : Byte;
fBitsPerPixel : Byte;
fWindow : packed Record
wLeft,
wTop,
wRight,
wBottom : WORD;
End; // of Packed Record
fHorzResolution : WORD;
fVertResolution : WORD;
fColorMap : Array[0..15] of ColorRecord;
fReserved : Byte;
fPlanes : Byte;
fBytesPerLine : WORD;
fPaletteInfo : WORD;
fFiller : Array[0..57] of Byte;
End; // of Packed Record
////////////////////////////////////////////////////////////////////////
// //
// PCXData //
// //
////////////////////////////////////////////////////////////////////////
// Const
// fMaxDataFileLength = $7FFFFF; // Max filelength 8,3 Mbyte
Type
TPCXData = Object
// fData : Array[0..fMaxDataFileLength] of Byte;
fData : Array of Byte;
End;
////////////////////////////////////////////////////////////////////////
// //
// ScanLine //
// //
////////////////////////////////////////////////////////////////////////
Const
fMaxScanLineLength = $FFF; // Max image width: 4096 pixels
Type
mByteArray = Array[0..fMaxScanLineLength] of Byte;
pmByteArray = ^mByteArray;
// The "standard" pByteArray allocates 32768 bytes,
// which is a little bit overdone here, I think...
Const
fMaxImageWidth = $FFF; // Max image width: 4096 pixels
Type
xByteArray = Array[0..fMaxImageWidth] of Byte;
////////////////////////////////////////////////////////////////////////
// //
// PCXPalette //
// //
////////////////////////////////////////////////////////////////////////
Type
fColorEntry = packed Record
R,G,B : Byte;
End; // of packed Record
Type
TPCXPalette = packed Record
fSignature : Byte;
fPalette : Array[0..255] of fColorEntry;
End; // of packed Record
////////////////////////////////////////////////////////////////////////
// //
// Classes //
// //
////////////////////////////////////////////////////////////////////////
Type
TPCXImage = Class;
TPCXFile = Class;
////////////////////////////////////////////////////////////////////////
// //
// PCXFile //
// //
// File handler //
// //
////////////////////////////////////////////////////////////////////////
TPCXFile = Class(TPersistent)
Private
fHeight : Integer;
fWidth : Integer;
fPCXHeader : TPCXImageHeader;
fPCXData : TPCXData;
fPCXPalette : TPCXPalette;
fColorDepth : Cardinal;
fCurrentPos : Cardinal;
Protected
{ Protected declarations }
Public
{ Public declarations }
constructor Create;
destructor Destroy; override;
Procedure LoadFromFile(Const Filename : String);
Procedure LoadFromStream(Stream : TStream);
Procedure SaveToFile(Const Filename : String);
Procedure SaveToStream(Stream : TStream);
Published
{ Published declarations }
{ The publishing is done in the TPCXImage section }
End;
////////////////////////////////////////////////////////////////////////
// //
// TPCXImage //
// //
// Image handler //
// //
////////////////////////////////////////////////////////////////////////
TPCXImage = class(TGraphic)
Private
{ Private declarations }
fBitmap : TBitmap;
fPCXFile : TPCXFile;
fRLine,fGLine,fBLine : xByteArray;
fP : pmByteArray;
Procedure ConvertPCXDataToImage;
Procedure ConvertImageToPCXData;
Procedure FillDataLines(Const fLine : Array of Byte);
Procedure CreatePCXHeader;
// Procedure ProcessLine(Var fLine : Array of Byte; Const W : Cardinal);
Protected
{ Protected declarations }
Procedure Draw(ACanvas : TCanvas; Const Rect : TRect); override;
Function GetHeight : Integer; override;
Function GetWidth : Integer; override;
Procedure SetHeight(Value : Integer); override;
Procedure SetWidth(Value : Integer); override;
Function GetEmpty : Boolean; override;
Public
{ Public declarations }
// Procedure Draw(ACanvas : TCanvas; Const Rect : TRect); override;
constructor Create; override;
destructor Destroy; override;
Procedure Assign(Source : TPersistent); override;
Procedure AssignTo(Dest : TPersistent); override;
Procedure LoadFromFile(const Filename : String); override;
Procedure LoadFromStream(Stream : TStream); override;
Procedure SaveToFile(const Filename : String); override;
Procedure SaveToStream(Stream : TStream); override;
Procedure LoadFromClipboardFormat(AFormat : Word; AData : THandle;
APalette : HPALETTE); override;
Procedure SaveToClipboardFormat(Var AFormat : Word;
Var AData : THandle; Var APalette : HPALETTE); override;
Published
{ Published declarations }
Property Height : Integer
read GetHeight write SetHeight;
Property Width : Integer
read GetWidth write SetWidth;
End;
Implementation
////////////////////////////////////////////////////////////////////////
// //
// TPCXImage //
// //
// Image handler //
// //
////////////////////////////////////////////////////////////////////////
constructor TPCXImage.Create;
Begin
inherited Create;
If not Assigned(fBitmap) then
fBitmap := TBitmap.Create;
If not Assigned(fPCXFile) then
fPCXFile := TPCXFile.Create;
End;
//----------------------------------------------------------------------
destructor TPCXImage.Destroy;
Begin
fPCXFile.Free;
fBitmap.Free; // Reversed order of create
//SetLength(fRLine,0);
//Setlength(fGLine,0);
//SetLength(fBLine,0);
inherited Destroy;
End;
//----------------------------------------------------------------------
Procedure TPCXImage.SetHeight(Value : Integer);
Begin
If Value >= 0 then
fBitmap.Height := Value;
End;
//----------------------------------------------------------------------
Procedure TPCXImage.SetWidth(Value : Integer);
Begin
If Value >= 0 then
fBitmap.Width := Value;
End;
//----------------------------------------------------------------------
Function TPCXImage.GetHeight : Integer;
Begin
Result := fPCXFile.fHeight;
End;
//----------------------------------------------------------------------
Function TPCXImage.GetWidth : Integer;
Begin
Result := fPCXFile.fWidth;
End;
//--------------------------------------------------------------------//
// The credits for this procedure go to his work of TGIFImage by //
// Reinier P. Sterkenburg //
// NOT TESTED! //
// added 19/08/2001 //
//--------------------------------------------------------------------//
Procedure TPCXImage.LoadFromClipboardFormat(AFormat : Word;
ADAta : THandle; APalette : HPALETTE);
Var
Size : Integer;
Buf : Pointer;
Stream : TMemoryStream;
BMP : TBitmap;
Begin
If (AData = 0) then
AData := GetClipBoardData(AFormat);
If (AData <> 0) and (AFormat = CF_PCX) then
Begin
Size := GlobalSize(AData);
Buf := GlobalLock(AData);
Try
Stream := TMemoryStream.Create;
Try
Stream.SetSize(Size);
Move(Buf^,Stream.Memory^,Size);
Self.LoadFromStream(Stream);
finally
Stream.Free;
End;
finally
GlobalUnlock(AData);
End;
End
else
If (AData <> 0) and (AFormat = CF_BITMAP) then
Begin
BMP := TBitmap.Create;
Try
BMP.LoadFromClipboardFormat(AFormat,AData,APalette);
Self.Assign(BMP);
finally
BMP.Free;
End;
End
else
Raise Exception.Create(CLIPBOARD_LOAD_ERROR);
End;
//--------------------------------------------------------------------//
// The credits for this procedure go to his work of TGIFImage by //
// Reinier P. Sterkenburg //
// NOT TESTED! //
// added 19/08/2001 //
//--------------------------------------------------------------------//
Procedure TPCXImage.SaveToClipboardFormat(Var AFormat : Word;
Var AData : THandle; Var APalette : HPALETTE);
Var
Stream : TMemoryStream;
Data : THandle;
Buf : Pointer;
Begin
If Empty then
Exit;
// First store the bitmap to the clipboard
fBitmap.SaveToClipboardFormat(AFormat,AData,APalette);
// Then try to save the PCX
Stream := TMemoryStream.Create;
try
SaveToStream(Stream);
Stream.Position := 0;
Data := GlobalAlloc(HeapAllocFlags,Stream.Size);
try
If Data <> 0 then
Begin
Buf := GlobalLock(Data);
try
Move(Stream.Memory^,Buf^,Stream.Size);
finally
GlobalUnlock(Data);
End;
If SetClipBoardData(CF_PCX,Data) = 0 then
Raise Exception.Create(CLIPBOARD_SAVE_ERROR);
End;
except
GlobalFree(Data);
raise;
End;
finally
Stream.Free;
End;
End;
//--------------------------------------------------------------------//
// NOT TESTED! //
// added 19/08/2001 //
//--------------------------------------------------------------------//
Function TPCXImage.GetEmpty : Boolean;
Begin
If Assigned(fBitmap) then
Result := fBitmap.Empty
else
Result := (fPCXFile.fHeight = 0) or (fPCXFile.fWidth = 0);
End;
//----------------------------------------------------------------------
Procedure TPCXImage.SaveToFile(const Filename : String);
Var
fPCX : TFileStream;
Begin
If (fBitmap.Width = 0) or (fBitmap.Height = 0) then
Raise Exception.Create(BITMAP_EMPTY);
CreatePCXHeader;
ConvertImageToPCXData;
fPCX := TFileStream.Create(Filename,fmCreate);
Try
fPCX.Position := 0;
SaveToStream(fPCX);
finally
fPCX.Free;
End;
SetLength(fPCXFile.fPCXData.fData,0);
End;
//--------------------------------------------------------------------//
// NOT TESTED! //
//--------------------------------------------------------------------//
Procedure TPCXImage.AssignTo(Dest : TPersistent);
Var
bAssignToError : Boolean;
Begin
bAssignToError := True;
If Dest is TBitmap then
Begin
(Dest as TBitmap).Assign(fBitmap);
bAssignToError := False;
End;
If Dest is TPicture then
Begin
(Dest as TPicture).Graphic.Assign(fBitmap);
bAssignToError := False;
End;
If bAssignToError then
Raise Exception.Create(ASSIGNTO_ERROR);
// You can write other assignments here...
End;
//--------------------------------------------------------------------//
Procedure TPCXImage.Assign(Source : TPersistent);
Var
iX,iY : Integer;
bAssignError : Boolean;
Begin
bAssignError := True;
If (Source is TBitmap) then
Begin
fBitmap.Assign(Source as TBitmap);
bAssignError := False;
End;
If (Source is TPicture) then
Begin
iX := (Source as TPicture).Width;
iY := (Source as TPicture).Height;
fBitmap.Width := iX;
fBitmap.Height := iY;
fBitmap.Canvas.Draw(0,0,(Source as TPicture).Graphic);
bAssignError := False;
End;
// You can write other assignments here...
If bAssignError then
Raise Exception.Create(ASSIGN_ERROR);
End;
//----------------------------------------------------------------------
Procedure TPCXImage.Draw(ACanvas : TCanvas; const Rect : TRect);
Begin
// ACanvas.Draw(0,0,fBitmap); // faster
ACanvas.StretchDraw(Rect,fBitmap); // slower
End;
//----------------------------------------------------------------------
Procedure TPCXImage.LoadFromFile(const Filename : String);
Begin
fPCXFile.LoadFromFile(Filename);
ConvertPCXDataToImage;
End;
//----------------------------------------------------------------------
Procedure TPCXImage.SaveToStream(Stream : TStream);
Begin
fPCXFile.SaveToStream(Stream);
End;
//----------------------------------------------------------------------
Procedure TPCXImage.LoadFromStream(Stream : TStream);
Begin
fPCXFile.LoadFromStream(Stream);
End;
//--------------------------------------------------------------------//
// Called by RLE compressor //
//--------------------------------------------------------------------//
Procedure TPCXImage.FillDataLines(Const fLine : Array of Byte);
Var
By : Byte;
Cnt : WORD;
I : Cardinal;
W : Cardinal;
Begin
I := 0;
By := fLine[0];
Cnt := $C1;
W := fBitmap.Width;
Repeat
Inc(I);
If By = fLine[I] then
Begin
Inc(Cnt);
If Cnt = $100 then
Begin
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Byte(Pred(Cnt));
Inc(fPCXFile.fCurrentPos);
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := By;
Inc(fPCXFile.fCurrentPos);
Cnt := $C1;
By := fLine[I];
End;
End;
If (By <> fLine[I]) then
Begin
If (Cnt = $C1) then
Begin
If (By < $C1) then
Begin
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := By;
Inc(fPCXFile.fCurrentPos);
End
else
Begin
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Byte(Cnt);
Inc(fPCXFile.fCurrentPos);
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := By;
Inc(fPCXFile.fCurrentPos);
End;
End
else
Begin
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Byte(Cnt);
Inc(fPCXFile.fCurrentPos);
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := By;
Inc(fPCXFile.fCurrentPos);
End;
Cnt := $C1;
By := fLine[I];
End;
Until I = W - 1;
// Write the last byte(s)
If (Cnt > $C1) then
Begin
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Byte(Cnt);
Inc(fPCXFile.fCurrentPos);
End;
If (Cnt = $C1) and (By > $C0) then
Begin
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Byte(Cnt);
Inc(fPCXFile.fCurrentPos);
End;
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := By;
Inc(fPCXFile.fCurrentPos);
// If fPCXFile.fCurrentPos > fMaxDataFileLength then
// Raise Exception.Create(PCXIMAGE_TOO_LARGE);
End;
//--------------------------------------------------------------------//
// RLE Compression algorithm //
//--------------------------------------------------------------------//
Procedure TPCXImage.ConvertImageToPCXData;
Var
H,W : Cardinal;
X,Y : Cardinal;
I : Cardinal;
Begin
H := fBitmap.Height;
W := fBitmap.Width;
fPCXFile.fCurrentPos := 0;
SetLength(fPCXFile.fPCXData.fData,6 * H * W); // to be sure
// SetLength(fRLine,W);
// SetLength(fGLine,W);
// SetLength(fBLine,W);
fBitmap.PixelFormat := pf24bit; // Do this if you're using ScanLine!
For Y := 0 to H - 1 do
Begin
fP := fBitmap.ScanLine[Y];
I := 0;
For X := 0 to W - 1 do
Begin
fRLine[X] := fP[I]; Inc(I); // Extract a red line
fGLine[X] := fP[I]; Inc(I); // Extract a green line
fBLine[X] := fP[I]; Inc(I); // Extract a blue line
End;
FillDataLines(fBLine); // Compress the blue line
FillDataLines(fGLine); // Compress the green line
FillDataLines(fRLine); // Compress the red line
End;
// Correct the length of fPCXData.fData
SetLength(fPCXFile.fPCXData.fData,fPCXFile.fCurrentPos);
End;
//----------------------------------------------------------------------
(*
Procedure TPCXImage.ProcessLine(Var fLine : Array of Byte; Const W : Cardinal);
Var
Cnt : Integer;
J,K : Cardinal;
By : Byte;
Begin
J := 0;
Repeat
By := fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos];
Inc(fPCXFile.fCurrentPos);
// one byte
If By < $C1 then
Begin
fLine[J] := By;
Inc(J);
End;
// multiple bytes (RLE)
If By > $C0 then
Begin
Cnt := By - $C0;
By := fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos];
Inc(fPCXFile.fCurrentPos);
For K := 1 to Cnt do
Begin
fLine[J] := By;
Inc(J);
End;
End;
Until J >= W;
End;
*)
//--------------------------------------------------------------------//
// RLE Decompression algorithm //
//--------------------------------------------------------------------//
Procedure TPCXImage.ConvertPCXDataToImage;
Var
I,J : Cardinal;
By : Byte;
Cnt : Byte;
H,W : Cardinal;
Y : Cardinal;
K,L : Cardinal;
Begin
H := fPCXFile.fPCXHeader.fWindow.wBottom - fPCXFile.fPCXHeader.fWindow.wTop + 1;
W := fPCXFile.fPCXHeader.fWindow.wRight - fPCXFile.fPCXHeader.fWindow.wLeft + 1;
//SetLength(fRLine,W); // Adjust line length
//SetLength(fGLine,W); // Adjust line length
//SetLength(fBLine,W); // Adjust line length
Y := 0; // First line of image
fBitmap.Width := W; // Set bitmap width
fBitmap.Height := H; // Set bitmap height
fBitmap.PixelFormat := pf24bit; // Do this if you're using ScanLine!
I := 0; // Pointer to data byte of fPXCFile
Repeat
// Process the red line
// ProcessLine(fRLine,W);
J := 0; // Pointer to position in Red / Green / Blue line
Repeat
By := fPCXFile.fPCXData.fData[I];
Inc(I);
// one byte
If By < $C1 then
Begin
fRLine[J] := By;
Inc(J);
End;
// multiple bytes (RLE)
If By > $C0 then
Begin
Cnt := By and $3F;
By := fPCXFile.fPCXData.fData[I];
Inc(I);
//FillChar(fRLine[J],Cnt,By);
//Inc(J,Cnt);
For K := 1 to Cnt do
Begin
fRLine[J] := By;
Inc(J);
End;
End;
Until J >= W;
If J > W then
Raise Exception.Create(PCX_WIDTH_ERROR);
// Process the green line
// ProcessLine(fGLine,W);
J := 0;
Repeat
By := fPCXFile.fPCXData.fData[I];
Inc(I);
// one byte
If By < $C1 then
Begin
fGLine[J] := By;
Inc(J);
End;
// multiple bytes (RLE)
If By > $C0 then
Begin
Cnt := By and $3F;
By := fPCXFile.fPCXData.fData[I];
Inc(I);
//FillChar(fGLine[J],Cnt,By);
//Inc(J,Cnt);
For K := 1 to Cnt do
Begin
fGLine[J] := By;
Inc(J);
End;
End;
Until J >= W;
If J > W then
Raise Exception.Create(PCX_WIDTH_ERROR);
// Process the blue line
// ProcessLine(fBLine,W);
J := 0;
Repeat
By := fPCXFile.fPCXData.fData[I];
Inc(I);
// one byte
If By < $C1 then
Begin
fBLine[J] := By;
Inc(J);
End;
// multiple bytes (RLE)
If By > $C0 then
Begin
Cnt := By and $3F;
By := fPCXFile.fPCXData.fData[I];
Inc(I);
//FillChar(fBLine[J],Cnt,By);
//Inc(J,Cnt);
For K := 1 to Cnt do
Begin
fBLine[J] := By;
Inc(J);
End;
End;
Until J >= W;
If J > W then
Raise Exception.Create(PCX_WIDTH_ERROR);
// Write the just processed data RGB lines to the bitmap
fP := fBitmap.ScanLine[Y];
L := 0;
For K := 0 to W - 1 do
Begin
fP[L] := fBLine[K]; Inc(L);
fP[L] := fGLine[K]; Inc(L);
fP[L] := fRLine[K]; Inc(L);
End;
Inc(Y); // Process the next RGB line
// If I > fMaxDataFileLength then
// Raise Exception.Create(PCXIMAGE_TOO_LARGE);
Until Y >= H;
If Y > H then
Raise Exception.Create(PCX_HEIGHT_ERROR);
// No need for those any more
SetLength(fPCXFile.fPCXData.fData,0);
// SetLength(fRLine,0);
// SetLength(fGLine,0);
// SetLength(fBLine,0);
End;
//----------------------------------------------------------------------
Procedure TPCXImage.CreatePCXHeader;
Var
H,W,W1 : WORD;
Begin
W := fBitmap.Width;
H := fBitmap.Height;
// PCX header
fPCXFile.fPCXHeader.fID := $0A; // BYTE
fPCXFile.fPCXHeader.fVersion := 5; // BYTE
fPCXFile.fPCXHeader.fCompressed := 1; // BYTE
// 1 = compressed
// 0 = uncompressed
fPCXFile.fPCXHeader.fBitsPerPixel := 8; // BYTE
fPCXFile.fPCXHeader.fWindow.wLeft := 0; // WORD
fPCXFile.fPCXHeader.fWindow.wTop := 0; // WORD
fPCXFile.fPCXHeader.fWindow.wRight := W - 1; // WORD
fPCXFile.fPCXHeader.fWindow.wBottom := H - 1; // WORD
fPCXFile.fPCXHeader.fHorzResolution := 72; // WORD
fPCXFile.fPCXHeader.fVertResolution := 72; // WORD
FillChar(fPCXFile.fPCXHeader.fColorMap,48,0); // Array of Byte
W1 := W;
If W and 1 = 1 then // is odd
Inc(W1); // then add 1,
// must be even and rounded up above
fPCXFile.fPCXHeader.fReserved := 0; // BYTE
fPCXFile.fPCXHeader.fPlanes := 3; // BYTE
fPCXFile.fPCXHeader.fBytesPerLine := W1; // WORD
// must be even
// rounded above
fPCXFile.fPCXHeader.fPaletteInfo := 1; // WORD
FillChar(fPCXFile.fPCXHeader.fFiller,58,0); // Array of Byte
End;
//======================================================================
////////////////////////////////////////////////////////////////////////
// //
// TPCXFile //
// //
////////////////////////////////////////////////////////////////////////
Constructor TPCXFile.Create;
Begin
inherited Create;
fHeight := 0;
fWidth := 0;
fCurrentPos := 0;
End;
//----------------------------------------------------------------------
Destructor TPCXFile.Destroy;
Begin
SetLength(fPCXData.fData,0);
inherited Destroy;
End;
//----------------------------------------------------------------------
Procedure TPCXFile.LoadFromFile(const Filename : String);
Var
fPCXStream : TFileStream;
Begin
fPCXStream := TFileStream.Create(Filename,fmOpenRead);
Try
fPCXStream.Position := 0;
LoadFromStream(fPCXStream);
finally
fPCXStream.Free;
End;
End;
//----------------------------------------------------------------------
Procedure TPCXFile.SaveToFile(const Filename : String);
Var
fPCXStream : TFileStream;
Begin
fPCXStream := TFileStream.Create(Filename,fmCreate);
Try
fPCXStream.Position := 0;
SaveToStream(fPCXStream);
finally
fPCXStream.Free;
End;
End;
//----------------------------------------------------------------------
Procedure TPCXFile.LoadFromStream(Stream : TStream);
Var
fFileLength : Cardinal;
I : Integer;
Begin
// Read PCX header
Stream.Read(fPCXHeader,SizeOf(fPCXHeader));
// Check ID byte
If fPCXHeader.fID <> $0A then
Raise Exception.Create(FORMAT_ERROR);
// Check PCX version byte
// ======================
// Versionbyte = 0 => PC PaintBrush V2.5
// Versionbyte = 2 => PC Paintbrush V2.8 with palette information
// Versionbyte = 3 => PC Paintbrush V2.8 without palette information
// Versionbyte = 4 => PC Paintbrush for Windows
// Versionbyte = 5 => PC Paintbrush V3 and up, and PC Paintbrush Plus
// 24 bit image support
If fPCXHeader.fVersion <> 5 then
Raise Exception.Create(VERSION_ERROR);
fWidth := fPCXHeader.fWindow.wRight - fPCXHeader.fWindow.wLeft + 1;
If fWidth < 0 then
Raise Exception.Create(WIDTH_OUT_OF_RANGE);
fHeight := fPCXHeader.fWindow.wBottom - fPCXHeader.fWindow.wTop + 1;
If fHeight < 0 then
Raise Exception.Create(HEIGHT_OUT_OF_RANGE);
If fWidth > fMaxImageWidth then
Raise Exception.Create(IMAGE_WIDTH_TOO_LARGE);
fColorDepth := 1 shl (fPCXHeader.fPlanes * fPCXHeader.fBitsPerPixel);
// The lines following are NOT tested!!!
If fColorDepth <= 16 then
For I := 0 to fColorDepth - 1 do
Begin
If fPCXHeader.fVersion = 3 then
Begin
fPCXPalette.fPalette[I].R := fPCXHeader.fColorMap[I].R shl 2;
fPCXPalette.fPalette[I].G := fPCXHeader.fColorMap[I].G shl 2;
fPCXPalette.fPalette[I].B := fPCXHeader.fColorMap[I].B shl 2;
End
else
Begin
fPCXPalette.fPalette[I].R := fPCXHeader.fColorMap[I].R;
fPCXPalette.fPalette[I].G := fPCXHeader.fColorMap[I].G;
fPCXPalette.fPalette[I].B := fPCXHeader.fColorMap[I].B;
End;
End;
fFileLength := Stream.Size - Stream.Position;
SetLength(fPCXData.fData,fFileLength);
// If fFileLength > fMaxDataFileLength then
// Raise Exception.Create(INPUT_FILE_TOO_LARGE);
Stream.Read(fPCXData.fData[0],fFileLength);
{
If fColorDepth = 256 then
Begin
Stream.Read(fPCXPalette,SizeOf(fPCXPalette));
If fPCXPalette.fSignature <> $0C then
Raise Exception.Create(PALETTE_ERROR);
End;
}
End;
//----------------------------------------------------------------------
Procedure TPCXFile.SaveToStream(Stream : TStream);
Begin
Stream.Write(fPCXHeader,SizeOf(fPCXHeader));
Stream.Write(fPCXData.fData[0],fCurrentPos);
End;
//----------------------------------------------------------------------
Initialization
TPicture.RegisterFileFormat('PCX','PC PaintBrush bitmap',TPCXImage);
//----------------------------------------------------------------------
Finalization
TPicture.UnRegisterGraphicClass(TPCXImage);
//----------------------------------------------------------------------
End.
]]>