VPF::Качественный ресайз jpg - Форум программистов

14SatanA88

Дата 25.10.2010, 11:33 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: нет
Всего: 5

Здравствуйте, программеры.

Появилась необходимость программно в пакетном режиме произвести ресайз jpg-изображений.
При этом столкнулся с проблемой потери качества при обработке картинки. Причем пользовался расхваленной процедурой SmoothResize, к тому же выставлял свойство quality в 100. Результат никак не устраивает.

Код процедуры:

Код


procedure SmoothResize(Width, Height : integer; S,D : TBitmap);
type
  TRGBArray = array[Word] of TRGBTriple;
  pRGBArray = ^TRGBArray;

var
  x, y: Integer;
  xP, yP: Integer;
  Mx, My: Integer;
  SrcLine1, SrcLine2: pRGBArray;
  t3: Integer;
  z, z2, iz2: Integer;
  DstLine: pRGBArray;
  DstGap: Integer;
  w1, w2, w3, w4: Integer;
begin
  S.PixelFormat := pf24Bit;
  D.PixelFormat := pf24Bit;
  if Width*Height=0 then
  begin
   D.Assign(S);
   exit;
  end;
  D.Width:=Width;
  D.Height:=Height;
  if (S.Width = D.Width) and (S.Height = D.Height) then
    D.Assign(S)
  else
  begin
    DstLine := D.ScanLine[0];
    DstGap  := Integer(D.ScanLine[1]) - Integer(DstLine);
    Mx := MulDiv(S.Width+1, $10000, D.Width);
    My := MulDiv(S.Height+1, $10000, D.Height);
    yP  := 0;

    for y := 0 to pred(D.Height) do
    begin
      xP := 0;

      SrcLine1 := S.ScanLine[yP shr 16];

      if (yP shr 16 < pred(S.Height))and(Y<>D.Height-1) then
        SrcLine2 := S.ScanLine[succ(yP shr 16)]
      else
      begin
        SrcLine1 := S.ScanLine[S.Height-2];
        SrcLine2 := S.ScanLine[S.Height-1];
      end;

      z2  := succ(yP and $FFFF);
      iz2 := succ((not yp) and $FFFF);
      for x := 0 to pred(D.Width) do
      begin
        t3 := xP shr 16;
        z  := xP and $FFFF;
        w2 := MulDiv(z, iz2, $10000);
        w1 := iz2 - w2;
        w4 := MulDiv(z, z2, $10000);
        w3 := z2 - w4;
        if (t3>=S.Width-1)or(x=D.Width-1) then
         t3:=S.Width-2;
        DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 +
          SrcLine1[t3 + 1].rgbtRed * w2 + SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16;

        DstLine[x].rgbtGreen := (SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +
          SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;

        DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 +
          SrcLine1[t3 + 1].rgbtBlue * w2 +SrcLine2[t3].rgbtBlue * w3 +  SrcLine2[t3 + 1].rgbtBlue * w4) shr 16;
        Inc(xP, Mx);
      end; {for}
      Inc(yP, My);
      DstLine := pRGBArray(Integer(DstLine) + DstGap);
    end; {for}
  end; {if}
end; {SmoothResize}

Для сравнения:
Исходная картинка:
user posted image

Ресайз через AcdSee (это желаемый результат):
user posted image

Ресайз через SmoothResize (то, что поучается у меня):
user posted image

Предвещая Ваши вопросы, скажу:
1. Поиском пользовался. Все похожие темы устарели, в итоге предлагают SmoothResize.
2. Пробовал разные параметры. Итог не радует.

Помогите решить проблему. Хочу программного ресайза с результатом хотя бы близким к тому, что получается при использовании AcdSee.
Заранее благодарю.

Alexeis

Дата 25.10.2010, 12:03 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Цитата(14SatanA88 @ 25.10.2010, 12:33

)

Причем пользовался расхваленной процедурой SmoothResize, к тому же выставлял свойство quality в 100. Результат никак не устраивает.

А если сохранять как битмап? Чтобы удостовериться что проблема не в jpeg-e. Все таки jpeg 100 это тоже с потерями.

На счет алгоритмов. Помню что правильное уменьшение делают следующим образом. Сначала делают кратное уменьшение в 2/4/8/16... раз. Кратность выбирают так чтобы размер полученной картинки был меньше либо равен необходимому. Далее делают увеличение до необходимого размера (билинейное/бикубическое).

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

14SatanA88

Дата 25.10.2010, 13:35 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: нет
Всего: 5

Цитата

А если сохранять как битмап? Чтобы удостовериться что проблема не в jpeg-e. Все таки jpeg 100 это тоже с потерями.

Ненене, нужно обязательно в jpg полученные картинки сохранять.

Цитата

На счет алгоритмов. Помню что правильное уменьшение делают следующим образом. Сначала делают кратное уменьшение в 2/4/8/16... раз. Кратность выбирают так чтобы размер полученной картинки был меньше либо равен необходимому. Далее делают увеличение до необходимого размера (билинейное/бикубическое).

А есть код, примеры, etc. ? Очень нужно.
Особенно интересует билинейное и бикубическое увеличение.
Параллельно сам поищу, конечно, но неизвестно, найду ли...

Alexeis

Дата 25.10.2010, 15:49 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Цитата(14SatanA88 @ 25.10.2010, 14:35

)

Ненене, нужно обязательно в jpg полученные картинки сохранять.

Не об этом же речь, сохранить чтобы проверить не является ли искажения результатом работы некачественного кодировщика jpeg.

