Problème de chargement d'un JPEG à partir d'un Stream

Salut à tous!

 

Cela fait un bon moment que je n'ai plus développé et je crois que je suis quelque peu rouillé!

 

Je suis en train de développer un petit logiciel afin de me permettre d'archiver mes anciennes photographies. Le principe est assez simple, j'ai numérisé quelques anciennes photos de famille et mon application devrait me permettre d'ouvrir les fichiers (au format JPG), d'ajouter un commentaire comme par exemple le nom des personnes photographiées, et d'enregistrer le tout dans un nouveau fichier.

 

J'ai donc créé un nouveau composant TImageComment en m'inspirant de la source de Antidote:

http://www.delphifr.com/codes/ENREGISTREMENT-IMAGE-TEXTE-DANS-FICHIER_17586.aspx

 

J'ai apporté quelques modifications à cette source afin de la transformer en composant et de lui permettre de faire la détection entre les formats graphiques suivant: Graphic, Bitmap, Icon et Metafile.

 

La procédure d'enregistrement du fichier de sortie semble se passer correctement pour l'ensemble des formats graphiques, mais lorsque je souhaite rouvrir les fichiers, l'application se plante uniquement lors du chargement d'une image JPEG (Graphic), l'erreur intervient au niveau de la ligne Picture.Graphic.LoadFromStream(MemS);

 

Mon nouveau composant possède les propriétés suivantes:

 

 - DefaultExt (String): pour l'extention du fichier global. Extention ".icf" par défaut.

 - FileType (String): pour le format du fichier, signature d'identification. Format "IMGCMT10" par défaut.

 - Lines (TStrings): pour contenir le commentaire.

 - Picture (TPicture): pour contenir l'image.

 

Voici le code source de mon nouveau composant qui ressemble fort à celui de Antidote:

 

unit ImageComment;

 

interface

 

uses

  SysUtils, Windows, Graphics, Classes, Controls, ExtCtrls, StdCtrls,

  JPEG;

 

type

  TGraphicFormat = (gfUnknow, gfGraphic, gfBitmap, gfIcon, gfMetafile);

 

  TDataInfo = record

    ActiveImage: Boolean;

    ActiveText: Boolean;

    FormatImage: TGraphicFormat;

    PosImage: Int64;

    PosText: Int64;

    SizeImage: Int64;

    SizeText: Int64;

  end;

 

  TImageComment = class(TComponent)

  private

    FDefaultExt: String;

    FFileType: String;

    FLines: TStrings;

    FPicture: TPicture;

    procedure SetDefaultExt(Value: String);

    procedure SetFileType(Value: String);

    procedure SetLines(Value: TStrings);

    procedure SetPicture(Value: TPicture);

    { Déclarations privées }

  protected

    DataInfo: TDataInfo;

    FileFormat: String[8];

    { Déclarations protégées }

  public

    LoadError: Byte;

    constructor Create(Aowner: TComponent); override;

    destructor Destroy; override;

    procedure LoadFromFile(const Filename: String);

    procedure SaveToFile(const Filename: String);

    { Déclarations publiques }

  published

    property DefaultExt: String read FDefaultExt write SetDefaultExt;

    property FileType: String read FFileType write SetFileType;

    property Lines: TStrings read FLines write SetLines;

    property Picture: TPicture read FPicture write SetPicture;

    { Déclarations publiées }

  end;

 

procedure Register;

 

implementation

 

procedure Register;

begin

   RegisterComponents('LeGuepard', [TImageComment]);

end;

 

constructor TImageComment.Create(Aowner :TComponent);

begin

   inherited Create(Aowner);

   FDefaultExt:='icf'; //ImageCommentFile

   FFileType:='IMGCMT10'; //ImageCommentFile 1.0

   FLines:=TStringList.Create;

   FPicture:=TPicture.Create;

   FileFormat:=FFileType;

   LoadError:=0;

end;

 

destructor TImageComment.Destroy;

begin

   FPicture.Free;

   FLines.Free;

   inherited Destroy;

end;

 

procedure TImageComment.SetDefaultExt;

begin

   if FDefaultExt<>Value then

    begin

       FDefaultExt:=Value;

    end;

end;

 

procedure TImageComment.SetFileType;

begin

   if FFileType<>Value then

    begin

       if Length(Value)>0 then FFileType:=Value

                          else FFileType:='IMGCMT10';

       FileFormat:=FFileType;                  

    end;

