Tri avec TObjectList

**Gilbert Geyer** · 29/11/2007, 17h13

Bonjour,

J'utilse le code suivant pour effectuer des tris sur une TObjectList :

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
98
99
100
101
102
103
type      TTruc = class
          public
            Titre   : string;
            Texte   : string;
            NbPages : word;
            constructor Create( iTitre, iTexte : string;  iNbPages  : word);
          end;

          TListeDeTrucs = class(TObjectList)
          private
            function  GetItem(Index: Integer): TTruc;
            procedure SetItem(Index: Integer; const Value: TTruc);
            function  fCompareAlphaTitres(Item1, Item2: Pointer): Integer;
          public
            function  Add(AObject: TTruc): Integer;
            procedure Insert(Index: Integer; AObject: TObject);
            property  Items[Index: Integer]: TTruc read GetItem write SetItem; default;
          end;

// TTruc :

constructor TTruc.Create( iTitre, iTexte : string; iNbPages  : word);
begin       Titre   := iTitre;
            Texte   := iTexte;
            NbPages := iNbPages;
end;

// TListeDeTrucs :

function  TListeDeTrucs.fCompareAlphaTitres(Item1, Item2: Pointer): Integer;
begin     if TTruc(item1).Titre > TTruc(item2).Titre then Result := +1 else
          if TTruc(item1).Titre < TTruc(item2).Titre then Result := -1
          else Result := 0;
end;

function  fCompareAlphaTitres(Item1, Item2: Pointer): Integer;
begin     if TTruc(item1).Titre > TTruc(item2).Titre then Result := +1 else
          if TTruc(item1).Titre < TTruc(item2).Titre then Result := -1
          else Result := 0;
end;

function  fCompareNumNbPages(Item1, Item2: Pointer): Integer;
begin     if TTruc(item1).NbPages > TTruc(item2).NbPages then Result := +1 else
          if TTruc(item1).NbPages < TTruc(item2).NbPages then Result := -1
          else Result := 0;
end;
function  TListeDeTrucs.Add(AObject: TTruc): Integer;
begin     result := inherited Add(AObject); end;
 
procedure TListeDeTrucs.Insert(Index: Integer; AObject: TObject);
begin     inherited Insert(index, AObject); end;

function  TListeDeTrucs.GetItem(Index: Integer): TTruc;
begin     result := TTruc(inherited GetItem(index)); end;

procedure TListeDeTrucs.SetItem(Index: Integer; const Value: TTruc);
begin     inherited setItem(index, value); end;

//---------Utilisation :

var       Li1 : TListeDeTrucs;

procedure TfrmTriSLObj.btnCeerListeDeTrucsClick(Sender: TObject);
var       i    : integer;
          sNum : string;
          nbPages : word;
begin     if not Assigned(Li1) Then li1 := TListeDeTrucs.Create(true);
          li1.OwnsObjects:=True;
          Randomize;
          for i:=1 to 10 do
          begin sNum:=intToStr(i);
                nbPages:=Random(100);
                li1.Add(TTruc.Create('Titre'+sNum, 'Texte'+sNum, nbPages ));
          end;
          for i := 0 to li1.count - 1 do
          begin red1.lines.Add(li1.items[i].Titre+' '+li1.items[i].Texte );
          end;

end;

procedure TfrmTriSLObj.btnTrierClick(Sender: TObject);
var       FCompareTri : TListSortCompare;
          i : word;
begin     //FCompareTri:=li1.fCompareAlphaTitres; //< NE MARCHE PAS [Erreur] uTriSLObj.pas(201): Types incompatibles : procédure normale et pointeur de méthode
          //Li1.Sort(FCompareTri);
          Li1.Sort(@fCompareAlphaTitres); //< Marche

          red1.lines.Add('');
          for i := 0 to li1.count - 1 do
          begin red1.lines.Add(li1.items[i].Titre);
          end;

          Li1.Sort(@fCompareNumNbPages); //< Marche
          red1.lines.Add('');
          for i := 0 to li1.count - 1 do
          begin red1.lines.Add(li1.items[i].Titre+' : '+intToStr(li1.items[i].NbPages));
          end;
end;

procedure TfrmTriSLObj.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin     if Assigned(li1) Then FreeAndNil(li1);
end;

... où j'ai, dans un 1er temps, voulu encapsuler dans TListeDeTrucs la fonction de comparaison (TListeDeTrucs.fCompareAlphaTitres() ) à utiliser par Sort mais le compilo n'a pas été d'accord.
... et dans un 2ème temps j'ai isolé les fonctions de comparaison (en vert ci-dessus) et cela a marché.

Questions :
1) Pourquoi cela n'a pas marché dans le 1er cas ?
2) Comment faire pour encapsuler les fonctions de comparaison dans le type TListeDeTrucs ?
3) Et, en supposant que mon encapsulage aie été correct, quelle est la bonne syntaxe pour appeler ces fonctions lors l'instruction "Li1.Sort(fonctionDeComparaison)" ?

A+

**tourlourou** · 29/11/2007, 17h43

Bonjour,

méthode d'objet et procédure normale sont incompatibles ; mais l'article de Laurent Dardenne ici permet de se sortir de l'ornière !

tu peux aussi plus simplement utiliser des méthodes qui appelleront Sort avec une fonction de comparaison interne à la méthode, qui ne sera donc pas une méthode d'objet :

Code :

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

1
2
3
4
5
6
7
8
9
procedure MaListe.TrieSelonNbDePages;
function  fCompareNumNbPages(Item1, Item2: Pointer): Integer;
begin     if TTruc(item1).NbPages > TTruc(item2).NbPages then Result := +1 else
          if TTruc(item1).NbPages < TTruc(item2).NbPages then Result := -1
          else Result := 0;
end;
begin
  Sort(@fCompareNumNbPages);
end;