Discussion :

[XeGregory]

Bonjour a tous,

Comment peut-on perdre de la qualité d'une image en passant par TPicture ?

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
procedure...
var
  Picture: TPicture;
begin
  Clipboard.Clear;
  RichEdit.CopyToClipboard; // TLMDRichEdit
 
  if Clipboard.HasFormat(CF_PICTURE) then
  begin
    Picture := TPicture.Create;
    Picture.Assign(Clipboard);
    Clipboard.Clear;
 
    Image1.Picture.Assign(Picture);
    FreeAndNil(Picture);
  end;
end;

Image d'origine



Image du ClipBoard



À mon avis, le problème provient du TPicture. Par exemple, si je copie l'image et que je la colle dans le Wordpad de Windows, l'image est de même qualité que l'origine.

Merci beaucoup.

[XeGregory]

J'ai testé de passer directement par le TMetaFile en redessinant le graphique sur Tbitmap.
Envain, j'ai toujours une perte de qualité.

Il y a quelque chose que je ne saisis pas.

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
var
  MetaFile: TMetaFile;
  Bitmap: TBitmap;
begin
  Clipboard.Clear;
  RichEdit.CopyToClipboard; // TLMDRichEdit
 
  if Clipboard.HasFormat(CF_METAFILEPICT) then
  begin
    MetaFile := TMetaFile.Create;
    MetaFile.Assign(Clipboard);
 
    Bitmap := TBitmap.Create;
    Bitmap.PixelFormat := pf32bit;
    Bitmap.SetSize(MetaFile.Width, MetaFile.Height);
    Bitmap.Canvas.StretchDraw(Rect(0, 0, MetaFile.Width, MetaFile.Height), MetaFile);
 
    Clipboard.Clear;
    Image1.Picture.Bitmap.Assign(Bitmap);
 
    FreeAndNil(Bitmap);
    FreeAndNil(MetaFile);
  end;
end;

En y jetant un coup d'œil plus attentif, on remarque un léger zoom sur le graphique collée dans la TImage, Il est possible que cette perte de qualité soit due au fait que les dimensions du TMetaFile ne sont pas correctes.

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
var
  MetaFile: TMetaFile;
  Bitmap: TBitmap;
  ImageOG: TPicture;
begin
  Clipboard.Clear;
  RichEdit.CopyToClipboard; // TLMDRichEdit
 
  if Clipboard.HasFormat(CF_METAFILEPICT) then
  begin
    MetaFile := TMetaFile.Create;
    MetaFile.Assign(Clipboard);
 
    ImageOG := TPicture.Create;
    ImageOG.LoadFromFile('Graph.bmp');
 
    ShowMessage('Image OG : Width = ' + IntToStr(ImageOG.Width) + ', Height = ' +
      IntToStr(ImageOG.Height) + #13 + 'Image MetaFile Clipboard : Width = ' +
      IntToStr(MetaFile.Width) + ', Height = ' + IntToStr(MetaFile.Height));
 
    ImageOG.Free;
 
    Bitmap := TBitmap.Create;
    Bitmap.PixelFormat := pf32bit;
    Bitmap.SetSize(MetaFile.Width, MetaFile.Height);
    Bitmap.Canvas.StretchDraw(Rect(0, 0, MetaFile.Width, MetaFile.Height), MetaFile);
 
    Clipboard.Clear;
    Image1.Picture.Bitmap.Assign(Bitmap);
 
    FreeAndNil(Bitmap);
    FreeAndNil(MetaFile);
  end;
end;

Il y a quelque chose qui me rajoute des pixels supplémentaires lors de la copie (CopyToClipboard).

[XeGregory]

Je crois avoir résolu le problème en passant par TMemoryStream & Picture.LoadFromStream(Stream)

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
var
  Metafile: TMetafile;
  Stream : TMemoryStream;
begin
  Clipboard.Clear;
  RichEdit.CopyToClipboard; // TLMDRichEdit
 
  if Clipboard.HasFormat(CF_METAFILEPICT) then
  begin
    Metafile := TMetafile.Create;
    Metafile.Assign(Clipboard);
 
    Metafile.Enhanced := False;
    Stream := TMemoryStream.Create;
    Metafile.SaveToStream(Stream);
    Stream.Position := 0;
 
    Clipboard.Clear;
    Image1.Picture.LoadFromStream(Stream);
 
    FreeAndNil(Stream);
    FreeAndNil(Metafile);
  end;
end;