Composant image pour un rendu optimal

Version imprimable

15/03/2010, 18h00
dacid

Composant image pour un rendu optimal

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.
15/03/2010, 18h41
Montor

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+
16/03/2010, 09h40
dacid

Bonjour Montor,

Merci pour la rapidité.

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

Code:

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).
25/03/2010, 21h22
Montor
désolé pour retard

Citation:

Code:

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

il fallait juste ajouter
Code:

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

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:

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;

26/03/2010, 14h20
Andnotor

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.

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

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

Code:

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:

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:

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:

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;

01/04/2010, 17h58
dacid

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. :(

je crois que tu devrais essayer ça...

Code:

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 );

04/04/2010, 02h14
Dr.Who

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.
05/04/2010, 13h30
GoustiFruit

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.

1 pièce(s) jointe(s)

@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:

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

07/04/2010, 09h29
GoustiFruit

Ah en effet c'est mieux :ccool: J'aurais dû regarder de plus près au code de dacid avant de tirer des conclusions !
07/04/2010, 09h42
dacid

Super,

C'est extra Montor, c'est 1000 fois mieux comme rendu.
Je n'avais jamais utilisé PaintBox, en fait.

Merci à tous.