end;

 

procedure TImageComment.SetLines;

begin

   FLines.Assign(Value);

end;

 

procedure TImageComment.SetPicture;

begin

   FPicture.Assign(Value);

end;

 

procedure TImageComment.LoadFromFile;

var

  FFormat: String[8];

  FileS: TFileStream;

  MemS: TMemoryStream;

begin

   LoadError:=0;

 

   if not FileExists(Filename) then

    begin

       LoadError:=1;

       Exit;

    end;

 

   FileS:=TFileStream.Create(Filename, fmOpenRead);

   MemS:=TMemoryStream.Create;

   try

     FileS.Read(FFormat, SizeOf(FileFormat));

     if FFormat<>FileFormat then

      begin

         LoadError:=2;

         Exit;

      end;

 

     FileS.Read(DataInfo, SizeOf(TDataInfo));

 

     if DataInfo.ActiveImage then

      begin

         FileS.Position:=DataInfo.PosImage;

         MemS.SetSize(DataInfo.SizeImage);

         MemS.CopyFrom(FileS,DataInfo.SizeImage);

         MemS.Position:=0;

         case DataInfo.FormatImage of

             gfGraphic: Picture.Graphic.LoadFromStream(MemS); // Ligne du Bug !

              gfBitmap: Picture.Bitmap.LoadFromStream(MemS);

                gfIcon: Picture.Icon.LoadFromStream(MemS);

            gfMetafile: Picture.Metafile.LoadFromStream(MemS);

         end;

         MemS.Clear;

      end;

 

     if DataInfo.ActiveText then

      begin

         FileS.Position:=DataInfo.PosText;

         MemS.SetSize(DataInfo.SizeText);

         MemS.CopyFrom(FileS,DataInfo.SizeText);

         MemS.Position:=0;

         Lines.LoadFromStream(MemS);

         MemS.Clear;

      end;

   finally

      MemS.Free;

      FileS.Free;

   end;

end;

 

procedure TImageComment.SaveToFile;

var

  ext:     String;

  path:    String;

  FileS: TFileStream;

  MemS: TMemoryStream;

begin

   if Length(DefaultExt)=0 then ext:='icf'

                           else ext:=LowerCase(DefaultExt);

   if Pos('.',ext)>1 then ext:=Copy(ext,1,(Pos('.',ext)-1));

   if Pos('.',ext)=0 then ext:='.'+ext;

   if ext='.' then ext:='.icf';

   if ExtractFileExt(Filename)='' then path:=Filename+ext

                                  else path:=Filename;

   ChangeFileExt(path,LowerCase(ExtractFileExt(path)));

 

   FileS:=TFileStream.Create(path, fmCreate);

   MemS:=TMemoryStream.Create;

   try

     MemS.Write(FileFormat, SizeOf(FileFormat));

     MemS.Write(DataInfo, SizeOf(DataInfo));

 

     DataInfo.FormatImage:=gfUnknow;

     if (Picture.Graphic is TGraphic) then DataInfo.FormatImage:=gfGraphic;

     if (Picture.Graphic is TBitmap) then DataInfo.FormatImage:=gfBitmap;

     if (Picture.Graphic is TIcon) then DataInfo.FormatImage:=gfIcon;

     if (Picture.Graphic is TMetafile) then DataInfo.FormatImage:=gfMetafile;

 

     DataInfo.ActiveImage:=(DataInfo.FormatImage<>gfUnknow);

 

     if DataInfo.ActiveImage then

      begin

         DataInfo.PosImage:=MemS.Position;

         case GraphicFormat of

             gfGraphic: Picture.Graphic.SaveToStream(MemS);

              gfBitmap: Picture.Bitmap.SaveToStream(MemS);

                gfIcon: Picture.Icon.SaveToStream(MemS);

            gfMetafile: Picture.Metafile.SaveToStream(MemS);

         end;

         DataInfo.SizeImage:=MemS.Position-DataInfo.PosImage;

      end;

 

     DataInfo.ActiveText:=(Length(Lines.Text)>0);

 

     if DataInfo.ActiveText then

      begin

         DataInfo.PosText:=MemS.Position;

         Lines.SaveToStream(MemS);

         DataInfo.SizeText:=MemS.Position-DataInfo.PosText;

      end;

 

     FileS.Write(FileFormat, SizeOf(FileFormat));

     FileS.Write(DataInfo, SizeOf(TDataInfo));

     if DataInfo.ActiveImage then

      begin

         case GraphicFormat of

             gfGraphic: Picture.Graphic.SaveToStream(FileS);

              gfBitmap: Picture.Bitmap.SaveToStream(FileS);

                gfIcon: Picture.Icon.SaveToStream(FileS);

            gfMetafile: Picture.Metafile.SaveToStream(FileS);

         end;

      end;

     if DataInfo.ActiveText then Lines.SaveToStream(FileS);

   finally

      MemS.Free;

      FileS.Free;

   end;

