Discussion :

[Jipété]

Bonjour,

dans une procédure, j'ai écrit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
img.Picture := nil;
if img.Picture <> nil then ShowMessage('diff de nil') else ShowMessage('égal à nil');

Je ne vous fais pas un dessin, c'est bien "diff de nil" qui est affiché...

Comment une chose pareille est-elle possible ?

Bon, pour m'en sortir je vais bidouiller avec le tag du TImage, mais quand même, j'aimerais bien une explication rationnelle...
Merci,

[Andnotor]

Picture n'est pas un objet mais une propriété de TImage. Son setter n'affecte pas le pointeur sous-jacent (FPicture), il ne fait que copier l'image source : FPicture.Assign().
Par contre, le getter retourne bien le pointeur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
property Picture: TPicture read FPicture write SetPicture;
 
procedure TCustomImage.SetPicture(const AValue: TPicture);
begin
  if FPicture=AValue then exit;
  //the OnChange of the picture gets called and
  // notifies this TCustomImage that something changed.
  FPicture.Assign(AValue);
end;

[Jipété]

Picture n'est pas un objet mais une propriété de TImage.

Hé ben voilà

Merci, camarade

[Jipété]

Bonjour,

c'était trop simple ! Voilà-t-y pas que je découvre, dans ExtDlgs,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
TOpenPictureDialog = class(TPreviewFileDialog)
  private
    FDefaultFilter: string;
    FImageCtrl: TImage;

et quelque part dans le fichier,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
procedure TOpenPictureDialog.ClearPreview;
begin
  FPictureGroupBox.Caption:='None';
  FImageCtrl.Picture:=nil;
end;

Je vous laisse comparer la réponse d'Andnotor et l'utilisation faite dans Lazarus, merci pour les retours.

[ThWilliam]

Salut JP.

Dans le cas d'un TImage: un TPicture est créé d'office.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
constructor TCustomImage.Create(AOwner: TComponent);
begin
    //...  
    FPicture := TPicture.Create;
    FPicture.OnChange := @PictureChanged;
    // ...
end;

Par contre ce que tu peux tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if Image1.Picture.Graphic = nil then ShowMessage('nil');

ou utiliser les propriétés Width et Height du Picture (si = 0 --> pas d'image contenue).

Cordialement
Thierry

[Jipété]

Yop, Thierry !

Merci pour tes précisions, qui appellent questions et remarques,

Par contre ce que tu peux tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if Image1.Picture.Graphic = nil then ShowMessage('nil');

Je n'y manquerai pas (mais pas là maintenant tout de suite, que j'ai d'autres galères sur les bras [encore ces histoires 24<>32 bits, c'est in-fer-nal !])

Question : ils ne le savent pas, ça, les gens qui ont écrit FImageCtrl.Picture:=nil; dans ExtDlgs ?

