Any way to speed up SaveToStream on TPNGImage?

I have a function that converts TBitmap (which I draw) to TPngImage and then saves it to stream, so other methods can use it. Png is used because it creates smaller images for report output (excel, html). The problem is that SaveToStream seems to take too much time, 15x more than converting TBitmap to TPngImage or using TStream with png. Here is the code:

var
 BitmapImage: TBitmap;      
 PNGImage: TPngImage;
 PngStream: TStream;        
begin
  // draw on BitmapImage
  ...
  PNGImage := TPngImage.Create;
  PNGStream := TMemoryStream.Create;
  Try
     PNGImage.Assign(BitmapPicture.Bitmap); // Step 1: assign TBitmap to PNG
     PNGImage.SaveToStream(PNGStream);  // Step 2: save PNG to stream
     WS.Shapes.AddPicture(PNGStream,PNGImage.Width,PNGImage.Height); // Step 3: Add PNG from Stream to Excel
  finally
     PNGImage.Free;
     PNGStream.Free;
  end;
...

This is tested with 70000 images and here are the timings:
Step 1: 7 s

Step 2: 93 s

Step 3: 6 s

Why is saving to Stream so slow? Any suggestion to optimize this?

Using Delphi XE7

EDIT

Here is example (MCVE) with simple bmp that gets converted to PNG and then saved into stream. Just for the sake of another verification I added SaveToFile, which of course takes longer, but it is saving to disk, so I assume acceptable.

The img1.bmp is 49.5KB, saved PNG is 661 bytes. link to img1.bmp = http://www.filedropper.com/img1_1

TMemoryStreamAccess = class(TMemoryStream)
  end;

procedure TForm1.Button1Click(Sender: TObject);
var BitmapImage:TBitmap;
  PNGImage:TPngImage;
  PNGStream:TMemoryStream;//TStream;
  i,t1,t2,t3,t4,t5,t6: Integer;
  vFileName:string;
begin

  BitmapImage:=TBitmap.Create;
  BitmapImage.LoadFromFile('c:\tmp\img1.bmp');

  t1:=0; t2:=0; t3:=0; t4:=0; t5:=0; t6:=0;

  for i := 1 to 70000 do
  begin

    PNGImage:=TPngImage.Create;
    PNGStream:=TMemoryStream.Create;
    try

      t1:=GetTickCount;
      PNGImage.Assign(BitmapImage);
      t2:=t2+GetTickCount-t1;

      t3:=GetTickCount;
      TMemoryStreamAccess(PNGStream).Capacity := 1000;
      PNGImage.SaveToStream(PNGStream);
      // BitmapImage.SaveToStream(PNGStream); <-- very fast!
      t4:=t4+GetTickCount-t3;

    finally
      PNGImage.Free;
      PNGstream.Free
    end;

  end;

   showmessage('Assign = '+inttostr(t2)+' - SaveToStream = '+inttostr(t4));
end;

This is tested with 70000 images and here are the timings:

Step 1: 7 s

Step 2: 93 s

Step 3: 6 s

Why is saving to Stream so slow?

Let's crunch some numbers:

Step 1: 7s = 7000ms. 7000 / 70000 = 0.1ms per image

Step 2: 93s = 93000ms. 93000 / 70000 = ~1.33ms per image

Step 3: 6s = 6000ms. 6000 / 70000 = ~0.086ms per image

Do you think 1.33 ms per SaveToStream() is slow? You are just doing a LOT of them, so they add up over time, that's all.

That being said, PNG data in memory is not compressed. It gets compressed when the data is saved. So that is one reason for slowdown. Also, saving the PNG does a lot of writes to the stream, which can cause the stream to perform multiple memory (re)allocations (TPNGImage also performs internal memory allocations during saving), so that is another slowdown.

Any suggestion to optimize this?

There is nothing you can do about the compression overhead, but you can at least pre-set the TMemoryStream.Capacity to a reasonable value before calling SaveToStream() to reduce the memory reallocations that TMemoryStream needs to perform during writing. You don't need to be exact with it. If writing to the stream causes its Size to exceed its current Capacity, it will simply increase its Capacity accordingly. Since you have already processed 70000 images, take the average size of them and add a few more KB to it, and use that as your initial Capacity.

type
  TMemoryStreamAccess = class(TMemoryStream)
  end;

var
  BitmapImage: TBitmap;      
  PNGImage: TPngImage;
  PngStream: TMemoryStream;        
begin
  // draw on BitmapImage
  ...
  PNGImage := TPngImage.Create;
  Try
    PNGImage.Assign(BitmapPicture.Bitmap); // Step 1: assign TBitmap to PNG
    PNGStream := TMemoryStream.Create;
    try
      TMemoryStreamAccess(PNGStream).Capacity := ...; // some reasonable value
      PNGImage.SaveToStream(PNGStream);  // Step 2: save PNG to stream
      WS.Shapes.AddPicture(PNGStream, PNGImage.Width, PNGImage.Height); // Step 3: Add PNG from Stream to Excel
    finally
      PNGStream.Free;
    end;
  finally
    PNGImage.Free;
  end;
  ...

If that still is not fast enough for you, consider using threads to process multiple images in parallel. Don't process them sequentially.