Pcximage

Pcximage

Pcximage : Mehreren tausend Tipps, um Ihr Leben einfacher machen.

Import / export von PCX unter Delphi (5.0)
////////////////////////////////////////////////////////////////////////
// //
TPCXImage / /
// ========= //
// //
Abgeschlossen: 10. August 2001 / /
Autor: M. de Haan / /
E-Mail: Der [email protected] / /
Getestet: Unter W95 SP1 / /
Version: 1.0 / /
// ------------------------------------------------------------------ //
Update: 14. August 2001 zu Version 1.1 / /
Grund: Hinzugefügt Versions-Check / /
Kommentar-Info auf Version hinzugefügt / /
Geändert von PCX-Header-ID-Prüfung / /
// ------------------------------------------------------------------ //
Update: 19. August 2001 auf Version 2.0 / /
Grund: Warnung von Delphi zur Verwendung von abstrakter Methoden, / /
verursacht durch die Implementierung nicht alle TGraphic-Methoden / /
(Dank geht an R.P. Sterkenburg für seine Diagnose) / /
Hinzugefügt: SaveToClipboardFormat / /
LoadFromClipboardFormat / /
GetEmpty / /
// ------------------------------------------------------------------ //
Update: 13. Oktober 2001 zu Version 2.1 / /
Grund: seltsame Fehler, Lesefehler, EExternalException, IDE / /
hängende, Delphi hängenden, Debugger Haning, Windows / /
hängende, Tastatur gesperrt, usw. / /
Geändert: Weisen Sie die Prozedur / /
// ------------------------------------------------------------------ //
// //
Das PCX-Bild-Dateiformat ist urheberrechtlich: / /
ZSoft, PC Paintbrush, PC Paintbrush plus / /
Marken: NA / /
Lizenzgebühren: NONE / /
// //
Der Autor kann nicht verantwortlich für die Verwendung dieser Software / /
// //
Bekannte Probleme / /
// ------------ //
// 1. Nur getestet mit PCX-Bilder-Version 3.0 (1991) / /
(24-Bit-Bilder unterstützen) / /
// //
// 2. Keine Unterstützung der Farbpalette / /
// //
// 3. Unkomprimierte Dateien werden nicht unterstützt / /
// //
// 4. AssignTo ist nicht getestet / /
// //
// 5. GetEmpty ist nicht getestet / /
// //
// 6. SaveToClipboardFormat ist nicht getestet / /
// //
// 7. LoadFromClipboardFormat ist nicht getestet / /
// //
// 8. mStream(Stream: TStream); außer Kraft setzen;
Verfahren SaveToFile (const Filename: String); außer Kraft setzen;
Prozedur SaveToStream(Stream: TStream); außer Kraft setzen;
Prozedur LoadFromClipboardFormat (AFormat: Wort; AData: THandle;
APalette: HPALETTE); außer Kraft setzen;
Procedure SaveToClipboardFormat (Var AFormat: Wort;
Var AData: THandle; Var APalette: HPALETTE); außer Kraft setzen;

Veröffentlicht
{Veröffentlichten Erklärungen}
Eigenschaft Height: Integer
Lesen Sie GetHeight Write SetHeight;
Eigenschaft-Breite: Integer
Lesen Sie GetWidth Write SetWidth;
Ende;
Umsetzung
////////////////////////////////////////////////////////////////////////
// //
TPCXImage / /
// //
Bild-Handler / /
// //
////////////////////////////////////////////////////////////////////////
Konstruktor TPCXImage.Create;
BEGIN
geerbte erstellen;
Wenn nicht dann Assigned(fBitmap)
fBitmap: = TBitmap.Create;
Wenn nicht dann Assigned(fPCXFile)
fPCXFile: = TPCXFile.Create;
Ende;
//----------------------------------------------------------------------
Destruktor TPCXImage.Destroy;
BEGIN
fPCXFile.Free;
fBitmap.Free; Umgekehrte Reihenfolge der erstellen
SetLength(fRLine,0);
SetLength(fGLine,0);
SetLength(fBLine,0);
geerbte Destroy;
Ende;
//----------------------------------------------------------------------
Prozedur TPCXImage.SetHeight(Value: Integer);
BEGIN
Wenn Wert > = 0 then
fBitmap.Height: = Value;
Ende;
//----------------------------------------------------------------------
Prozedur TPCXImage.SetWidth(Value: Integer);
BEGIN
Wenn Wert > = 0 then
fBitmap.Width: = Value;
Ende;
//----------------------------------------------------------------------
Funktion TPCXImage.GetHeight: Integer;
BEGIN
Ergebnis: = fPCXFile.fHeight;
Ende;
//----------------------------------------------------------------------
Funktion TPCXImage.GetWidth: Integer;
BEGIN
Ergebnis: = fPCXFile.fWidth;
Ende;
//--------------------------------------------------------------------//
Die Credits für diese Prozedur gehen zu seinem Werk TGIFImage von / /
Reinier s. Sterkenburg / /
NICHT GETESTET! //
19.08.2001 hinzugefügt / /
//--------------------------------------------------------------------//
Prozedur TPCXImage.LoadFromClipboardFormat (AFormat: Wort;
ADAta: THandle; APalette: HPALETTE);
Var
Größe: Integer;
Buf: Zeiger;
Stream: TMemoryStream;
BMP: TBitmap;
BEGIN
Wenn (AData = 0) dann
AData: = GetClipBoardData(AFormat);
Wenn (AData <> 0) und (AFormat = CF_PCX) dann
BEGIN
Größe: = GlobalSize(AData);
Buf: = GlobalLock(AData);
Versuchen Sie
Stream: = TMemoryStream.Create;
Versuchen Sie
Stream.SetSize(Size);
Move(buf^,Stream.Memory^,Size);
Self.LoadFromStream(Stream);
Schließlich
Stream.Free;
Ende;
Schließlich
GlobalUnlock(AData);
Ende;
Ende
sonst
Wenn (AData <> 0) und (AFormat = CF_BITMAP) dann
BEGIN
BMP: = TBitmap.Create;
Versuchen Sie
BMP. LoadFromClipboardFormat(AFormat,AData,APalette);
Self.Assign(BMP);
Schließlich
BMP. Frei;
Ende;
Ende
sonst
Exception.Create(CLIPBOARD_LOAD_ERROR) zu erhöhen;
Ende;
//--------------------------------------------------------------------//
Die Credits für diese Prozedur gehen zu seinem Werk TGIFImage von / /
Reinier s. Sterkenburg / /
NICHT GETESTET! //
19.08.2001 hinzugefügt / /
//--------------------------------------------------------------------//
Procedure TPCXImage.SaveToClipboardFormat (Var AFormat: Wort;
Var AData: THandle; Var APalette: HPALETTE);
Var
Stream: TMemoryStream;
Daten: THandle;
Buf: Zeiger;
BEGIN
Wenn leer, dann
Ausfahrt;
Speichern Sie zuerst die Bitmap in die Zwischenablage
fBitmap.SaveToClipboardFormat(AFormat,AData,APalette);
Versuchen Sie dann, die PCX speichern
Stream: = TMemoryStream.Create;
versuchen Sie
SaveToStream(Stream);
Stream.Position: = 0;
Daten: = GlobalAlloc(HeapAllocFlags,Stream.Size);
versuchen Sie
Wenn Daten <> 0 dann
BEGIN
Buf: = GlobalLock(Data);
versuchen Sie
Move(Stream.Memory^,buf^,Stream.Size);
Schließlich
GlobalUnlock(Data);
Ende;
Wenn SetClipBoardData(CF_PCX,Data) = 0 then
Exception.Create(CLIPBOARD_SAVE_ERROR) zu erhöhen;
Ende;
mit Ausnahme von
GlobalFree(Data);
erhöhen;
Ende;
Schließlich
Stream.Free;
Ende;
Ende;
//--------------------------------------------------------------------//
NICHT GETESTET! //
19.08.2001 hinzugefügt / /
//--------------------------------------------------------------------//
Funktion TPCXImage.GetEmpty: Boolean;
BEGIN
Wenn Assigned(fBitmap) dann
Ergebnis: = fBitmap.Empty
sonst
Ergebnis: = (fPCXFile.fHeight = 0) oder (fPCXFile.fWidth = 0);
Ende;
//----------------------------------------------------------------------
Procedure TPCXImage.SaveToFile (const Filename: String);
Var
fPCX: TFileStream;
BEGIN
Wenn (fBitmap.Width = 0) oder (fBitmap.Height = 0) dann
Exception.Create(BITMAP_EMPTY) zu erhöhen;
CreatePCXHeader;
ConvertImageToPCXData;
fPCX: = TFileStream.Create(Filename,fmCreate);
Versuchen Sie
fPCX.Position: = 0;
SaveToStream(fPCX);
Schließlich
fPCX.Free;
Ende;
SetLength(fPCXFile.fPCXData.fData,0);
Ende;
//--------------------------------------------------------------------//
NICHT GETESTET! //
//--------------------------------------------------------------------//
Prozedur TPCXImage.AssignTo(Dest: TPersistent);
Var
bAssignToError: Boolean;
BEGIN
bAssignToError: = True;
Wenn Dest TBitmap dann ist
BEGIN
(Dest als TBitmap). Assign(fBitmap);
bAssignToError: = False;
Ende;
Wenn Dest TPicture dann ist
BEGIN
(Dest als TPicture). Graphic.Assign(fBitmap);
bAssignToError: = False;
Ende;
Wenn bAssignToError dann
Exception.Create(ASSIGNTO_ERROR) zu erhöhen;
Sie können andere Aufgaben hier schreiben...
Ende;
//--------------------------------------------------------------------//
Prozedur TPCXImage.Assign(Source: TPersistent);
Var
iX, iY: Integer;
bAssignError: Boolean;
BEGIN
bAssignError: = True;
If (Quelle TBitmap) dann
BEGIN
fBitmap.Assign (Quelle als TBitmap);

bAssignError: = False;
Ende;
If (Quelle TPicture) dann
BEGIN
iX: = (Quelle als TPicture). Breite;
iY: = (Quelle als TPicture). Höhe;
fBitmap.Width: = iX;
fBitmap.Height: = iY;
fBitmap.Canvas.Draw (0,0, (Quelle als TPicture). Grafik);
bAssignError: = False;
Ende;
Sie können andere Aufgaben hier schreiben...
Wenn bAssignError dann
Exception.Create(ASSIGN_ERROR) zu erhöhen;
Ende;
//----------------------------------------------------------------------
Prozedur TPCXImage.Draw (ACanvas: TCanvas; const Rect: TRect);
BEGIN
ACanvas.Draw(0,0,fBitmap); schneller
ACanvas.StretchDraw(Rect,fBitmap); langsamer
Ende;
//----------------------------------------------------------------------
Procedure TPCXImage.LoadFromFile (const Filename: String);
BEGIN
fPCXFile.LoadFromFile(Filename);
ConvertPCXDataToImage;
Ende;
//----------------------------------------------------------------------
Prozedur TPCXImage.SaveToStream(Stream: TStream);
BEGIN
fPCXFile.SaveToStream(Stream);
Ende;
//----------------------------------------------------------------------
Prozedur TPCXImage.LoadFromStream(Stream: TStream);
BEGIN
fPCXFile.LoadFromStream(Stream);
Ende;
//--------------------------------------------------------------------//
Aufgerufen von RLE Kompressor / /
//--------------------------------------------------------------------//
Procedure TPCXImage.FillDataLines (Const fLine: Array von Byte);
Var
Von: Byte;
CNT: WORD;
Ich: Kardinal;
W: Kardinal;
BEGIN
Ich: = 0;
Von: = fLine [0];
CNT: = $C1;
W: = fBitmap.Width;
Wiederholen Sie die
Inc(I);
Wenn von fLine [I] dann =
BEGIN
Inc(CNT);
Wenn Cnt = $100 then
BEGIN
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos]: = Byte(Pred(Cnt));
Inc(fPCXFile.fCurrentPos);
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos]: = von;
Inc(fPCXFile.fCurrentPos);
CNT: = $C1;
Von: = fLine [I];
Ende;
Ende;
If (von <> fLine[I]) dann
BEGIN
Wenn (Cnt = $C1) dann
BEGIN
Wenn (von < $C1) dann
BEGIN
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos]: = von;
Inc(fPCXFile.fCurrentPos);
Ende
sonst
BEGIN
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos]: = Byte(Cnt);
Inc(fPCXFile.fCurrentPos);
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos]: = von;
Inc(fPCXFile.fCurrentPos);
Ende;
Ende
sonst
BEGIN
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos]: = Byte(Cnt);
Inc(fPCXFile.fCurrentPos);
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos]: = von;
Inc(fPCXFile.fCurrentPos);
Ende;
CNT: = $C1;
Von: = fLine [I];
Ende;
Bis ich = W - 1;
Schreiben der letzten byte(s)
Wenn (Cnt > $C1) dann
BEGIN
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos]: = Byte(Cnt);
Inc(fPCXFile.fCurrentPos);
Ende;
Wenn (Cnt = $C1) und (von > $C0) dann
BEGIN
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos]: = Byte(Cnt);
Inc(fPCXFile.fCurrentPos);
Ende;
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos]: = y;
Inc(fPCXFile.fCurrentPos);
Wenn fPCXFile.fCurrentPos > fMaxDataFileLength dann
Exception.Create(PCXIMAGE_TOO_LARGE) zu erhöhen;
Ende;
//--------------------------------------------------------------------//
RLE-Kompression Algorithmus / /
//--------------------------------------------------------------------//
Prozedur TPCXImage.ConvertImageToPCXData;
Var
H, W: Kardinal;
X, Y: Kardinal;
Ich: Kardinal;
BEGIN
H: = fBitmap.Height;
W: = fBitmap.Width;
fPCXFile.fCurrentPos: = 0;
SetLength (fPCXFile.fPCXData.fData,6 * H * W); um sicher zu sein
SetLength(fRLine,W);
SetLength(fGLine,W);
SetLength(fBLine,W);
fBitmap.PixelFormat: = pf24bit; Tun Sie dies, wenn Sie mit ScanLine!
Y: = 0, H - 1
BEGIN
fP: = fBitmap.ScanLine[Y];
Ich: = 0;
Für X: = 0, W - 1
BEGIN
fRLine [X]: = fP [I]; Inc(I); Extrahieren Sie eine rote Linie
fGLine [X]: = fP [I]; Inc(I); Extrahieren Sie eine grüne Linie
fBLine [X]: = fP [I]; Inc(I); Extrahieren Sie eine blaue Linie
Ende;
FillDataLines(fBLine); Komprimieren Sie die blaue Linie
FillDataLines(fGLine); Komprimieren Sie die grüne Linie
FillDataLines(fRLine); Komprimieren Sie die rote Linie
Ende;

Korrigieren Sie die Länge des fPCXData.fData
SetLength(fPCXFile.fPCXData.fData,fPCXFile.fCurrentPos);
Ende;
//----------------------------------------------------------------------
(*
Procedure TPCXImage.ProcessLine (Var fLine: Array of Byte; Const W: Cardinal);
Var
CNT: Integer;
J, K: Kardinal;
Von: Byte;
BEGIN
J: = 0;
Wiederholen Sie die
Von: = fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos];
Inc(fPCXFile.fCurrentPos);
ein byte
If von < $C1 dann
BEGIN
fLine [J]: = von;
Inc(J);
Ende;
mehrere Bytes (RLE)
If von > $C0 dann
BEGIN
CNT: = von - $C0;
Von: = fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos];
Inc(fPCXFile.fCurrentPos);
Für K: = 1 Cnt do
BEGIN
fLine [J]: = von;
Inc(J);
Ende;
Ende;
Bis J > = W;
Ende;
*)
//--------------------------------------------------------------------//
RLE Dekomprimierungsalgorithmus / /
//--------------------------------------------------------------------//
Prozedur TPCXImage.ConvertPCXDataToImage;
Var
I, J: Kardinal;
Von: Byte;
CNT: Byte;
H, W: Kardinal;
Y: Kardinal;
K, L: Kardinal;
BEGIN
H: = fPCXFile.fPCXHeader.fWindow.wBottom - fPCXFile.fPCXHeader.fWindow.wTop + 1;
W: = fPCXFile.fPCXHeader.fWindow.wRight - fPCXFile.fPCXHeader.fWindow.wLeft + 1;
SetLength(fRLine,W); Zeilenlänge anpassen
SetLength(fGLine,W); Zeilenlänge anpassen
SetLength(fBLine,W); Zeilenlänge anpassen
Y: = 0; Erste Zeile des Bildes
fBitmap.Width: = W; Set-Bitmap-Breite
fBitmap.Height: = H; Set-Bitmap-Höhe
fBitmap.PixelFormat: = pf24bit; Tun Sie dies, wenn Sie mit ScanLine!
Ich: = 0; Zeiger auf Daten-Byte des fPXCFile
Wiederholen Sie die
Die rote Linie zu verarbeiten
ProcessLine(fRLine,W);
J: = 0; Zeiger auf die position in rot / grün / blaue Linie
Wiederholen Sie die
Von: = fPCXFile.fPCXData.fData[I];
Inc(I);
ein byte
If von < $C1 dann
BEGIN
fRLine [J]: = von;
Inc(J);
Ende;
mehrere Bytes (RLE)
If von > $C0 dann
BEGIN
CNT: = durch und $3F;
Von: = fPCXFile.fPCXData.fData[I];
Inc(I);
FillChar(fRLine[J],Cnt,By);
Inc(J,CNT);
Für K: = 1 Cnt do
BEGIN
fRLine [J]: = von;
Inc(J);
Ende;
Ende;
Bis J > = W;
Wenn J > W dann
Exception.Create(PCX_WIDTH_ERROR) zu erhöhen;
Prozess der grünen Linie
ProcessLine(fGLine,W);
J: = 0;
Wiederholen Sie die
Von: = fPCXFile.fPCXData.fData[I];
Inc(I);
ein byte
If von < $C1 dann
BEGIN
fGLine [J]: = von;
Inc(J);
Ende;
mehrere Bytes (RLE)
If von > $C0 dann
BEGIN
CNT: = durch und $3F;
Von: = fPCXFile.fPCXData.fData[I];
Inc(I);
FillChar(fGLine[J],Cnt,By);
Inc(J,CNT);
Für K: = 1 Cnt do
BEGIN
fGLine [J]: = von;
Inc(J);
Ende;
Ende;
Bis J > = W;
Wenn J > W dann
Exception.Create(PCX_WIDTH_ERROR) zu erhöhen;
Die blaue Linie zu verarbeiten
ProcessLine(fBLine,W);
J: = 0;
Wiederholen Sie die
Von: = fPCXFile.fPCXData.fData[I];
Inc(I);
ein byte
If von < $C1 dann
BEGIN
fBLine [J]: = von;
Inc(J);
Ende;
mehrere Bytes (RLE)
If von > $C0 dann
BEGIN
CNT: = durch und $3F;
Von: = fPCXFile.fPCXData.fData[I];
Inc(I);
FillChar(fBLine[J],Cnt,By);
Inc(J,CNT);
Für K: = 1 Cnt do
BEGIN
fBLine [J]: = von;
Inc(J);
Ende;
Ende;
Bis J > = W;
Nbsp; Wenn J > W dann
Exception.Create(PCX_WIDTH_ERROR) zu erhöhen;
Schreiben Sie gerade verarbeiteten Daten RGB-Linien auf die bitmap
fP: = fBitmap.ScanLine[Y];
L: = 0;
Für K: 0-W - 1 tun =
BEGIN
fP [L]: = fBLine [K]; Inc(L);
fP [L]: = fGLine [K]; Inc(L);
fP [L]: = fRLine [K]; Inc(L);
Ende;
Inc(Y); Prozess der nächsten Zeile RGB
Wenn ich > fMaxDataFileLength dann
Exception.Create(PCXIMAGE_TOO_LARGE) zu erhöhen;
Bis Y > = H;
Wenn Y > H dann
Exception.Create(PCX_HEIGHT_ERROR) zu erhöhen;
Keine Notwendigkeit für diese mehr
SetLength(fPCXFile.fPCXData.fData,0);
SetLength(fRLine,0);
SetLength(fGLine,0);
SetLength(fBLine,0);
Ende;
//----------------------------------------------------------------------
Prozedur 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 = komprimierte
0 = unkomprimierte
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); Byte-Array
W1: = W;
Wenn W und dann 1 = 1 / / ungerade ist
Inc(W1); Fügen Sie 1,
sogar und bis oben abgerundeten müssen
fPCXFile.fPCXHeader.fReserved: = 0; BYTE
fPCXFile.fPCXHeader.fPlanes: = 3; BYTE
fPCXFile.fPCXHeader.fBytesPerLine: = W1; WORD
muss auch sein
oben gerundet
fPCXFile.fPCXHeader.fPaletteInfo: = 1; WORD
FillChar(fPCXFile.fPCXHeader.fFiller,58,0); Byte-Array
Ende;
//======================================================================
////////////////////////////////////////////////////////////////////////
// //
TPCXFile / /
// //
////////////////////////////////////////////////////////////////////////
Konstruktor TPCXFile.Create;
BEGIN
geerbte erstellen;
fHeight: = 0;
fWidth: = 0;
fCurrentPos: = 0;
Ende;
//----------------------------------------------------------------------
Destruktor TPCXFile.Destroy;
BEGIN
SetLength(fPCXData.fData,0);
geerbte Destroy;
Ende;
//----------------------------------------------------------------------
Procedure TPCXFile.LoadFromFile (const Filename: String);
Var
fPCXStream: TFileStream;
BEGIN
fPCXStream: = TFileStream.Create(Filename,fmOpenRead);
Versuchen Sie
fPCXStream.Position: = 0;
LoadFromStream(fPCXStream);
Schließlich
fPCXStream.Free;
Ende;
Ende;
//----------------------------------------------------------------------
Procedure TPCXFile.SaveToFile (const Filename: String);
Var
fPCXStream: TFileStream;
BEGIN
fPCXStream: = TFileStream.Create(Filename,fmCreate);
Versuchen Sie
fPCXStream.Position: = 0;
SaveToStream(fPCXStream);
Schließlich
fPCXStream.Free;
Ende;
Ende;
//----------------------------------------------------------------------
Prozedur TPCXFile.LoadFromStream(Stream: TStream);
Var
fFileLength: Kardinal;
Ich: Integer;
BEGIN
Read-PCX-header
Stream.Read(fPCXHeader,SizeOf(fPCXHeader));
Prüfen Sie die ID-byte
Wenn fPCXHeader.fID <> $0A dann
Exception.Create(FORMAT_ERROR) zu erhöhen;
PCX Version Byte zu überprüfen
// ======================
Versionbyte = 0 = > PC PaintBrush v2. 5
Versionbyte = 2 = > PC Paintbrush v2. 8 mit Paletteninformationen
Versionbyte = 3 = > PC Paintbrush v2. 8 ohne Paletteninformationen
Versionbyte = 4 = > PC Paintbrush für Windows
Versionbyte = 5 = > PC Paintbrush V3 und oben und PC Paintbrush Plus
Unterstützung von 24-Bit-Bilder
Wenn dann fPCXHeader.fVersion <> 5
Exception.Create(VERSION_ERROR) zu erhöhen;
fWidth: = fPCXHeader.fWindow.wRight - fPCXHeader.fWindow.wLeft + 1;
Wenn fWidth < 0 dann
Exception.Create(WIDTH_OUT_OF_RANGE) zu erhöhen;
fHeight: = fPCXHeader.fWindow.wBottom - fPCXHeader.fWindow.wTop + 1;
Wenn fHeight < 0 dann
Exception.Create(HEIGHT_OUT_OF_RANGE) zu erhöhen;
Wenn fWidth > fMaxImageWidth dann
Exception.Create(IMAGE_WIDTH_TOO_LARGE) zu erhöhen;
fColorDepth: = 1 Shl (fPCXHeader.fPlanes * fPCXHeader.fBitsPerPixel);
Die folgenden Zeilen sind nicht getestet!!!
Wenn fColorDepth < = 16 dann
Für I: = 0 to fColorDepth - 1
BEGIN
Wenn 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;
Ende
sonst
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;
Ende;
Ende;
fFileLength: = Stream.Size - Stream.Position;
SetLength(fPCXData.fData,fFileLength);
Wenn fFileLength > fMaxDataFileLength dann
Exception.Create(INPUT_FILE_TOO_LARGE) zu erhöhen;
Stream.Read(fPCXData.fData[0],fFileLength);
{
Wenn fColorDepth = 256 then
BEGIN
Stream.Read(fPCXPalette,SizeOf(fPCXPalette));
Wenn fPCXPalette.fSignature <> $0 C dann
Exception.Create(PALETTE_ERROR) zu erhöhen;
Ende;
}
Ende;
//----------------------------------------------------------------------
Prozedur TPCXFile.SaveToStream(Stream: TStream);
BEGIN
Stream.Write(fPCXHeader,SizeOf(fPCXHeader));
Stream.Write(fPCXData.fData[0],fCurrentPos);
Ende;
//----------------------------------------------------------------------
Initialisierung
TPicture.RegisterFileFormat ('PCX', 'PC PaintBrush-Bitmap', TPCXImage);
//----------------------------------------------------------------------
Finalisierung
TPicture.UnRegisterGraphicClass(TPCXImage);
//----------------------------------------------------------------------
Ende.
//======================================================================