Bonjour,
Le but de ma fonction est de générer un JPEG à partir des metafiles contenus dans mon objet QuickReport.
voici la fonction :
procedure TModuleExportMail.ExportToJPEGStream(AReport: TQuickRep; AStream: TStream);
var aMeta : TMetaFile;
PageNum,MaxPage : integer;
AWidth, AHeight : Integer;
MonBMP : TBitmap;
Jpg: TJPEGImage;
ImageEnProc : TImageEnProc;
Ratio : Extended;
NHeight : Integer;
NewWidth, NewHeight,Oldheight : integer;
begin
MonBMP := TBitmap.create;
Jpg := TJPEGImage.Create;
ImageEnProc := TImageEnProc.Create (nil);
try
AReport.PrepareExportMetafile;
MaxPage := Areport.QRPrinter.PageCount;
MonBMP.Height := 0;
Jpg.Performance := jpBestQuality;
Jpg.CompressionQuality := 90;
for PageNum := 1 to MaxPage do
begin
aMeta := Areport.QRPrinter.GetPage(PageNum);
if assigned(ameta) then
begin
try
Oldheight := MonBMP.Height;
MonBMP.PixelFormat := pf24bit;
MonBMP.Width := ameta.Width;
MonBMP.Height := MonBMP.Height + ameta.Height;
MonBMP.Canvas.Draw(0,Oldheight, ameta);
finally
aMeta.Free;
end;
end;
end;
if MonBMP.Width > 0 then
begin
NewWidth := 800;
NewHeight := -1;
Jpg.Performance := jpBestQuality;
Jpg.CompressionQuality := 90;
Ratio := MonBMP.Height/MonBMP.Width;
NHeight := Round(Ratio * NewWidth);
ImageEnProc.AttachedBitMap := MonBMP;
ImageEnProc.Resample(NewWidth, NewHeight, rfMitchell);
MonBMP.Width := NewWidth;
MonBMP.Height := NHeight;
Jpg.Assign(MonBMP);
Jpg.savetoStream(Astream);
end;
finally
MonBMP.free;
jpg.free;
ImageEnProc.Free;
end;
end;
Comme vous le constater mon but est de récuperer l'image sous une résolution de 800 x YYY afin qu'elle puisse etre facilement exploitable.
cela fonctionne très bien, mais le problème est que la fonction ReSample est super longue et pénalise beaucoup le reste de mon programme. Connaissez vous un moyen d'optimiser, ou une autre moulinette pour mon besoin ?
Cordialement.