Pcximage

Pcximage

Pcximage : Plusieurs milliers de conseils pour vous faciliter la vie.

Importer / exporter PCX sous Delphi (5.0)
////////////////////////////////////////////////////////////////////////
// //
// TPCXImage //
// ========= //
// //
// d'achevement: le 10 août 2001 //
// Auteur: M. de Haan //
// e-Mail: [email protected] //
// Teste: sous W95 SP1 //
// Version: 1.0 //
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
// mise a Jour: le 14 août 2001 a la version 1.1 //
// Raison: Ajout de la verification de la version du //
// Ajout de commentaire info sur la version //
// Change PCX en-tete de controle de l'ID //
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
// mise a Jour: le 19 août 2001 pour la version 2.0 //
// Motif: Avertissement de Delphes sur l'utilisation de methodes abstraites, //
// causes par la non mise en œuvre de TOUS les TGraphic methodes //
// (Grace a la R. P. Sterkenburg pour son diagnostic) //
// Ajoute le: SaveToClipboardFormat //
// LoadFromClipboardFormat //
// GetEmpty //
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
// mise a Jour: le 13 octobre 2001 a la version 2.1 //
// Motif: d'etranges erreurs, les erreurs de lecture, EExternalException, IDE //
// pendaison, Delphi, la pendaison, le Debogueur haning, windows //
// la pendaison, le clavier verrouille, et ainsi de suite //
// Modifie: Attribuer une procedure //
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
// //
// L'image PCX format de fichier est protege par copyright par: //
// ZSoft, PC Paintbrush, PC Paintbrush plus //
// les Marques: NA //
// Redevances: AUCUN //
// //
// L'auteur ne peut etre tenu responsable de l'utilisation de ce logiciel //
// //
// problemes Connus //
// & & & & & & //
// 1. Teste uniquement avec PCX images de la version 3.0 (1991) //
// (24 bits prise en charge des images) //
// //
// 2. Pas de palette de support /de /de
// //
// 3. Fichiers non compresses ne sont pas pris en charge //
// //
// 4. AssignTo n'est PAS teste //
// //
// 5. GetEmpty n'est PAS teste //
// //
// 6. SaveToClipboardFormat n'est PAS teste //
// //
// 7. LoadFromClipboardFormat n'est PAS teste //
// //
// 8. L'image sera TOUJOURS stocke en tant que 24 bits pour une image pcx //
// //
////////////////////////////////////////////////////////////////////////
Unite
& nbsp & nbsp & nbsp PCXImage
Interface

