如何从一个PNG文件复制另一个PNG文件？

Question

我的应用程序需要大量的PNG图像，但在尝试处理它们时，我经常搞砸我的代码。为了让我的生活更轻松，我使用Realword Paint做了一个大的PNG图像，并将所有这些小的PNG图像粘贴到其中。现在我只有一个文件了。现在我只需要复制一个带透明度的PNG到另一个PNG上（顺便说一句，不要问为什么），因为我需要单独处理每个图像。当涉及到处理图像时，我是一个糟糕的程序员。我正在使用Delphi 7。

PGNImage.Resize

procedure TPngObject.Resize(const CX, CY: Integer);
  function Min(const A, B: Integer): Integer;
  begin
    if A < B then Result := A else Result := B;
  end;
var
  Header: TChunkIHDR;
  Line, NewBytesPerRow: Integer;
  NewHandle: HBitmap;
  NewDC: HDC;
  NewImageData: Pointer;
  NewImageAlpha: Pointer;
  NewImageExtra: Pointer;
begin
  if (CX > 0) and (CY > 0) then
  begin
    {Gets some actual information}
    Header := Self.Header;

    {Creates the new image}
    NewDC := CreateCompatibleDC(Header.ImageDC);
    Header.BitmapInfo.bmiHeader.biWidth := cx;
    Header.BitmapInfo.bmiHeader.biHeight := cy;
    NewHandle := CreateDIBSection(NewDC, pBitmapInfo(@Header.BitmapInfo)^,
      DIB_RGB_COLORS, NewImageData, 0, 0);
    SelectObject(NewDC, NewHandle);
    {$IFDEF UseDelphi}Canvas.Handle := NewDC;{$ENDIF}
    NewBytesPerRow := (((Header.BitmapInfo.bmiHeader.biBitCount * cx) + 31)
      and not 31) div 8;

    {Copies the image data}
    for Line := 0 to Min(CY - 1, Height - 1) do
      CopyMemory(Ptr(Longint(NewImageData) + (Longint(CY) - 1) *
      NewBytesPerRow - (Line * NewBytesPerRow)), Scanline[Line],
      Min(NewBytesPerRow, Header.BytesPerRow));

    {Build array for alpha information, if necessary}
    if (Header.ColorType = COLOR_RGBALPHA) or
      (Header.ColorType = COLOR_GRAYSCALEALPHA) then
    begin
      GetMem(NewImageAlpha, CX * CY);
      Fillchar(NewImageAlpha^, CX * CY, 255);
      for Line := 0 to Min(CY - 1, Height - 1) do
        CopyMemory(Ptr(Longint(NewImageAlpha) + (Line * CX)),
        AlphaScanline[Line], Min(CX, Width));
      FreeMem(Header.ImageAlpha);
      Header.ImageAlpha := NewImageAlpha;
    end;

    {$IFDEF Store16bits}
    if (Header.BitDepth = 16) then
    begin
      GetMem(NewImageExtra, CX * CY);
      Fillchar(NewImageExtra^, CX * CY, 0);
      for Line := 0 to Min(CY - 1, Height - 1) do
        CopyMemory(Ptr(Longint(NewImageExtra) + (Line * CX)),
        ExtraScanline[Line], Min(CX, Width));
      FreeMem(Header.ExtraImageData);
      Header.ExtraImageData := NewImageExtra;
    end;
    {$ENDIF}

    {Deletes the old image}
    DeleteObject(Header.ImageHandle);
    DeleteDC(Header.ImageDC);

    {Prepares the header to get the new image}
    Header.BytesPerRow := NewBytesPerRow;
    Header.IHDRData.Width := CX;
    Header.IHDRData.Height := CY;
    Header.ImageData := NewImageData;

    {Replaces with the new image}
    Header.ImageHandle := NewHandle;
    Header.ImageDC := NewDC;
  end
  else
    {The new size provided is invalid}
    RaiseError(EPNGInvalidNewSize, EInvalidNewSize)

end;

SmoothResize由Gustavo Daud创建

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
  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;

非常感谢，祝您今天过得愉快！

- Little Helper

---

请勿因我的提问而攻击我，但为什么不将所有单独的 PNG 图像文件存储到一个资源文件中，需要时从该文件加载它们呢？这样做后你只需一个文件，并且该文件会打包进你的可执行文件的资源空间中...只需一行代码即可加载存储的 PNG 图像文件，非常简单易行。 - LaKraven

@LaKren 我知道这些，但问题是我不太聪明，不知道如何做到这一点，所以我在请求代码。我并不想无礼，但如果没有代码，我就什么也做不了。我不是懒惰，只是在处理这个层面的图像时比较菜... - Little Helper

@Roberts，这取决于您将使用哪个库。如果您没有选择库，我们无法为您提供代码示例。对于那些想要查看如何复制此类图像的人，请查看TPNGImage.Resize函数内部。 - TLama

