Модераторы: Snowy, Alexeis, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Скопировать часть изображения, TPngObject 
V
    Опции темы
Proxin
Дата 21.8.2010, 02:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 3
Как можно скопировать часть изображения из одного png-рисунка в другой? bitblt в этом случае не работает. Для хранения png использую tpngobject.

Это сообщение отредактировал(а) Proxin - 21.8.2010, 02:03
PM MAIL   Вверх
x128
Дата 21.8.2010, 12:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: 5
Всего: 7
Для TPngObject лучше копировать ручками через Scanline и AlphaScanline т.к. BitBlt альфу не скопирует, а метод Draw наложит с учетом альфы копируемый фрагмент.
PM MAIL WWW   Вверх
Proxin
Дата 21.8.2010, 14:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 3
можете пример привести?
PM MAIL   Вверх
AntonN
Дата 21.8.2010, 21:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 7
Всего: 18
пример http://desksoft.ru/index.php?downloads=att...ents&id=256 рисования bitmap на канву (точнее на другой буфер) через сканлайн, не сложно переписать под пнг (либо png перегонять в tbitmap)


--------------------
user posted image
PM MAIL WWW   Вверх
Proxin
Дата 24.8.2010, 17:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 3
Проблема решена. Вот код:
Код

procedure ConvertPngToBitmap(inpng:tpngobject;var outbitmap:tbitmap);
var rgb:prgbaarray;alp:pbytearray;i,j:integer;
begin
outbitmap:=tbitmap.create;
outbitmap.assign(inpng);
outbitmap.pixelformat:=pf32bit;
for i:=0 to outbitmap.height-1 do begin
rgb:=outbitmap.scanline[i];
alp:=inpng.alphascanline[i];
for j:=0 to outbitmap.width-1 do
rgb[j].rgbreserved:=alp[j];
end;
end;
procedure ConvertBitmapToPng(inbitmap:tbitmap;var outpng:tpngobject);
var rgb:prgbaarray;alp:pbytearray;i,j:integer;
begin
outpng:=tpngobject.create;
outpng.assign(inbitmap);
outpng.createalpha;
for i:=0 to inbitmap.height-1 do begin
rgb:=inbitmap.scanline[i];
alp:=outpng.alphascanline[i];
for j:=0 to inbitmap.width-1 do
alp[j]:=rgb[j].rgbreserved;
end;
end;
procedure CutImage(index:integer;inbitmap:tbitmap;var outbitmap:tbitmap);
begin
outbitmap:=tbitmap.create;
outbitmap.width:=16;outbitmap.height:=16;
bitblt(outbitmap.canvas.handle,0,0,16,16,inbitmap.canvas.handle,index*16,0,srccopy);
end;
procedure GetPngIcon(inpng:tpngobject;var outpng:tpngobject;index:integer);
var bmp,bmp2:tbitmap;
begin
convertpngtobitmap(inpng,bmp);
cutimage(index,bmp,bmp2);
freeandnil(bmp);
convertbitmaptopng(bmp2,outpng);
freeandnil(bmp2);
end;

Входной файл - длинный лист иконок (16х16). 
PM MAIL   Вверх
AntonN
Дата 24.8.2010, 21:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 7
Всего: 18
альфаканал тоже копируется? smile


--------------------
user posted image
PM MAIL WWW   Вверх
x128
Дата 25.8.2010, 12:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: 5
Всего: 7
Цитата(Proxin @  24.8.2010,  17:06 Найти цитируемый пост)
Проблема решена. Вот код:

Полная ерунда!
1) Зачем там битмап?
2) 
Цитата(AntonN @  24.8.2010,  21:47 Найти цитируемый пост)
альфаканал тоже копируется? 


Код

function CreatePNG(const src: TPNGObject; const r: TRect): TPNGObject;
var
  i, xmax, ymax: integer;
