Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Звук, графика и видео > Скопировать часть изображения


Автор: Proxin 21.8.2010, 02:01
Как можно скопировать часть изображения из одного png-рисунка в другой? bitblt в этом случае не работает. Для хранения png использую tpngobject.

Автор: x128 21.8.2010, 12:10
Для TPngObject лучше копировать ручками через Scanline и AlphaScanline т.к. BitBlt альфу не скопирует, а метод Draw наложит с учетом альфы копируемый фрагмент.

Автор: Proxin 21.8.2010, 14:46
можете пример привести?

Автор: AntonN 21.8.2010, 21:17
пример http://desksoft.ru/index.php?downloads=attachments&id=256 рисования bitmap на канву (точнее на другой буфер) через сканлайн, не сложно переписать под пнг (либо png перегонять в tbitmap)

Автор: Proxin 24.8.2010, 17:06
Проблема решена. Вот код:
Код

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). 

Автор: AntonN 24.8.2010, 21:47
альфаканал тоже копируется? smile

Автор: x128 25.8.2010, 12:56
Цитата(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;


Как-то так. Надеюсь смысл понятен.

Автор: Proxin 25.8.2010, 15:41
да, действительно, мой код дерьмовый. не разобрался с форматом до конца ещё. кстати, где в в tpngobject нашли createblank? 
и гед у tpngobject canvas?

Автор: x128 25.8.2010, 16:47
Цитата(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.

Автор: Flashboy 27.9.2010, 21:42
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,но не рушит его?
Прогоните функцию несколько тысяч раз с большими изображениями и посмотрите на выделенную память под приложение.
Можно конечно переделать в процедуру, но а есть ли вариант высвободить память оставив алгоритм функцией???

Автор: x128 28.9.2010, 10:22
Цитата(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 Найти цитируемый пост)
Можно конечно переделать в процедуру, но а есть ли вариант высвободить память оставив алгоритм функцией???

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

Автор: AntonN 28.9.2010, 21:30
не знаю как остальные, но я бы так делать поостерегся (создавать в процедуре и возвращать указатель на объект), а вдруг он не создастся, а там ниже dst.Free?

Автор: Flashboy 28.9.2010, 21:41
А Так?:
Код

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;

Автор: Qu1nt 28.9.2010, 23:41
AntonN,
Эээ, и что?!

Автор: AntonN 29.9.2010, 01:22
Qu1nt, наверное можно получить AV, не?

Автор: Qu1nt 29.9.2010, 09:33
AntonN,
Код

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

Откуда AV?

Автор: AntonN 30.9.2010, 08:19
Код

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

Автор: Qu1nt 30.9.2010, 12:26
Для этого придумали конструкцию try-finally.
Код

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

Автор: AntonN 30.9.2010, 21:09
Qu1nt, ты ее видишь в коде который нам дали? Я нет. Более того, что то подобное нужно делать и в самой CreatePNG().

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)