Composant image pour un rendu optimal

**dacid** · 15/03/2010, 18h00

Bonjour à tous,

Dans mon appli, je dois afficher un Tiff (grâce à GraphicEx) qui se redimensionne avec l'appli (alClient).
Seulement, quand il est plus petit que sa taille d'origine, il est vraiment illisible.
J'ai essayé avec Graphics32, mais le résultat est à peu près le même.

Y a t-il un composant ou une façon de faire qui dégraderait le moins possible l'affichage de mon Tiff ?
Existe t-il un antiAlias, un magnifiqueur ou un truc de ce style dans les composants que j'utilise ?

Merci d'avance.

**Montor** · 15/03/2010, 18h41

Attention GraphicEx ne fonctionne pas avec toutes les formats tiff

il y a la fonction "StrechDraw" dans l'unité GraphicEx.pas

Tu peux utiliser GDI+

**dacid** · 16/03/2010, 09h40

Bonjour Montor,

Merci pour la rapidité.

J'ai essayé StretchDraw, mais je ne suis pas sur de bien savoir l'utiliser.

Code :

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

Image1.Canvas.StretchDraw(Image1.ClientRect, Image1.Picture.Graphic);

De cette manière, il ne me le dessine pas ou il faut, il est tout écrasé et, du peu que je puisse voir, il n'est pas spécialement plus lisible.

