Image 如何从其他PNG复制一个PNG？

我的应用程序需要很多PNG，我经常在尝试使用它们时弄乱代码。为了让我的生活更轻松，我用Realword Paint制作了一个大的PNG图像，并将所有小的PNG图像粘贴到上面。现在我有了一个文件。现在我只需要将一个PNG以透明的方式复制到另一个PNG上（顺便说一句，不要问为什么），因为我需要独立处理每个图像。当涉及到处理图像时，我是一个糟糕的程序员。我使用的是Delphi7

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;

---

非常感谢，祝你有愉快的一天

我试着编写代码，只需使用加载png即可。和他一起工作真是太可怕了

尝试使用来翻译PNG文件。很明显，它有一个

---

如果您真的陷入困境，可以使用的单独可执行文件进行图像裁剪。

以下是一个从“切片PNG”修改而来的示例代码（“此函数用于将一个大PNG文件（例如，一个包含工具栏上所有图像的图像）切片为更小、大小相等的图片”）找到的过程：

下面是另一个版本（它工作得非常快）：

过程裁剪（源：TPNGObject；左、上、宽、高：整数；
外部目标：TPNGObject）；
变量
IsAlpha：布尔型；
行：整数；
开始
如果是（Source.Width<（左+宽））或（Source.Height<（顶+高）），则
引发异常。创建（'无效位置/大小'）；
目标：=TPNGObject.CreateBlank（Source.Header.ColorType，
Source.Header.bit深度、宽度、高度）；
IsAlpha:=Source.Header.ColorType在[COLOR\u GRAYSCALEALPHA，COLOR\u RGBALPHA]中；
对于行：=0到目标。高度-1 do
开始
如果我是阿尔法那么
CopyMemory（Target.AlphaScanline[Line]，
Ptr（LongInt（源.字母扫描线[行+顶]）+LongInt（左）），
目标宽度）；
CopyMemory（目标扫描线[Line]，
Ptr（LongInt（源扫描线[行+顶]）+LongInt（左*3）），
目标宽度*3）；
结束；
结束；

---

注意：上述代码与较新版本1.56+兼容（该版本支持

CreateBlank

构造函数）

请不要问我，但为什么不将所有单个PNG转储到一个资源文件中，然后根据需要从该文件加载它们呢？当您完成时，它是一个文件，并被打包到可执行文件的资源空间中。。。一行代码加载存储的PNG，虽然很容易，但是没有？那么，一种方法（虽然不是最优雅的，但我相信）是迭代片段的X和Y，然后将像素颜色（RGBA以保留Alpha）复制到新的PNG容器实例上。这当然需要你知道你的“分段”的上、下、左、右坐标。@LaKren我知道所有这些，但问题是我很笨，我不知道怎么做，我要的是代码。我不想粗鲁，但没有代码我什么都做不了。我不懒惰，在这个级别上处理图像时我是noob…@Roberts，这取决于你将使用什么库。如果您没有选择库，我们无法为您提供代码示例。对于那些想了解如何复制此类图像的人，请查看

TPNGImage.Resize

函数内部。然后在我（或其他人）在此发布代码示例之前，请查看该

TPNGImage.Resize

函数。您需要做的唯一修改不是从0开始迭代，而是从您指定的坐标开始迭代。@Sertac现在正在考虑，为了简单起见，不可能使用

StretchDIBits

并仅修改图像标题？+1@TLama，我也相信这可以在不使用

TBitmap

的情况下完成，方法是启动

CreateBlank

并将

Scanline

和

AlphaScanline

复制到新的PNG。但我今天懒得去尝试任何东西；）@塞塔克的方法不会“失败”。实际上，它工作得很好。我只分享了一个选择，它不涉及中间

TBitmap

，应该更快。我很久以前测试过它，我只是说，如果有任何问题，也许我会使用你的。我希望我没有在一开始就做那个毫无意义的检查。无论如何，这真的很好！嘿，我有一个问题，当我试图在从应用程序执行的DLL中使用这个函数时，它会引发异常“找不到有效的头”等等。为什么？

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;

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

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;