end;

 

end.

 

Le code du prototype de l'application qui fait appel à ce composant est le suivant:

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, jpeg, ExtCtrls, ExtDlgs, ImageComment;

 

type

  TForm1 = class(TForm)

    Memo1: TMemo;

    ScrollBox1: TScrollBox;

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    Button4: TButton;

    Image1: TImage;

    OpenDialog1: TOpenDialog;

    SaveDialog1: TSaveDialog;

    OpenPictureDialog1: TOpenPictureDialog;

    ImageComment1: TImageComment;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

  private

    { Déclarations privées }

  public

    { Déclarations publiques }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.Button1Click(Sender: TObject);

begin

   if OpenPictureDialog1.Execute then

    begin

       Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);

       ImgExt:= ExtractFileExt(OpenPictureDialog1.FileName);

    end;

end;

 

procedure TForm1.Button2Click(Sender: TObject);

begin

   ImageComment1.Picture:=Image1.Picture;

   ImageComment1.Lines:=Memo1.Lines;

end;

 

procedure TForm1.Button3Click(Sender: TObject);

begin

   if SaveDialog1.Execute then ImageComment1.SaveToFile(SaveDialog1.FileName);

end;

 

procedure TForm1.Button4Click(Sender: TObject);

begin

   if OpenDialog1.Execute then ImageComment1.LoadFromFile(OpenDialog1.FileName);

   Image1.Picture.Assign(ImageComment1.Picture);

   Memo1.Lines.Assign(ImageComment1.Lines);

end;

 

end.

 

Cela fait plusieurs jours que je planche sur ce bug et je commence à devenir "chèvre", j'ai beau comparer avec le code source de Antidote, je ne vois vraiment pas où se trouve le problème d'autant plus que ce composant fonctionne correctement pour trois des quatre format.

 

Je me suis donc dit que l'un d'entre vous pourrait y voir plus clair et trouver la solution à mon problème.

 

Pour celui qui le désir, je peux lui envoyer un e-mail avec le zip de mon travail pour faire des tests.

 

Je vous remercie d'avance pour le temps que vous apporterez à ce problème.

 

Bizz à tous!

 

Julien.

bonsoir,
gfGraphic: Picture.Graphic.LoadFromStream(MemS); // Ligne du Bug !

format jpg est-il défini ?

cantador

je ne suis pas sur, mais il me semble que TGraphic est une classe abstraite, un peu comme TStream ou TStrings.

Si il permet effectivement d'assurer le support a de nouveaux format d'image, il me semble qu'il faille utiliser la classe permettant de gerer ce format (TJpegImage, TPNGObject, TGifImage).

toute les classes image (TBitmap, TMetaFile, TJpegImage etc) sont des dérivées de TGraphic, donc je pense qu'il faut ajouter les formats utilisable au type TGraphicFormat (virer gfGraphic) soit :

gfJpeg, gfPng, gfGif (par exemple)

puis gerer le format dans le case :

case ... of
  gfJpeg : TJpegImage(Picture.Graphic).SaveToStream ...
  gfPng : TPNGObject(Picture.Graphic).SaveToStream ...
  gfGif : TGIFImage(Picrute.Graphic).SaveToStream ...

si ça ne marche pas il faudra faire :

case ... of
gfJpeg : begin
  with TJPegImage.Create do
  try
    Assign(Picture.Graphic);
    {gerer les options du jpeg, compression etc }
    SaveToStream(...);
  finally
    Free;
  end;
end;

---

Bonsoir et merci de m'avoir répondu aussi rapidement !

 

Tout abord, pour répondre à Cantador, oui l'unité JPEG est déclarée dans mes uses.

 

f0xi, j'ai essayé tes deux versions des modifications, mais rien y fait, cela plante toujours.

 

