Discussion :

[Jipété]

Bonsoir,

si je m'attendais à cette misère...

Dans mon prog d'étude et de tests, j'ai une douzaine de boutons, et donc une douzaine de procédures identiques sauf une ligne, celle qui appelle la sous-routine spécifique de redimensionnement (à qui je passe le TBitmap source chargé par un fichier, le TBitmap destination qui recevra le traitement, et les dimensions à utiliser).
Une fois le redimensionnement de bm1 effectué vers bm2, le résultat est affiché dans un Paintbox, qui a été effacé au début de la proc.
Tout ça fonctionne tip-top !

Je voulais récupérer ces résultats pour les comparer et comme c'est gonflant et long de faire des copies d'écran et les éditer, j'ai rajouté après l'affichage de bm2 un appel vers une sous-proc qui va sauvegarder le bitmap en faisant bm2.SaveToFile('/chemin/fichier.bmp'); et ça fonctionne très bien pour 11 boutons (certains utilisent StretchDraw, d'autres les routines à base de ScanLine) mais pour le bouton avec StrechtBlt l'image est noire, alors qu'elle est bien affichée dans le Paintbox, que je viens de doubler par un image1.Picture.Bitmap.Assign(bm2);, correct également.

Si je résumais, je dirais que l'enregistrement d'un TBitmap est correct à 99 % et que le 1 % restant correspond à son remplissage par StretchBlt, qui ne nuit pas à l'affichage mais donne un fichier plein de noir (qui a néanmoins une taille identique aux 11 autres fichiers).

Alors je simplifie et après l'affichage de bm2, je le sauvegarde directement dans la proc du bouton, et le résultat est tout aussi foireux...
Encore plus fort, toujours dans la proc du bouton, l'image a été chargée par bm2 (je la vois avec mes yeux, cette foutue image), je l'enregistre avec image1.Picture.Bitmap.SaveToFile('/chemin/fichier.bmp'); et c'est encore l'image noire dans le fichier.

J'ai essayé de sauver bm2 dans un TMemoryStream que j'enregistre, image noire.
J'ai essayé de sauver image1.Picture " " " " " "
J'ai essayé de sauver image1.Picture.Bitmap " " " " " "
et je rappelle que je vois l'image dans image1.

Je ne sais plus quoi penser, je ne sais plus quoi essayer...
Une idée sur ce coup-là ?


Ah, pendant qu'on cause de StretchBlt, vous savez ce que raconte MSDN à son propos ?

After setting the HALFTONE stretching mode, an application must call the SetBrushOrgEx function to set the brush origin. If it fails to do so, brush misalignment occurs.

Donc logiquement on se dit qu'il faut mettre ça en place, des fois que ça réglerait ce problème d'image noire ?
Pas mal de recherches, lectures et études, découverte de ça :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
var
  p:TPoint;
  dc:HDC;
begin
  dc:=ACanvas.Handle;
  GetBrushOrgEx(dc,p);
  SetStretchBltMode(dc,HALFTONE);
  SetBrushOrgEx(dc,p.x,p.y,@p);
  StretchBlt(dc,
    Rect.Left,Rect.Top,
    Rect.Right-Rect.Left,Rect.Bottom-Rect.Top,
    Canvas.Handle,0,0,Width,Height,ACanvas.CopyMode);
end;

mise en place, compil et paf !, Lazarus ne connaît pas le couple GetBrushOrgEx/SetBrushOrgEx, encore des recherches, une piste avec HtmlMisc.pas qui les propose, et qu'est-ce qu'on trouve en étudiant le fichier ?

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
function GetBrushOrgEx(DC: HDC; var lppt: TPoint): BOOL;
begin
{$IFDEF MSWINDOWS}
  Result := Windows.GetBrushOrgEx(DC, lppt);
{$ELSE}
  WriteLn('GetBrushOrgEx not implemented yet');
{$ENDIF}
end;
 
function SetBrushOrgEx(DC: HDC; X, Y: Integer; PrevPt: PPoint): BOOL;
begin
{$IFDEF MSWINDOWS}
  Result := Windows.SetBrushOrgEx(DC, X, Y, PrevPt);
{$ELSE}
  WriteLn('SetBrushOrgEx not implemented yet');
{$ENDIF}
end;

Vraiment vraiment vraiment décourageant...

[Jipété]

Bonjour,

hier soir ça devait être un peu embrouillé, ce matin j'ai tout repris à la base : nouveau projet, 2 TImage, 1 TButton, 1 OpenPictureDialog, et un code ultra simplissime :

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
procedure TForm1.Button1Click(Sender: TObject);
var
  bm1,bm2: TBitmap;
begin
  if not opd.Execute then exit;
 
  bm1 := TBitmap.Create;
  bm1.LoadFromFile(opd.FileName);
 
  bm2 := TBitmap.Create;
  bm2.pixelformat := bm1.PixelFormat;
  bm2.Width := 200;
  bm2.Height:= 150;
 
  if
  StretchBmp(bm1,bm2, 200,150)
  then begin
    image1.Picture.Bitmap.Assign(bm2);
    bm2.SaveToFile('/chemin/Blt__oeil.bmp'); // --> image NOIRE !
  end;
 
  if
  Scaled_Bmp(bm1,bm2, 200,150)
  then begin
    image2.Picture.Bitmap.Assign(bm2);
    bm2.SaveToFile('/chemin/Draw_oeil.bmp'); // --> image OK
  end;
 
  bm2.Free;
  bm1.Free;
end;

Je vous laisse juger du résultat, de gauche à droite les aperçus sur mon Bureau, au centre le programme avec l'image1 en haut (source : StretchBlt) et l'image2 en bas (source StretchDraw -- au passage, on notera les différences [subtiles !] de couleurs) et à droite la construction de la fiche, si vous voulez jouer aussi.


Et pour bien jouer, les codes des procédures :

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
function StretchBmp(var src,dst: TBitmap; const MaxWidth, MaxHeight: integer): boolean;
var
  Scale: double;
begin
  Result:= False;
  if (src.Width = 0) or (src.Height = 0) then Exit;
  Scale:= Min(MaxWidth / src.Width, MaxHeight / src.Height);
  dst.Width := Round(src.Width  * Scale);
  dst.Height:= Round(src.Height * Scale);
  // dessus : identique dans les 2 procs
  SetStretchBltMode(dst.Canvas.Handle, HALFTONE);
  Result:= StretchBlt(dst.Canvas.Handle,
             0, 0, dst.Width, dst.Height,
             src.Canvas.Handle,
             0, 0, src.Width, src.Height,
             SRCCOPY);
end;

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
function Scaled_Bmp(var src,dst: TBitmap; const MaxWidth, MaxHeight: integer): Boolean;
var
  Scale: double;
begin
  Result:= False;
  if (src.Width = 0) or (src.Height = 0) then Exit;
  Scale:= Min(MaxWidth / src.Width, MaxHeight / src.Height);
  dst.Width := Round(src.Width  * Scale);
  dst.Height:= Round(src.Height * Scale);
  // dessus : identique dans les 2 procs
  dst.Canvas.StretchDraw(rect(0, 0, dst.Width, dst.Height), src);
  Result := True;
end;

Ah, je confirme que les 2 fichiers sur le Bureau ont la même taille, 70,3 ko.
Bonne journée,

[ThWilliam]

Salut JP.

J'ai trouvé le pourquoi de l'image noire dans le SaveTofile.
Le handle du canvas de bm2 n'est pas alloué !!!

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
function StretchBmp(var src,dst: TBitmap; const MaxWidth, MaxHeight: integer): boolean;
var
  Scale: double;
begin
  Result:= False;
  if (src.Width = 0) or (src.Height = 0) then Exit;
  Scale:= Min(MaxWidth / src.Width, MaxHeight / src.Height);
  dst.Width := Round(src.Width  * Scale);
  dst.Height:= Round(src.Height * Scale);
  // je teste si Canvas.Handle est alloué
  if dst.canvas.HandleAllocated then showmessage('allocated');
  SetStretchBltMode(dst.Canvas.Handle, HALFTONE);
  Result:= StretchBlt(dst.Canvas.Handle,
             0, 0, dst.Width, dst.Height,
             src.Canvas.Handle,
             0, 0, src.Width, src.Height,
             SRCCOPY);
end;

Encore un problème graphique dans Lazarus !
Si, juste après la ligne dst.Height, tu utilises le canvas avec un truc bidon du genre : dst.canvas.pixels[0,0]:= clyellow; --> le Handle est alors alloué, et le savetofile est ok.
Mais ne me demande pas pourquoi le TImage affiche bien le bitmap...

Reste à trouver le moyen élégant d'allouer ce handle, si la procédure existe !!!

Bon W.E.
Amicalement
Thierry

[Jipété]

Salut Thierry,

J'ai trouvé le pourquoi de l'image noire dans le SaveTofile.
Le handle du canvas de bm2 n'est pas alloué !!!

T'es trop fort !
Moi, de mon côté j'avais trouvé autre chose (j'ai d'abord cherché du côté des handles sans rien découvrir), mais j'ai été accaparé au moment où j'allais poster, 'fin bon, voilà le résultat des tests de fin de matinée :

À partir de mon projet simplissime, j'ai creusé, suis tombé sur des comportements farfelus et on en revient toujours à la même histoire, le sous-système graphique est tout pourri...
Qu'on en juge, à partir du code d'un nouveau bouton, et tout se passe au niveau des commentaires :

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
procedure TForm1.Button2Click(Sender: TObject);
var
  bm1,bm2: TBitmap;
  lii: TLazIntfImage; // uses IntfGraphics
begin
  if not opd.Execute then exit;
 
  bm1 := TBitmap.Create;  // création source
  bm1.LoadFromFile(opd.FileName); // chargement source
  ShowMessage(StringReplace(bm1.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
  // BitsPerPixel=24 <-- forcé à 24 par le LoadFromFile, sinon 32
 
  lii := bm1.CreateIntfImage; // 2 lignes rajoutées pour voir ce que ça donnerait
  bm1.LoadFromIntfImage(lii); // mais elles ne servent à rien pour ce pb, si ce n'est à repasser PixelFormat à 32
  ShowMessage(StringReplace(bm1.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
  // BitsPerPixel=32 
 
  bm2 := TBitmap.Create; // création destination
  bm2.Width := 200;
  bm2.Height:= 150;
  bm2.LoadFromFile(opd.FileName); // rajouté, lire pourquoi dessous
  ShowMessage(StringReplace(bm2.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
  // BitsPerPixel=32 et 24 si je rajoute LoadFromFile,
  // et là, enfin, l'image est dans le fichier !
  // mais pas à la bonne taille, ce qui est normal à ce niveau
  bm2.FreeImage; // 3 lignes rajoutées --> servent à rien, taille non changée dans le fichier alors que dimensions OK dans ShowMessage dessous
  bm2.Width := 200;
  bm2.Height:= 150;
  ShowMessage(StringReplace(bm2.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
  // BitsPerPixel=24 Width=200 Height=150
 
  if
  StretchBmp(bm1,bm2, 200,150) // redimensionnement
  then begin
    image1.Picture.Bitmap.Assign(bm2); // affichage parfait
    bm2.SaveToFile('/chemin/Blt__oeil.bmp'); // toujours pas à la bonne taille (c'est celle du fic d'origine) alors que 
    ShowMessage(StringReplace(bm2.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
    // BitsPerPixel=24 Width=155 Height=150
    // Width à 155 c'est la bonne valeur par rapport à Height à 150 donc le StretchBlt a fait son taf !
 
    // on dirait que bm2.SaveToFile sauvegarde l'image chargée au LoadFromFile
    // et ne tient donc pas compte du FreeImage...
    image1.Picture.Bitmap.SaveToFile('/chemin/Blt_img_oeil.bmp'); // toujours trop grand alors que l'affichage est correct
  end;
 
  if  // pour contrôle, et ça, c'est toujours tout bon
  Scaled_Bmp(bm1,bm2, 200,150)
  then begin
    image2.Picture.Bitmap.Assign(bm2);
    bm2.SaveToFile('/chemin/Draw_oeil.bmp');
  end;
 
  bm2.Free;
  lii.Free;
  bm1.Free;
end;

Bon, allez, je jette l'éponge et StretchBlt par la même occasion.

Je barre cette dernière ligne rageuse, m'en vais creuser ta piste.
Notez cependant qu'on dirait (avec des pincettes) que de mon côté je détecte plutôt un pb de PixelFormat à 32 en natif et inchangeable vers 24 nécessaire, à moins de passer par LoadFromFile qui rajoute un effet de bord foireux. Peut-être qu'en faisant ça je trifouille ce handle manquant ?

(Et bon, ce qui me remonte le moral, c'est que je ne suis pas fou et que je poste de vrais problèmes ! Parce que y a des jours je me demande...)

[Jipété]

Le handle du canvas de bm2 n'est pas alloué !!!

Bravo pour ta trouvaille, la mienne (bm2.LoadFromFile) je peux la zapper.
Et le fait que PixelFormat soit en 24 ou 32 bits n'a aucune incidence sur ce problème.

Cependant, c'est encore un truc de malade cette histoire, car si je fais

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
var
  Scale: double;
  dc: HDC;
begin
  //...
  dc := dst.Canvas.Handle;
  ShowMessage(IntToStr(dc)); // affiche un nombre sur 10 chiffres
  // je teste si Canvas.Handle est alloué
  if dst.Canvas.HandleAllocated then ShowMessage('allocated'); // vu !
  SetStretchBltMode(dc, HALFTONE);
  Result:= StretchBlt(dc,
  //...
end;

le fichier ne contient qu'une image noire alors que j'ai vu "allocated" !

Pour avoir la bonne image dans le fichier, je fais

Code :

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

1
2
3
4
5
6
7
  dst.Canvas.Pixels[0,0]:= clYellow; // mandatory pour avoir la suite qui fonctionne bien
  //ShowMessage(IntToStr(dst.Canvas.Handle)); // même nombre que précédemment, sur 10 chiffres
  // je teste si Canvas.Handle est alloué
  if dst.canvas.HandleAllocated then showmessage('allocated');
  SetStretchBltMode(dst.Canvas.Handle, HALFTONE);
  Result:= StretchBlt(dst.Canvas.Handle,
  //...

Test complémentaire : le simple fait d'appeler ShowMessage(IntToStr(dst.Canvas.Handle)); (ligne du pixel jaune commentée) fait apparaître le "allocated", on se demande bien pourquoi.
Ça doit être autre chose qu'un simple problème de handle allocated ou pas...

Mais c'est très bien, ton pixel jaune, de toute façon il va être écrabouillé par le StretchBlt ensuite.
Pi j'ai essayé plein d'autres trucs, aucun ne fonctionne, alors ça va rester comme ça en attendant mieux.

Notez-vous-le en gros sur vos tablettes !

Et tu sais, un jour sur l'autoroute j'ai dépanné mon câble d'accélérateur cassé d'un coup avec un bout de fil électrique, et si je n'avais pas eu une fuite de pompe à eau de nombreuses années plus tard, la bagnole fonctionnerait encore !
Moralité : ne pas avoir peur des bidouilles efficaces.

Merci Thierry pour ta piste, bon dimanche à tous,

[Jipété]

Bonjour,

Ce matin je me suis rendu compte d'une similitude avec StretchDraw : que j'utilise Canvas.StretchBlt avec un bouton ou Canvas.StretchDraw avec un autre bouton, en mode pas-à-pas à un moment je me retrouve dans

Code :

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

1
2
3
4
5
6
7
8
procedure TCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic);
begin
  if not Assigned(SrcGraphic) then exit;
  Changing;
  RequiredState([csHandleValid]);
  SrcGraphic.Draw(Self, DestRect); // jump vers procedure TRasterImage.Draw(DestCanvas: TCanvas; const DestRect: TRect);
  Changed;
end;

StretchBlt serait donc juste un enrobage de StretchDraw, un peu mal écrit ?

Car en examinant les manières d'utiliser StretchDraw trouvées ici et là sur le web et en les reportant vers StrechBlt, il n'y en a aucune qui me génère l'image sauf la tienne, Thierry !
Comment l'as-tu trouvée ?

Code :

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

1
2
3
4
5
6
7
  dst.TransparentMode := tmAuto;     // img noire
  dst.Canvas.Brush.Color := clBlack; // img noire
  dst.Canvas.CopyMode := cmSrcCopy;  // img noire
  dst.Canvas.Pixels[0,0]:= clYellow; // ok Thierry
  SetStretchBltMode(dst.Canvas.Handle, HALFTONE);
  Result:= StretchBlt(dst.Canvas.Handle,
  ...

Et le plus dément, c'est que toutes ces options, si je les enlève dans les proc's à base de StretchDraw, ben elles fonctionnent toujours bien et les images enregistrées sont toujours ok.
Allez, en gros et pour faire court et simple, StretchBlt a été écrit avec les pieds !
Ne plus utiliser, on ne sait pas où on va avec ce truc.

[ThWilliam]

Salut JP.

Juste encore un mot sur StretchBlt.

Si, à la fin de ta procédure StretchBmp, tu ajoutes :

Code :

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

Dst.Canvas.Changed;

alors le SaveToFile est ok.

C'est d'ailleurs ce qui est fait à la fin de la procédure TCanvas.StretchDraw

Amicalement
Thierry

[Jipété]

Juste encore un mot sur StretchBlt.

No problémo

Si, à la fin de ta procédure StretchBmp, tu ajoutes :

Code :

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

Dst.Canvas.Changed;

alors le SaveToFile est ok.

Ça alors ! Bien vu, j'ai testé, ça fonctionne
EDIT : j'ai honte, j'avais dû poser la question et tu m'avais déjà donné cette réponse il y 3 mois... /EDIT

C'est d'ailleurs ce qui est fait à la fin de la procédure TCanvas.StretchDraw

C'est à ça que tu pensais (dernière ligne) :

Code :

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

1
2
3
4
5
6
7
8
procedure TCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic);
begin
  if not Assigned(SrcGraphic) then exit;
  Changing;
  RequiredState([csHandleValid]);
  SrcGraphic.Draw(Self, DestRect); // jump vers procedure TRasterImage.Draw(DestCanvas: TCanvas; const DestRect: TRect);
  Changed; // <<<<<<<<<<<<<<<<< ?
end;

auquel cas je ne comprends pas, car il me semble bien que ce TCanvas.StretchDraw est appelé par StretchBlt.


Et si je blinde de ShowMessage(IntToStr(dst.Canvas.Handle)); les différentes lignes utiles de StretchBmp, je récupère toujours le même identifiant.

Une solution bien mystérieuse, donc !
Mais merci à toi de l'avoir trouvée et, oui, c'est plus "propre" même si on ne comprend pas comment ça fonctionne,