Наложить png на png

[doktor255]

Сообщение от phomm

Тогда примеры всех пар картинок в студию, а то Повторяю, это рассчитывается просто и легко аналитически.

Это понятно, но при расширении пропадает прозрачность. Попробуй, увидишь. Вот ещё один вариант склейки. Умеет расширять холст, но при расширении теряется прозрачность, и вываливаются ошибки при использовании png без альфы, хоть в коде и стоит CreateAlpha.

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, PngImage, StdCtrls;

const
  MaxPixelCountA = MaxInt div SizeOf(TRGBQuad);
  MaxPixelCount = MaxInt div SizeOf(TRGBTriple);
type
  PRGBArray = ^TRGBArray;
  TRGBArray = array[0..MaxPixelCount-1] of TRGBTriple;
  PRGBAArray = ^TRGBAArray;
  TRGBAArray = array[0..MaxPixelCountA-1] of TRGBQuad;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure BuildPNG2BMP(png:string; bmp:tbitmap);
var iii,ii:integer;
    PNB:TPngImage; fff:PRGBAArray; aaa:pByteArray;
begin
  PNB:=TPngImage.Create;
  try
    PNB.LoadFromFile(png);
    pnb.CreateAlpha;
    bmp.Assign(pnb);
    bmp.PixelFormat:=pf32bit;
    for ii:=0 to bmp.Height-1 do begin
       fff:=bmp.ScanLine[ii];
       aaa:=pnb.AlphaScanline[ii];
       for iii:=0 to bmp.Width-1 do begin
         fff[iii].rgbReserved:=aaa[iii];
       end;
    end;
  finally
    PNB.free;
  end;
end;

procedure BuildBMP2PNG(bmp:Tbitmap; png:string);
var iii,ii:integer; PNB:TPngImage; fff:PRGBAArray; aaa:pByteArray;
begin
  PNB:=TPngImage.Create;
  try
    PNB.Assign(bmp);
    pnb.CreateAlpha;
    for ii:=0 to bmp.Height-1 do begin
        fff:=bmp.ScanLine[ii];
        aaa:=pnb.AlphaScanline[ii];
        for iii:=0 to bmp.Width-1 do begin
          aaa[iii]:=fff[iii].rgbReserved;
        end;
    end;
    PNB.SaveToFile(png);
  finally
    PNB.free;
  end;
end;

procedure Copy32to32_Bitmap(B_in:TBitmap; Bout:Tbitmap; x,y:integer);
var cy,cx:Integer;
   RowOut,Row1,Row2: PRGBAArray;
begin
  if(Bout.Width<B_in.Width+x) then Bout.Width:=B_in.Width+x;
  if(Bout.Height<B_in.Height+y) then Bout.Height:=B_in.Height+y;
  for cy:=0 to B_in.Height-1 do begin
    Row1:=B_in.ScanLine[cy];
    RowOut:=Bout.ScanLine[cy+y];
    for cx:=0 to B_in.Width-1 do begin
       RowOut[cx+x]:=Row1[cx];
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var bt_tmp,bt_out:tbitmap;
begin
  bt_tmp:=TBitmap.Create;
  bt_out:=TBitmap.Create;
  try
    bt_out.PixelFormat:=pf32bit;
    BuildPNG2BMP( '1.png',bt_tmp );
    Copy32to32_Bitmap(bt_tmp,bt_out,0,0);
    BuildPNG2BMP( '2.png',bt_tmp );
    Copy32to32_Bitmap(bt_tmp,bt_out,0,0);
    BuildBMP2PNG( bt_out,'result.png' );
  finally
    bt_tmp.Free;
    bt_out.Free;
  end;
end;

end.

[phomm]

Ну значится, мы с doktor255 несколько дней поработали, и получили такой результат. Хотя, конечно, не все его задачи мы прорешали, но сама функция работает отлично.
На вход ей подаётся две пнг-картинки: та, которая будет фоном (на которую накладывать) и та, которая будет картинкой(накладываемая). На выходе итог наложения картинок записывается в ту, которая была фоном, но переделать на то, чтобы она отдельно выдавалась (в ПНГ, задаваемую параметром, вместо создания её внутри функции), совсем несложно: убрать assign в конце, blendedPng надо сделать параметром, вместо присвоения в blendedPng результата конструирования, вызвать CreateBlank непосредственно у blendedPng (вроде ничего не забыл, но если что - пишите, я выложу готовую и проверенную).
Фон в начале работы функции подгоняет свои размеры под итоговую картинку, учитывая смещение накладываемой картинки относительно фона, указанное в виде аргументов Х и У. Приоритет у накладываемой картинки, таким образом, что её пиксели будут "поверх" накладываться при смешивании с альфаканалом. В тестовой программе фон это картинка выдаваемая ползунком с подписью Back а накладываемая, соответственно, Front. Сам алгоритм смешивания - Porter-Duff .
В программе также реализована конверсия из любого формата загружаемой из файла пнг-картинки в 32битную, т.к. иначе (для некоторых форматов) будут ошибки рисования. Сам алгоритм конверсии взят из интернета, ссылка прилагается комментарием в коде.
Также прилагается тестовая программа, в ней можно напихать любые пнг-картинки в папочку и тестить как они блендятся.

