Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Звук, графика и видео > Graphics32 Thumbnails

Автор: Akella 31.8.2011, 00:04

Привет, а Великий 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

могу посоветовать использовать ресайз (либа 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?

Автор: Alexeis 31.8.2011, 10:40

Цитата(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 и должно грузить.

Автор: Akella 31.8.2011, 16:06

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

Добавлено через 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

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

)

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

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

)

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

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

Автор: ~FoX~ 1.9.2011, 08:58

Цитата(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;

Автор: Akella 1.9.2011, 11:14

Я использовал для подсчёт отношения округление 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

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

)

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

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

Автор: Akella 4.9.2011, 17:36

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

Автор: Alexx82 7.9.2011, 08:05

Цитата

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

Цитата

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

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

Автор: Akella 7.9.2011, 09:26

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

Автор: sg729 20.4.2012, 20:14

Цитата(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 вроде бы не нужно.

Автор: Akella 20.4.2012, 22:28

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

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

Автор: sg729 21.4.2012, 10:50

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

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

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

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

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

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

Автор: goa_dreamer 3.5.2012, 10:39

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

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

После поиска данного решения, пересмотра вариантов функций сторонних разработчиков, решил проверить, а что же имеет в основе 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.