Discussion :

[SergioMaster]

Bonjour,

je reviens sur ce sujet, que j'ai abordé à maintes reprises, car j'ai l'impression d'avoir fait une petite boulette (fuite de mémoire) dans mes essais (https://serge-girard.developpez.com/...dings/ListView

suite à ce que j'ai pu écrire ici, j'ai pu aller plus loin jusqu'à ce que je constate une fuite de mémoire

la cause, cette instruction AListItemBitmap.Bitmap:=TBitmap.Create(40,40);voilà le challenge : avoir des éléments au sein d'un rectangle au coin arrondi.

(cerise sur le gâteau, avoir une couleur différente pour l'élément sélectionné )

mon code, sans fuite mémoire

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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
  private
    { Déclarations privées }
     backcolor,selectedcolor, itemcolor, alternative : TAlphaColor;
     afmxobj : TFmxObject;

     idrec : integer;
  public
    { Déclarations publiques }
  end;

var
  Form15: TForm15;


implementation

{$R *.fmx}

uses System.UIConsts;

procedure TForm15.FormCreate(Sender: TObject);
var afmxobj : TFmxObject;
begin
// obtenir les couleurs du style, modifier au besoin 
afmxobj := Stylebook1.Style.FindStyleResource('listviewstyle.background');
if assigned(afmxObj) and (afmxobj is TColorObject)  then
   backcolor:=TColorObject(afmxobj).Color;

afmxobj := Stylebook1.Style.FindStyleResource('listviewstyle.itembackground');
if assigned(afmxObj) and (afmxobj is TColorObject)  then
//   itemcolor:=TColorObject(afmxobj).Color; 
   itemcolor:=Talphacolors.Green;
afmxobj := Stylebook1.Style.FindStyleResource('listviewstyle.alternatingitembackground');
if assigned(afmxObj) and (afmxobj is TColorObject)  then
//   alternative:=TColorObject(afmxobj).Color;
   alternative:=Talphacolors.Navy;
afmxobj := Stylebook1.Style.FindStyleResource('listviewstyle.glow');
if assigned(afmxObj) and (afmxobj is TColorObject)  then
 begin
   selectedcolor:=TColorObject(afmxobj).Color;
 end;

// cacher les cadres 
afmxobj := Stylebook1.Style.FindStyleResource('listviewstyle.frame');
if assigned(afmxObj) and (afmxobj is TColorObject)  then
   TColorObject(afmxobj).Color:=$00000000;

// cacher selection
afmxobj := Stylebook1.Style.FindStyleResource('listviewstyle.selection');
    if assigned(afmxObj) and (afmxobj is TStyleObject)  then
     TStyleObject(afmxobj).visible:=false;

idrec:=0;
end;

procedure TForm15.ListView1ItemClick(const Sender: TObject;
  const AItem: TListViewItem);
begin
idrec:=Listview1.ItemIndex;
ListView1.RecalcSize;
end;


procedure TForm15.ListView1UpdatingObjects(const Sender: TObject;
  const AItem: TListViewItem; var AHandled: Boolean);
var AListItemBitmap : TListItemImage;
    AColor : TAlphaColor;
    aCanvas : Tcanvas;
    abitmap : TBitmap;
begin

AListItemBitmap:=AItem.Objects.FindObjectT<TListItemImage>('Image2');
if assigned(AListItemBitmap) then
 begin
//    AListItemBitmap.Bitmap:=Image1.Bitmap; // non
//   AListItemBitmap.Bitmap:=TBitmap.Create(Trunc(listview1.width),Trunc(ListView1.ItemAppearance.ItemHeight)); // non, fuite mémoire
    aColor:=ItemColor;
    if Listview1.AlternatingColors AND (odd(aitem.index))then acolor:=Alternative;
    if aitem.index=idrec then
       acolor:=selectedcolor;
    AListItemBitmap.Bitmap.SetSize(Trunc(listview1.width),Trunc(ListView1.ItemAppearance.ItemHeight));
    AListItemBitmap.Bitmap.Clear(backcolor) ;
    with AListItemBitmap.bitmap.Canvas do
     begin
      BeginScene;
      Fill.Color:=acolor;
      Fill.Kind:=TBrushkind.Solid;
      FillRect(TREctF.Create(0,0,listview1.width,ListView1.ItemAppearance.ItemHeight),20,20,allCorners,1);
      Stroke.Thickness:=1;
      Stroke.Color:=TAlphaColors.red;
      DrawRectSides(TREctF.Create(0,0,listview1.width,ListView1.ItemAppearance.ItemHeight),20,20,allCorners,1,allSides);
      EndScene;
     end;
 end;
end;

end.

Seulement, si cela fonctionne, cela nécessite qu'un bitmap soit lié Ma question, comment faire en sorte que je n'aie pas besoin de bitmap à lier (cf code en rouge) sans que, pour autant, je n'aie pas de fuite mémoire ?

[exoseven]

a vérifier mais il me semble que tu doives pouvoir faire

Code :

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

1
2
AListItemBitmap.OwnsBitmap := True;
AListItemBitmap.Bitmap:=TBitmap.Create(Trunc(listview1.width),Trunc(ListView1.ItemAppearance.ItemHeight));

[SergioMaster]

Bonjour et merci

J'avais aussi fait cet essai avec toujours une fuite mémoire. Mais peut-être me suis-je planté dans l'ordre des instructions (à force d'en faire )
une nouvelle tentative et j'observe que j'ai toujours la fuite mémoire, pas au premier affichage, mais dès que je change d'item. Il manque donc un test

Éco !

Code :

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

1
2
3
4
5
6
 
  if  not AListItemBitmap.OwnsBitmap then
    begin
      AListItemBitmap.OwnsBitmap:=true;
      AListItemBitmap.Bitmap:=TBitmap.Create(Trunc(listview1.width),Trunc(ListView1.ItemAppearance.ItemHeight)); // non
    end;

Le problème de fuite semble résolu, une trace plus poussée semble nécessaire avant que cette solution soit validée, la description de OwnsBitmap me paraissant un peu floue

[exoseven]

oui en effet d'ailleurs dans l'exemple d'embarcadero c'est testé comme cela

Code :

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

1
2
3
4
5
if (LThumb.Bitmap = nil) or (not LThumb.OwnsBitmap) then
begin
   LThumb.OwnsBitmap := True;
   LThumb.Bitmap := TBitmap.Create(0, 0);
end;

[SergioMaster]

Merci, cet exemple m'avait totalement échappé.