Discussion :

[Gilbert Geyer]

Bonjour,

J'ai une Form qui comporte une Image1 qui en recouvre les deux tiers de droite comme habillage et qui est chargée avec l'inspecteur d'objets à la conception avec un fichier *.jpg type 16 millions de couleurs ( la partie gauche de l'écran est occupée par divers composants).

Au lancement de l'appli la qualité visulle de cette Image1 est bonne.

Par la suite je charge un fichier-image (*.bmp, *.jpg ou *.wmf) dont j'extrais le BitMap par conversion à partir duquel j'en crée un autre de taille réduite (en pf24Bit) qui est sauvé sur le disque puis affiché dans une vignette formée par un TPanel supportant un TImage créés de façon dynamique.

Bien que la qualité d'origine des fichier-image-source chargés soit équivalente à celle logée dans Image1, après l'affichage d'une de ces vignettes la qualité visuelle est déplorable non seulement celle des vignettes mais également celle d'Image1 qui était pourtant bonne au lancement. Elles donnent l'impression qu'on en a réduit le nombre de couleurs. Le résultat est déplorable en particulier dans le cas de fichiers *.bmp et *.jpg

Pour corser le tout quand j'affiche les images des fichiers-source et des fichiers de taille réduite avec PaintShopPro la qualité visuelle des conversions est correcte, du coup je ne sais plus où chercher le bug qui réduit la qualité de l'affichage. (Windows98 - Delphi5)

Quelqu'un aurait une idée, une explication, un remède ?

A toutes fins utiles voiçi les parties concernées du code :

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
 
private
    { Déclarations privées }
    procedure AffPanelVignette(const nomFichier: string; X,Y : integer);
    procedure VignetteMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  public
    { Déclarations publiques }
  end;
 
var
  frmTrImages: TfrmTrImages;
 
  largeurMax : integer;
 
//--- Récup des BitMap pf24bit à partir de fichiers-image ----------------------------
 
  function BMPdeBMP(const nomFichierBMP : string) : TBitmap;
 
  function BMPdeJPEG(const nomFichierJPEG : string): TBitmap;
  // Renvoie le Bmp d'un fichier JPG
 
  function BMPdeWMF(const nomFichierWMF : string) : TBitmap;
  // Renvoie le Bmp d'un fichier WMF
 
  function BMPdeICO(const nomFichierICO : string) : TBitmap;
  // Renvoie le Bmp d'un fichier ICO
 
  function  ReDimImageSD(const nomFichier: string; LargeurMax: Integer) : tBitMap;
  // Renvoie le Bmp de taille réduite d'un fichier *.BMP, *.JPG ou *.WMF avec StretchDraw
 
implementation
 
{$R *.DFM}
 
//---------------------------------------------------------------------------
 
function BMPdeBMP(const nomFichierBMP : string) : TBitmap;
begin    Result := Nil;
         if (nomFichierBMP = '') then EXIT;
         Result:= TBitmap.Create;
         Result.PixelFormat := pf24Bit;
         try // test de chargement
             Result.LoadFromFile(nomFichierBMP);
         except
             Result.Free; Result:= Nil;
             Result.Palette
         end;
end; // BMPdeBMP
 
function BMPdeJPEG(const nomFichierJPEG : string): TBitmap;
var      JPEGImage: TJPEGImage;
begin    Result := Nil;
         if (nomFichierJPEG = '') then EXIT;
         try
             JPEGImage := TJPEGImage.Create;
             Result := TBitmap.Create;
             Result.PixelFormat := pf24Bit;
             try // test de chargement
               JPEGImage.LoadFromFile(nomFichierJPEG);
               JPEGImage.DIBNeeded;
               Result.Assign(JPEGImage);
             finally
               JPEGImage.Free;
             end;
         except
             Result := Nil;
         end;
end; // BMPdeJPEG
 
function BMPdeWMF(const nomFichierWMF : string) : TBitmap;
var      MetaFile: TMetafile;
begin    Result := Nil;
         Metafile := TMetaFile.Create;
         if (nomFichierWMF = '') then EXIT;
         try Result := TBitmap.Create;
             Result.PixelFormat := pf24Bit;
             MetaFile.LoadFromFile(nomFichierWMF);
             // Dessine le metafile dans le canvas du Bitmap
             Result.Height := Metafile.Height;
             Result.Width  := Metafile.Width;
             Result.Canvas.Draw(0, 0, MetaFile);
         finally
             MetaFile.Free;
         end;
end;
 
function BMPdeICO(const nomFichierICO : string) : TBitmap;
var      Icon: TIcon;
begin    Result:= Nil;
         Icon  := TIcon.Create;
         if (nomFichierICO = '') then EXIT;
         try
            Icon.LoadFromFile(nomFichierICO);
            Result:= TBitmap.Create;
            Result.PixelFormat := pf24Bit;
            try // Conversion
               Result.Height:= Icon.Height;
               Result.Width := Icon.Width;
               Result.Canvas.Draw(0, 0, Icon);
            except
               Result.Free; Result:=nil;
            end;
         finally
            Icon.Free;
         end;
end;
 