ou utiliser les propriétés Width et Height du Picture (si = 0 --> pas d'image contenue).

Pi faudra bien vérifier si ces deux propriétés sont remises à 0 en cas d'effacement d'image, que ça risque encore d'être une blague, ça !

[tourlourou]

Les objets Picture du TImage et Graphic du TPicture disposent de méthodes Clear : voir ce qu'elles font ?

Il me semble qu'il y avait une différence Delphi/Lazarus au Assign(nil), qui ne vidait pas l'image sous Lazarus...

[Jipété]

Bonjour Yves,

Il me semble qu'il y avait une différence Delphi/Lazarus au Assign(nil), qui ne vidait pas l'image sous Lazarus...

C'est curieux parce que ce que je m'étais noté en commentaire après l'instruction, c'est exactement l'inverse !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

img.Picture := nil; // pour effacer l'image

Encore un paquet de tests à venir, quoi, sauf que là je n'ai pas le temps !...

[Jipété]

Bonjour,

j'avais dit que je testerais, c'est fait, avec ce petit bout de rien du tout :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
procedure TForm1.Button10Click(Sender: TObject);
var
  bmp: TBitmap;
begin
  if not opd.Execute then Exit;
  bmp:= TBitmap.Create;
  bmp.LoadFromFile(opd.FileName);
  image1.Picture.Assign(bmp);
  bmp.Free;
 
  if Image1.Picture.Graphic = nil then ShowMessage('ipg nil') else ShowMessage('ipg not nil');
  ShowMessage(IntToStr(Image1.Picture.Width)+' '+IntToStr(Image1.Picture.Height));
  Image1.Picture := nil; // code Laz ExtDlgs
  //Image1.Picture.Clear; // Yves, = idem ci-dessus
  ShowMessage(IntToStr(Image1.Picture.Width)+' '+IntToStr(Image1.Picture.Height));
  if Image1.Picture.Graphic = nil then ShowMessage('ipg nil') else ShowMessage('ipg not nil');
  if Image1.Picture = nil then ShowMessage('ip nil') else ShowMessage('ip not nil');
end;

Et voilà les résultats :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
ipg not nil // on s'en doutait
400 300
image effacée
0 0
ipg nil // bien !
ip not nil // dans les deux cas

La leçon à retenir : c'est Thierry qui a raison, en ce qui concerne l'état du TPicture, et c'est Yves qui apporte sa pierre à l'édifice avec son .Clear qui m'avait d'autant plus échappé que les gars de Lazarus proposaient leur solution, et que jusqu'à preuve du contraire il n'y avait pas de raison de ne pas leur faire confiance.

Sauf que la preuve du contraire, je l'ai maintenant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
// /!\ /!\ /!\ le problème du PixelFormat 24<>32 /!\ /!\ /!\
procedure TForm1.Button9Click(Sender: TObject);
var
  bmp: TBitmap;
begin
  if not opd.Execute then Exit; bmp:= TBitmap.Create; bmp.LoadFromFile(opd.FileName);
 
 
  ShowMessage(StringReplace(bmp.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
  // windows : BitsPerPixel=24, Depth=24 avec un fichier 24 comme avec un 32 ! :-(
  // même défaut sous linux
  // et AlphaPrec à 0, fichier 24 comme 32, dans les 2 OS.
  // heureusement la lecture du BitmapInfoHeader permet de faire la différence
 
 
  image1.Picture.Assign(bmp); bmp.Free;
end;

(mise en forme pour mettre l'accent sur ce qui est important)

Du coup je comprends mieux pourquoi les gens qui avaient commencé à développer une unité de resampling (j'en ai déjà parlé) ont abandonné le truc en 2009, juste après avoir porté leur code Delphi sous... Lazarus !
Z'ont dû être dégoûtés, les pauvres : on le voit, il y a du TODO dans le fichier qui est resté là, mais il y a aussi ça, en prod' :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
// 0103 191209	Alexx2000	- Ported to FreePascal/Lazarus
//			        - Added alpha channel support
 
    if Src.RawImage.Description.AlphaPrec = 0 then // if bitmap has not alpha channel
      SrcIntfImage := CreateAlphaFromMask(Src)
    else
      SrcIntfImage := TLazIntfImage.Create(Src.RawImage, False);

parce qu'au vu de mes tests du Button9 (et d'ailleurs en mettant un point d'arrêt sur la ligne 4 if Src.RawImage... ça confirme ce que j'écris), les bitmaps 32 bits passés dans cette moulinette sont considérés sans alpha channel !
Le dernier test que j'ai fait dans cette routine a été de virer purement et simplement le test, de n'utiliser que SrcIntfImage := CreateAlphaFromMask(Src) et le résultat sur les images est strictement identique à celui généré avec le if, fichiers 24 et fichiers 32.
Fermez le ban, l'affaire est entendue.

Au plus j'y pense et au plus je me dis que ce RawImage.Description n'est utilisable qu'avec les TLazIntfImage, qui jouent avec Init_BPPxxxxxx, et là ça a son sens.
Mais rien dans l'aide, dans le wiki, dans les exemples, pour nous éviter ces embrouilles innombrables...

Bonne journée,

[ThWilliam]

Pour revenir sur l'effacement de l'image...

je déconseillerais : Image1.Picture := nil;

Si on regarde le code de TPicture.Clear :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
procedure TPicture.Clear;
begin
  SetGraphic(nil); // procédure privée
end;
 
procedure TPicture.SetGraphic(Value: TGraphic);
var
  NewGraphic: TGraphic;
  ok: boolean;
begin
  if (Value=FGraphic) then exit;
  NewGraphic := nil;
  ok := False;
  try
    if Value <> nil then
    begin
      NewGraphic := TGraphicClass(Value.ClassType).Create;
      NewGraphic.Assign(Value);
      NewGraphic.OnChange := @Changed;
      NewGraphic.OnProgress := @Progress;
    end;
    FGraphic.Free;
    FGraphic := NewGraphic;
    Changed(Self);
    ok := True;
  finally
    // this try..finally construction will in case of an exception
    // not alter the error backtrace output
    if not ok then
      NewGraphic.Free;
  end;
end;

On voit très clairement que si Value = nil, le TGraphic est libéré et mis à nil.

Comme, de plus, Changed est appelé, Clear me semble être la meilleure solution pour effacer l'image.

Bon dimanche.
Thierry

[Andnotor]

Ça revient au même puisque SetPicture appelle Assign qui appelle SetGraphic

Le problème réside plus dans le fait qu'une encapsulation ne devrait pas prêter à confusion comme c'est le cas ici, impossible de savoir ce qui se passe (pourquoi pas égal à nil) sans aller voir les sources. Clear est plus logique.

[Jipété]

Clear me semble être la meilleure solution pour effacer l'image.

Clear est plus logique.

Les objets Picture du TImage et Graphic du TPicture disposent de méthodes Clear : voir ce qu'elles font ?

T'as gagné une caisse de champagne !


Me reste plus qu'à revoir tous mes codes...

[tintinux]

Vous avez gagné le droit de modifier le source de Lazarus dans svn, ou bien au moins de signaler l'anomalie dans le bug tracker.

Il faudrait donc qu'affecter nil à la propriété lève une exception, ou bien éventuellement appelle Clear, au choix.

Sinon cette discussion ne sortira jamais d'ici et Jipété continuera à râler...

[der§en]

À raison, il faut bien l'admettre

[Jipété]

Vous avez gagné le droit de modifier le source de Lazarus dans svn, ou bien au moins de signaler l'anomalie dans le bug tracker.

Ouais, ben je me sens pas le courage/l'énergie, pi fait trop chaud, pi y aurait tellement de trucs à signaler, et tout est tellement emberlificoté, que je comprends que rien ne change...