Цитата(14SatanA88 @ 25.10.2010, 14:35

)

Особенно интересует билинейное и бикубическое увеличение.

Да полно. Можно еще попробовать сделать ту же операцию при помощи GDI+. Там уже реализован бикубик и свой Jpeg декодер/енкодер. Качество может оказаться приемлемым.

--------------------

Snowy

Дата 25.10.2010, 16:05 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484

Vampyre Imaging Library
Умеет быстро и качественно работать с разными форматами.
Умеет ресайзить, крутить, поворачивать.
Бесплатная, чистый паскаль, cross-platform, FPC, delphi.32, delphi.net.
В демах есть пример конвертора изо-всего во всё.

14SatanA88

Дата 25.10.2010, 16:44 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: нет
Всего: 5

Snowy, спасибо, посмотрю.

Цитата

не в этом дело. сама процедура так плохо ресайзит. пробовал и jpg, и bmp.

14SatanA88

Дата 26.10.2010, 09:52 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: нет
Всего: 5

Snowy, не могу установить Vampyre Imaging Library
Если ты устанавливал, помоги, а то я еще долго буду разбираться.

Snowy

Дата 26.10.2010, 11:13 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484

Её не нужно ставить. Это не компонент.
Просто пропиши в путях к либам путь к папке Source.
Как юзать - смотри в демках VampConvert.dpr
Там всё, что тебе нужно и даже больше.

14SatanA88

Дата 26.10.2010, 11:26 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: нет
Всего: 5

Snowy, пути делфе указал. при запуске VampConvert появляется консоль и через секунду закрывается.
Именно то, что мне нужно, нашел при втыкании LCLImager.exe
Исходники к этой штуке написаны на Lazarus. Как мне открыть проект в Delphi 7?

Или, чтобы было еще проще, объясни мне, идиоту, как вытащить себе в проект функцию бикубического либо билинейного ресайза, чтобы она работала. Буду очень признателен.

Кстати, пробовал открывать другие проекты, но они не компилятся. Ссылаются на отсутствие файла sdl.dcu, которого в папке с Vampyre Imaging Library нет...

А вот, нашел в коде функцию ресайза Imaging.ResizeImage()
Теперь осталось понять, что в нее запихать, чтобы она работала...

Это сообщение отредактировал(а) 14SatanA88 - 26.10.2010, 11:43

Snowy

Дата 26.10.2010, 11:44 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484

Чтобы собрать демы, есть в батники в папке Scripts
BuildDemosDelphi.bat скомпилит все демы.
VampConvert так и должен делать. Это ж утилита коммандной строки.
Запусти его из консоли. Там параметры коммандной строки задавать нужно.
Или просто код смотри - справка там в явном виде через WriteLn нарисована.
Ресайзить просто - Imaging.ResizeImage(список_имаджей, новая_ширина, новая_высота, rfBicubic);
Подробнее всё в том же VampConvert.

14SatanA88

Дата 26.10.2010, 11:58 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: нет
Всего: 5

Цитата

Ресайзить просто - Imaging.ResizeImage(список_имаджей, новая_ширина, новая_высота, rfBicubic);

Да, я уже понял, нашел. Только вот один вопрос остался - как вогнать картинку в первый параметр? Подробней, шаг за шагом, если можно

Код


  Imaging.LoadImageFromFile('d:\original.jpg', MainImage);
  Imaging.ResizeImage(MainImage,69,100,rfBicubic);

Пробовал вот так, что-то не ресайзит. Картинка остается как и была. По атрибутам тоже не видно, что ее трогали (время не меняется).

Это сообщение отредактировал(а) 14SatanA88 - 26.10.2010, 12:02

Snowy

Дата 26.10.2010, 12:08 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484

Ты сохранить забыл. Отресайзил, но в памяти.
Вот накидал пример.

Код

program test;

uses
  SysUtils, Classes, ImagingTypes, Imaging;

function ResizeImage(infile, outfile: string; width, height: integer): boolean;
var
  Images: TDynImageDataArray;
  i: integer;
begin
  result := false;
  try
    if not Imaging.LoadMultiImageFromFile(infile, Images) then Exit;
    if (Length(Images) = 0) or not Imaging.TestImagesInArray(Images) then Exit;
    for i := 0 to High(Images) do
      Imaging.ResizeImage(Images[i], width, height, rfBicubic {rfBilinear});
    if not Imaging.SaveMultiImageToFile(outfile, Images) then Exit;
    Imaging.FreeImagesInArray(Images);
    result := true;
  except result := false;
  end;
end;

begin
  ResizeImage('C:\1.jpg', 'C:\2.jpg', 64, 64);
end.

14SatanA88

Дата 26.10.2010, 13:35 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: нет
Всего: 5

Огромное спасибо, Snowy, вопрос решен полностью.
Только вот скажи еще, если ты знаешь, в чем разница между билинейным и бикубическим ресайзом?

Snowy

Дата 26.10.2010, 13:49 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484

Бикубическая интерполяция

Добавлено через 1 минуту
Грубо говоря, билинейная быстрее, бикубическая качественнее.

Alexeis

Дата 26.10.2010, 13:51 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Цитата(14SatanA88 @ 26.10.2010, 14:35

)

в чем разница между билинейным и бикубическим ресайзом?

Билинейная интерполяция использует линейную функцию для аппроксимации промежуточных цветов. И использует только ближайшие 4 пикселя. Бикубик использует кубический сплайн и 16 точек для аппроксимации промежуточных значений. Это медленнее, но качество получается лучше.

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »