How to copy one PNG from other PNG?

Question

My application needs a lot of PNGs and I often mess up my code while trying to work with them. To make my life easier I made one big PNG image in Realword Paint and pasted all t

Answer 1

Here is one sample code modified from a 'SlicePNG' ("This function slices a large PNG file (e.g. an image with all images for a toolbar) into smaller, equally-sized pictures") procedure found elsewhere:

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;

Sample call:

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

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

Answer 2

I've tried writing code to just load a png using libpng. It's pretty horrible to work with.

Try using imlib2 to take care of translating PNG files. it has a Delphi binding, apparently.

If if you get really stuck you could use Inage Magick's separate executable to do the image cropping.

Answer 3

Here is another version (It works very fast):

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;

Note: The above code is compatible with the newer pngimage Version 1.56+ (which supports the CreateBlank constructor)