& nbsp & nbsp & nbsp Windows,
& nbsp & nbsp & nbsp SysUtils,
& nbsp & nbsp & nbsp Classes,
& nbsp & nbsp & nbsp Graphiques
Const
& nbsp & nbsp & nbsp WIDTH_OUT_OF_RANGE = 'Illegal de la largeur de l'entree dans le PCX en-tete du fichier'
& nbsp & nbsp & nbsp HEIGHT_OUT_OF_RANGE = 'Illegal hauteur de l'entree dans le PCX en-tete du fichier'
& nbsp & nbsp & nbsp FILE_FORMAT_ERROR = 'format de fichier non Valide'
& nbsp & nbsp & nbsp VERSION_ERROR = 'Seuls les PC Paintbrush (plus) V3.0 et superieur '
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! 'sont pris en charge'
& nbsp & nbsp & nbsp FORMAT_ERROR = 'Illegal d'identification de l'octet dans le fichier PCX'
& ! & ! & ! & ! & nbsp & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! 'en-tete'
& nbsp & nbsp & nbsp PALETTE_ERROR = 'non Valide palette trouve'
& nbsp & nbsp & nbsp ASSIGN_ERROR = 'ne Peut Attribuer un TBitmap ou un TPicture'
& nbsp & nbsp & nbsp ASSIGNTO_ERROR = 'Ne peut AssignTo un TBitmap'
& nbsp & nbsp & nbsp PCXIMAGE_EMPTY = 'L'image PCX est vide'
& nbsp & nbsp & nbsp BITMAP_EMPTY = 'Le bitmap est vide'
& nbsp & nbsp & nbsp INPUT_FILE_TOO_LARGE = 'Le fichier d'entree est trop grand pour etre lu'
& nbsp & nbsp & nbsp IMAGE_WIDTH_TOO_LARGE = 'Largeur de l'image PCX trop grande a gerer'
& nbsp & nbsp & nbsp // ajoute 19/08/2001
& nbsp & nbsp & nbsp CLIPBOARD_LOAD_ERROR = 'Chargement a partir du presse-papiers echoue'
& nbsp & nbsp & nbsp // ajoute le 19/08/2001
& nbsp & nbsp & nbsp CLIPBOARD_SAVE_ERROR = 'Economie dans le presse-papiers a echoue'
& nbsp & nbsp & nbsp // ajoutee 14/10/2001
& nbsp & nbsp & nbsp PCX_WIDTH_ERROR = 'Inattendue largeur de ligne en PCX de donnees'
& nbsp & nbsp & nbsp PCX_HEIGHT_ERROR = 'Plus PCX donnees que prevu'
& nbsp & nbsp & nbsp PCXIMAGE_TOO_LARGE = 'image PCX trop grand'
// ajoute le 19/08/2001
Var
& nbsp & nbsp & nbsp CF_PCX : Mot
////////////////////////////////////////////////////////////////////////
// //
// PCXHeader //
// //
////////////////////////////////////////////////////////////////////////
Type
& nbsp & nbsp & nbsp ColorRecord = paniers Enregistrement
& ! & ! & ! & ! & ! & nbsp R,G,B : Byte
& nbsp & nbsp & nbsp Fin // d'Enregistrement
Type
& nbsp & nbsp & nbsp TPCXImageHeader = paniers Enregistrement
& ! & ! & ! & ! & ! & nbsp fID : Octet
& ! & ! & ! & ! & ! & nbsp fVersion : Octet
& ! & ! & ! & ! & ! & nbsp fCompressed : Byte
& ! & ! & ! & ! & ! & nbsp fBitsPerPixel : Octet
& ! & ! & ! & ! & ! & nbsp fWindow : emballe Enregistrement
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp wLeft,
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp wTop,
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp wRight,
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp wBottom : MOT
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Fin // de Paniers Enregistrement
& ! & ! & ! & ! & ! & nbsp fHorzResolution : MOT
& ! & ! & ! & ! & ! & nbsp fVertResolution : MOT
& ! & ! & ! & ! & ! & nbsp fColorMap : Array[0..15] de ColorRecord
& ! & ! & ! & ! & ! & nbsp fReserved : Octet
& ! & ! & ! & ! & ! & nbsp fPlanes : Byte
& ! & ! & ! & ! & ! & nbsp fBytesPerLine : MOT
& ! & ! & ! & ! & ! & nbsp fPaletteInfo : MOT
& ! & ! & ! & ! & ! & nbsp fFiller : Array[0..57] of Byte
& ! & ! & ! & ! & ! & nbsp Fin // de Paniers Enregistrement
////////////////////////////////////////////////////////////////////////
// //
// PCXData //
// //
////////////////////////////////////////////////////////////////////////
// Const
// fMaxDataFileLength = $7FFFFF // Max filelength 8,3 Mo
Type
& nbsp & nbsp & nbsp TPCXData = Objet
& ! & ! & ! & ! & ! & nbsp // fData : Array[0..fMaxDataFileLength] of Byte
& ! & ! & ! & ! & ! & nbsp fData : Tableau de Byte
& nbsp & nbsp & nbsp Fin
////////////////////////////////////////////////////////////////////////
// //
// ScanLine //
// //
////////////////////////////////////////////////////////////////////////
Const
& nbsp & nbsp & nbsp fMaxScanLineLength = $FFF // Max largeur de l'image: 4096 pixels
Type
& nbsp & nbsp & nbsp mByteArray = Array[0..fMaxScanLineLength] of Byte
& nbsp & nbsp & nbsp pmByteArray = ^mByteArray
// Le 'standard' pByteArray alloue 32768 octets,
// qui est un peu exagere ici, Je pense...
Const
& nbsp & nbsp & nbsp fMaxImageWidth = $FFF // Max largeur de l'image: 4096 pixels
Type
& nbsp & nbsp & nbsp xByteArray = Array[0..fMaxImageWidth] of Byte
////////////////////////////////////////////////////////////////////////
// //
// PCXPalette //
// //
////////////////////////////////////////////////////////////////////////
Type
& nbsp & nbsp & nbsp fColorEntry = paniers Enregistrement
& ! & ! & ! & ! & ! & nbsp R,G,B : Byte
& nbsp & nbsp & nbsp Fin // de paniers Enregistrement
Type
& nbsp & nbsp & nbsp TPCXPalette = paniers Enregistrement
& ! & ! & ! & ! & ! & nbsp fSignature : Octet
& ! & ! & ! & ! & ! & nbsp fPalette : Array[0..255] de fColorEntry
& nbsp & nbsp & nbsp Fin // de paniers Enregistrement
////////////////////////////////////////////////////////////////////////
// //
// les Classes //
// //
////////////////////////////////////////////////////////////////////////
Type
& nbsp & nbsp & nbsp TPCXImage = Classe
& nbsp & nbsp & nbsp TPCXFile = Classe
////////////////////////////////////////////////////////////////////////
// //
// PCXFile //
// //
// gestionnaire de Fichier //
// //
////////////////////////////////////////////////////////////////////////
TPCXFile = Classe(TPersistent)
& nbsp & nbsp & nbsp Prive
& ! & ! & ! & ! & ! & nbsp fHeight : Integer
& ! & ! & ! & ! & ! & nbsp fWidth : Entier
& ! & ! & ! & ! & ! & nbsp fPCXHeader : TPCXImageHeader
& ! & ! & ! & ! & ! & nbsp fPCXData : TPCXData
& ! & ! & ! & ! & ! & nbsp fPCXPalette : TPCXPalette
& ! & ! & ! & ! & ! & nbsp fColorDepth : le Cardinal
& ! & ! & ! & ! & ! & nbsp fCurrentPos : Le Cardinal
& nbsp & nbsp & nbsp Protege
& ! & ! & ! & ! & ! & nbsp { declarations Protegees }
& nbsp & nbsp & nbsp Public
& ! & ! & ! & ! & ! & nbsp { declarations Publiques }
& ! & ! & ! & ! & ! & nbsp constructeur Creer
& ! & ! & ! & ! & ! & nbsp destructeur de Detruire remplacer
& ! & ! & ! & ! & ! & nbsp Procedure LoadFromFile(Const Filename : String)
& ! & ! & ! & ! & ! & nbsp Procedure LoadFromStream(Stream : TStream)
& ! & ! & ! & ! & ! & nbsp Procedure SaveToFile(Const Filename : String)
& ! & ! & ! & ! & ! & nbsp Procedure SaveToStream(Stream : TStream)
& nbsp & nbsp & nbsp Publie
& ! & ! & ! & ! & ! & nbsp { Publie des declarations }
& ! & ! & ! & ! & nbsp - nbsp { La publication se fait dans le TPCXImage section }
Fin
////////////////////////////////////////////////////////////////////////
// //
// TPCXImage //
// //
// Image de gestionnaire //
// //
////////////////////////////////////////////////////////////////////////
TPCXImage = classe(TGraphic)
& nbsp & nbsp & nbsp Prive
& ! & ! & ! & ! & ! & nbsp { Private declarations }
& ! & ! & ! & ! & ! & nbsp fBitmap : TBitmap
& ! & ! & ! & ! & ! & nbsp fPCXFile : TPCXFile
& ! & ! & ! & ! & ! & nbsp fRLine,fGLine,fBLine : xByteArray
& ! & ! & ! & ! & ! & nbsp fP : pmByteArray
& ! & ! & ! & ! & ! & nbsp Procedure ConvertPCXDataToImage
& ! & ! & ! & ! & ! & nbsp Procedure ConvertImageToPCXData
& ! & ! & ! & ! & ! & nbsp Procedure FillDataLines(Const fLine : Tableau de Byte)
& ! & ! & ! & ! & ! & nbsp Procedure CreatePCXHeader
& ! & ! & ! & ! & ! & nbsp // Procedure ProcessLine(Var fLine : Tableau de Byte Const W : le Cardinal)
& nbsp & nbsp & nbsp Protege
& ! & ! & ! & ! & ! & nbsp { declarations Protegees }
& ! & ! & ! & ! & ! & nbsp Procedure de Tirage au sort(ACanvas : TCanvas Const Rect : TRect) remplacer
& ! & ! & ! & ! & ! & nbsp Fonction GetHeight : Integer remplacer
& ! & ! & ! & ! & ! & nbsp Fonction GetWidth : Integer remplacer
& ! & ! & ! & ! & ! & nbsp Procedure SetHeight(Valeur : Entier) remplacer
& ! & ! & ! & ! & ! & nbsp Procedure SetWidth(Valeur : Entier) remplacer
& ! & ! & ! & ! & ! & nbsp Fonction GetEmpty : Boolean remplacer
& nbsp & nbsp & nbsp Public
& ! & ! & ! & ! & ! & nbsp { declarations Publiques }
& ! & ! & ! & ! & ! & nbsp // Procedure de Tirage au sort(ACanvas : TCanvas Const Rect : TRect) remplacer
& ! & ! & ! & ! & ! & nbsp constructeur de substitution de Creer
& ! & ! & ! & ! & ! & nbsp destructeur de Detruire remplacer
& ! & ! & ! & ! & ! & nbsp Procedure de Ceder(Source : TPersistent) remplacer
& ! & ! & ! & ! & ! & nbsp Procedure AssignTo(Dest : TPersistent) remplacer
& ! & ! & ! & ! & ! & nbsp Procedure LoadFromFile(const Filename : String) remplacer
& ! & ! & ! & ! & ! & nbsp Procedure LoadFromStream(Stream : TStream) remplacer
& ! & ! & ! & ! & ! & nbsp Procedure SaveToFile(const Filename : String) remplacer
& ! & ! & ! & ! & ! & nbsp Procedure SaveToStream(Stream : TStream) remplacer
& ! & ! & ! & ! & ! & nbsp Procedure LoadFromClipboardFormat(AFormat : Mot de AData : THandle
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp APalette : HPALETTE) remplacer
& ! & ! & ! & ! & ! & nbsp Procedure SaveToClipboardFormat(Var AFormat : Mot
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Var AData : THandle Var APalette : HPALETTE) remplacer