procedure OverlapPNG(Layer1, Layer2: TPNG; AX, AY: Integer);
const
  defrgb: TRGBTriple = (rgbtBlue: 0; rgbtGreen: 0; rgbtRed: 0);
var
  x, y, wd, hg, sx1, sx2, sy1, sy2, fx1, fx2, fy1, fy2: Integer;
  SL1, SL2, SLBlended: pRGBLine;
  aSL1, aSL2, aSLBlended: PByteArray;
  bc2, bc3, a1, a2: single;
  aSL1x, aSL2x: Byte;
  L1rgb, L2rgb: TRGBTriple;
  blendedPNG: TPNG;
begin
  wd := Abs(Min(0, Ax)) + Max(Layer1.Width, Ax + Layer2.Width);
  hg := Abs(Min(0, Ay)) + Max(Layer1.Height, Ay + Layer2.Height);
  blendedPNG := TPNG.CreateBlank(COLOR_RGBALPHA, 8, wd, hg);
  sx1 := Abs(Min(0, AX));
  sy1 := Abs(Min(0, AY));
  sx2 := Max(0, AX);
  sy2 := Max(0, AY);
  fx1 := sx1 + Layer1.Width;
  fy1 := sy1 + Layer1.Height;
  fx2 := sx2 + Layer2.Width;
  fy2 := sy2 + Layer2.Height;

  for y := 0 to hg - 1 do
  begin
    SL1 := nil;
    aSL1 := nil;
    SL2 := nil;
    aSL2 := nil;
    if (y >= sy1) and (y < fy1) then
      SL1 := Layer1.Scanline[y - sy1];
    if (y >= sy1) and (y < fy1) then
      aSL1 := Layer1.AlphaScanline[y - sy1];
    if (y >= sy2) and (y < fy2) then
      SL2 := Layer2.Scanline[y - sy2];
    if (y >= sy2) and (y < fy2) then
      aSL2 := Layer2.AlphaScanline[y - sy2];
    SLBlended := blendedPNG.Scanline[y];
    aSLBlended := blendedPNG.AlphaScanline[y];

    for x := 0 to wd - 1 do
    begin
      aSL1x := 0;
      aSL2x := 0;
      L1rgb := defrgb;
      L2rgb := defrgb;
      if Assigned(aSL1) and (x >= sx1) and (x < fx1) then
        aSL1x := aSL1[x - sx1];
      if Assigned(aSL2) and (x >= sx2) and (x < fx2) then
        aSL2x := aSL2[x - sx2];
      if (aSL1x = 0) and (aSL2x = 0) then
        Continue;
      if Assigned(SL1) and (x >= sx1) and (x < fx1) then
        L1rgb := SL1[x - sx1];
      if Assigned(SL2) and (x >= sx2) and (x < fx2) then
        L2rgb := SL2[x - sx2];
      // Porter-Duff Alpha-Blending Formulas
      a1 := aSL1x / 255;
      a2 := aSL2x / 255;
      bc3 := 1 - (1 - a2) * (1 - a1);
      aSLBlended[x] := Round(bc3 * 255);
      bc2 := a1 * (1 - a2);
      SLBlended[x].rgbtRed := Round((L2rgb.rgbtRed * a2 + L1rgb.rgbtRed * bc2) / bc3);
      SLBlended[x].rgbtGreen := Round((L2rgb.rgbtGreen * a2 + L1rgb.rgbtGreen * bc2) / bc3);
      SLBlended[x].rgbtBlue := Round((L2rgb.rgbtBlue * a2 + L1rgb.rgbtBlue * bc2) / bc3);
    end;
  end;
  Layer1.Assign(blendedPNG);
  blendedPNG.Free;
end;