在我（或其他人）在此处发布代码示例之前，请查看TPNGImage.Resize函数。您需要进行的唯一修改是从您指定的坐标开始迭代，而不是从0开始。 - TLama

很高兴这次讨论为你带来了需要的结果 :) - LaKraven

Answer 1

这里是另一个版本（它非常快）：

procedure CropPNG(Source: TPNGObject; Left, Top, Width, Height: Integer;
  out Target: TPNGObject);
var
  IsAlpha: Boolean;
  Line: Integer;
begin
  if (Source.Width < (Left + Width)) or (Source.Height < (Top + Height)) then
    raise Exception.Create('Invalid position/size');

  Target := TPNGObject.CreateBlank(Source.Header.ColorType, 
    Source.Header.BitDepth, Width, Height);
  IsAlpha := Source.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA];
  for Line := 0 to Target.Height - 1 do
  begin
    if IsAlpha then
      CopyMemory(Target.AlphaScanline[Line], 
        Ptr(LongInt(Source.AlphaScanline[Line + Top]) + LongInt(Left)), 
        Target.Width);
    CopyMemory(Target.Scanline[Line], 
      Ptr(LongInt(Source.Scanline[Line + Top]) + LongInt(Left * 3)), 
      Target.Width * 3);
  end;
end;

注意: 以上代码兼容较新的pngimage版本1.56+（支持CreateBlank构造函数）。

- kobik

---

@Sertac的方法不会“失败”。实际上，它很有效。我只是分享了一种不涉及中间TBitmap并且应该更快的替代方法。 - kobik

我之前测试过了，只是说如果出现任何问题，也许我会使用你的。 - Little Helper

我希望我一开始没有加入那个毫无意义的检查。不管怎样，这真的很好！ - Sertac Akyuz

嗨，我有一个问题，当我尝试从应用程序中执行的DLL中使用这个函数时，它会引发异常“找不到有效的头部”等等。为什么会这样？ - Little Helper

Answer 2

这是一份示例代码，修改自“SlicePNG”（“此函数将大型PNG文件（例如具有工具栏中的所有图像的图像）切成相同大小的小图片”）过程，在其他地方找到：

procedure CropPNG(Source: TPNGObject; Left, Top, Width, Height: Integer;
    out Target: TPNGObject);

  function ColorToTriple(Color: TColor): TRGBTriple;
  begin
    Color := ColorToRGB(Color);
    Result.rgbtBlue := Color shr 16 and $FF;
    Result.rgbtGreen := Color shr 8 and $FF;
    Result.rgbtRed := Color and $FF;
  end;

var
   X, Y: Integer;
   Bitmap: TBitmap;
   BitmapLine: PRGBLine;
   AlphaLineA, AlphaLineB: pngimage.PByteArray;
begin
  if (Source.Width < (Left + Width)) or (Source.Height < (Top + Height)) then
    raise Exception.Create('Invalid position/size');

  Bitmap := TBitmap.Create;
  try
    Bitmap.Width := Width;
    Bitmap.Height := Height;
    Bitmap.PixelFormat := pf24bit;

    for Y := 0 to Bitmap.Height - 1 do begin
      BitmapLine := Bitmap.Scanline[Y];
      for X := 0 to Bitmap.Width - 1 do
        BitmapLine^[X] := ColorToTriple(Source.Pixels[Left + X, Top + Y]);
    end;

    Target := TPNGObject.Create;
    Target.Assign(Bitmap);
  finally
    Bitmap.Free;
  end;

  if Source.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA] then begin
    Target.CreateAlpha;
    for Y := 0 to Target.Height - 1 do begin
      AlphaLineA := Source.AlphaScanline[Top + Y];
      AlphaLineB := Target.AlphaScanline[Y];
      for X := 0 to Target.Width - 1 do
        AlphaLineB^[X] := AlphaLineA^[X + Left];
    end;
  end;
end;

示例调用：

var
  Png: TPNGObject;
  CroppedPNG: TPNGobject;
begin
  PNG := TPNGObject.Create;
  PNG.LoadFromFile('..\test.png');

  CropPNG(PNG, 30, 10, 60, 50, CroppedPNG);
  CroppedPNG.SaveToFile('..\croptest.png');

- Sertac Akyuz

---

@Sertac，现在想想，使用StretchDIBits并仅修改图像头是否可能？ - TLama

+1 简单易懂。@TLama，我也相信这可以在不使用 TBitmap 的情况下完成，通过使用 CreateBlank 并将 Scanline 和 AlphaScanline 复制到新的 PNG 中。但是今天我太懒了，实际上什么都没试 ;) - kobik

Answer 3

我尝试编写代码仅使用libpng加载png文件。这很难处理。

尝试使用imlib2来处理转换PNG文件。它似乎有Delphi绑定。

如果你真的卡住了，你可以使用Image Magick的独立可执行文件来裁剪图片。

- Michael Slade