[poli-smen]

Сообщение от U.B.M.

Всем доброго!

Возник вопрос:

Код:

procedure TForm1.CheckBox1Click(Sender: TObject);
var
  jpeg : TJpegImage;
begin
  jpeg := TJpegImage.Create;

  jpeg.Assign(ImageIn.picture.graphic);
  jpeg.Grayscale := checkbox1.Checked;
  ImageOut.Picture.Graphic.Assign(jpeg);

  jpeg.Destroy;
end;

Всё нормально - картинка сереет и цветнеет при постановке/снятии галочки.

Код:

procedure TForm1.TrackBar1Change(Sender: TObject);
var
  jpg : TJpegImage;
begin
  Edit1.Text := IntTostr(TrackBar1.Position);
  jpg := TJpegImage.Create;
  jpg.Assign(ImageIn.picture.graphic);
  jpg.CompressionQuality := TrackBar1.Position;
  jpg.DIBNeeded;
  jpg.Compress;

//  jpg.SaveToFile('D:\Out.jpg');

  ImageOut.Picture.Graphic.Assign(jpg);
end;

мотаю ползунком - качество картинки не меняется (при этом в файл сохраняется скомпрессованная картинка).

Что не так?

Это всё потому что TJpegImage использует 2 буфера: DIB-буфер и JPEG-буфер. В методах LoadFromFile, LoadFromStream, SaveToFile, SaveToStream участвует JPEG-буфер, а в методе Assign участвует DIB-буфер, его то мы и видим в компоненте TImage. А вот JPEG-буфер мы фактически никогда не видим.
Схема примерно такая:
При загрузке jpeg-картинки очищаются оба буфера и в JPEG-буфер загружается jpeg-картинка.
Когда есть нужда прорисовать картинку (например в TImage), то запрашивается DIB-буфер, а если он пустой, то вызывается метод DIBNeeded, который распаковывает картинку из JPEG-буфера в DIB-буфер.
Когда вызываем метод Compress то DIB-буфер упаковывается в JPEG-буфер, но для отображения всё равно продолжает использоваться DIB-буфер, который после Compress совершенно не изменился.
Вот если бы можно было убить DIB-буфер, то при следующем запросе из JPEG-буфер распаковалось бы новое (пережатое) содержимое. Но если для создания DIB-буфера есть соответствующий метод (DIBNeeded), то для его разрушения к сожалению нет.
Точнее такой метод есть. Называется он FreeBitmap, но он почему-то скрыт в protected секции и для обычного использования недоступен.
Но зато он доступен, для наследников TJPEGImage из чего вытекает такой полухакерский способ:

Объявляем наследника TJPEGImage следующим образом:

Код:

type
  TMyJpegImage = class(TJPEGImage);

И после метода Compress вызываем FreeBitmap следующим образом:

Код:

procedure TForm1.TrackBar1Change(Sender: TObject);
var
  jpg : TJpegImage;
begin
...
  jpg.Compress;
  TMyJpegImage(jpg).FreeBitmap;
 
//  jpg.SaveToFile('D:\Out.jpg');
 
  ImageOut.Picture.Graphic.Assign(jpg);
end;

Но к счастью есть более легальный способ очистить DIB-буфер. Дело в том, что установка некоторых свойств (например Grayscale) в TJpegImage автоматически очищает DIB-буфер. Вот пример использования такого способа:

Код:

procedure TForm1.TrackBar1Change(Sender: TObject);
var
  jpg : TJpegImage;
begin
...
  jpg.Compress;
  jpg.Grayscale:=True;
  jpg.Grayscale:=False;
 
//  jpg.SaveToFile('D:\Out.jpg');
 
  ImageOut.Picture.Graphic.Assign(jpg);
end;

Или так:

Код:

procedure TForm1.TrackBar1Change(Sender: TObject);
var
  jpg : TJpegImage;
begin
...
  jpg.Compress;
  jpg.Grayscale:=not jpg.Grayscale;
  jpg.Grayscale:=not jpg.Grayscale;
 
//  jpg.SaveToFile('D:\Out.jpg');
 
  ImageOut.Picture.Graphic.Assign(jpg);
end;

Справедливости ради отмечу ещё один способ:

Код:

procedure TForm1.TrackBar1Change(Sender: TObject);
var
  jpg : TJpegImage;
  ms: TMemoryStream;
begin
...
  jpg.Compress;
  ms:=TMemoryStream.Create;
  try
    jpg.SaveToStream(ms);
    ms.Position:=0;
    jpg.LoadFromStream(ms);
  finally
    ms.Free;
  end;
 
//  jpg.SaveToFile('D:\Out.jpg');
 
  ImageOut.Picture.Graphic.Assign(jpg);
end;

Здесь используется тот факт, что метод LoadFromStream перед загрузкой jpeg-картинки очищает оба буфера.