& nbsp & nbsp & nbsp Publie
& ! & ! & ! & ! & ! & nbsp { Publie des declarations }
& ! & ! & ! & ! & ! & nbsp Propriete de la Hauteur : Entier
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp lire GetHeight ecrire SetHeight
& ! & ! & ! & ! & ! & nbsp Propriete Width : Integer
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp lire GetWidth ecrire SetWidth
Fin
Application
////////////////////////////////////////////////////////////////////////
// //
// TPCXImage //
// //
// Image de gestionnaire //
// //
////////////////////////////////////////////////////////////////////////
constructeur TPCXImage.Creer
Begin
herite de Creer
Si non Affecte(fBitmap)
& nbsp & nbsp & nbsp fBitmap := TBitmap.Creer
Si non Affecte(fPCXFile)
& nbsp & nbsp & nbsp fPCXFile := TPCXFile.Creer
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & &
destructeur TPCXImage.Detruire
Begin
fPCXFile.Gratuit
fBitmap.Gratuit // Inversee afin de creer
//SetLength(fRLine,0)
//Setlength(fGLine,0)
//SetLength(fBLine,0)
herite de Detruire
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & &
Procedure TPCXImage.SetHeight(Valeur : Entier)
Begin
Si Valeur >= 0 alors
& nbsp & nbsp & nbsp fBitmap.Hauteur := Valeur
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & &
Procedure TPCXImage.SetWidth(Valeur : Entier)
Begin
Si Valeur >= 0 alors
& nbsp & nbsp & nbsp fBitmap.Largeur := Valeur
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & &
Fonction de TPCXImage.GetHeight : Integer
Begin
Result := fPCXFile.fHeight
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & &
Fonction de TPCXImage.GetWidth : Integer
Begin
Result := fPCXFile.fWidth
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
// Les credits pour cette procedure va a son travail de TGIFImage par //
// Reinier P. Sterkenburg //
// PAS TESTE! //
// ajoute le 19/08/2001 //
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
Procedure TPCXImage.LoadFromClipboardFormat(AFormat : Mot
& nbsp & nbsp & nbsp ADAta : THandle APalette : HPALETTE)
Var
& nbsp & nbsp & nbsp Taille : Integer
& nbsp & nbsp & nbsp Buf : Pointeur
& nbsp & nbsp & nbsp Stream : TMemoryStream
& nbsp & nbsp & nbsp BMP : TBitmap
Begin
If (AData = 0) puis
& nbsp & nbsp & nbsp AData := GetClipBoardData(AFormat)
If (AData <> 0) et (AFormat = CF_PCX)
& nbsp & nbsp & nbsp Commencer
& nbsp & nbsp & nbsp Taille := GlobalSize(AData)
& nbsp & nbsp & nbsp Buf := GlobalLock(AData)
& nbsp & nbsp & nbsp Essayer
& ! & ! & ! & ! & ! & nbsp Stream := TMemoryStream.Creer
& ! & ! & ! & ! & ! & nbsp Essayer
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Flux.SetSize(Taille)
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Deplacer(Buf^,Stream.De memoire^,Taille)
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Auto.LoadFromStream(Stream)
& ! & ! & ! & ! & ! & nbsp enfin
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Flux.Gratuit
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Fin
& nbsp & nbsp & nbsp enfin
& ! & ! & ! & ! & ! & nbsp GlobalUnlock(AData)
& ! & ! & ! & ! & ! & nbsp Fin
& nbsp & nbsp & nbsp Fin
else
& nbsp & nbsp & nbsp Si (AData <> 0) et (AFormat = CF_BITMAP)
& ! & ! & ! & ! & ! & nbsp Commencer
& ! & ! & ! & ! & ! & nbsp BMP := TBitmap.Creer
& ! & ! & ! & ! & ! & nbsp Essayer
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp BMP.LoadFromClipboardFormat(AFormat,AData,APalette)
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Auto.Attribuer(BMP)
& ! & ! & ! & ! & ! & nbsp enfin
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp BMP.Gratuit
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Fin
& ! & ! & ! & ! & ! & nbsp Fin
& nbsp & nbsp & nbsp else
& ! & ! & ! & ! & ! & nbsp Raise Exception.Creer(CLIPBOARD_LOAD_ERROR)
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
// Les credits pour cette procedure va a son travail de TGIFImage par //
// Reinier P. Sterkenburg //
// PAS TESTE! //
// ajoute le 19/08/2001 //
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
Procedure TPCXImage.SaveToClipboardFormat(Var AFormat : Mot
& nbsp & nbsp & nbsp Var AData : THandle Var APalette : HPALETTE)
Var
& nbsp & nbsp & nbsp Stream : TMemoryStream
& nbsp & nbsp & nbsp Donnees : THandle
& nbsp & nbsp & nbsp Buf : Pointeur
Begin
Si Vide alors
& nbsp & nbsp & nbsp Sortie
// tout d'Abord stocker l'image dans le presse-papiers
fBitmap.SaveToClipboardFormat(AFormat,AData,APalette)
// Puis essayez d'enregistrer le PCX
Stream := TMemoryStream.Creer

