Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 15.01.2012, 09:53   #1
dmitriegorovih
Ещё не
Форумчанин
 
Аватар для dmitriegorovih
 
Регистрация: 04.01.2010
Сообщений: 517
По умолчанию Resize PNG картинки

Всем доброго времени суток! Делаю Resize PNG картинки вот так
Код:
var
  SL1: pRGBLine;
  aSL1: PByteArray;
  bmp,bmpa,bmp_tmp:Tbitmap;
  png,png2:TPNGObject;
  x,y:integer;
  r,g,b,i:cardinal;
begin
  bmp:=Tbitmap.Create;
  bmpa:=Tbitmap.Create;
  bmp_tmp:=Tbitmap.Create;
  bmp_tmp.PixelFormat:=pf24bit;
  bmp_tmp.Width:=image2.Width;
  bmp_tmp.Height:=image2.Height;
  png:=TPNGObject.Create;
  png2:=TPNGObject.Create;
  png.Assign(image1.Picture);
  png2.Assign(image2.Picture);
  bmp.Width:=png.Width;
  bmp.Height:=png.Height;
  bmpa.Width:=png.Width;
  bmpa.Height:=png.Height;
  bmp.PixelFormat:=pf24bit;
  bmpa.PixelFormat:=pf24bit;
  for y:=0 to png.Height-1 do
  begin
    sl1:=png.Scanline[y];
    asl1:=png.AlphaScanline[y];
    for x:=0 to png.Width-1 do
    begin
      bmp.Canvas.Pixels[x,y]:=rgb(sl1[x].rgbtRed,sl1[x].rgbtGreen,sl1[x].rgbtBlue);
      bmpa.Canvas.Pixels[x,y]:=asl1[x];
    end;
  end;
  bmp_tmp.Canvas.StretchDraw(rect(0,0,image2.Width,image2.Height),bmp);
  bmp.Assign(bmp_tmp);
  bmp_tmp.Canvas.StretchDraw(rect(0,0,image2.Width,image2.Height),bmpa);
  for y:=0 to png2.Height-1 do
  begin
    sl1:=png2.Scanline[y];
    asl1:=png2.AlphaScanline[y];
    for x:=0 to png2.Width-1 do
    begin
      ColortoRGB(bmp.Canvas.Pixels[x,y],r,g,b);
      sl1[x].rgbtRed:=r;
      sl1[x].rgbtGreen:=g;
      sl1[x].rgbtBlue:=b;
      asl1[x]:=bmp_tmp.Canvas.Pixels[x,y];
    end;
  end;
  image2.Picture.Assign(png2);
  freeandnil(bmp);
  freeandnil(bmpa);
  freeandnil(bmp_tmp);
  freeandnil(png);
  freeandnil(png2);
end;

procedure TForm1.ColortoRGB(Color: Cardinal; var R, G, B: Cardinal);
begin
b:=Color div 65536;
g:=(Color-(b*65536)) div 256;
r:=((Color-(b*65536))-(g*256));
end;
все работает НО! Resize жутко медленно делает, есть ли другие способы?
Воображение важнее, чем знания. (Albert Einstein)
dmitriegorovih вне форума Ответить с цитированием
Старый 15.01.2012, 12:12   #2
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,876
По умолчанию

У пнг используете сканлайн, а у бмп почему-то canvas.pixels ... странно
Используйте сканлайн уж и для бмп тогда - всяко побыстрее будет

Плюс ещё кое-где можно пооптимизировать, предвычислять кое-что вне циклов, а то лишние операции, например:
Код:
for y:=0 to png2.Height-1 do
  begin
    sl1:=png2.Scanline[y];
    asl1:=png2.AlphaScanline[y];
    for x:=0 to png2.Width-1 do
Здесь явно png2.Width вычисляется png2.Height раз, а это могут быть сотни обращений к полям объекта, который в памяти, следовательно постоянно из памяти в регистры гоняется

Ну а вообще совет мой будет куда более колким - используйте готовые либы для данной цели... велосипеды они почти только для опыта хороши. Либ вагон - syngdiplus например.
phomm вне форума Ответить с цитированием
Старый 15.01.2012, 13:21   #3
dmitriegorovih
Ещё не
Форумчанин
 
