Discussion :

[MIWAN]

Bonjour
Apres plusieurs tentation avec Tlistview pour agrandir une bitmap , je n’arrive pas a être satisfait , et pour cela je m’adresse a vous pour trouver une aide
Bon voila mon code

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
 
procedure FillListView(path: string; mask: string = '*.jpg');
var
  sr:  TSearchRec;
  img: TPicture;
  bmp: TBitmap;
  pic: TBitMap;
begin
  img := TPicture.Create;
  bmp := TBitMap.Create;
  pic := TBitMap.Create;
  With Form1 do
  if FindFirst(path + mask, $20, sr) = 0 then
  begin
    repeat
      if (sr.Attr and $20) = $20 then
      begin
        try
          img.LoadFromFile(path + sr.Name);
        except
          Continue;
        end;
        bmp.Assign(img.Graphic);
        pic.Width := 80;
        pic.Height:= 80;
        pic.Canvas.StretchDraw(Rect(0,0,pic.Width, pic.Height), bmp);
        ImageList1.Add(pic, nil);
        with ListView1.Items.Add do begin
          Caption := sr.Name;
          ImageIndex := ListView1.Items.Count-1;
        end;
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
  img.Free; bmp.Free; pic.Free;
end;

l'appele

Code :

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

1
2
3
4
5
6
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  FillListView('C:\images\', '*.jpg');
  FillListView('C:\images\', '*.bmp');
End;

[ThWilliam]

Bonjour.

Canvas.StretchDraw est la méthode la plus rapide, mais la plus mauvaise pour un stretching. L'api windows StretchBlt donne un résultat bien meilleur.
Ensuite tu fais un stretching 80/80 : ok si toutes tes images originales sont carrées, sinon tu crées une distorsion de l'image --> faire un stretch proportionnel, c.à.d. déterminer la hauteur et la largeur de ton bitmap Pic (avec un maximum de 80 pour chacune) à l'échelle de l'original.

Cordialement
Thierry

[MIWAN]

Merci pour votre intervention
Dans ce cas, on doit passer par la procedure ResizeBMP

[ThWilliam]

Voilà, de mémoire, le code que j'utilisais sous Delphi7 pour faire un resize proportionnel.

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
function StretchBmp(Source, Dest: TBitmap; MaxWidth, MaxHeight: integer): boolean;
var
   Scale: double;
begin
   Result:= false;
   if (Source.Width = 0) or (Source.Height = 0) then Exit;
   Scale:= Min(MaxWidth / Source.Width, MaxHeight / Source.Height); // il faut déclarer uses math
   Dest.Width:=  Round(Source.Width * Scale);
   Dest.Height:= Round(Source.Height * Scale);
   SetStretchBltMode(Dest.Canvas.Handle, HALFTONE);
   Result:= StretchBlt(Dest.Canvas.Handle,
                             0, 0, Dest.Width, Dest.Height,
                             Source.Canvas.Handle,
                             0, 0, Source.Width, Source.Height,
                             SRCCOPY);
end;

Donc dans ton cas, l'appel se fait : StretchBmp(Bmp, Pic, 80, 80)

Cordialement
Thierry

[MIWAN]

Hi Thierry
Pour ne pas vous déranger : même avec StretchBmp je ne vois aucune déférence et pour vous faciliter la tache je vous envois le projet ci vous avais biens sure le temps ;
Je suis très reconnaissant.

[Cirec]

Salut à tous,

il y a plusieurs problèmes à ton code.

1. TImageList n'accepte pas des images de différentes taille
2. tu n'as pas adapté la taille des images dans ImageList1
3. le code pourrait être optimisé

voici le code qui corrige les deux premiers problèmes :

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
62
63
64
65
66
67
68
69
70
function StretchBmp(Source, Dest: TBitmap; MaxWidth, MaxHeight: integer): boolean;
var
   Scale: double;
   NewHeight, NewWidth: Integer;            // Ajoué
begin
   Result:= false;
   if (Source.Width = 0) or (Source.Height = 0) then Exit;
   Scale:= Min(MaxWidth / Source.Width, MaxHeight / Source.Height); // il faut déclarer uses math
   Dest.Width:=  MaxWidth;            // Ajoué
   Dest.Height:= MaxHeight;            // Ajoué
   NewWidth:=  Round(Source.Width * Scale);            // Modifié
   NewHeight:= Round(Source.Height * Scale);            // Modifié
   SetStretchBltMode(Dest.Canvas.Handle, HALFTONE);
   Dest.Canvas.FillRect(Dest.Canvas.ClipRect);
   Result:= StretchBlt(Dest.Canvas.Handle,
                             (MaxWidth-NewWidth) div 2,             // Modifié
                             (MaxHeight-NewHeight) div 2,           // Modifié 
                             NewWidth, NewHeight,
                             Source.Canvas.Handle,
                             0, 0, Source.Width, Source.Height,
                             SRCCOPY);
end;
 
procedure FillListView(path: string; mask: string = '*.jpg');
var
  sr:  TSearchRec;
  img: TPicture;
  bmp: TBitmap;
  pic: TBitMap;
begin
  img := TPicture.Create;
  bmp := TBitMap.Create;
  pic := TBitMap.Create;
  With Form1 do
  if FindFirst(path + mask, $20, sr) = 0 then
  begin
    repeat
      if (sr.Attr and $20) = $20 then
      begin
        try
          img.LoadFromFile(path + sr.Name);
        except
          Continue;
        end;
        bmp.Assign(img.Graphic);
     //   pic.Width := 80;
     //   pic.Height:= 80;
    //    pic.Canvas.StretchDraw(Rect(0,0,pic.Width, pic.Height), bmp);
       StretchBmp(Bmp, Pic, ImageList1.Width, ImageList1.Height);            // Modifié
        ImageList1.Add(Pic, nil);
        with ListView1.Items.Add do begin
          Caption := sr.Name;
          ImageIndex := ListView1.Items.Count-1;
        end;
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
  img.Free; bmp.Free; pic.Free;
end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  // ici tu ajustes la taille voulue ... Ex. 80 
  ImageList1.Width := 512;              // Ajoué
  ImageList1.Height := 512;             // Ajoué
  FillListView('C:\images\', '*.jpg');
  FillListView('C:\images\', '*.bmp');
End;

Ce code des miniatures de 512 x 512 sans aucun soucis ... testé et compilé sous D7 & D2009.

@+ Cirec

[MIWAN]

bonjour

Merci ça marche très bien

Merci a tous