Conversion bmp->jpeg compression

Version imprimable

Pourquoi je ne vois pas de différence de qualité en faisant bouger mon trackbar lors de l'affichage ?

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
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtDlgs, StdCtrls, ExtCtrls, ComCtrls,jpeg;
 
type
  TForm1 = class(TForm)
    TrackBar1: TTrackBar;
    Panel1: TPanel;
    Button1: TButton;
    Ouvrir: TOpenPictureDialog;
    Sauver: TSaveDialog;
    Button2: TButton;
    PaintBox1: TPaintBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Déclarations privées }
    bmp:TBitMap;
    jpg:TJPEGImage;
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
 
begin
  If Not Ouvrir.Execute Then Exit;
  If UpperCase(ExtractFileExt(Ouvrir.FileName))<>'.BMP' Then Exit;
  bmp.LoadFromFile(Ouvrir.FileName);
  jpg.CompressionQuality:=Trackbar1.position;
  jpg.GrayScale:=False;
  jpg.Assign(bmp);
  paintbox1.invalidate;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
 Sauver.FileName:=Copy(Ouvrir.FileName,1,Length(Ouvrir.FileName)-4)+'.jpg';
 If Not Sauver.Execute Then Exit;
 jpg.SaveToFile(Sauver.FileName);
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 bmp.Free;
 jpg.Free;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 jpg:=TJPEGImage.Create;
 bmp:=TBitMap.Create;
 
 with trackbar1 do
  begin
   min:=1;
   max:=100;
   position:=100;
  end;
  doublebuffered:=true;
end;
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
 paintbox1.canvas.draw(0,0,jpg);
end;
 
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
   jpg.CompressionQuality:=Trackbar1.position;
   jpg.GrayScale:=False;
   jpg.Assign(bmp);
   paintbox1.invalidate;
end;
 
end.

MERCI

26/04/2010, 22h52
Montor

ajoute

Code:

jpg.compress();
26/04/2010, 23h10
Jipété
Salut !

Citation:

Envoyé par Archimède

Pourquoi je ne vois pas de différence de qualité en faisant bouger mon trackbar lors de l'affichage ?

Peut-être parce qu'il manque l'instruction « Compress » ?
J'ai trouvé ça sur Delphi3000 :
Code:

1 2 3 4 // Do the Compression and Save New File oJPG.CompressionQuality := iCompression; oJPG.Compress; oJPG.SaveToFile(AOutFile);
Mais je ne suis pas du tout spécialiste et n'ai rien testé (il est tard...)

Ah, y a ça, aussi : Using the JPEG Unit, où je lis que tu risques d'avoir un souci :

Citation:

However, just setting the compression level for a JPEG isn’t enough; you have to call the compress method to actually cause change in the image. Even after calling the compress method, no change is made in the actual file–only in the image being viewed. To change the compression in the file itself, you must set the compression level, call the compress method, and then save the image to a file.

(c'est moi qui met en gras)
Valà
26/04/2010, 23h18
Montor

C'est pas trop compliqué il peux trouver un exemple dans le help
27/04/2010, 10h29
Archimède

Montor---> merci, j'avais déjà essayé d'ajouter compress mais sans succès pour autant...

Apparemment, il faut tout de même l'ajouter...(cf: Using the JPEG Unit)

Jipété--> super tes références, il me reste à décortiquer tout ça. je regarde...

C'est faisable, xnview permet bien de le faire...

Si vous trouvez la solution ...
27/04/2010, 10h54
Jipété

Citation:

Envoyé par Archimède

C'est faisable, xnview permet bien de le faire...

Si vous trouvez la solution ...

Peut-être (je dis bien « peut-être ») SaveToStream de ton jpeg compressé, suivi d'un LoadFromStream pour l'image destinataire ?

Juste une idée comme ça...

Excellente remarque Jipété, en effet, si je n'avais pas la fameuse erreur:
#42, ce serait parfait...
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 procedure TForm1.TrackBar1Change(Sender: TObject); var stream:TMemoryStream; begin try jpg.CompressionQuality:=Trackbar1.position; jpg.GrayScale:=False; jpg.Assign(bmp); stream:=TMemoryStream.create; jpg.Savetostream(stream); Stream.Position:=0; jpg.LoadFromStream(stream); finally stream.free; end; paintbox1.invalidate; end;
en forçant la compile, ça marche...

Comment contourner la classe d'exception EJPEG renvoyée ?

c'est bon, apparemment ça marche :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
procedure TForm1.TrackBar1Change(Sender: TObject);
var stream:TMemoryStream;
begin
    jpg.CompressionQuality:=Trackbar1.position;
    jpg.GrayScale:=False;
    jpg.Assign(bmp);
    if not jpg.empty then
     try
      stream:=TMemoryStream.create;
      jpg.Savetostream(stream);
      Stream.Position:=0;
      jpg.LoadFromStream(stream);
     finally
      freeandnil(Stream);
     end;
 
paintbox1.invalidate;
end;

Merci pour le coup de main ;)