Аватар для dmitriegorovih
 
Регистрация: 04.01.2010
Сообщений: 517
По умолчанию

Цитата:
Здесь явно png2.Width вычисляется png2.Height раз, а это могут быть сотни обращений к полям объекта, который в памяти, следовательно постоянно из памяти в регистры гоняется
Спасибо учтено!
а вот
Цитата:
У пнг используете сканлайн, а у бмп почему-то canvas.pixels ... странно
Используйте сканлайн уж и для бмп тогда - всяко побыстрее будет
у bmp я скайлайн не нашел мож не там искал?
Воображение важнее, чем знания. (Albert Einstein)
dmitriegorovih вне форума Ответить с цитированием
Старый 15.01.2012, 13:45   #4
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию

Код:
TBitmap.Scanline[];
P.S. Используйте класс TPngImage вместо устаревшего TPNGObject (в новых версиях Делфи).
"ковыряю изнутри" (с)

Последний раз редактировалось 3D Hunter; 15.01.2012 в 13:47.
3D Hunter вне форума Ответить с цитированием
Старый 15.01.2012, 22:45   #5
postal2
Форумчанин
 
Аватар для postal2
 
Регистрация: 31.10.2008
Сообщений: 215
По умолчанию

Вот только сегодня нашёл, делюсь
Код:
procedure SmoothResize(apng:tpngobject; NuWidth,NuHeight:integer);
var
  xscale, yscale         : Single;
  sfrom_y, sfrom_x       : Single;
  ifrom_y, ifrom_x       : Integer;
  to_y, to_x             : Integer;
  weight_x, weight_y     : array[0..1] of Single;
  weight                 : Single;
  new_red, new_green     : Integer;
  new_blue, new_alpha    : Integer;
  new_colortype          : Integer;
  total_red, total_green : Single;
  total_blue, total_alpha: Single;
  IsAlpha                : Boolean;
  ix, iy                 : Integer;
  bTmp : TPNGObject;
  sli, slo : pRGBLine;
  ali, alo: pbytearray;
begin
  new_alpha := 0;
  ali := nil;
  alo := nil;
  if not (apng.Header.ColorType in [COLOR_RGBALPHA, COLOR_RGB]) then
    raise Exception.Create('Only COLOR_RGBALPHA and COLOR_RGB formats' +
    ' are supported');
  IsAlpha := apng.Header.ColorType in [COLOR_RGBALPHA];
  if IsAlpha then new_colortype := COLOR_RGBALPHA else
    new_colortype := COLOR_RGB;
  bTmp := Tpngobject.CreateBlank(new_colortype, 8, NuWidth, NuHeight);
  xscale := bTmp.Width / (apng.Width-1);
  yscale := bTmp.Height / (apng.Height-1);
  for to_y := 0 to bTmp.Height-1 do
  begin
    sfrom_y := to_y / yscale;
    ifrom_y := Trunc(sfrom_y);
    weight_y[1] := sfrom_y - ifrom_y;
    weight_y[0] := 1 - weight_y[1];
    for to_x := 0 to bTmp.Width-1 do
    begin
      sfrom_x := to_x / xscale;
      ifrom_x := Trunc(sfrom_x);
      weight_x[1] := sfrom_x - ifrom_x;
      weight_x[0] := 1 - weight_x[1];

      total_red   := 0.0;
      total_green := 0.0;
      total_blue  := 0.0;
      total_alpha  := 0.0;
      for ix := 0 to 1 do begin
        for iy := 0 to 1 do begin
          sli := apng.Scanline[ifrom_y + iy];
          if IsAlpha then ali := apng.AlphaScanline[ifrom_y + iy];
          new_red := sli[ifrom_x + ix].rgbtRed;
          new_green := sli[ifrom_x + ix].rgbtGreen;
          new_blue := sli[ifrom_x + ix].rgbtBlue;
          if IsAlpha then new_alpha := ali[ifrom_x + ix];
          weight := weight_x[ix] * weight_y[iy];
          total_red   := total_red   + new_red   * weight;
          total_green := total_green + new_green * weight;
          total_blue  := total_blue  + new_blue  * weight;
          if IsAlpha then total_alpha  := total_alpha  + new_alpha  * weight;
        end;
      end;
      slo := bTmp.ScanLine[to_y];
      if IsAlpha then alo := bTmp.AlphaScanLine[to_y];
      slo[to_x].rgbtRed := Round(total_red);
      slo[to_x].rgbtGreen := Round(total_green);
      slo[to_x].rgbtBlue := Round(total_blue);
      if isAlpha then alo[to_x] := Round(total_alpha);
    end;
  end;
  apng.Assign(bTmp);
  bTmp.Free;