function  ReDimImageSD(const nomFichier: string; LargeurMax: Integer) : tBitMap;
//        Pour BMP, JPG et  WMF avec StretchDraw
var       BmpSource: TBitmap; ext : string; ok : boolean;
begin     BmpSource := TBitmap.Create;
          BmpSource.PixelFormat := pf24Bit;
          ok := false;
          try
             ext:=UpperCase(ExtractFileExt(nomFichier));
             if (ext='.JPG') then
             begin BmpSource:=BMPdeJPEG(nomFichier);
                   ok:=true
             end else
             if (ext='.BMP') then
             begin BmpSource:=BMPdeBMP(nomFichier);
                   ok:=true
             end else
             if (ext='.WMF') then
             begin BmpSource:=BMPdeWMF(nomFichier);
                   ok:=true
             end else sms(ext+' = Format non supporté par ReDimImageSD');
             if ok then
             begin if (BmpSource.Width > LargeurMax) then //
                   begin
                      Result := TBitmap.Create;
                      with Result do
                      begin PixelFormat := pf24Bit;
                            Width := LargeurMax;
                            Height := MulDiv(LargeurMax, BmpSource.Height, BmpSource.Width);
                            Canvas.StretchDraw(Rect(0,0,Result.Width,Result.Height), BmpSource);
                      end;
                   end;
             end else Result:=Nil;
          finally
                BmpSource.Free;
          end;
end; //ReDimImageSD
 
// Utilisation ---------------------------------------------------------
 
procedure TfrmTrImages.bNomFichierSourceClick(Sender: TObject);
const     filtre='fichiers (*.bmp;*.jpg;*.wmf|*.bmp;*.jpg;*.wmf|tous (*.*)|*.*';
begin     with OpenPictureDialog1 do
          begin Filter:=Filtre;
                if Execute then EdNomFichier.text:= FileName;
          end;
end;
 
procedure TfrmTrImages.edLargeurMaxChange(Sender: TObject);
begin     panel1.width:=StrToInt(edLargeurMax.text); // réglette pour visu largeur
          LargeurMax:=StrToInt(edLargeurMax.text);
end;
 
procedure TfrmTrImages.AffPanelVignette(const nomFichier: string; X,Y : integer);
var       plVi : tPanel; img : tImage;
begin     plVi:=tPanel.create(frmTrImages);
          with plVi do
          begin parent:=frmTrImages;
                DoubleBuffered := true;
                visible:=false;
                left:=X; top:=Y;
                align:=alNone;
                caption:=nomFichier;
                autoSize:=false;
          end;
          img:=tImage.create(plVi);
          with img do
          begin parent:=plVi; align:=alNone; autosize:=true; // Taille réelle
                left:=0; top:=0;
                picture.LoadFromFile(nomFichier);
                onMouseMove:=VignetteMouseMove; // Pour déplacer les vignettes à la souris
          end;
          with plVi do
          begin width:=img.picture.Width;
                height:=img.picture.Height;
                visible:=true;
          end;
end;
 
procedure TfrmTrImages.VignetteMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
//        Déplacement vignettes
const     SCDragMove = $F014;
var       pa : TControl; PLs : tPanel; nomPl : string;
begin     if (ssLeft in Shift) then
          begin ReleaseCapture;
                pa:=(sender as tImage).parent;
                pa.Perform(WM_SysCommand, SCDragMove, 0);
          end;
end;
 
var       Chemin,nomFi : string; // du Bmp-Réduit
procedure TfrmTrImages.bRedimensionnerClick(Sender: TObject);
var       Bmp : tBitMap;
begin     // Reduction de la taille :
          Bmp:=ReDimImageSD(EdNomFichier.text, LargeurMax);
          // Sauvegarde vers disque :
          Chemin:=extractFilePath(EdNomFichier.text);
          nomFi:=extractFileName(EdNomFichier.text);
          nomFi:='Reduc_'+ChangeFileExt(nomFi,'.bmp');
          bmp.SaveToFile(Chemin+nomFi);
          // Affichage dans vignette :
          AffPanelVignette(Chemin+nomFi, 230,40);
end;
 
procedure TfrmTrImages.FormPaint(Sender: TObject);
begin     Image1.refresh; // aucune de ces trois instructions n'apporte d'amélioration à image1
          Image1.Repaint;
          Image1.Update;
 
end;
 
END.

Dans l'attente, merci.

[tourlourou]

désolé, mais je ne vois rien dans le code qui me semble susceptible d'un tel effet !

sans compter que Image1 ne devrait pas être affectée, car il n'y a pas d'appel à elle, si j'ai bien compris, à aucun endroit de ton code ?

je te conseille de faire démarabouter ton PC !

[Gilbert Geyer]

Bonjour,

Merci Tourlourou.

désolé, mais je ne vois rien dans le code qui me semble susceptible d'un tel effet !

... C'est bien ce qui m'agace le plus, car j'espérais qu'il y aurait un bug rectifiable dans le code vu qu'on est toujours sec quand il sagit de caprices du matériel.

sans compter que Image1 ne devrait pas être affectée, car il n'y a pas d'appel à elle, si j'ai bien compris, à aucun endroit de ton code ?

... Effectivement, Image1 est chargée à la conception via l'Inspecteur d'objets et sa qualité visuelle reste impeccable tant que je n'affiche pas une autre image dans une vignette puis elle se dégrade en même temps que celle de la vignette.

je te conseille de faire démarabouter ton PC

... je vais faire la manip, mais comme je cherche la cause depuis presque une semaine j'ai déjà rebooté le PC "n" fois et le bug persiste.

En tous cas merci d'avoir jeté un coup d'oeil dans le code.

A+