J'ai essayé ta bibliothèque aussi.
Le dessin à l'air mieux, mais je n'arrive pas à lui donner le même comportement qu'au tImage.
Il le dessine à une certaine échelle non logique et ne gère pas le redimensionnement.
Je te joint un programme de test (il y a un tImage32 dessus et il faut ajouter GraphicEx, le poids limite ne me permettait pas de l'intégrer).

**Montor** · 25/03/2010, 21h22

désolé pour retard

Code :

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

Image1.Canvas.StretchDraw(Image1.ClientRect, Image1.Picture.Graphic);

il fallait juste ajouter

Code :

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

1
2
SetStretchBltMode(Image1.Canvas.handle,HALFTONE );
Image1.Canvas.StretchDraw(Image1.ClientRect, Image1.Picture.Graphic);

**dacid** · 26/03/2010, 09h34

Bonjour Montor,

Non, rien à faire, il ne la redessine pas proportionnellement.
De plus, je n'ai pas l'impression que ça améliore la qualité.

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 TfrmMain.Button2Click(Sender: TObject);
var strTemp: String;
begin
  try
    strTemp := chemRacineApp+'MonImg.tif';
    if FileExists(strTemp) then begin
      // Charger le tImage2
      Image2.Picture.LoadFromFile(strTemp);
      // Charger le tImage1
      SetStretchBltMode(Image1.Canvas.handle, HALFTONE);
      Image1.Canvas.StretchDraw(Image1.ClientRect, Image2.Picture.Graphic);
      // Methode GDI
      //LoadImgPlus(strTemp, Image1.Picture.Bitmap, Image1.Height, Image1.Width);
    end;
  except
    setInfo('ERREUR: Impossible de charger l''image: '+strTemp);
  end;
end;

**Andnotor** · 26/03/2010, 14h20

Pas de miracle, StretchDraw rempli le rectangle avec l'image fournie. Si tu veux une image proportionnelle, à toi de lui passer un rectangle correct (calculé).

Tu peux t'inspirer de ceci.

**Montor** · 26/03/2010, 21h13

@Andnotor
dacid veut améliorer la qualité de l'affichage

Voici trois méthodes pour le même but testées sous D7

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
uses GraphicEx,GdipApi;
{$R *.dfm}
procedure Stretch_API(AGraphic:TGraphic;ACanvas:TCanvas;ARect:TRect);
var
 Q:TBitmap;
 D:integer;
begin
 Q:=TBitmap.Create;
 try
  Q.Width  :=AGraphic.Width;
  Q.Height :=AGraphic.Height;
  Q.Canvas.Draw(0,0,AGraphic);
  D :=Windows.GetStretchBltMode(ACanvas.Handle);
  try
     Windows.SetStretchBltMode(ACanvas.Handle,HALFTONE);
     ACanvas.CopyRect(ARect,Q.Canvas,Q.Canvas.ClipRect);
  finally
   Windows.SetStretchBltMode(ACanvas.Handle,D);
  end;
 finally
 Q.Free();
 end;
end;
 
procedure Stretch_GraphicEx(AGraphic:TGraphic;ACanvas:TCanvas;ARect:TRect);
var
 Q:TBitmap;
begin
 Q:=TBitmap.Create;
 try
  Q.Width  :=AGraphic.Width;
  Q.Height :=AGraphic.Height;
  Q.Canvas.Draw(0,0,AGraphic);
  with ARect do
  GraphicEx.Stretch(Right-Left,Bottom-Top,sfHermite,1,Q);
  ACanvas.CopyRect(ARect,Q.Canvas,Q.Canvas.ClipRect);
 finally
 Q.Free();
 end;
end;
{tests}
procedure TForm1.Button1Click(Sender: TObject);
begin
  {Methode 1 lente}
  // Stretch_API(image1.Picture.Graphic,image1.Canvas,image1.ClientRect);
 
  {Methode 2 lente}
  // Stretch_GraphicEx(image1.Picture.Graphic,image1.Canvas,image1.ClientRect);
 
  {Methode 3 rapide GDI+}
  with image1 do
   LoadImgPlus('C:\A.tif',Picture.Bitmap,Width,Height,False,true);
end;

Unité GdipApi.pas modifiée

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
unit GdipApi;
//simplification de unité GdipApi.pas par Zutatous
interface
 
uses
  Windows, SysUtils, Graphics;
 
 procedure LoadImgPlus(const Filename:Widestring;AOut:TBitmap; W,H : Cardinal;
           AutoSize,Stretch:boolean);
 procedure SaveImgPlus(const Filename:Widestring;AInp:TBitmap;AFormat:string='.bmp');
 
implementation
 type
  DebugEventLevel = (
    DebugEventLevelFatal,
    DebugEventLevelWarning
  );
     Unit_ = (
    UnitWorld,
    UnitDisplay,
    UnitPixel,
    UnitPoint,
    UnitInch,
    UnitDocument,
    UnitMillimeter
  );
  TUnit = Unit_;
  TDebugEventLevel = DebugEventLevel;
  DebugEventProc = procedure(level: DebugEventLevel; message: PChar); stdcall;
  GdiplusStartupInput = packed record
    GdiplusVersion          : Cardinal;
    DebugEventCallback      : DebugEventProc;
    SuppressBackgroundThread: BOOL;
    SuppressExternalCodecs  : BOOL;
  end;
  TGdiplusStartupInput = GdiplusStartupInput;
  PGdiplusStartupInput = ^TGdiplusStartupInput;
  GPIMAGE     =Pointer;
  GPBITMAP    =Pointer;
  GPGRAPHICS  =Pointer;
 
  EncoderParameter = packed record
    Guid           : TGUID;
    NumberOfValues : ULONG;
    Type_          : ULONG;
    Value          : Pointer;
  end;
  TEncoderParameter = EncoderParameter;
  PEncoderParameter = ^TEncoderParameter;
 
  EncoderParameters = packed record
    Count     : UINT;
    Parameter : array[0..0] of TEncoderParameter;
  end;
  TEncoderParameters = EncoderParameters;
  PEncoderParameters = ^TEncoderParameters;
 
var
  StartupInput: TGDIPlusStartupInput;
  gdiplusToken: ULONG;
 
 const BmpEncoder   :TGuid = '{557CF400-1A04-11D3-9A73-0000F81EF32E}';
 const JpegEncoder  :TGuid = '{557CF401-1A04-11D3-9A73-0000F81EF32E}';
 const GifEncoder   :TGuid = '{557CF402-1A04-11D3-9A73-0000F81EF32E}';
 const TifEncoder   :TGuid = '{557CF405-1A04-11D3-9A73-0000F81EF32E}';
 const PngEncoder   :TGuid = '{557CF406-1A04-11D3-9A73-0000F81EF32E}';
 const QualityParam :TGuid = '{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}';
 
 function GdipCreateBitmapFromFile(filename: PWCHAR;
          out bitmap: Pointer): byte;stdcall;external 'Gdiplus.dll' ;
 
 function GdipGetImageWidth(image: GPIMAGE;
          var width: UINT): byte; stdcall;external 'Gdiplus.dll' ;
 
 function GdipGetImageHeight(image: GPIMAGE;
          var height: UINT): byte; stdcall;external 'Gdiplus.dll' ;
 
 function GdipCreateFromHDC(hdc: HDC;
          out graphics: GPGRAPHICS): byte; stdcall;external 'Gdiplus.dll' ;
 
 function GdipDrawImage(graphics: GPGRAPHICS; image: GPIMAGE; x: Single;
          y: Single): byte; stdcall;external 'Gdiplus.dll' ;
 
 function GdipDeleteGraphics(graphics: GPGRAPHICS): byte; stdcall;
          external 'Gdiplus.dll' ;
 
 function GdipDisposeImage(image: GPIMAGE): byte; stdcall;
          external 'Gdiplus.dll' ;
 
 function GdipCreateBitmapFromHBITMAP(hbm: HBITMAP; hpal: HPALETTE;
          out bitmap: GPBITMAP): byte; stdcall;external 'Gdiplus.dll' ;
 
 function GdipSaveImageToFile(image: GPIMAGE;
         filename: PWCHAR;
         clsidEncoder: PGUID;
         encoderParams: PEncoderParameters): byte; stdcall; external 'Gdiplus.dll' ;
 
 function GdiplusStartup(out token: ULONG; input: PGdiplusStartupInput;
          output: Pointer): Byte; stdcall;external 'Gdiplus.dll' ;
 
 procedure GdiplusShutdown(token: ULONG); stdcall;external 'Gdiplus.dll' ;
 
 function GdipDrawImageRectRect(graphics: GPGRAPHICS; image: GPIMAGE;
    dstx: Single; dsty: Single; dstwidth: Single; dstheight: Single;
    srcx: Single; srcy: Single; srcwidth: Single; srcheight: Single;
    srcUnit: TUnit; imageAttributes: pointer;
    callback: pointer; callbackData: Pointer): byte; stdcall;external 'Gdiplus.dll' ;
 
procedure LoadImgPlus(const Filename:Widestring;AOut:TBitmap; W,H : Cardinal;
          AutoSize,Stretch:boolean);
var
 xH,xW:cardinal;
 Pimg,dc:Pointer;
begin
    if not Assigned(AOut) then Exit;
    if GdipCreateBitmapFromFile(PWidechar(Filename), Pimg)= 0 then
    begin
      GdipGetImageHeight(Pimg,xH);
      GdipGetImageWidth(Pimg,xW);
      if AutoSize then
      begin
        W  := xW;
        H  := xH;
      end else if not Stretch then  begin
        xW :=W;
        xH :=H;
      end;
      AOut.Width  :=W;
      AOut.Height :=H;
 
 
      GdipCreateFromHDC(AOut.Canvas.Handle,dc);
      GdipDrawImageRectRect(dc,Pimg,0,0,W,H,
       0,0,xW,xH,UnitPixel,nil,nil,nil);
      GdipDeleteGraphics(dc);
      GdipDisposeImage(Pimg);
    end;
end;
 
procedure SaveImgPlus(const Filename:Widestring;AInp:TBitmap;AFormat:string);
var
 Pimg       : Pointer;
 SaveFormat : TGuid;
 S          : Widestring;
 W          : EncoderParameters;
 CompressRate:integer;
begin
    if not Assigned(AInp) then Exit;
 
    AFormat :=LowerCase(AFormat);
    if AFormat = '.bmp' then
      SaveFormat := BmpEncoder
    else if AFormat = '.jpg' then
      SaveFormat := JpegEncoder
    else if AFormat = '.png' then
      SaveFormat := PngEncoder
    else if AFormat = '.tif' then
      SaveFormat := TifEncoder
    else if AFormat = '.gif' then
      SaveFormat := GifEncoder
    else
      raise Exception.Create('Format non valide '+AFormat);
 
    S:= ChangeFileExt(Filename,AFormat);
    if GdipCreateBitmapFromHBITMAP(AInp.Handle,AInp.Palette,Pimg )= 0 then
    begin
      if AFormat = '.jpg' then
      with W.Parameter[0] do
      begin
        W.Count :=1;
        CompressRate := 80;
        Guid := QualityParam;
        NumberOfValues := 1;
        Type_ :=4;
        Value :=@CompressRate;
        GdipSaveImageToFile(Pimg,PWideChar(S),@SaveFormat,@W);
      end
        else GdipSaveImageToFile(Pimg,PWideChar(S),@SaveFormat,nil);
 
      GdipDisposeImage(Pimg);
    end;
 
end;
 
 
initialization
  StartupInput.DebugEventCallback := nil;
  StartupInput.SuppressBackgroundThread := False;
  StartupInput.SuppressExternalCodecs   := False;
  StartupInput.GdiplusVersion := 1;
  GdiplusStartup(gdiplusToken, @StartupInput, nil);
finalization
  GdiplusShutdown(gdiplusToken);
end.

pour faire une zoom sur une parti de l'image utiliser la fonction rapide GdipDrawImageRectRect voir ici

c'est pas trop compliqué pour gérer la proportion

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
uses GraphicEx,GdipApi,math;
{$R *.dfm}
procedure Stretch_API(AGraphic:TGraphic;ACanvas:TCanvas;ARect:TRect);
var
 Q:TBitmap;
 D:integer;
begin
 Q:=TBitmap.Create;
 try
 
  Q.Width  :=AGraphic.Width;
  Q.Height :=AGraphic.Height;
  Q.Canvas.Draw(0,0,AGraphic);
 
  D :=Windows.GetStretchBltMode(ACanvas.Handle);
  try
     Windows.SetStretchBltMode(ACanvas.Handle,HALFTONE);
     ACanvas.CopyRect(ARect,Q.Canvas,Q.Canvas.ClipRect);
  finally
   Windows.SetStretchBltMode(ACanvas.Handle,D);
  end;
 finally
 Q.Free();
 end;
end;
 
procedure Stretch_GraphicEx(AGraphic:TGraphic;ACanvas:TCanvas;ARect:TRect);
var
 Q:TBitmap;
begin
 Q:=TBitmap.Create;
 try
  Q.Width  :=AGraphic.Width;
  Q.Height :=AGraphic.Height;
  Q.Canvas.Draw(0,0,AGraphic);
  with ARect do
  GraphicEx.Stretch(Right-Left,Bottom-Top,sfHermite,1,Q);
  ACanvas.Draw(0,0,Q);
 finally
 Q.Free();
 end;
end;
 
 
procedure LoadImg(const Filename:Widestring;AOut:TBitmap; W,H : Cardinal;
          AutoSize,Stretch,Proportion:boolean);
var
 xH,xW:cardinal;
 R:Single;
begin
    if not Assigned(AOut) then Exit;
    with TPicture.Create do
    try
      LoadFromFile(Filename);
      xH :=Graphic.Height;
      xW :=Graphic.Width;
      if AutoSize then
      begin
        W  := xW;
        H  := xH;
      end else if Proportion then  begin
        R  := Min(W/xW, H/xH);
        W  := Round(xW * R);
        H  := Round(xH * R);
      end else if not Stretch then  begin
        xW :=W;
        xH :=H;
      end;
      AOut.Width  :=W;
      AOut.Height :=H;
      {Methode 1 }
      //  Stretch_API(Graphic,AOut.Canvas,AOut.Canvas.ClipRect);
 
      {Methode 2 }
      Stretch_GraphicEx(Graphic,AOut.Canvas,AOut.Canvas.ClipRect);
    finally
     Free();
    end;
end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 
 
 {Methode 1,  Methode 2 }
 //with image1 do
 //   LoadImg('C:\A.tif',Picture.Bitmap,Width,Height,False,true,true);
 
 {Methode 3 rapide GDI+}
  with image1 do
   LoadImgPlus('C:\A.tif',Picture.Bitmap,Width,Height,False,true,true);
 
end;

...j'ai ajouter un parametre pour cela dans la fonction LoadImgPlus GDI+ c'est plus radie en plus tu peux enregister
avec le format Tif ce n'est ps le cas avec GraphicEx

LoadImgPlus
Ajoute uses Math

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
procedure LoadImgPlus(const Filename:Widestring;AOut:TBitmap; W,H : Cardinal;
          AutoSize,Stretch,Proportion:boolean);
var
 xH,xW:cardinal;
 Pimg,dc:Pointer;
 R:Single;
begin
    if not Assigned(AOut) then Exit;
    if GdipCreateBitmapFromFile(PWidechar(Filename), Pimg)= 0 then
    begin
      GdipGetImageHeight(Pimg,xH);
      GdipGetImageWidth(Pimg,xW);
      if AutoSize then
      begin
        W  := xW;
        H  := xH;
      end else if Proportion then  begin
        R  := Min(W/xW, H/xH);
        W  := Round(xW * R);
        H  := Round(xH * R);
      end else if not Stretch then  begin
        xW :=W;
        xH :=H;
      end;
      AOut.Width  :=W;
      AOut.Height :=H;
 
      GdipCreateFromHDC(AOut.Canvas.Handle,dc);
      GdipDrawImageRectRect(dc,Pimg,0,0,W,H,
       0,0,xW,xH,UnitPixel,nil,nil,nil);
      GdipDeleteGraphics(dc);
      GdipDisposeImage(Pimg);
    end;
end;

**dacid** · 01/04/2010, 17h58

Merci pour ta réponse très détaillée Montor,

J'ai testé tous tes scripts, et je n'ai pas réussi à trouver une qualité supérieure à un tiff chargé directement dans un tImage de façon basique.

Si tu veux voir, j'ai joint le prog qui me sert à faire mes tests, il y a un onglet pour chacun des tImage, ainsi c'est plus facile de les comparer.

Mon tif (joint au rar) est un dessin avec des lignes. Le problème, c'est que comme je ne charge pas à sa taille d'origine, beaucoup de ces lignes disparaissent et le dessin devient illisible.
Je crois que je vais devoir me faire une raison.

**Eric Boisvert** · 02/04/2010, 15h35

je crois que tu devrais essayer ça...

Code :

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

1
2
3
4
5
6
 
      // Charger le tImage1 pleine grandeur
      Image1.Stretch:=False; //car le stretch est pourri...
      Image1.Picture.LoadFromFile(strTemp);
      //Stretch from GraphicEx qui fait un excellent travaille...
      Stretch(Image1.Width, Image1.Height,sfHermite, 1, Image1.Picture.Bitmap );

**Dr.Who** · 04/04/2010, 02h14

tout a fait normal et tu ne pourra rien n'y faire.

en bitmap, le redimensionnement, même proportionnel et même secondé par des algorithmes d'amélioration, donnera toujours un résultat plus ou moins décevant.
c'est encore plus vrai quand le bitmap possède des géométries fines tel que des lignes.

pour les aplats de couleurs, comme les photos par exemple le redimensionnement ne pose pas trop de problème.

le redimensionnement pour les images possédant des géométries fine doit se faire de façon proportionnelle avec des facteurs "parfaits".

pour les géométries fine, une seule solution : le vectoriel ou, la vectorisation bitmap.

**GoustiFruit** · 05/04/2010, 13h30

Je ne suis pas tout à fait d'accord, certes il y aura de la perte mais il doit y avoir moyen de faire beaucoup mieux: je viens de tester le rendu dans son programme d'un côté, et dans mon afficheur d'images préféré (XnView) avec la même image, et XnView fait un excellent travail en comparaison, l'image reste "lisible" même fortement réduite. Même la visionneuse intégrée de Windows fait beaucoup mieux.
Un truc étonnant tout de même: j'ai converti l'original (tif) en bmp et dans l'explorateur Windows (XP) en mode affichage "miniatures", la miniature du bmp est plus belle que la miniature du tif.

**Montor** · 06/04/2010, 22h20

@dacid
désolé mais là tu mélange tous ... j'esserai d'être plus clair donc si tu veux creer des miniatures de qualité

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 Thumb(const AFilename: string): Integer;
var
 Bmp :TBitmap;
begin
  Result := 1;
  Bmp :=TBitmap.Create;
  try
    Bmp.Width   :=300;
    Bmp.Height  :=300;
    LoadImgPlus(AFilename,Bmp,Bmp.Width,Bmp.Height,false,false, true);
 
    SaveImgPlus(AFilename+'_Thumb.tif',Bmp,'.tif');
 
  finally
    Bmp.Free();
  end;
end;

tu peux voir mon project dans la piece jointe