& nbsp & nbsp & nbsp SaveToStream(Stream)
& nbsp & nbsp & nbsp Flux.Position := 0
& nbsp & nbsp & nbsp Donnees := GlobalAlloc(HeapAllocFlags,Stream.Taille)
& nbsp & nbsp & nbsp essayer
& nbsp & nbsp & nbsp Si les Donnees <> 0 then
& ! & ! & ! & ! & ! & nbsp Commencer
& ! & ! & ! & ! & ! & nbsp Buf := GlobalLock(Donnees)
& ! & ! & ! & ! & ! & nbsp essayer
& ! & ! & ! & ! & ! & nbsp Deplacer(en streaming.De Memoire^,Buf^,Stream.Taille)
& ! & ! & ! & ! & ! & nbsp enfin
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp GlobalUnlock(Donnees)
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Fin
& ! & ! & ! & ! & ! & nbsp Si SetClipBoardData(CF_PCX,Donnees) = 0, alors
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Raise Exception.Creer(CLIPBOARD_SAVE_ERROR)
& ! & ! & ! & ! & ! & nbsp Fin
& nbsp & nbsp & nbsp a l'exception de
& ! & ! & ! & ! & ! & nbsp GlobalFree(Donnees)
& ! & ! & ! & ! & ! & nbsp soulever
& ! & ! & ! & ! & ! & nbsp Fin
& nbsp & nbsp & nbsp enfin
& ! & ! & ! & ! & ! & nbsp Flux.Gratuit
& nbsp & nbsp & nbsp Fin
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
// PAS TESTE! //
// ajoute le 19/08/2001 //
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
Fonction de TPCXImage.GetEmpty : Boolean
Begin
S'il est Affecte(fBitmap)
& nbsp & nbsp & nbsp Resultat := fBitmap.Vide
else
& nbsp & nbsp & nbsp Result := (fPCXFile.fHeight = 0) ou (fPCXFile.fWidth = 0)
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & &
Procedure TPCXImage.SaveToFile(const Filename : String)
Var
& nbsp & nbsp & nbsp fPCX : TFileStream
Begin
If (fBitmap.Largeur = 0) ou (fBitmap.Hauteur = 0) then
& nbsp & nbsp & nbsp Raise Exception.Creer(BITMAP_EMPTY)
CreatePCXHeader
ConvertImageToPCXData
fPCX := TFileStream.Creer(nom de fichier,fmCreate)