end;
Около 350 мс на 400*500 картинке, вполне устраивает.
[Ferox]
postal2 вне форума Ответить с цитированием
Старый 15.01.2012, 23:42   #6
dmitriegorovih
Ещё не
Форумчанин
 
Аватар для dmitriegorovih
 
Регистрация: 04.01.2010
Сообщений: 517
По умолчанию

Цитата:
Сообщение от 3D Hunter Посмотреть сообщение
Код:
TBitmap.Scanline[];
P.S. Используйте класс TPngImage вместо устаревшего TPNGObject (в новых версиях Делфи).
У меня Delphi 7 поэтому не чего подобного нет

Цитата:
Сообщение от postal2 Посмотреть сообщение
Вот только сегодня нашёл, делюсь
Код:
procedure SmoothResize(apng:tpngobject; NuWidth,NuHeight:integer);
var
  xscale, yscale         : Single;
  sfrom_y, sfrom_x       : Single;
  ifrom_y, ifrom_x       : Integer;
  to_y, to_x             : Integer;
  weight_x, weight_y     : array[0..1] of Single;
  weight                 : Single;
  new_red, new_green     : Integer;
  new_blue, new_alpha    : Integer;
  new_colortype          : Integer;
  total_red, total_green : Single;
  total_blue, total_alpha: Single;
  IsAlpha                : Boolean;
  ix, iy                 : Integer;
  bTmp : TPNGObject;
  sli, slo : pRGBLine;
  ali, alo: pbytearray;
begin
  new_alpha := 0;
  ali := nil;
  alo := nil;
  if not (apng.Header.ColorType in [COLOR_RGBALPHA, COLOR_RGB]) then
    raise Exception.Create('Only COLOR_RGBALPHA and COLOR_RGB formats' +
    ' are supported');
  IsAlpha := apng.Header.ColorType in [COLOR_RGBALPHA];
  if IsAlpha then new_colortype := COLOR_RGBALPHA else
    new_colortype := COLOR_RGB;
  bTmp := Tpngobject.CreateBlank(new_colortype, 8, NuWidth, NuHeight);
  xscale := bTmp.Width / (apng.Width-1);
  yscale := bTmp.Height / (apng.Height-1);
  for to_y := 0 to bTmp.Height-1 do
  begin
    sfrom_y := to_y / yscale;
    ifrom_y := Trunc(sfrom_y);
    weight_y[1] := sfrom_y - ifrom_y;
    weight_y[0] := 1 - weight_y[1];
    for to_x := 0 to bTmp.Width-1 do
    begin
      sfrom_x := to_x / xscale;
      ifrom_x := Trunc(sfrom_x);
      weight_x[1] := sfrom_x - ifrom_x;
      weight_x[0] := 1 - weight_x[1];

      total_red   := 0.0;
      total_green := 0.0;
      total_blue  := 0.0;
      total_alpha  := 0.0;
      for ix := 0 to 1 do begin
        for iy := 0 to 1 do begin
          sli := apng.Scanline[ifrom_y + iy];
          if IsAlpha then ali := apng.AlphaScanline[ifrom_y + iy];
          new_red := sli[ifrom_x + ix].rgbtRed;
          new_green := sli[ifrom_x + ix].rgbtGreen;
          new_blue := sli[ifrom_x + ix].rgbtBlue;
          if IsAlpha then new_alpha := ali[ifrom_x + ix];
          weight := weight_x[ix] * weight_y[iy];
          total_red   := total_red   + new_red   * weight;
          total_green := total_green + new_green * weight;
          total_blue  := total_blue  + new_blue  * weight;
          if IsAlpha then total_alpha  := total_alpha  + new_alpha  * weight;
        end;
      end;
      slo := bTmp.ScanLine[to_y];
      if IsAlpha then alo := bTmp.AlphaScanLine[to_y];
      slo[to_x].rgbtRed := Round(total_red);
      slo[to_x].rgbtGreen := Round(total_green);
      slo[to_x].rgbtBlue := Round(total_blue);
      if isAlpha then alo[to_x] := Round(total_alpha);
    end;
  end;
  apng.Assign(bTmp);
  bTmp.Free;
