PNG Resize

uses Vcl.Imaging.PngImage

//

procedure copy_to_resized_png( tar, src:string; w, h: Integer);
  var
    bmp: TBitmap;
    png, output: TPngImage;
  begin
    png := TPngImage.Create;
    png.LoadFromFile( src);
    bmp := TBitmap.Create;
    bmp.Width := w;
    bmp.Height := h;

    bmp.Canvas.StretchDraw( RECT( 0, 0, w, h), png);

    output := TPngImage.Create;
    output.Assign( bmp);
    output.SaveToFile( tar);

    output.Free;
    bmp.Free;
    png.Free;
  end;

Beispiel :

procedure TForm1.Button1Click(Sender: TObject);
var pic_empty, pic_stamp, pic_result :TPicture;
   r:TRect;
   png : TPNGObject;
begin
  pic_stamp := TPicture.Create;
  pic_stamp.LoadFromFile('c:\image.png');
  pic_stamp.Graphic.Transparent := True;

  pic_empty := TPicture.Create;
  pic_empty.LoadFromFile('c:\empty.png');
  pic_empty.Graphic.Transparent := True;

  r.Left := 0;
  r.Top := 0;
  r.Right := r.Left + 100;
  r.Bottom := r.Top + 100;

  pic_result := tpicture.Create;
  pic_result.Bitmap.Assign(pic_empty.Graphic);
  pic_result.Graphic.Transparent := True;

  try
    pic_result.Bitmap.Canvas.StretchDraw(r,pic_stamp.Graphic);
    pic_result.Bitmap.Width := 100;
    pic_result.Bitmap.Height:= 100;

    png := TPNGObject.Create;
    png.Assign(pic_result.Bitmap);
    png.SaveToFile('c:\result.png');
  finally
  png.Free;
  pic_result.Free;
  pic_empty.Free;
  pic_stamp.free;
  end;
end;