VPF::Graphics32 Thumbnails - Форум программистов

Akella

Дата 31.8.2011, 00:04 (ссылка)

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

Загрузка ...

Творец

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

Репутация: 1
Всего: 329

Привет, а Великий All!

Вопрос по библиотеке Graphics32. Как там можно создавать миниатюрные копии изображений (jpg, bmp, png)?

Ни в примерах, ни в справке не могу найти.

Хотел сам попытаться

Код


Var
 Bitmap32: TBitmap32;
begin
 Bitmap32 := TBitmap32.Create;
 Bitmap32.LoadFromFile('E:\Pictures\2010-11-19 20.10.56.jpg');

но.....

Цитата

Project Project5.exe raised exception class EInvalidGraphic with message 'Unknown picture file extension (.jpg)'.

14SatanA88

Дата 31.8.2011, 08:10 (ссылка)

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

Загрузка ...

Опытный

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

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

могу посоветовать использовать ресайз (либа Vampyre Imaging Library)

Код


uses jpeg, ImagingTypes, Imaging, ImagingUtility;

и использовать такого рода функцию

Код


function ResizeImage(infile, outfile: string; width, height: integer): boolean;
var
  MainImage: TImageData;
begin
  result := false;
  try
    Imaging.LoadImageFromFile(infile, MainImage); // загрузка картинки
    Imaging.ResizeImage(MainImage, width, height, rfBicubic {rfBilinear}); // бикубический ресайз
    Imaging.SaveImageToFile(outfile, MainImage); // сохранение отресайженной картинки
    Imaging.FreeImage(MainImage);
    result := true;
  except result := false;
  end;
end;

или устраивает только Graphics32?

Это сообщение отредактировал(а) 14SatanA88 - 31.8.2011, 08:15

Alexeis

Дата 31.8.2011, 10:40 (ссылка)

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

Загрузка ...

Амеба

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

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

