Import /eksport PCX henhold Delphi (5.0) //////////////////////////////////////////////////////////////////////////////TPCXImage ////======= == ////////fullført: 10. august 2001 ////Forfatter: M. de Haan ////E-post: [email protected] ////Testet: Under W95 SP1 ////Versjon: 1.0 ////---------------------------------------- -------------------------- ////Oppdatering: den 14 august 2001 til versjon 1.1 ////Reason: Lagt versjonskontroll ////Lagt kommentar info på versjon ////Endret PCX header ID sjekk ////----------------------------- ------------------------------------- ////Oppdatering: den 19 august 2001 til versjon 2.0 ////Årsak: Advarsel fra Delphi om bruk av abstrakte metoder, ////forårsaket av ikke gjennomføre ALL TGraphic metoder ////(Takk går til RP Sterkenburg for hans diagnose) ////Lagt: SaveToClipboardFormat ////LoadFromClipboardFormat ////GetEmpty ////--------------------------------------- --------------------------- ////Oppdatering: den 13 oktober 2001 til versjon 2.1 ////Grunn: merkelig feil, lesefeil, EExternalException, IDE ////hengende, Delphi hengende, Debugger henge, vinduer ////hengende, tastatur låst, og så videre ////Endret: Tildele prosedyre ////------- -------------------------------------------------- --------- ////////PCX bildefil format er kopibeskyttet av: ////ZSoft, PC Paintbrush, PC Paintbrush pluss ////Varemerker: NA ////Royalty avgifter: INGEN ////////Forfatteren kan ikke holdes ansvarlig for bruk av denne programvaren ////////Kjente problemer ////------------ ////1. Kun testet med PCX bilder versjon 3.0 (1991) ////(24 bit bilder støtte) ////////2. Ingen palett støtte ////////3. Ukomprimert filer er støttes ikke ////////4. AssignTo er IKKE testet ////////5. GetEmpty er IKKE testet ////////6. SaveToClipboardFormat er IKKE testet ////////7. LoadFromClipboardFormat er IKKE testet ////////8. Bildet vil ALLTID bli lagret som en 24 bit pcx bilde //////////////////////////////////////////////////////////////////////////////Unit PCXImage; InterfaceUses Windows, SysUtils, klasser, grafikk, Const WIDTH_OUT_OF_RANGE = 'Ulovlig bredde oppføring i PCX fil header'; HEIGHT_OUT_OF_RANGE = 'Ulovlig høyde oppføring i PCX fil header'; FILE_FORMAT_ERROR = 'Ugyldig filformat'; VERSION_ERROR = 'Only PC Paintbrush (pluss) V3.0 og høyere' + 'støttes'; FORMAT_ERROR = 'Ulovlig identifikasjon byte i PCX fil' + 'header'; PALETTE_ERROR = 'Ugyldig palett funnet'; ASSIGN_ERROR = 'kan bare tilordne et TBitmap eller en tBildeinnstilling'; ASSIGNTO_ERROR = 'Kan bare AssignTo en TBitmap'; PCXIMAGE_EMPTY = 'The PCX bildet er tomt'; BITMAP_EMPTY = 'Den bitmap er tomt'; INPUT_FILE_TOO_LARGE = 'The input filen er for stor til å bli lest'; IMAGE_WIDTH_TOO_LARGE = 'Bredde på PCX bildet for stor til å håndtere'; //Lagt 19/08/2001 CLIPBOARD_LOAD_ERROR = 'Loading fra utklippstavlen mislyktes'; //Lagt 19/08/2001 CLIPBOARD_SAVE_ERROR = 'Saving til utklippstavle mislyktes'; //Lagt 14/10/2001 PCX_WIDTH_ERROR = 'Uventet linjebredde i PCX data'; PCX_HEIGHT_ERROR = 'Flere PCX data funnet enn forventet'; PCXIMAGE_TOO_LARGE = 'PCX bildet for stor'; //lagt 19/08 /2001Var CF_PCX: Word; //////////////////////////////////////////////////////////////////////////////PCXHeader //////////////////////////////////////////////////////////////////////////////Type ColorRecord = pakket Record R, G, B: Byte; Slutt; //Av registreringstype TPCXImageHeader = pakket Record FID: Byte; fVersion: Byte; fCompressed: Byte; fBitsPerPixel: Byte; fWindow: pakket Record wLeft, wTop, Wright, wBottom: WORD; Slutt; //Av Pakket Record fHorzResolution: WORD; fVertResolution: WORD; fColorMap: Array [0..15] av ColorRecord; fReserved: Byte; fPlanes: Byte; fBytesPerLine: WORD; fPaletteInfo: WORD; fFiller: Array [0..57] av Byte; Slutt; //Av Pakket Record //////////////////////////////////////////////////////////////////////////////PCXData ////////////////////////////////////////////////////////////////////////////////Const //fMaxDataFileLength = $ 7FFFFF; //Max filelength 8,3 MbyteType TPCXData = Object //fData: Array [0..fMaxDataFileLength] av Byte; fData: Array of Byte; Slutt;//////////////////////////////////////////////////////////////////////////////Scanline //////////////////////////////////////////////////////////////////////////////Const fMaxScanLineLength = $ FFF; //Max bildebredde: 4096 pixelsType mByteArray = Array [0..fMaxScanLineLength] av Byte; pmByteArray = ^ mByteArray; //Den "standard" pByteArray tildeler 32768 bytes, //som er litt overdrevet her, tror jeg ... Const fMaxImageWidth = $ FFF; //Max bildebredde: 4096 pixelsType xByteArray = Array [0..fMaxImageWidth] av Byte; //////////////////////////////////////////////////////////////////////////////PCXPalette //////////////////////////////////////////////////////////////////////////////Type fColorEntry = pakket Record R, G, B: Byte; Slutt; //Av pakket registreringstype TPCXPalette = pakket Record fSignature: Byte; fPalette: Array [0..255] av fColorEntry; Slutt; //Av pakket Record //////////////////////////////////////////////////////////////////////////////Klasser //////////////////////////////////////////////////////////////////////////////Type TPCXImage = klasse; TPCXFile = Klasse; //////////////////////////////////////////////////////////////////////////////PCXFile ////////Fil handler //////////////////////////////////////////////////////////////////////////////TPCXFile = Class (TPersistent) Privat fHeight: Integer; fWidth: Integer; fPCXHeader: TPCXImageHeader; fPCXData: TPCXData; fPCXPalette: TPCXPalette; fColorDepth: Cardinal; fCurrentPos: Cardinal; Beskyttet {Beskyttede erklæringer} Offentlig {offentlige erklæringer} konstruktør Opprett; destructor Destroy; styre; Prosedyre LoadFromFile (Const Name: String); Prosedyre LoadFromStream (Stream: TStream); Prosedyre SaveToFile (Const Name: String); Prosedyre SaveToStream (Stream: TStream); Publisert {Publisert erklæringer} {Publiserings er gjort i TPCXImage delen} End; //////////////////////////////////////////////////////////////////////////////TPCXImage ////////Bilde handler //////////////////////////////////////////////////////////////////////////////TPCXImage = klasse (TGraphic) Private {felleserklæringer} fBitmap: TBitmap; fPCXFile: TPCXFile; fRLine, fGLine, fBLine: xByteArray; FP: pmByteArray; Prosedyre ConvertPCXDataToImage; Prosedyre ConvertImageToPCXData; Prosedyre FillDataLines (Const fLine: Array of Byte); Prosedyre CreatePCXHeader; //Prosedyre ProcessLine (Var fLine: Array of Byte, Const W: Cardinal); Beskyttede {beskyttede erklæringer} Prosedyre Draw (ACanvas: TCanvas; Const rect: TRect); styre; Funksjon GetHeight: Integer; styre; Funksjon GetWidth: Integer; styre; Prosedyre SetHeight (Verdi: Integer); styre; Prosedyre SetWidth (Verdi: Integer); styre; Funksjon GetEmpty: Boolean; styre; Offentlige {offentlige erklæringer} //Prosedyre Draw (ACanvas: TCanvas; Const rect: TRect); styre; konstruktør Opprett; styre; destructor Destroy; styre; Prosedyre Assign (Kilde: TPersistent); styre; Prosedyre AssignTo (Mål: TPersistent); styre; Prosedyre LoadFromFile (konst Name: String); styre; Prosedyre LoadFromStream (Stream: TStream); styre; Prosedyre SaveToFile (konst Name: String); styre; Prosedyre SaveToStream (Stream: TStream); styre; Prosedyre LoadFromClipboardFormat (AFormat: Word, ADATA: THandle; APalette: HPALETTE); styre; Prosedyre SaveToClipboardFormat (Var AFormat: Word; Var Adata: THandle; Var APalette: HPALETTE); styre; Publisert {Publisert erklæringer} Eiendom Høyde: Integer lese GetHeight skrive SetHeight; Eiendom Bredde: Integer lese GetWidth skrive SetWidth;End;Implementation//////////////////////////////////////////////////////////////////////////////TPCXImage ////////Bilde handler //////////////////////////////////////////////////////////////////////////////konstruktør TPCXImage.Create; Begininherited Lag; Hvis ikke Assigned (fBitmap) da fBitmap: = TBitmap.Create; Hvis ikke Assigned (fPCXFile) da fPCXFile: = TPCXFile.Create;End;//----------------------------------------------------------------------destructor TPCXImage.Destroy; BeginfPCXFile.Free; fBitmap.Free; //Omvendt rekkefølge av skape //SetLength (fRLine, 0); //Setlength (fGLine, 0); //SetLength (fBLine, 0); arvet Destroy, End; //---------- -------------------------------------------------- ---------- Prosedyre TPCXImage.SetHeight (Verdi: Integer); BeginIf Value > = 0, så fBitmap.Height: = verdi; End; //------------ -------------------------------------------------- -------- Prosedyre TPCXImage.SetWidth (Verdi: Integer); BeginIf Value > = 0, så fBitmap.Width: = verdi; End; //-------------- -------------------------------------------------- ------ Funksjon TPCXImage.GetHeight: Integer; BeginResult: = fPCXFile.fHeight;End;//----------------------------------------------------------------------Function TPCXImage.GetWidth: Integer; BeginResult: = fPCXFile.fWidth; End; //--------------------------------- ----------------------------------- ////Studiepoengene for denne prosedyren gå til sitt arbeid for TGIFImage av ////Reinier P. Sterkenburg ////IKKE TESTET! ////Lagt 19/08/2001 ////------------------------------------ -------------------------------- //Prosedyre TPCXImage.LoadFromClipboardFormat (AFormat: Word, ADATA: THandle; APalette: HPALETTE ); Var Størrelse: Integer; Buf: Pointer; Stream: TMemoryStream; BMP: TBitmap; BeginIf (Adata = 0) så Adata: = GetClipBoardData (AFormat); Hvis (Adata < > 0) og (AFormat = CF_PCX) da Begin Størrelse: = GlobalSize (Adata); Buf: = GlobalLock (Adata); Prøv Stream: = TMemoryStream.Create; Prøv Stream.SetSize (Size); Move (BUF ^, Stream.Memory ^, Size); Self.LoadFromStream (Stream); endelig Stream.Free; Slutt; endelig GlobalUnlock (Adata); Slutt; Endelse Hvis (Adata < > 0) og (AFormat = CF_BITMAP) da Begin BMP: = TBitmap.Create; Prøv BMP.LoadFromClipboardFormat (AFormat, ADATA, APalette); Self.Assign (BMP); endelig BMP.Free; Slutt; Avslutt annet Hev Exception.Create(CLIPBOARD_LOAD_ERROR);End;//--------------------------------------------------------------------////Studiepoeng for denne prosedyren gå til sitt arbeid TGIFImage av ////Reinier P. Sterkenburg ////IKKE TESTET! ////Lagt 19/08/2001 ////------------------------------------ -------------------------------- //Prosedyre TPCXImage.SaveToClipboardFormat (Var AFormat: Word; Var Adata: THandle; Var APalette: HPALETTE); Var Stream: TMemoryStream; Data: THandle; Buf: Pointer; BeginIf Empty deretter Exit; //Først lagre bitmap til clipboardfBitmap.SaveToClipboardFormat (AFormat, ADATA, APalette); //Deretter prøver å redde PCXStream: = TMemoryStream.Create, prøv SaveToStream (Stream); Stream.Position: = 0; Data: = GlobalAlloc (HeapAllocFlags, Stream.Size); prøv Hvis data < > 0 da Begynn Buf: = GlobalLock (Data); prøv Move (Stream.Memory ^, Buf ^, Stream.Size); endelig GlobalUnlock (Data); Slutt; Hvis SetClipBoardData (CF_PCX, data) = 0, så Raise Exception.Create (CLIPBOARD_SAVE_ERROR); Slutt; bortsett GlobalFree (Data); heve; Slutt; endelig Stream.Free; Ende; End; //-------------------------------------------- ------------------------ ////IKKE TESTET! ////Lagt 19/08/2001 ////------------------------------------ -------------------------------- //Funksjon TPCXImage.GetEmpty: Boolean; BeginIf Assigned (fBitmap) da Resultat: = fBitmap.Emptyelse Resultat: = (fPCXFile.fHeight = 0) eller (fPCXFile.fWidth = 0); End; //------------------------ ---------------------------------------------- Prosedyre TPCXImage.SaveToFile (konst Name: String); Var fPCX: TFileStream; BeginIf (fBitmap.Width = 0) eller (fBitmap.Height = 0) så Raise Exception.Create (BITMAP_EMPTY); CreatePCXHeader; ConvertImageToPCXData; fPCX: = TFileStream.Create (filnavn, fmCreate); Prøv fPCX.Position: = 0; SaveToStream (fPCX), og endelig fPCX.Free; End;SetLength(fPCXFile.fPCXData.fData,0);End;//--------------------------------------------------------------------////IKKE TESTET! ////---------------------------------------------- ---------------------- //Prosedyre TPCXImage.AssignTo (Mål: TPersistent); Var bAssignToError: Boolean; BeginbAssignToError: = True; Hvis Dest er TBitmap da Begin (destin som TBitmap) .Assign (fBitmap); bAssignToError: = False; End; Hvis Dest er tBildeinnstilling da Begin (destin som tBildeinnstilling) .Graphic.Assign (fBitmap); bAssignToError: = False; End; Hvis bAssignToError deretter Raise Exception.Create (ASSIGNTO_ERROR); //Du kan skrive andre oppgaver her ... End; //---------------------- ---------------------------------------------- //Prosedyre TPCXImage .Assign (Kilde: TPersistent); Var iX, iY: Integer; bAssignError: Boolean; BeginbAssignError: = true; Hvis (Kilde er TBitmap) da Begin fBitmap.Assign (Kilde som TBitmap); bAssignError: = False; Enden, hvis (Kilde er tBildeinnstilling) da Begin iX: = (Kilde som tBildeinnstilling) .Width; iY: = (Kilde som tBildeinnstilling) .Height; fBitmap.Width: = iX; fBitmap.Height: = iY; fBitmap.Canvas.Draw (0,0, (Kilde som tBildeinnstilling) .Graphic); bAssignError: = False; Slutten; //Du kan skrive andre oppgaver her ... Hvis bAssignError deretter Raise Exception.Create(ASSIGN_ERROR);End;//----------------------------------------------------------------------Procedure TPCXImage.Draw (ACanvas: TCanvas; konst rect: TRect); Begynn //ACanvas.Draw (0,0, fBitmap); //FasterACanvas.StretchDraw (Rect, fBitmap); //SlowerEnd; //-------------------------------------------- -------------------------- Prosedyre TPCXImage.LoadFromFile (konst Name: String);BeginfPCXFile.LoadFromFile(Filename);ConvertPCXDataToImage;End;//----------------------------------------------------------------------Procedure TPCXImage.SaveToStream (Stream: TStream);BeginfPCXFile.SaveToStream(Stream);End;//----------------------------------------------------------------------Procedure TPCXImage.LoadFromStream (Stream: TStream);BeginfPCXFile.LoadFromStream(Stream);End;//--------------------------------------------------------------------////Kalt av RLE kompressor ////------------------------------------------ -------------------------- //Prosedyre TPCXImage.FillDataLines (Const fLine: Array of Byte); Var Av: Byte; teller: WORD; I: Cardinal; W: Cardinal, BeginI: = 0; Av: = fLine [0]; teller: = $ C1; W: = fBitmap.Width; Gjenta Inc (I), If By = fLine [I] deretter Begynn Inc (teller); Hvis CNT = $ 100 da begynne fPCXFile.fPCXData.fData [fPCXFile.fCurrentPos]: = Byte (Pred (teller)); Inc (fPCXFile.fCurrentPos); fPCXFile.fPCXData.fData [fPCXFile.fCurrentPos]: = Av; Inc (fPCXFile.fCurrentPos); teller: = $ C1; Av: = fLine [I]; End, End; Hvis (By < > fLine [I]) så begynner Hvis (teller = $ C1) så begynner Hvis (By < $ C1) så Begynn fPCXFile.fPCXData.fData [fPCXFile.fCurrentPos]: = By, Inc (fPCXFile.fCurrentPos); End annet Begynn fPCXFile.fPCXData.fData [fPCXFile.fCurrentPos]: = Byte (teller); Inc (fPCXFile.fCurrentPos); fPCXFile.fPCXData.fData [fPCXFile.fCurrentPos]: = By; Inc (fPCXFile.fCurrentPos); Slutt; Avslutt annet Begynn fPCXFile.fPCXData.fData [fPCXFile.fCurrentPos]: = Byte (teller); Inc (fPCXFile.fCurrentPos); fPCXFile.fPCXData.fData [fPCXFile.fCurrentPos]: = By; Inc (fPCXFile.fCurrentPos); Slutt; Cnt: = $ C1; Av: = fLine [I]; Slutten; Inntil jeg = W - 1; //Skriv den siste byte (s) Hvis (teller > $ C1) så Begynn fPCXFile.fPCXData.fData [fPCXFile.fCurrentPos]: = Byte (teller); Inc (fPCXFile.fCurrentPos); Enden, hvis (teller = $ C1) og (By > $ C0) så Begynn fPCXFile.fPCXData.fData [fPCXFile.fCurrentPos]: = Byte (teller); Inc (fPCXFile.fCurrentPos); Enden, fPCXFile.fPCXData.fData [fPCXFile.fCurrentPos]: = By, Inc (fPCXFile.fCurrentPos); //Hvis fPCXFile.fCurrentPos > fMaxDataFileLength deretter //Raise Exception.Create(PCXIMAGE_TOO_LARGE);End;//--------------------------------------------------------------------////RLE-komprimering algoritmen ////------------------------------------------- ------------------------- //Prosedyre TPCXImage.ConvertImageToPCXData; Var H, W: Cardinal; X, Y: Cardinal; I: Cardinal, BeginH: = fBitmap.Height; W: = fBitmap.Width; fPCXFile.fCurrentPos: = 0; SetLength (fPCXFile.fPCXData.fData, 6 * H * W); //For å være sikker //SetLength (fRLine, W); //SetLength (fGLine, W); //SetLength (fBLine, W); fBitmap.PixelFormat: = pf24bit; //Gjør dette hvis du bruker Scanline For Y: = 0 til H - en trenger Begynn FP: = fBitmap.ScanLine [Y]; I: = 0; For X: = 0 til W - en trenger Begynn fRLine [X]: = FP [I]; Inc (I); //Pakk en rød linje fGLine [X]: = FP [I]; Inc (I); //Pakk en grønn linje fBLine [X]: = FP [I]; Inc (I); //Pakk en blå linje End; FillDataLines (fBLine); //Komprimere den blå linjen FillDataLines (fGLine); //Komprimere den grønne linjen FillDataLines (fRLine); //Komprimere den røde linjen End; //Rett lengde fPCXData.fDataSetLength(fPCXFile.fPCXData.fData,fPCXFile.fCurrentPos);End;//----------------------------------------------------------------------(*Procedure TPCXImage.ProcessLine (Var fLine: Array of Byte, Const W: Cardinal); Var teller: Integer; J, K: Cardinal; Av: Byte; BeginJ: = 0; Gjenta etter: = fPCXFile.fPCXData.fData [fPCXFile.fCurrentPos]; Inc (fPCXFile.fCurrentPos); //Én byte If By < $ C1 så Begynn fLine [J]: = By; Inc (J); Slutt; //Flere bytes (RLE) Hvis ved > $ C0 deretter Begynn teller: = By - $ C0; Av: = fPCXFile.fPCXData.fData [fPCXFile.fCurrentPos]; Inc (fPCXFile.fCurrentPos); For K: = 1 til teller vet Begynn fLine [J]: = By; Inc (J); Slutt; Slutten; Inntil J > = W; ende; *) //----------------------------------- --------------------------------- ////RLE dekompresjon algoritme ////------ -------------------------------------------------- ------------ //Prosedyre TPCXImage.ConvertPCXDataToImage; Var I, J: Cardinal; Av: Byte; Cnt: Byte; H, W: Cardinal; Y: Cardinal; K, L: Cardinal, BeginH: = fPCXFile.fPCXHeader.fWindow.wBottom - fPCXFile.fPCXHeader.fWindow.wTop + 1; W: = fPCXFile.fPCXHeader.fWindow.wRight - fPCXFile.fPCXHeader.fWindow.wLeft + 1; //SetLength (fRLine, W); //Juster linjelengde //SetLength (fGLine, W); //Juster linjelengde //SetLength (fBLine, W); //Juster linje lang: = 0; //Første linje av imagefBitmap.Width: = W; //Set bitmap widthfBitmap.Height: = H; //Sett bitmap heightfBitmap.PixelFormat: = pf24bit; //Gjør dette hvis du bruker Scanline I: = 0;! //Peker til data byte av fPXCFileRepeat //Process den røde linjen //ProcessLine (fRLine, W); J: = 0; //Peker til stilling i Rød /Grønn /Blå linje Gjenta Av: = fPCXFile.fPCXData.fData [I]; Inc (I); //Én byte If By < $ C1 så Begynn fRLine [J]: = By; Inc (J); Slutt; //Flere bytes (RLE) Hvis ved > $ C0 deretter Begynn teller: = Av og $ 3F; Av: = fPCXFile.fPCXData.fData [I]; Inc (I); //FillChar (fRLine [J], teller, By); //Inc (J, teller); For K: = 1 til teller vet Begynn fRLine [J]: = By; Inc (J); Slutt; Slutt; Inntil J > = W; Hvis J > W deretter Raise Exception.Create (PCX_WIDTH_ERROR); //Process den grønne linjen //ProcessLine (fGLine, W); J: = 0; Gjenta Av: = fPCXFile.fPCXData.fData [I]; Inc (I); //Én byte If By < $ C1 så Begynn fGLine [J]: = By; Inc (J); Slutt; //Flere bytes (RLE) Hvis ved > $ C0 deretter Begynn teller: = Av og $ 3F; Av: = fPCXFile.fPCXData.fData [I]; Inc (I); //FillChar (fGLine [J], teller, By); //Inc (J, teller); For K: = 1 til teller vet Begynn fGLine [J]: = By; Inc (J); Slutt; Slutt; Inntil J > = W; Hvis J > W deretter Raise Exception.Create (PCX_WIDTH_ERROR); //Process den blå linjen //ProcessLine (fBLine, W); J: = 0; Gjenta Av: = fPCXFile.fPCXData.fData [I]; Inc (I); //Én byte If By < $ C1 så Begynn fBLine [J]: = By; Inc (J); Slutt; //Flere bytes (RLE) Hvis ved > $ C0 deretter Begynn teller: = Av og $ 3F; Av: = fPCXFile.fPCXData.fData [I]; Inc (I); //FillChar (fBLine [J], teller, By); //Inc (J, teller); For K: = 1 til teller vet Begynn fBLine [J]: = By; Inc (J); Slutt; Slutt; Inntil J > = W; Hvis J > W deretter Raise Exception.Create (PCX_WIDTH_ERROR); //Skriv de bare bearbeidede data RGB linjer til bitmap fp: = fBitmap.ScanLine [Y]; L: = 0; For K: = 0 til W - en trenger Begynn FP [L]: = fBLine [K]; Inc (L); FP [L]: = fGLine [K]; Inc (L); FP [L]: = fRLine [K]; Inc (L); Slutt; Inc (Y); //Prosess neste RGB linje //Hvis jeg > fMaxDataFileLength deretter //Raise Exception.Create (PCXIMAGE_TOO_LARGE); Inntil Y > = H; Hvis Y > H deretter Raise Exception.Create (PCX_HEIGHT_ERROR); //Ikke behov for dem alle moreSetLength (fPCXFile.fPCXData.fData, 0); //SetLength (fRLine, 0); //SetLength (fGLine, 0); //SetLength(fBLine,0);End;//----------------------------------------------------------------------Procedure TPCXImage.CreatePCXHeader; Var H, W, W1: WORD; BeginW: = fBitmap.Width; H = fBitmap.Height; //PCX headerfPCXFile.fPCXHeader.fID: = $ 0A; //BYTEfPCXFile.fPCXHeader.fVersion: = 5; //BYTEfPCXFile.fPCXHeader.fCompressed: = 1; //BYTE //1 = komprimert //0 = uncompressedfPCXFile.fPCXHeader.fBitsPerPixel: = 8; //BYTEfPCXFile.fPCXHeader.fWindow.wLeft: = 0; //WORDfPCXFile.fPCXHeader.fWindow.wTop: = 0; //WORDfPCXFile.fPCXHeader.fWindow.wRight: = W - 1; //WORDfPCXFile.fPCXHeader.fWindow.wBottom: = H - 1; //WORDfPCXFile.fPCXHeader.fHorzResolution: = 72; //WORDfPCXFile.fPCXHeader.fVertResolution: = 72; //WORDFillChar (fPCXFile.fPCXHeader.fColorMap, 48,0); //Array of ByteW1: = W; Hvis W og 1 = 1 da //er oddetall Inc (W1); //Deretter legge en, //må være jevn og rundet opp abovefPCXFile.fPCXHeader.fReserved: = 0; //BYTEfPCXFile.fPCXHeader.fPlanes: = 3; //BYTEfPCXFile.fPCXHeader.fBytesPerLine: = W1; //WORD //må være enda //avrundet abovefPCXFile.fPCXHeader.fPaletteInfo: = 1; //WORDFillChar (fPCXFile.fPCXHeader.fFiller, 58,0); //Array of ByteEnd;//======================================================================//////////////////////////////////////////////////////////////////////////////TPCXFile //////////////////////////////////////////////////////////////////////////////Constructor TPCXFile.Create; Begininherited Opprett; fHeight: = 0; fWidth: = 0; fCurrentPos: = 0; End; //---------------------------------------- ------------------------------ Destructor TPCXFile.Destroy; BeginSetLength (fPCXData.fData, 0); arvet Destroy, End; //------------------------------------------------- --------------------- Prosedyre TPCXFile.LoadFromFile (konst Name: String); Var fPCXStream: TFileStream; BeginfPCXStream: = TFileStream.Create (Filename, fmOpenRead); Prøv fPCXStream.Position: = 0; LoadFromStream (fPCXStream), og endelig fPCXStream.Free; Ende; End; //-------------------------------------------- -------------------------- Prosedyre TPCXFile.SaveToFile (konst Name: String); Var fPCXStream: TFileStream; BeginfPCXStream: = TFileStream.Create (Filename , fmCreate); Prøv fPCXStream.Position: = 0; SaveToStream (fPCXStream), og endelig fPCXStream.Free; Ende; End; //-------------------------------------------- -------------------------- Prosedyre TPCXFile.LoadFromStream (Stream: TStream); Var fFileLength: Cardinal; I: Integer; Begynn //Les PCX headerStream.Read (fPCXHeader, sizeof (fPCXHeader)); //Sjekk ID byteIf fPCXHeader.fID < > $ 0A deretter Raise Exception.Create (FORMAT_ERROR); //Sjekk PCX versjon byte //====================== //Versionbyte = 0 = > PC Paintbrush V2.5 //Versionbyte = 2 = > PC Paintbrush V2.8 med palett informasjon //Versionbyte = 3 = > PC Paintbrush V2.8 uten palett informasjon //Versionbyte = 4 = > PC Paintbrush for Windows //Versionbyte = 5 = > PC Paintbrush V3 og opp, og PC Paintbrush Plus //24 bits bilde supportIf fPCXHeader.fVersion < > 5 da Raise Exception.Create (VERSION_ERROR); fWidth: = fPCXHeader.fWindow.wRight - fPCXHeader.fWindow.wLeft + 1; Hvis fWidth < 0 da Raise Exception.Create (WIDTH_OUT_OF_RANGE); fHeight: = fPCXHeader.fWindow.wBottom - fPCXHeader.fWindow.wTop + 1; Hvis fHeight < 0 da Raise Exception.Create (HEIGHT_OUT_OF_RANGE); Hvis fWidth > fMaxImageWidth deretter heve Exception.Create (IMAGE_WIDTH_TOO_LARGE); fColorDepth: = 1 SHL (fPCXHeader.fPlanes * fPCXHeader.fBitsPerPixel); //Linjene følgende er IKKE testet !!! Hvis fColorDepth < = 16 da For jeg: = 0 til fColorDepth - en ikke begynner Hvis fPCXHeader.fVersion = 3 så Begynn 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; Avslutt annet Begynn fPCXPalette.fPalette [I] .R: = fPCXHeader.fColorMap [I] .R; fPCXPalette.fPalette [I] .G: = fPCXHeader.fColorMap [I] .G; fPCXPalette.fPalette [I] .B: = fPCXHeader.fColorMap [I] .B; Slutt; Enden, fFileLength: = Stream.Size - Stream.Position; SetLength (fPCXData.fData, fFileLength); //Hvis fFileLength > fMaxDataFileLength deretter //Raise Exception.Create (INPUT_FILE_TOO_LARGE); Stream.Read (fPCXData.fData [0], fFileLength) {Hvis fColorDepth = 256 da Begin Stream.Read (fPCXPalette, sizeof (fPCXPalette)); Hvis fPCXPalette.fSignature < > $ 0C deretter Raise Exception.Create (PALETTE_ERROR); Slutten;} ende; //------------------------------------------- --------------------------- Prosedyre TPCXFile.SaveToStream (Stream: TStream);BeginStream.Write(fPCXHeader,SizeOf(fPCXHeader));Stream.Write(fPCXData.fData[0],fCurrentPos);End;//----------------------------------------------------------------------Initialization TPicture.RegisterFileFormat ('PCX', 'PC Paintbrush bitmap',TPCXImage);//----------------------------------------------------------------------Finalization TPicture.UnRegisterGraphicClass(TPCXImage);//----------------------------------------------------------------------End.//======================================================================