Discussion :

[Roukin54]

Bonjour,

Le but de ma fonction est de générer un JPEG à partir des metafiles contenus dans mon objet QuickReport.

voici la fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
procedure 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.

[Andnotor]

Tu ne nous montre pas le code de cette fonction, donc difficile à dire s'il y a plus rapide ! Mais j'utiliserais StretchBlt.

[Roukin54]

dsl ce n'est pas une fonction mais une procédure... et elle est dans le poste.

[Roukin54]

les Qreport contiennent des metafile (un metafile par page) je récupere donc un à un les metafile et je les combinent pour faire une image unique en sortie

[Andnotor]

Je vois bien où elle est utilisée, mais pas où elle est déclarée .

Maintenant, tu pourrais aussi tout faire en une étape en remplaçant Draw par StretchDraw.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
...
PageWidth := 800;
MonBMP.PixelFormat := pf24bit;
 
for PageNum := 1 to MaxPage do
begin
  aMeta := Areport.QRPrinter.GetPage(PageNum);
 
  if assigned(aMeta) then
  begin
    //Initialisation (1ère page seulement)
    if PageNum = 1 then
    begin
      Ratio      := PageWidth /aMeta.Width;
      PageHeight := Trunc(aMeta.Height *Ratio);
      R          := Rect(0, 0, PageWidth, PageHeight);
      MonBMP.SetSize(PageWidth, PageHeight *MaxPage);
    end;
 
    //Copie
    try
      MonBMP.Canvas.StretchDraw(R, aMeta);
    finally
      aMeta.Free;  //Est-ce nécessaire ?!?
    end;
 
    //Décalage (Page suivante)
    OffsetRect(R, 0, PageHeight);
  end;
end;
...

[Roukin54]

Désolé, je crois que l'on ne parlait pas de la même fonction, tu parlais de Resample ? C'est une fonction de mon objet TimageEnproc (composant imageen), voici le code mais ca ne te servira pas à grand chose je pense.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
procedure TImageEnProc.Resample(NewWidth, NewHeight: integer; FilterType: TResampleFilter);
var
  newbitmap: TIEBitmap;
begin
  {$ifdef IEPROFILE} try IEProfileBegin('TImageEnProc.Resample'); {$endif}
  if not MakeConsistentBitmap([]) then
    exit;
  if (fIEBitmap.Width = 0) or (fIEBitmap.Height = 0) then
    exit;
  if fAutoUndo then
    SaveUndoCaptioned('Resample ' + inttostr(NewWidth) + ',' + inttostr(NewHeight), ieuImage);
  //
  newbitmap := TIEBitmap.create;
  ResampleTo(newbitmap, NewWidth, NewHeight, FilterType); // ResampleTo resizes the bitmap and set pixelformat
  fIEBitmap.assign(newbitmap);
  FreeAndNil(newbitmap);
  //
  Update;
  DoFinishWork;
  {$ifdef IEPROFILE} finally IEProfileEnd; end; {$endif}
end;

Sinon ta proposition est intéressante je vois où tu veux en venir mais la procedure setSize n'existe pas sur mon TBitmap

[Andnotor]

...mais le problème est que la fonction ReSample est super longue et pénalise beaucoup le reste de mon programme.

Pourtant c'est bien de cette procédure que tu parlais dans ton 1er post .
Mis à part, je ne vois pas l'avantage de cette procédure par rapport à un simple StretchDraw.

Remplace simplement SetSize par MonBmp.Width et MonBmp.Height.

[Roukin54]

En faites j'utilise le resample pour reduire la résolution/taille de mon image sans la déteriorer.
Je viens d'essayer ton idée, fonctionne impeccable !

Je te remercie beaucoup de t etre pencher sur mon problème !!!

je cloture donc

Bien cordialement