& nbsp & nbsp & nbsp fPCX.Position := 0
& nbsp & nbsp & nbsp SaveToStream(fPCX)
enfin
& nbsp & nbsp & nbsp fPCX.Gratuit
& nbsp & nbsp & nbsp Fin
SetLength(fPCXFile.fPCXData.fData,0)
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
// PAS TESTE! //
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
Procedure TPCXImage.AssignTo(Dest : TPersistent)
Var
& nbsp & nbsp & nbsp bAssignToError : Boolean
Begin
bAssignToError := True
Si Dest est TBitmap puis
& nbsp & nbsp & nbsp Commencer
& nbsp & nbsp & nbsp (Dest comme TBitmap).Attribuer(fBitmap)
& nbsp & nbsp & nbsp bAssignToError := False
& nbsp & nbsp & nbsp Fin
Si Dest est TPicture puis
& nbsp & nbsp & nbsp Commencer
& nbsp & nbsp & nbsp (Dest comme TPicture).Graphique.Attribuer(fBitmap)
& nbsp & nbsp & nbsp bAssignToError := False
& nbsp & nbsp & nbsp Fin
Si bAssignToError puis
& nbsp & nbsp & nbsp Raise Exception.Creer(ASSIGNTO_ERROR)
// Vous pouvez ecrire d'autres affectations ici...
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
Procedure TPCXImage.Attribuer(Source : TPersistent)
Var
& nbsp & nbsp & nbsp iX,iY : Integer
& nbsp & nbsp & nbsp bAssignError : Boolean
Begin
bAssignError := True
If (Source TBitmap)
& nbsp & nbsp & nbsp Commencer
& nbsp & nbsp & nbsp fBitmap.Attribuer(Source TBitmap)