Цитата(http://graphics32.org/documentation/Docs/Units/GR32/Classes/TBitmap32/_Body.htm)

TBitmap32 does not implement its own low-level streaming or low-level file loading/saving. Instead, it uses streaming methods of temporal TBitmap or TPicture objects. This is an obvious performance penalty, however such approach allows using third-party libraries, which extend TGraphic class for various image formats support (JPEG, TGA, TIFF, GIF, PNG, etc.)

В общем сам он не имеет отношения к загрузке и сохранению файлов и использует стандартные классы или те что зарегистрированы в делфи. Собственно uses jpeg и должно грузить.

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

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

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

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

Akella

Дата 31.8.2011, 16:06 (ссылка)

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

Загрузка ...

Творец

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

Репутация: 1
Всего: 329

А как уменьшить пропорционально?

Добавлено через 56 секунд
Есть SetSize(NewWidth, NewHeight), но это не совсем то.

Добавлено через 2 минуты и 36 секунд

Код


uses
 ...GR32, JPEG;

...
...

procedure TForm5.Button1Click(Sender: TObject);
Var
 b: TBitmap32;
begin
  b := TBitmap32.Create;
  b.LoadFromFile('E:\Pictures\MyAlbum\_Обработать\2010-11-19 20.10.56.jpg');
  b.SetSize(150, 100);
  b.SaveToFile('d:\11.jpg');
  b.Free;
end;

В выходном файле только чёрный квадрат.

Добавлено через 4 минуты и 18 секунд
14SatanA88, в твоём коде тоже нужно указывать конкретные значения ширины и высоты, а значит это не пропорциональное изменение размера.

14SatanA88

Дата 1.9.2011, 08:05 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата(Akella @ 31.8.2011, 16:06

)

нужно указывать конкретные значения ширины и высоты

Цитата(Akella @ 31.8.2011, 16:06

)

А как уменьшить пропорционально?

ну да. я использовал математику. нужные значения подсчитать несложно.

~FoX~

Дата 1.9.2011, 08:58 (ссылка)

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

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 2
Всего: 68

Цитата(Akella @ 31.8.2011, 17:06

)

А как уменьшить пропорционально?

Код


function GetProportional(OldW, OldH, cw, ch: integer): TRect; //получаем пропорцианальный рект
var
  xyaspect: Double; //отношение
begin
  if ((OldW > cw) or (OldH > ch)) then begin
    if ((OldW > 0) and (OldH > 0)) then    begin
      xyaspect := OldW / OldH;
      if OldW > OldH then begin
        OldW := cw;
        OldH := Trunc(cw / xyaspect);
        if OldH > ch then begin
          OldH := ch;
          OldW := Trunc(ch * xyaspect);
        end; //OldH
      end //OldW>OldH
      else begin
        OldH := ch;
        OldW := Trunc(ch * xyaspect);
        if OldW > cw then begin
          OldW := cw;
          OldH := Trunc(cw / xyaspect);
        end; //OldW>cw
      end;
    end
    else begin
      OldW := cw;
      OldH := ch;
    end;
  end;
  with Result do begin
    Left := 0;
    Top := 0;
    Right := OldW;
    Bottom := OldH;
  end;
  //OffsetRect(Result, (cw - OldW) div 2, (ch - OldH) div 2);
end;

Это сообщение отредактировал(а) ~FoX~ - 1.9.2011, 08:59

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

…множественность никогда не следует полагать без необходимости…

Akella

Дата 1.9.2011, 11:14 (ссылка)

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

Загрузка ...

Творец

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

Репутация: 1
Всего: 329

Я использовал для подсчёт отношения округление Round. Так более просто и мне понятнее. Не понимаю, зачем такие сложности?
На примере JPG

Код


procedure JpegToBmp(jpg: TJPEGImage; bmpDest: TBitmap);
var
  tmp: TBitmap;
  ratio: double;
  newW, newH: integer;
begin
  tmp := TBitmap.Create;

  try
    jpg.Scale := jsEighth;
    jpg.DIBNeeded;

    tmp.Assign(jpg);

    //если размеры исходного изображеия больше эскиза, то уменьшаем исходное изображением до размеров экскиза
    if (jpg.Width > iThumbnailMaxWidth) and (jpg.Height > iThumbnailMaxHeight) then
    begin

      if tmp.Width > tmp.Height then
        ratio := iThumbnailMaxWidth / tmp.Height
      else
        ratio := iThumbnailMaxHeight / tmp.Height;

      bmpDest.Width  := Round(ratio * tmp.Width);
      bmpDest.Height := Round(ratio * tmp.Height);
    end;//if (jpg.Width > tmp.Width) and (jpg.Height > tmp.Height) then

    SetStretchBltMode(bmpDest.Canvas.Handle, HALFTONE);
    StretchBlt(bmpDest.Canvas.Handle, 0, 0, bmpDest.Width, bmpDest.Height, tmp.Canvas.Handle, 0, 0, tmp.Width, tmp.Height, SRCCOPY);
  finally
    tmp.Free;
  end;
end;

На примере BMP

Код


procedure BmpToBmp(bmpSrc, bmpDest: TBitmap);
var
  ratio: double;
  newW, newH: integer;
begin

    //если размеры исходного изображеия больше эскиза, то уменьшаем исходное изображением до размеров экскиза
    if (bmpSrc.Width > iThumbnailMaxWidth) and (bmpSrc.Height > iThumbnailMaxHeight) then
    begin

      if bmpSrc.Width > bmpSrc.Height then
        ratio := iThumbnailMaxWidth / bmpSrc.Height
      else
        ratio := iThumbnailMaxHeight / bmpSrc.Height;

      bmpDest.Width  := Round(ratio * bmpSrc.Width);
      bmpDest.Height := Round(ratio * bmpSrc.Height);
    end;// if (bmpSrc.Width > iThumbnailMaxWidth) and (bmpSrc.Height > iThumbnailMaxHeight) then

  SetStretchBltMode(bmpDest.Canvas.Handle, HALFTONE);
  StretchBlt(bmpDest.Canvas.Handle, 0, 0, bmpDest.Width, bmpDest.Height, bmpSrc.Canvas.Handle, 0, 0, bmpSrc.Width, bmpSrc.Height, SRCCOPY);
end;

На примере PNG

Код


procedure PngToBmp(pngSrc: TdxPNGImage; bmpDest: TBitmap);
var
  tmp: TBitmap;
  ratio: double;
  newW, newH: integer;
begin
  tmp := TBitmap.Create;

  try
    tmp.Assign(pngSrc);

    //если размеры исходного изображеия больше эскиза, то уменьшаем исходное изображением до размеров экскиза
    if (pngSrc.Width > iThumbnailMaxWidth) and (pngSrc.Height > iThumbnailMaxHeight) then
    begin
      if tmp.Width > tmp.Height then
        ratio := iThumbnailMaxWidth / tmp.Height
      else
        ratio := iThumbnailMaxHeight / tmp.Height;

      bmpDest.Width  := Round(ratio * tmp.Width);
      bmpDest.Height := Round(ratio * tmp.Height);
    end;//if (jpg.Width > tmp.Width) and (jpg.Height > tmp.Height) then

    SetStretchBltMode(bmpDest.Canvas.Handle, HALFTONE);
    StretchBlt(bmpDest.Canvas.Handle, 0, 0, bmpDest.Width, bmpDest.Height, tmp.Canvas.Handle, 0, 0, tmp.Width, tmp.Height, SRCCOPY);
  finally
    tmp.Free;
  end;
end;

Добавлено @ 11:17
Вы мне скажите, как мне GR32 победить? Почему на выходе квадрат Малевича?

Мне нужно создавать эскизы фотографий на лету, перед загрузкой в таблицу, т.к. в таблицу я загружаю эскизы. Или StretchBlt достаточно шустрая процедура?

~FoX~

Дата 4.9.2011, 10:47 (ссылка)

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

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 2
Всего: 68

Цитата(Akella @ 1.9.2011, 12:14

)

Вы мне скажите, как мне GR32 победить? Почему на выходе квадрат Малевича?

Покажи весь код, т.к. в приведенном все в порядке...

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

…множественность никогда не следует полагать без необходимости…

Akella

Дата 4.9.2011, 17:36 (ссылка)

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

Загрузка ...

Творец

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

Репутация: 1
Всего: 329

Я же дал код. См выше.
http://forum.vingrad.ru/index.php?showtopi...t&p=2395906

Alexx82

Дата 7.9.2011, 08:05 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата

Project Project5.exe raised exception class EInvalidGraphic with message 'Unknown picture file extension (.jpg)'.

Цитата

Вы мне скажите, как мне GR32 победить? Почему на выходе квадрат Малевича?

Может быть потому что ты классу (TBitmap) предназнченному для работы с файлами .bmp пытаешься подсунуть .jpg файл

Akella

Дата 7.9.2011, 09:26 (ссылка)

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

Загрузка ...

Творец

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

Репутация: 1
Всего: 329

Не знаю, может быть. Я забросил GR32.

sg729

Дата 20.4.2012, 20:14 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата(Akella @ 31.8.2011, 00:04)

Привет, а Великий All!

Вопрос по библиотеке Graphics32. Как там можно создавать миниатюрные копии изображений (jpg, bmp, png)?

Ни в примерах, ни в справке не могу найти.

В FAQ есть намек на решение этой задачи. Смысл в том, что нужно создавать дополнительный объект TBitmap32 и на нем отрисовывать картинку из исходного TBitmap32 :

http://graphics32.org/wiki/FAQ/Resampling

Цитата

Example 2: Suppose that we want to resize the source bitmap Src by drawing it onto the destination bitmap Dst. We want to use TKernelResampler and we want to use TLanczosKernel as a reconstruction filter (also known as a convolution kernel). This could be done as follows:

Код


procedure DrawSrcToDst(Src, Dst: TBitmap32);
var
  R: TKernelResampler;  
begin
  R := TKernelResampler.Create(Src);
  R.Kernel := TLanczosKernel.Create;
  Dst.Draw(Dst.BoundsRect, Src.BoundsRect, Src);
end;

Примерно вот так можно отресайзить :

Код


Jpg:=TJPEGImage.Create;
Bmp:=TBitmap.Create;
SrcBmp32:=TBitmap32.Create;
DstBmp32:=TBitmap32.Create;
Jpg.CompressionQuality:=90;
SrcBmp32.Assign(ImgView321.Bitmap);
SetBitmapResampler(SrcBmp32);                  // здесь задается способ ресамплинга
w:=StrToInt(ScaledWidthLabeledEdit.Text);   // w, h - размеры которые надо получить. 
h:=StrToInt(ScaledHeightLabeledEdit.Text);
DstBmp32.SetSize(w,h);
DstBmp32.Draw(DstBmp32.BoundsRect, SrcBmp32.BoundsRect, SrcBmp32);
Bmp.Assign(DstBmp32);
Jpg.Assign(Bmp);
Jpg.SaveToFile(SavePictureDialog1.FileName);
Jpg.Free;
Bmp.Free;
SrcBmp32.Free;
DstBmp32.Free;

Здесь w, h - размеры которые надо получить. Конечно, желательно еще добавить try ... except как полагается.
Способ ресамплинга задается тоже по чудному, примерно так:

Код


Bmp32.ResamplerClassName:='TKernelResampler';
KernelResampler:=TKernelResampler.Create(Bmp32);
KernelResampler.Kernel:=TLanczosKernel.Create;
TLanczosKernel(KernelResampler.Kernel).Width:=3;

при этом никакого KernelResampler.Free вроде бы не нужно.

Это сообщение отредактировал(а) sg729 - 20.4.2012, 20:18

Akella

Дата 20.4.2012, 22:28 (ссылка)

(голосов:1)

Загрузка ...

Творец

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

Репутация: 1
Всего: 329

спасибо
а главное вовремя smile

Добавлено через 37 секунд
сидел перед монитором, ждал, пока ответят smile

sg729

Дата 21.4.2012, 10:50 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата(Akella @ 20.4.2012, 22:28)

спасибо
а главное вовремя smile

Добавлено @ 22:29
сидел перед монитором, ждал, пока ответят smile

Ну что поделать smile

Лучше поздно чем никогда smile

Только вчера увидел эту тему, да и сам занялся graphics32 с неделю тому назад... а с "черным квадратом Малевича" применительно к graphics32 судя по яндексу сталкивались многие. Пусть уж лучше будет здесь упоминание об этом, может облегчит кому-нибудь мучения smile

goa_dreamer

Дата 3.5.2012, 10:39 (ссылка)

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

Загрузка ...

Новичок

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

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

(Для модераторов, можете перенести данное сообщение в соотствующую тему если нужно).

Задача: качественно изменить размер картинки с сохранением полутонов.

После поиска данного решения, пересмотра вариантов функций сторонних разработчиков, решил проверить, а что же имеет в основе Delphi TImage, модуль Graphics.pas:

Код


    DoHalftone := (BPP <= 8) and (BPP < (FDIB.dsbm.bmBitsPixel * FDIB.dsbm.bmPlanes));
    if DoHalftone then
    begin
      GetBrushOrgEx(ACanvas.FHandle, pt);
      SetStretchBltMode(ACanvas.FHandle, HALFTONE);
      SetBrushOrgEx(ACanvas.FHandle, pt.x, pt.y, @pt);
    end else if not Monochrome then
      SetStretchBltMode(ACanvas.Handle, STRETCH_DELETESCANS);

По-сути все задача с качественным изменением картинки заключается в задании условия DoHalftone, если вы вручную выставите DoHalftone := True, тогда SetStretchBltMode(ACanvas.FHandle, HALFTONE) - будет постоянным.
Чтобы увидеть разницу с использованием стандартного изменения картинки, вы можете изменить SetStretchBltMode(ACanvas.Handle, STRETCH_DELETESCANS) на SetStretchBltMode(ACanvas.Handle, STRETCH_ORSCANS), или на любую StrechMode-переменную из документации функции SetStretchBltMode.

Это сообщение отредактировал(а) goa_dreamer - 3.5.2012, 11:01

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