end;
Около 350 мс на 400*500 картинке, вполне устраивает.
не могли бы вы скинуть модуль а то мой модуль не знает этой строчки.
Воображение важнее, чем знания. (Albert Einstein)
dmitriegorovih вне форума Ответить с цитированием
Старый 15.01.2012, 23:53   #7
postal2
Форумчанин
 
Аватар для postal2
 
Регистрация: 31.10.2008
Сообщений: 215
По умолчанию

Модуль pngimage, по умолчанию вроде для дельфи 7. А та функция создаёт пустое изображение PNG.
Вложения
Тип файла: zip pngimage.zip (155.8 Кб, 64 просмотров)
[Ferox]
postal2 вне форума Ответить с цитированием
Старый 16.01.2012, 16:12   #8
dmitriegorovih
Ещё не
Форумчанин
 
Аватар для dmitriegorovih
 
Регистрация: 04.01.2010
Сообщений: 517
По умолчанию

Огромное спасибо postal2 все работает именно так как я и хотел
Воображение важнее, чем знания. (Albert Einstein)
dmitriegorovih вне форума Ответить с цитированием
Старый 22.02.2012, 18:18   #9
X11
Пользователь
 
Регистрация: 20.01.2010
Сообщений: 54
По умолчанию

Для Delphi XE2, возможно, придется изменить объявление 2х переменных:

Код:
ali, alo: Vcl.Imaging.pngimage.pByteArray;
и входного параметра
Код:
aPng: TPngObject
X11 вне форума Ответить с цитированием
Старый 01.08.2012, 14:01   #10
X11
Пользователь
 
Регистрация: 20.01.2010
Сообщений: 54
По умолчанию

Не могу найти нормально работающего примера, чтобы качественно увеличить PNG с alpha-каналом.
Delphi XE2

На сайте абракадабры (EDN>>CodeCentral) есть примеры работы с PNG: http://cc.embarcadero.com/Item/25631, в том числе и есть пример процедуры SmoothResize.

Там есть такой кусок кода:

Код:
  if not (apng.Header.ColorType in [COLOR_RGBALPHA, COLOR_RGB]) then
    raise Exception.Create('Only COLOR_RGBALPHA and COLOR_RGB formats' +
    ' are supported');


Проблема в том, что у меня изображение имеет apng.Header.ColorType равный 3, а именно COLOR_PALETTE

Цитата:
unit Vcl.Imaging.pngimage;
...
....
{Avaliable color modes for PNG}
COLOR_GRAYSCALE = 0;
COLOR_RGB = 2;
COLOR_PALETTE = 3;
COLOR_GRAYSCALEALPHA = 4;
COLOR_RGBALPHA = 6;

поэтому вываливается Exception


Я с изображениями вообще не работал.
Поэтому нужна процедура изменения размера PNG. Или как "конвертировать" существующее изображение, чтобы эта процедура схавала мой png и не подавилась?
Может можно как сконвертировать изображение из COLOR_PALETTE в COLOR_RGBALPHA или в COLOR_RGB?
X11 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Узнать разрешение png картинки zver777 Мультимедиа в Delphi 10 06.11.2011 01:01
Фрейм в виде png картинки dmitriegorovih Общие вопросы Delphi 0 16.07.2010 20:42
png картинки в Delphi 10 Marsel737 Общие вопросы Delphi 8 07.05.2010 22:03
PNG Resize serhiyiv Мультимедиа в Delphi 1 14.03.2010 11:52
вывод картинки *.png на экран телефона furstenberg Общие вопросы по Java, Java SE, Kotlin 3 31.07.2008 22:07