J'ai vraiment l'impression que le problème se produit au moment de la lecture du fichier et à présent il s'arrêter à la ligne suivant:

 

         FileS.Position:=DataInfo.PosImage;

         MemS.SetSize(DataInfo.SizeImage);

         MemS.CopyFrom(FileS,DataInfo.SizeImage);

==>  MemS.Position:=0; <==

         TJPEGImage(Picture.Graphic).LoadFormStream(MemS);

 

De plus, dans la source de Antidote, cela fonctionne très bien comme cela,c'est bien ce qui fait que je n'y comprend plus rien!

 

Pire encore. dans ma "batterie" de test, j'ai créé un fichier avec mon application et je l'ai réouverte avec l'application de Antidote (en adaptant la signature du fichier bien évidement), et cela fonctionne également.

 

Pour celui que cela intéresse, j'ai préparé un zip avec mon composant, mon application test et la source de Antidote. Je peux vous l'envoyer par e-mail. Je la posterais bien comme source sur CS mais je me dis qu'il ne sert vraiment à rien de charger le serveur du site avec une source défectueuse, je préfère attendre que ce composant soir totalement opérationnel pour le poster.

 

Encore merci à vous tous de m'aider.

 

Bizz.

 

Julien.

mmm etrange ... probablement un probleme de memoire, de directive de compilation ou de stream.

parfois delphi a quelques soucis, dernierement j'ai été confronté a un probleme qu'il m'a été difficile de resoudre (1H de recherche intensive), en effet il m'etait impossible de compilé une unité, avec un code trés simple et sans aucune erreur :

function test(const S: string): string;
begin
  result := test;
end;

on ne peu pas plus simple, pourtant, il n'en voulais pas.

grace au recherche, j'ai finalement trouvé que le probleme venait de deux fin de ligne (0x0D0A) qui etaient cassée (0x0D uniquement) ce qui faisait galéré le compilateur.

cela pour dire que parfois, un probleme dans le code ne vient pas forcement du code mais d'ailleur.

sinon, aprés réanalyse de ton code, j'ai remarqué des incoherences de methodes.
notement sur l'utilisation en parallele d'un TMemoryStream et d'un TFileStream.
le probleme ne viens pas de la, mais il y a surrement un truc a ameliorer de ce coté.

---

Tout abord, pour répondre à Cantador, oui l'unité JPEG est déclarée dans mes uses.

J'avais vu..
mais c'était plutôt à propos de la liste TGraphicFormat et de la traduction du format jpg..(que f0xi d'ailleurs a soulevée)

J'ai hâte de connaître la solution..

cantador

function test(const S: string): string;
begin
  result := test;
end;

@f0xi :
je confirme, ça ne compile pas..

cantador

Salut à tous !

function test(const S: string): string;
begin
  result := test;
end;

==> Il n'y aurait pas un problème de récursivité dans ce truc, et il ne manquerait pas le passage de paramètres lors de l'appel à test !!??

Pour ce qui est du parallélisme entre TMemoryStream et TFileStream, c'est clair que je trouvais moi aussi cela un peu lourd, mais avant d'affiner, j'essaie de faire un composant qui fonctionne en reprenant la manière de faire de Antidote qui fonctionne correctement ... le sien !

Cantador, f0xi, il n'y aurait pas l'un d'entre vous qui voudrait bien essayer mon code source sur sa machine (les sources du composant et de l'unité de test sont dans le premier message),  histoire de voir si vous avez la même phénomène chez vous. Cela nous aiderait sûrement à faire avancer le Smilblic !!!!

Merci d'avance.

Bizz à tous,

Julien.

 

PS: Pourquoi a-t-on pour le moment tant de mal à écrire un message sur le forum? En moment d'envoyer ma réponse, j'ai toujours le message

 

Il y a eu une erreur dans la page
Désolé pour le désagrément, un log a été envoyé au webmasteur pour corriger au plus vite le problème

Cordialement

Nicolas SOREL (Nix)

 

Je suis obligé de m'y reprendre une dizaine de fois avant que cela passe. Heureusement que je penses à faire un copier/coller avant de cliquer sur "Ajouter" !

@cantador : ah quel boulet je fait!

c'etait bien sur : result := S; et pas result := Test; ...
forcement oui, ça compile pas.

@leguepard :
pas de soucis, envois moi ta source par email, je te file mon adresse en mp.

---