begin
  xmax:=r.Right-r.Left;
  ymax:=r.Bottom-r.Top;
  result:=TPNGObject.CreateBlank(COLOR_RGBALPHA, 8, xmax, ymax);
  BitBlt(result.Canvas.Handle, 0,0,xmax,ymax, src.Canvas.Handle, r.Left, r.Top, SRCCOPY);
  for i:=0 to ymax-1 do
    CopyMemory(result.AlphaScanline[i], pByte(dword(src.AlphaScanline[i+r.Top])+r.Left), xmax);
end;

...

src:=TPNGObject.Create;
src.LoadFromFile('image.png');
dst:=CreatePNG(src, Rect(0,0,16,16);
dst.SaveToFile('ico.png');
dsr.Free;
src.Free;


Как-то так. Надеюсь смысл понятен.
PM MAIL WWW   Вверх
Proxin
Дата 25.8.2010, 15:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 3
да, действительно, мой код дерьмовый. не разобрался с форматом до конца ещё. кстати, где в в tpngobject нашли createblank? 
и гед у tpngobject canvas?

Это сообщение отредактировал(а) Proxin - 25.8.2010, 16:20
PM MAIL   Вверх
x128
Дата 25.8.2010, 16:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: 5
Всего: 7
Цитата(Proxin @  25.8.2010,  15:41 Найти цитируемый пост)
где в в tpngobject нашли createblank? 

Цитата

Components > TPNGObject > Methods > CreateBlank 

Creates a new blank png image using the format specified.

constructor CreateBlank(ColorType, Bitdepth: Cardinal; cx, cy: Integer);

Description
Use this method instead of standard constructor to create a blank png image from scratch.
Following are the possibilities for the paramenters:
...



Цитата(Proxin @  25.8.2010,  15:41 Найти цитируемый пост)
гед у tpngobject canvas

Цитата

Components > TPNGObject > Properties > Canvas 

Allows access to direct paint into the PNG image using Windows GDI.

variable Canvas: TCanvas;

Description
Use the canvas property to draw using regular GDI tools into the PNG image.
For more information on these tools, check Delphi TCanvas help.
PM MAIL WWW   Вверх
Flashboy
Дата 27.9.2010, 21:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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

Код

function CreatePNG(const src: TPNGObject; const r: TRect): TPNGObject;
var
  i, xmax, ymax: integer;
begin
  xmax:=r.Right-r.Left;
  ymax:=r.Bottom-r.Top;
  result:=TPNGObject.CreateBlank(COLOR_RGBALPHA, 8, xmax, ymax);
  BitBlt(result.Canvas.Handle, 0,0,xmax,ymax, src.Canvas.Handle, r.Left, r.Top, SRCCOPY);
  for i:=0 to ymax-1 do
    CopyMemory(result.AlphaScanline[i], pByte(dword(src.AlphaScanline[i+r.Top])+r.Left), xmax);
end;



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

Это сообщение отредактировал(а) Flashboy - 27.9.2010, 23:02
PM MAIL ICQ   Вверх
x128
Дата 28.9.2010, 10:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: 5
Всего: 7
Цитата(Flashboy @  27.9.2010,  21:42 Найти цитируемый пост)
Как в данном случае избежать переполнения, сейчас функция выделяет память под PNG,но не рушит его?

Функция и не должна, освобождать ресурсы нужно в теле основной программы, как показано в примере.
Цитата(x128 @  25.8.2010,  12:56 Найти цитируемый пост)
Код
src:=TPNGObject.Create;
src.LoadFromFile('image.png');
dst:=CreatePNG(src, Rect(0,0,16,16));
dst.SaveToFile('ico.png');
dst.Free;
src.Free;


Цитата(Flashboy @  27.9.2010,  21:42 Найти цитируемый пост)
Можно конечно переделать в процедуру, но а есть ли вариант высвободить память оставив алгоритм функцией???

Если переделать в процедуру, ровным счетом ничего не поменяется...


Это сообщение отредактировал(а) x128 - 28.9.2010, 10:24
PM MAIL WWW   Вверх
AntonN
Дата 28.9.2010, 21:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 7
Всего: 18
не знаю как остальные, но я бы так делать поостерегся (создавать в процедуре и возвращать указатель на объект), а вдруг он не создастся, а там ниже dst.Free?


--------------------
user posted image
PM MAIL WWW   Вверх
Flashboy
Дата 28.9.2010, 21:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
А Так?:
Код

Procedure CutPNG(Source: TPNGImage; OutPNG: TPNGImage; R: TRect);
Var
   i,xmax,ymax: integer;
   Inside: TPNGImage;
Begin
   xmax := r.Right - r.Left;
   ymax := r.Bottom - r.Top;
   Inside := TPNGImage.CreateBlank(COLOR_RGBALPHA,8,xmax,ymax);
   BitBlt(Inside.Canvas.Handle,0,0,xmax,ymax,Source.Canvas.Handle,R.Left,R.Top,SRCCOPY);
   For i := 0 To ymax - 1 Do
      CopyMemory(Inside.AlphaScanline[i],pByte(dword(Source.AlphaScanline[i + R.Top]) + R.Left),xmax);
   OutPNG.Assign(Inside);
   FreeAndNil(Inside);
End;

Было мной протестировано, память высвобождается при многократном использовании, в остальных случаях(функция и пример ниже) высвобождение не происходит.
Цитата

x128, 
Если переделать в процедуру, ровным счетом ничего не поменяется...

Согласен с этим если сделать так:
Код

Procedure CutPNG(Source: TPNGImage; OutPNG: TPNGImage; R: TRect);
Var
   i,xmax,ymax: integer;
Begin
   xmax := r.Right - r.Left;
   ymax := r.Bottom - r.Top;
  OutPNG.CreateBlank(COLOR_RGBALPHA,8,xmax,ymax);
   BitBlt(OutPNG.Canvas.Handle,0,0,xmax,ymax,Source.Canvas.Handle,R.Left,R.Top,SRCCOPY);
   For i := 0 To ymax - 1 Do
      CopyMemory(OutPNG.AlphaScanline[i],pByte(dword(Source.AlphaScanline[i + R.Top]) + R.Left),xmax);
End;


Это сообщение отредактировал(а) Flashboy - 28.9.2010, 21:45
PM MAIL ICQ   Вверх
Qu1nt
Дата 28.9.2010, 23:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 2
Всего: 50
AntonN,
Эээ, и что?!
PM MAIL   Вверх
AntonN
Дата 29.9.2010, 01:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 7
Всего: 18
Qu1nt, наверное можно получить AV, не?


--------------------
user posted image
PM MAIL WWW   Вверх
Qu1nt
Дата 29.9.2010, 09:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 2
Всего: 50
AntonN,
Код

procedure TObject.Free;
begin
  if Self <> nil then
    Destroy;
end;

Откуда AV?
PM MAIL   Вверх
AntonN
Дата 30.9.2010, 08:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 7
Всего: 18
Код

dst:=CreatePNG(src, Rect(0,0,16,16));
dst.SaveToFile('ico.png');
dst.Free;



--------------------
user posted image
PM MAIL WWW   Вверх
Qu1nt
Дата 30.9.2010, 12:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 2
Всего: 50
Для этого придумали конструкцию try-finally.
Код

dst := CreatePNG(src, Rect(0, 0, 16, 16));
try
  dst.SaveToFile('ico.png');
finally
  dst.Free;
end;
PM MAIL   Вверх
AntonN
Дата 30.9.2010, 21:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 7
Всего: 18
Qu1nt, ты ее видишь в коде который нам дали? Я нет. Более того, что то подобное нужно делать и в самой CreatePNG().


--------------------
user posted image
PM MAIL WWW   Вверх
Страницы: (2) [Все] 1 2 
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

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

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0851 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.