You are not logged in.
Pages: 1
Hi everybody,
I want to save many tif images (486, one file ~3MB) in one pdf. But now I have an "Out of memory"-problem.
var
i: Integer;
lPdf: TPdfDocument;
lPage: TPdfPage;
lImage :TPdfImage;
lFiles: TStringList;
begin
lFiles:= TStringList.Create;
try
// Search for tif
ScanDir(FImageFolder, '*.tif', True, False, lFiles);
lPDF:= TPdfDocument.Create();
lPDF.NewDoc;
lPDF.DefaultPaperSize:= psA4;
try
for i:= 0 to Pred(lFiles.Count) do
begin
lPage:= FPDF.AddPage;
img1.LoadFromFile(lFiles[i], 0);
lImage := TPdfImage.Create(lPDF, img1.Graphic, true);
lPDF.AddXObject('image' + IntToStr(i), lImage);
lPDF.Canvas.DrawXObject(0, 0, lPage.PageWidth, lPage.PageHeight, 'image' + IntToStr(i));
end;
finally
lPDF.SaveToFile(ExtractFilePath(Application.ExeName) + 'output.pdf');
lPDF.Free;
end;
finally
lFiles.Free;
end;
end;
After 190 files I get a "Out of memory" Error.
I don't know how I can fix this.
Maybe someone knows a solution to the problem.
Thanks, Matthias.
Offline
Take a look at TPdfDocument.SaveToStreamDirectBegin/PageFlush/End methods, able to render all page content directly to the destination stream/file, therefore reducing the memory use to a minimal value for huge content - used e.g. in TPdfDocumentGDI.SaveToStream() and TGDIPages.ExportPDFStream().
Offline
Thank you, ab.
I changed my code to:
var
i: Integer;
lPage: TPdfPage;
lPdf: TPdfDocument;
lImage :TPdfImage;
lFiles: TStringList;
fs: TFileStream;
begin
lFiles:= TStringList.Create;
try
ScanDir(FImageFolder, '*.tif', True, False, lFiles);
if lFiles.Count = 0 then
Exit;
lPdf:= TPdfDocument.Create;
fs:= TFileStream.Create(ExtractFilePath(Application.ExeName) + 'output.pdf', fmCreate);
lPdf.NewDoc;
lPdf.DefaultPaperSize:= psA4;
try
lPdf.SaveToStreamDirectBegin(fs);
for i:= 0 to Pred(lFiles.Count) do
begin
lPage:= lPdf.AddPage;
img1.LoadFromFile(lFiles[i], 0);
lImage := TPdfImage.Create(lPdf, img1.Graphic, true);
lPdf.AddXObject('image' + IntToStr(i), lImage);
lPdf.Canvas.DrawXObject(0, 0, lPage.PageWidth, lPage.PageHeight, 'image' + IntToStr(i));
lPdf.SaveToStreamDirectPageFlush;
img1.Clear;
end;
lPdf.SaveToStreamDirectEnd;
finally
fs.Free;
lPdf.Free;
end;
finally
lFiles.Free;
end;
end;
It's little bit better.
Now I can save 391 of 486 images in the pdf before I get the "out of memory" error.
Don't know why, in taskmanager the programsize is around 30MB all the time.
Is it possible to destroy the lImage object after the flush?
Any ideas?
Offline
AFAIK, the image should be released when flush to the disk.
See FWriter.fDestStream.Size := 0 in TPdfStream.InternalWriteTo.
Try to use the new FlushCurrentPageNow parameter of TPdfDocument.SaveToStreamDirectPageFlush(), or the new low-level TPdfObject.ForceSaveNow method.
See http://synopse.info/fossil/info/51487ef761
Offline
Sorry, same problem. Here is my sourcecode for testing:
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;
Offline
I have tried it now. Nothing changed.
...
lPdf.AddXObject('image' + IntToStr(i), lImage);
lPdf.Canvas.DrawXObject(0, 0, lPage.PageWidth, lPage.PageHeight, 'image' + IntToStr(i));
lImage.ForceSaveNow;
lPdf.SaveToStreamDirectPageFlush(True);
...
Offline
Seems to be ok. Frees memory in SynCommons. Jumps into:
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;
...
If you want to try, increase imagesize. With lBmp.Width:= 20048; lBmp.Height:= 26000; program crashes after 3 images.
Offline
Solution: Use FastMM in project and it works!
uses
FastMM4,
...
@ab: big thank you.
Offline
Pages: 1