& nbsp & nbsp & nbsp bAssignError := False
& nbsp & nbsp & nbsp Fin
If (Source TPicture)
& nbsp & nbsp & nbsp Commencer
& nbsp & nbsp & nbsp iX := (Source TPicture).La largeur
& nbsp & nbsp & nbsp iY := (Source TPicture).Hauteur
& nbsp & nbsp & nbsp fBitmap.Largeur := iX
& nbsp & nbsp & nbsp fBitmap.Hauteur := iY
& nbsp & nbsp & nbsp fBitmap.Toile.Draw(0,0,(Source TPicture).Le graphique)
& nbsp & nbsp & nbsp bAssignError := False
& nbsp & nbsp & nbsp Fin
// Vous pouvez ecrire d'autres affectations ici...
Si bAssignError puis
& nbsp & nbsp & nbsp Raise Exception.Creer(ASSIGN_ERROR)
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & &
Procedure TPCXImage.Tirage(ACanvas : TCanvas const Rect : TRect)
Begin
// ACanvas.Draw(0,0,fBitmap) // plus rapide
ACanvas.StretchDraw(Rect,fBitmap) / / - vite
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & &
Procedure TPCXImage.LoadFromFile(const Filename : String)
Begin
fPCXFile.LoadFromFile(nom de fichier)
ConvertPCXDataToImage
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & &
Procedure TPCXImage.SaveToStream(Stream : TStream)
Begin
fPCXFile.SaveToStream(Stream)
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & &
Procedure TPCXImage.LoadFromStream(Stream : TStream)
Begin
fPCXFile.LoadFromStream(Stream)
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
// Appelee par RLE compresseur //
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
Procedure TPCXImage.FillDataLines(Const fLine : Tableau de Byte)
Var
& nbsp & nbsp & nbsp Par : Octet
& nbsp & nbsp & nbsp Cnt : MOT
& nbsp & nbsp & nbsp I : le Cardinal
& nbsp & nbsp & nbsp W : le Cardinal
Begin
I := 0
Par := fLine[0]
Cnt := $C1
W := fBitmap.La largeur
Repeat
& nbsp & nbsp & nbsp Inc(I)
& nbsp & nbsp & nbsp Si Par = fLine[I]
& ! & ! & ! & ! & ! & nbsp Commencer
& ! & ! & ! & ! & ! & nbsp Inc(Cnt)
& ! & ! & ! & ! & ! & nbsp Si Cnt = 100 $alors
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Commencer
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Octet(Pred(Cnt))
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Inc(fPCXFile.fCurrentPos)
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Par
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Inc(fPCXFile.fCurrentPos)
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Cnt := $C1
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Par := fLine[I]
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Fin
& ! & ! & ! & nbsp & nbsp & nbsp Fin
& ! & ! & ! & ! & ! & nbsp Si (Par <> fLine[I])
& ! & ! & ! & ! & ! & nbsp Commencer
& ! & ! & ! & ! & ! & nbsp Si (Cnt = $C1) puis
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Commencer
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Si (Par < $C1) puis
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp Commencer
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Par
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp Inc(fPCXFile.fCurrentPos)
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp Fin
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp else
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp Commencer
& ! & ! & ! & ! & ! & ! & ! & nbsp & ! & ! & ! & nbsp fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Octet(Cnt)
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp Inc(fPCXFile.fCurrentPos)
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Par
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp Inc(fPCXFile.fCurrentPos)
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp Fin
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Fin
& ! & ! & ! & ! & ! & nbsp else
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Commencer
& nbsp & nbsp & ! & ! & ! & ! & ! & ! & nbsp fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Octet(Cnt)
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Inc(fPCXFile.fCurrentPos)
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Par
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Inc(fPCXFile.fCurrentPos)
& ! & ! & ! & ! & ! & ! & ! & ! & nbsp Fin
& ! & ! & ! & ! & ! & nbsp Cnt := $C1
& ! & ! & ! & ! & ! & nbsp Par := fLine[I]
& ! & ! & ! & ! & ! & nbsp Fin
Jusqu'a ce que I = W - 1
// Ecrire le dernier octet(s)
if (Cnt > $C1)
& nbsp & nbsp & nbsp Commencer
& nbsp & nbsp & nbsp fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Octet(Cnt)
& nbsp & nbsp & nbsp Inc(fPCXFile.fCurrentPos)
& nbsp & nbsp & nbsp Fin
if (Cnt = $C1) et (Par > $C0)
& nbsp & nbsp & nbsp Commencer
& nbsp & nbsp & nbsp fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Octet(Cnt)
& nbsp & nbsp & nbsp Inc(fPCXFile.fCurrentPos)
& nbsp & nbsp & nbsp Fin
fPCXFile.fPCXData.fData[fPCXFile.fCurrentPos] := Par
Inc(fPCXFile.fCurrentPos)
// Si fPCXFile.fCurrentPos > fMaxDataFileLength puis
// Raise Exception.Creer(PCXIMAGE_TOO_LARGE)
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
// RLE algorithme de Compression //
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & //
Procedure TPCXImage.ConvertImageToPCXData
Var
& nbsp & nbsp & nbsp H,W : le Cardinal
& nbsp & nbsp & nbsp X,Y : le Cardinal
& nbsp & nbsp & nbsp I : le Cardinal
Begin
H := fBitmap.Hauteur
W := fBitmap.La largeur
fPCXFile.fCurrentPos := 0
SetLength(fPCXFile.fPCXData.fData,6 * H * W) // pour etre sûr
// SetLength(fRLine,W)
// SetLength(fGLine,W)
// SetLength(fBLine,W)
fBitmap.PixelFormat := pf24bit // Faire cela si vous utilisez ScanLine!
Pour Y := 0 pour H - 1 do
& nbsp & nbsp & nbsp Commencer
& nbsp & nbsp & nbsp fP := fBitmap.ScanLine[Y]
& ! & ! & ! I := 0
& nbsp & nbsp & nbsp Pour X := 0 pour W - 1 do
& ! & ! & ! & ! & ! & nbsp Commencer
& ! & ! & ! & ! & ! & nbsp fRLine[X] := fP[I] Inc(I) // Extraire une ligne rouge
& ! & ! & ! & ! & ! & nbsp fGLine[X] := fP[I] Inc(I) // Extraction d'une ligne verte
& ! & ! & ! & ! & ! & nbsp fBLine[X] := fP[I] Inc(I) // Extraire une ligne bleue
& ! & ! & ! & ! & ! & nbsp Fin
& nbsp & nbsp & nbsp FillDataLines(fBLine) // Compresser la ligne bleue
& nbsp & nbsp & nbsp FillDataLines(fGLine) // Compresser la ligne verte
& nbsp & nbsp & nbsp FillDataLines(fRLine) // Compresser la ligne rouge
& nbsp & nbsp & nbsp Fin

// de Corriger la longueur de fPCXData.fData
SetLength(fPCXFile.fPCXData.fData,fPCXFile.fCurrentPos)
Fin
// & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & & &
(*
Procedure TPCXImage.ProcessLine(Var fLine : Tableau de Byte Const W : le Cardinal)
Var
& nbsp & nbsp & nbsp Cnt : Integer
& nbsp & nbsp & nbsp J,K : le Cardinal
& nbsp & nbsp nbsp &