mORMot Open Source

function THeapMemoryStream.Realloc(var NewCapacity: longint): Pointer;
...
if NewCapacity <> Capacity then begin
  if NewCapacity = 0 then begin
    FreeMem(Memory);
    Result := nil;
  end else begin
    if Capacity = 0 then
      GetMem(Result, NewCapacity) else
    if NewCapacity > Capacity then // only realloc if necessary (grow up)
      ReallocMem(Result, NewCapacity) else
      NewCapacity := Capacity; // same capacity as before
    if Result = nil then
      raise EStreamError.Create('THeapMemoryStream'); // memory allocation bug
  end;
end;
...

var
  i: Integer;
  lPage: TPdfPage;
  lPdf: TPdfDocument;
  lImage :TPdfImage;
  lBmp: TBitmap;
  fs: TFileStream;
begin
  lBmp:= TBitmap.Create;
  lPdf:= TPdfDocument.Create;
  fs:= TFileStream.Create(ExtractFilePath(Application.ExeName) + 'output.pdf', fmCreate);
  try
    lBmp.PixelFormat:= pf8bit;
    lBmp.Width:= 2048;
    lBmp.Height:= 2600;
    lPdf.NewDoc;
    lPdf.DefaultPaperSize:= psA4;
    lPdf.SaveToStreamDirectBegin(fs);
    for i:= 1 to 500 do
    begin
      lPage:= lPdf.AddPage;
      lImage := TPdfImage.Create(lPdf, lBmp, true);
      lPdf.AddXObject('image' + IntToStr(i), lImage);
      lPdf.Canvas.DrawXObject(0, 0, lPage.PageWidth, lPage.PageHeight, 'image' + IntToStr(i));
      lPdf.SaveToStreamDirectPageFlush(True);
    end;
    lPdf.SaveToStreamDirectEnd;
  finally
    fs.Free;
    lPdf.Free;
    lBmp.Free;
  end;
end;