Discussion :

[SergioMaster]

Bonjour,

La recherche dans un TListView via la SearchBox reste une de mes bêtes noires. En effet, de base, tous les éléments texte d'un item sont pris en considération (visibles ou non) et par défaut, la recherche se fait sur un Contains sans casse. [Aparté] vous ne trouvez pas que Contains devrait avoir, comme StartsWith ou EndsWith, la possibilité d'être "case sensitive" !? [/Aparté]
Vous me rétorquerez qu'il existe un évènement OnFilter qui permet de modifier ce comportement.
Exact mais, problème : OnFilter n'indique que la valeur testée mais aucune indication de l'élément de l'item, qu'en est-il si je ne veux tester un seul élément (pour l'instant je m'arrête à un seul )


Donc, je repars en croisade après cette discussion.
Par rapport au bébé de la discussion (je n'aimais pas trop cette variable booléenne restrictive),
j'ai établi un premier "brouillon" (qui fonctionne) mon idée de départ, ajouter, en quelque sorte, des propriétés (TSearchInlist) à la TListView par l'intermédiaire de son TagObject.
Avantage de cette solution : la recherche devient "paramétrable" puisqu'il me suffit de changer l'objet

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
 
type
  TSearchMode = (smContains, smStartwith, smEndwith);
 
 
  TSearchinList = Class(TObject)
   private
    CurIndice : UInt8;
    FieldIndice :Smallint;
    MaxIndice : UInt8;
    Mode : TSearchMode;
    casesensitive : Boolean;
  end;
 
  TForm1 = class(TForm)
    ListView1: TListView;
    PrototypeBindSource1: TPrototypeBindSource;
    BindingsList1: TBindingsList;
    LinkFillControlToField1: TLinkFillControlToField;
    procedure ListView1Filter(Sender: TObject; const AFilter, AValue: string;
      var Accept: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Déclarations privées }
    S : TSearchinList;
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.fmx}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
S:=TSearchinList.Create;
S.CurIndice:=0;
S.FieldIndice:=-1;  // -1 tout les éléments
S.MaxIndice:=1;    // nombre d'élements avec caption d'un item de liste
S.Mode:=smContains;
S.casesensitive:=False;
ListView1.TagObject:=S;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
S.Free;
end;
 
procedure TForm1.ListView1Filter(Sender: TObject; const AFilter,
  AValue: string; var Accept: Boolean);
var AVal, AFil : String;  // à cause de Contains je dois passer par des variables locales pour la casse :-( 
begin
Accept:=True;
if AFilter.IsEmpty then Exit;
AVal:=AValue;
AFil:=AFilter;
if not TSearchInList(Listview1.TagObject).casesensitive then
  begin
    AVal:=LowerCase(AValue);
    AFil:=LowerCase(AFilter);
  end;
 
case S.Mode of
 smContains  : Accept:=((S.FieldIndice=-1) OR (S.CurIndice=S.FieldIndice)) AND AVal.Contains(AFil);
 smStartwith : Accept:=((S.FieldIndice=-1) OR (S.CurIndice=S.FieldIndice)) AND AVal.StartsWith(AFil);
 smEndwith   : Accept:=((S.FieldIndice=-1) OR (S.CurIndice=S.FieldIndice)) AND Aval.EndsWith(AFil);
end;
if Accept then S.CurIndice:=0
          else inc(S.CurIndice);
{TODO : à revoir}
if S.CurIndice>S.MaxIndice then S.CurIndice:=0; // Oui mais s'il s'agit d'un Entête ou d'un Pied ?
end;
 
end.

Cela va certainement évoluer dans la journée pour avoir quelque chose de plus "portable" :
1 - Ajouter un constructor (avec initialisation des "propriétés"). À ce propos coder ça proprement <?
2 - mettre une partie du "filtre" dans l'objet
3 - retrouver le MaxIndice (nombre d'élements avec caption d'un item de liste), le constructeur me fournirait le nom de la liste
4 - plutôt que d'utiliser le FieldIndice, retrouver les noms des éléments ce qui serait plus facile

Mes autres questions
- tout d'abord ma démarche, qu'en pensez vous ?
- il serait mieux de savoir de quel élément/item il s'agit mais comment ?
- d'autres suggestions ?

[Paul TOTH]

à mon avis, tu devrais séparer l'affichage et le traitement des données

j'utilise souvent un simple TListBox en VirtualOwnerDraw pour afficher toutes sortes de listes y compris des arbres comme dans cet exemple où j'utilise deux TListBox pour afficher d'un côté un arbre, et de l'autre un dump hexadecimal.

j'ai donc un arbre indépendant qui est constitué d'objets que je peux manipuler en toute liberté; ce n'est pas le cas dans l'exemple, mais pour filtrer les données j'alimente une nouvelle liste qui comprend un sous-ensemble des noeuds de mon arbre (selon les critères) et ma listbox les dessine exactement de la même façon.

et si tu veux garder la notion de TreeView, tu as le composant TVirtualTreeView qui permet également d'avoir tes données à part....il est un peu moins souple d'usage mais propose des tas d'options d'affichage.

[SergioMaster]

Bonjour Paul,

à mon avis, tu devrais séparer l'affichage et le traitement des données

si tu es allé voir la "discussion" que j'ai cité j'ai pu remarquer une nette différence en temps de traitement entre une version recherche via filtre données et une recherche dans la liste

et si tu veux garder la notion de TreeView, tu as le composant TVirtualTreeView

ben, ce n'en est pas un, TreeView j'y pense mais c'est un truc qui n'est pas liable (dommage) quant à VirtualTreeView que j'ai déjà beaucoup utilisé en VCL je ne savais pas que l'on pouvait l'utiliser avec FMX ?


Donc pour l'instant je parle uniquement de TListView, pas de TListBox (quoique ...) et de sa possibilité, très sympa au demeurant, de mettre un TSearchBox automatiquement rien qu'en cochant la propriété SearchVisible.

Par défaut, cela permet de rechercher dans la liste, et ce sans effort, tout élément contenant la chaine de caractère(s) saisie dans la boite.

Ma liste est remplie par livebindings (pour les tests c'est un TPrototypeBindSource qui fait office de table)
de fait il n'y a aucun TreeView
en exemple : deux éléments texte

si je fais une recherche "normale" avec 'ma' j'obtiens

N.B. oui, pour l'instant la liste n'est pas triée (par flemme), les Headers m'ont permis de vérifier le onFilter ne prenait pas ceux-ci en compte

La liste résultante contient Paul Davis | mediumaquamarine
"grâce" à mon brouillon (en indiquant que je recherche que sur le second champ fieldindice:=1) je ne verrais que ce dernier

à noter que mon brouillon à évoluer en

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
104
105
106
107
108
109
 
type
  TSearchMode = (smContains, smStartwith, smEndwith);
 
 
  TSearchinList = Class(TObject)
   private
    Parent : TListView;
    CurIndice : UInt8;
    FieldIndice :Smallint;
    MaxIndice : UInt8;
    Mode : TSearchMode;
    casesensitive : Boolean;
   public
     constructor Create(AOwner : TListView);
     destructor  Destroy;
     function Accept(const AFilter, AValue: string) : Boolean;
  end;
 
  TForm1 = class(TForm)
    ListView1: TListView;
    PrototypeBindSource1: TPrototypeBindSource;
    BindingsList1: TBindingsList;
    LinkFillControlToField1: TLinkFillControlToField;
    procedure ListView1Filter(Sender: TObject; const AFilter, AValue: string;
      var Accept: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Déclarations privées }
    S : TSearchinList;
 
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.fmx}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
S:=TSearchinList.Create(ListView1);
S.FieldIndice:=-1;
//S.MaxIndice:=1;    // nombre d'élements avec caption d'un item de liste
S.Mode:=smContains;
S.casesensitive:=false;
ListView1.TagObject:=S;
//ListView1.OnItemChange:=ChangeItem;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(S);
end;
 
procedure TForm1.ListView1Filter(Sender: TObject; const AFilter,
  AValue: string; var Accept: Boolean);
begin
Accept:=True;
if AFilter.IsEmpty
  then Accept:=True
  else Accept:=S.Accept(AFilter,AValue);
end;
 
{ TSearchinList }
 
function TSearchinList.Accept(const AFilter, AValue: string): Boolean;
var AVal, AFil : String;
begin
Result:=True;
if AFilter.IsEmpty then Exit;
 
AVal:=AValue;
AFil:=AFilter;
if not Self.casesensitive then
  begin
    AVal:=LowerCase(AValue);
    AFil:=LowerCase(AFilter);
  end;
 
case Self.Mode of
 smContains  : Result:=((Self.FieldIndice=-1) OR (Self.CurIndice=Self.FieldIndice)) AND AVal.Contains(AFil);
 smStartwith : Result:=((Self.FieldIndice=-1) OR (Self.CurIndice=Self.FieldIndice)) AND AVal.StartsWith(AFil);
 smEndwith   : Result:=((Self.FieldIndice=-1) OR (Self.CurIndice=Self.FieldIndice)) AND Aval.EndsWith(AFil);
end;
if Result then Self.CurIndice:=0
          else inc(Self.CurIndice);
if Self.CurIndice>Self.MaxIndice then Self.CurIndice:=0;
end;
 
constructor TSearchinList.Create(AOwner: TListView);
begin
inherited Create;
Self.Parent:=AOwner;  // {TODO : est-ce possible de récupérer les noms (en stringlist ?)  et/ou le nombre d'éléments maxindice ?}
Self.CurIndice:=0;
Self.FieldIndice:=-1; // {TODO : plus d'un élément, une liste de numéro ou de noms ce serait mieux}
Self.MaxIndice:=1;    // nombre d'élements avec caption d'un item de liste parent
Self.Mode:=smContains;
Self.casesensitive:=False;
end;
 
destructor TSearchinList.Destroy;
begin
inherited Destroy;
end;

[Paul TOTH]

ah t'es sous FMX, j'avais pas lu l'autre conversation

je ne sais pas si VirtualTreeView fonctionne sous FMX...mais bon dans l'idée il est toujours plus efficace de traiter les données d'un côté et gérer l'affichage de l'autre.

[SergioMaster]

J'ai du arrêté mon post pour cause d'intervention.

Bien sûr le but du jeu est de faire en sorte que la partie TSearchInList soit une unité indépendante.
Mais je me posais encore d'autres questions, comme :
- serait-il possible d'en faire une Interface (ce qui éviterai le FreeAndNil qui pourrait être oublié par un autre codeur)
- en ce cas comment en faire un Objet ?
- Il y a aussi plein de ces petites directives comme strict private etc. qui pourraient certainement optimisé la chose

[SergioMaster]

3 - retrouver le MaxIndice (nombre d'élements avec caption d'un item de liste), le constructeur me fournirait le nom de la liste
4 - plutôt que d'utiliser le FieldIndice, retrouver les noms des éléments ce qui serait plus facile

Ces deux points, j'ai fini par les résoudre (non sans mal)

Voici le nouveau constructeur (nécessite la déclaration de l'unité FMX.Controls.Presentation)

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
constructor TSearchinList.Create(AOwner: TListView);
var DynApp : TDynamicAppearance;
    appObj : TCollectionItem;
begin
inherited Create;
Self.Parent:=AOwner;
Self.CurIndice:=0;
Self.FieldIndice:=-1; // {TODO : plus d'un élément, une liste de numéro ou de noms ce serait mieux}
Self.MaxIndice:=-1;   // nombre d'élements
Self.Mode:=smContains;
Self.Fields:=TList<String>.Create;
// Self.TestFields:=TList<String>.Create;
if Self.Parent.ItemAppearance.ItemAppearance='DynamicAppearance'
 then begin
   DynApp:=TDynamicAppearance(Self.Parent.ItemAppearanceObjects.ItemObjects);
   for appObj in DynApp.ObjectsCollection do
    begin
      if appobj is TAppearanceObjectItem then
      begin
         inc(Self.MaxIndice);
         if TAppearanceObjectItem(AppObj).Appearance is TTextObjectAppearance  then
            Self.Fields.Add(TAppearanceObjectItem(AppObj).AppearanceObjectName);
      end;
    end;
 end
 else begin
   Self.Fields.Add('text');
   if LowerCase(Self.Parent.ItemAppearance.ItemAppearance).Contains('detail')
     then Self.Fields.Add('detail');
 end;
Self.casesensitive:=False;
end;

et les modifications sur le type

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
type
  TSearchMode = (smContains, smStartwith, smEndwith);
 
 
  TSearchinList = Class(TObject)
   strict private
    Parent : TListView;
    CurIndice : word;
    MaxIndice : SmallInt;
    Fields : TList<String>;    // liste de tous les TTextObjectAppearance
   private
    TestFields : TList<String>;
    FieldIndice :Smallint;
    Mode : TSearchMode;
    casesensitive : Boolean;
   public
     constructor Create(AOwner : TListView);
     destructor  Destroy; override;
     function Accept(const AFilter, AValue: string) : Boolean;
  end;

Reste un point à améliorer : il serait bon qu'il y ait possibilité de tester plus d'un seul élément donc FieldIndice ne suffit plus. J'ai donc rajouté TestFields pour, à court terme, remplacer FieldIndice

Voilà ce qui remplira ma matinée (entrecoupée de rugby)

[SergioMaster]

Voilà un premier jus

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
 
unit SearchInListView;
 
interface
 uses  System.SysUtils, System.Types, System.Classes,
       System.Generics.Collections,
       FMX.ListView, FMX.ListView.Types, FMX.ListView.Appearances;
 
 type
   TSearchMode = (smContains, smStartwith, smEndwith);
 
   TSearchinList = Class(TObject)
   strict private
    Parent : TListView;
    Fields : TList<String>;
    CurIndice : smallint;
    MaxIndice : SmallInt;
   public
    TestFields : TList<String>;
    Mode : TSearchMode;
    CaseSensitive : Boolean;
    constructor Create(AOwner : TListView);
    destructor  Destroy; override;
    function Accept(const AFilter, AValue: string) : Boolean;
  end;
 
implementation
 
uses FMX.ListView.DynamicAppearance;
 
function TSearchinList.Accept(const AFilter, AValue: string): Boolean;
var AVal, AFil, test : String;
begin
Result:=True;
if AFilter.IsEmpty then Exit;
 
AVal:=AValue;
AFil:=AFilter;
if not Self.casesensitive then
  begin
    AVal:=LowerCase(AValue);
    AFil:=LowerCase(AFilter);
  end;
case Self.Mode of
 smContains  : Result:=((Self.TestFields.Count=0)
                          OR Self.TestFields.Contains(Self.Fields.Items[Self.CurIndice]))
                        AND AVal.Contains(AFil);
 smStartwith : Result:=((Self.TestFields.Count=0)
                        OR Self.TestFields.Contains(Self.Fields.Items[Self.CurIndice]))
                        AND AVal.StartsWith(AFil);
 smEndwith   : Result:=((Self.TestFields.Count=0)
                         OR Self.TestFields.Contains(Self.Fields.Items[Self.CurIndice]))
                        AND AVal.EndsWith(AFil);
end;
if Result then Self.CurIndice:=0
          else inc(Self.CurIndice);
if Self.CurIndice>Self.MaxIndice then self.CurIndice:=0;
end;
 
constructor TSearchinList.Create(AOwner: TListView);
var DynApp : TDynamicAppearance;
    appObj : TCollectionItem;
begin
inherited Create;
Self.Parent:=AOwner;
Self.CurIndice:=0;
// Self.FieldIndice:=-1; // {TODO : plus d'un élément, une liste de numéro ou de noms ce serait mieux}
Self.MaxIndice:=-1;   // nombre d'élements
Self.Mode:=smContains;
Self.Fields:=TList<String>.Create;
Self.TestFields:=TList<String>.Create;
if Self.Parent.ItemAppearance.ItemAppearance='DynamicAppearance'
 then begin
   DynApp:=TDynamicAppearance(Self.Parent.ItemAppearanceObjects.ItemObjects);
   for appObj in DynApp.ObjectsCollection do
    begin
      if appobj is TAppearanceObjectItem then
        if TAppearanceObjectItem(AppObj).Appearance is TTextObjectAppearance
        then begin
             inc(Self.MaxIndice);
             Self.Fields.Add(TAppearanceObjectItem(AppObj).AppearanceObjectName);
        end;
    end;
 end
 else begin
   Self.Fields.Add('text');
   if LowerCase(Self.Parent.ItemAppearance.ItemAppearance).Contains('detail')
     then Self.Fields.Add('detail');
 end;
Self.casesensitive:=False;
end;
 
destructor TSearchinList.Destroy;
begin
Self.Fields.Free;
Self.TestFields.Free;
inherited Destroy;
end;
 
end.

L'utilisation en est donc simplifiée puisque intégrable dans toute unité contenant un TListView

par exemple :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
procedure TFormPaiement.FormCreate(Sender: TObject);
begin
S:=TSearchinList.Create(ListView1);
S.TestFields.AddRange(['Text4']);    // recherche uniquement sur l'élément nommé 'text4'
S.Mode:=smStartWith;                  // commençant par le filtre
S.casesensitive:=false;                 // sans tenir compte de la casse
ListView1.TagObject:=S;               // association à la liste  
end;
 
procedure TFormPaiement.FormDestroy(Sender: TObject);
begin
FreeAndNil(S);
end;

Deux points restent en obligatoires :

1. il faut associer l'objet à la liste, donc l'utilisation de TagObject de la liste est interdite pour tout autre chose
2. il ne faut pas oublier de libérer l'objet

À moins qu'en passant par un objet interface ces points puissent être rayés, mais question interface je ne suis certainement pas aussi bon un coup de main ?
d'autres idées/demandes sur cette recherche

[tourlourou]

Bonsoir,

Pour ne pas oublier sa destruction, puisqu'il connaît le ListView qui lui est passé au Create, pourquoi ne pas lui attribuer le Parent du ListView ?

[SergioMaster]

Bonjour,

J'y ai pensé mais j'ai du mal m'y prendre car cela n'a pas fonctionné. En fait dans mes divers essais c'est un faux parent, je n'ai pas songé faire un addobject au TlistView, piste à creuser .

Je tente actuellement de faire une interface.

Voici mon état d'avancement, quasiment une traduction littérale du source déjà présenté (seul Maxindice, inutile, est passé à la trappe)

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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
unit SearchListViewInterface;
 
interface
 
uses System.SysUtils, System.Types, System.Classes,
  System.Generics.Collections,
  FMX.ListView,
  FMX.Dialogs;
 
type
  TSearchMode = (smContains, smStartwith, smEndwith, smEqual);
 
  ISearchInListView = interface
    ['{0AF62378-366E-4AED-9918-28F8BA5859A8}']
 
    function Accept(const AFilter, AValue: string): Boolean;
    function GetList: TListView;
    procedure SetList(Value: TListView);
    function GetCurrentIndice: SmallInt;
    procedure SetCurrentIndice(Value: SmallInt);
    function  GetFields : TList<String>;
    function GetTestFields: TList<String>;
    procedure SetTestFields(Value: TList<String>);
    function GetMode: TSearchMode;
    procedure SetMode(Value: TSearchMode);
    function GetCase: Boolean;
    procedure SetCase(Value: Boolean);
 
    property List: TListView read GetList write SetList;
    property Fields: TList<String> read GetFields;
    property CurrentIndice: SmallInt read GetCurrentIndice;
 
    property TestFields: TList<String> read GetTestFields write SetTestFields;
    property Mode: TSearchMode read GetMode write SetMode;
    property CaseSensitive: Boolean read GetCase write SetCase;
 
  end;
 
  TISearchInListView = class(TInterfacedObject, ISearchInListView)
  private
    FList: TListView;
    FFields: TList<String>;
    FTests: TList<String>;
    FCurrent: SmallInt;
    FMax: SmallInt;
    FMode: TSearchMode;
    FCase: Boolean;
  public
    constructor Create(List : TListView );
    destructor Destroy; override;
    function Accept(const AFilter: string; const AValue: string): Boolean;
    function GetCase: Boolean;
    function GetCurrentIndice : SmallInt;
    function GetList: TListView;
    function GetMode: TSearchMode;
    function GetTestFields: System.Generics.Collections.TList<System.string>;
    procedure SetCase(Value: Boolean);
    procedure SetCurrentIndice(Value: SmallInt);
    procedure SetList(Value: TListView);
    procedure SetMode(Value: TSearchMode);
    procedure SetTestFields
      (Value: System.Generics.Collections.TList<System.string>);
    function GetFields : TList<String>;
  end;
 
implementation
 
uses FMX.ListView.Types,
  FMX.ListView.Appearances,
  FMX.ListView.DynamicAppearance;
 
{ TISearchInListView }
 
function TISearchInListView.Accept(const AFilter, AValue: string): Boolean;
var
  AVal, AFil, test: String;
begin
  Result := True;
  if AFilter.IsEmpty then
    Exit;
 
  AVal := AValue;
  AFil := AFilter;
  if not FCase then
  begin
    AVal := LowerCase(AValue);
    AFil := LowerCase(AFilter);
  end;
  case FMode of
    smContains:
      Result := ((FTests.Count = 0) OR FTests.Contains(FFields.Items[FCurrent]))
        AND AVal.Contains(AFil);
    smStartwith:
      Result := ((FTests.Count = 0) OR FTests.Contains(FFields.Items[FCurrent]))
        AND AVal.StartsWith(AFil);
    smEndwith:
      Result := ((FTests.Count = 0) OR FTests.Contains(FFields.Items[FCurrent]))
        AND AVal.EndsWith(AFil);
    smEqual:
      Result := ((FTests.Count = 0) OR FTests.Contains(FFields.Items[FCurrent]))
        AND (AVal = AFil);
  end;
  if Result then
    FCurrent := 0
  else
    inc(FCurrent);
 
 if FCurrent > (FFields.Count-1) then
    FCurrent := 0;
end;
 
constructor TISearchInListView.Create(List : TListView );
begin
  SetList(List);
  FTests:=TList<String>.Create;
  FCurrent:=0;
  FMode:=smContains;
  FCase:=False;
end;
 
destructor TISearchInListView.Destroy;
begin
  FFields.Free;
  FTests.Free;
  inherited;
end;
 
function TISearchInListView.GetCase: Boolean;
begin
  Result := FCase;
end;
 
function TISearchInListView.GetCurrentIndice: SmallInt;
begin
Result := FCurrent;
end;
 
function TISearchInListView.GetFields: TList<String>;
begin
Result:= FFields;
end;
 
function TISearchInListView.GetList: TListView;
begin
  Result := FList;
end;
 
function TISearchInListView.GetMode: TSearchMode;
begin
  Result := FMode;
end;
 
function TISearchInListView.GetTestFields
  : System.Generics.Collections.TList<System.string>;
begin
  Result := FTests;
end;
 
procedure TISearchInListView.SetCase(Value: Boolean);
begin
  if Value <> FCase then
    FCase := Value;
end;
 
procedure TISearchInListView.SetCurrentIndice(Value: SmallInt);
begin
  if Value <> FCurrent then
    FCurrent := Value;
end;
 
procedure TISearchInListView.SetList(Value: TListView);
var
  DynApp: TDynamicAppearance;
  appObj: TCollectionItem;
begin
  if Value <> FList then
  begin
    FList := Value;
    if not Assigned(FFields) then
      FFields := TList<String>.Create;
    // obtenir les éléments texte
    if FList.ItemAppearance.ItemAppearance = 'DynamicAppearance' then
    begin
      DynApp := TDynamicAppearance(FList.ItemAppearanceObjects.ItemObjects);
      for appObj in DynApp.ObjectsCollection do
      begin
        if appObj is TAppearanceObjectItem then
          if TAppearanceObjectItem(appObj).Appearance is TTextObjectAppearance
          then
          begin
            inc(FMax);
            FFields.Add(TAppearanceObjectItem(appObj).AppearanceObjectName);
          end;
      end;
    end
    else
    begin
      FMax:=0;
      FFields.Add('text');
      if LowerCase(FList.ItemAppearance.ItemAppearance).Contains('detail')
       then begin
        FFields.Add('detail');
        FMax:=1;
       end;
    end;
  end;
end;
 
procedure TISearchInListView.SetMode(Value: TSearchMode);
begin
  FMode := Value;
end;
 
procedure TISearchInListView.SetTestFields
  (Value: System.Generics.Collections.TList<System.string>);
begin
  if not Assigned(FTests) then
    FTests := TList<string>.Create;
  FTests := Value;
end;
 
end.

À mon avis il y a encore à élaguer/simplifier
ces propriétés par exemple

Code :

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

1
2
3
    property List: TListView read GetList write SetList;
    property Fields: TList<String> read GetFields;
    property CurrentIndice: SmallInt read GetCurrentIndice;

sont-elles nécessaires dans l'interface car utiles uniquement au sein de l'objet ?

[SergioMaster]

Bonjour,

j'allais cocher la discussion comme résolue, voilà mon dernier jus :

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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
unit SearchListViewInterface;
 
interface
 
uses System.SysUtils, System.Types, System.Classes,
  System.Generics.Collections,
  FMX.ListView,
  FMX.Dialogs;
 
type
  TSearchMode = (smContains, smStartwith, smEndwith, smEqual);
 
  ISearchInListView = interface
    ['{0AF62378-366E-4AED-9918-28F8BA5859A8}']
 
    function Accept(const AFilter, AValue: string): Boolean;
    function GetList: TListView;
    procedure SetList(Value: TListView);
    function GetTestFields: TList<String>;
    procedure SetTestFields(Value: TList<String>);
    function GetMode: TSearchMode;
    procedure SetMode(Value: TSearchMode);
    function GetCase: Boolean;
    procedure SetCase(Value: Boolean);
 
    property List: TListView read GetList write SetList;
    property TestFields: TList<String> read GetTestFields write SetTestFields;
    property Mode: TSearchMode read GetMode write SetMode;
    property CaseSensitive: Boolean read GetCase write SetCase;
 
  end;
 
  TISearchInListView = class(TInterfacedObject, ISearchInListView)
  strict private
    FCurrent: SmallInt;
    FFields: TList<String>;
  private
    FList: TListView;
    FTests: TList<String>;
    FMode: TSearchMode;
    FCase: Boolean;
  public
    constructor Create(List : TListView );
    destructor Destroy; override;
    function Accept(const AFilter: string; const AValue: string): Boolean;
    function GetCase: Boolean;
    function GetList: TListView;
    function GetMode: TSearchMode;
    function GetTestFields: System.Generics.Collections.TList<System.string>;
    procedure SetCase(Value: Boolean);
    procedure SetList(Value: TListView);
    procedure SetMode(Value: TSearchMode);
    procedure SetTestFields
      (Value: System.Generics.Collections.TList<System.string>);
  end;
 
implementation
 
uses FMX.ListView.Types,
  FMX.ListView.Appearances,
  FMX.ListView.DynamicAppearance;
 
{ TISearchInListView }
 
function TISearchInListView.Accept(const AFilter, AValue: string): Boolean;
var
  AVal, AFil, test: String;
begin
  Result := True;
  if AFilter.IsEmpty then
    Exit;
 
  AVal := AValue;
  AFil := AFilter;
  if not FCase then
  begin
    AVal := LowerCase(AValue);
    AFil := LowerCase(AFilter);
  end;
  case FMode of
    smContains:
      Result := ((FTests.Count = 0) OR FTests.Contains(FFields.Items[FCurrent]))
        AND AVal.Contains(AFil);
    smStartwith:
      Result := ((FTests.Count = 0) OR FTests.Contains(FFields.Items[FCurrent]))
        AND AVal.StartsWith(AFil);
    smEndwith:
      Result := ((FTests.Count = 0) OR FTests.Contains(FFields.Items[FCurrent]))
        AND AVal.EndsWith(AFil);
    smEqual:
      Result := ((FTests.Count = 0) OR FTests.Contains(FFields.Items[FCurrent]))
        AND (AVal = AFil);
  end;
  if Result then
    FCurrent := 0
  else
    inc(FCurrent);
 
 if FCurrent > (FFields.Count-1) then
    FCurrent := 0;
end;
 
constructor TISearchInListView.Create(List : TListView );
begin
  SetList(List);
  FTests:=TList<String>.Create;
  FCurrent:=0;
  FMode:=smContains;
  FCase:=False;
end;
 
destructor TISearchInListView.Destroy;
begin
  FreeAndNil(FFields); // if Assigned(FFields) then FFields.Free;
  FreeAndnil(FTests);  // if Assigned(FTests) then FTests.Free;
  inherited;
end;
 
function TISearchInListView.GetCase: Boolean;
begin
  Result := FCase;
end;
 
function TISearchInListView.GetList: TListView;
begin
  Result := FList;
end;
 
function TISearchInListView.GetMode: TSearchMode;
begin
  Result := FMode;
end;
 
function TISearchInListView.GetTestFields
  : System.Generics.Collections.TList<System.string>;
begin
  Result := FTests;
end;
 
procedure TISearchInListView.SetCase(Value: Boolean);
begin
  if Value <> FCase then
    FCase := Value;
end;
 
procedure TISearchInListView.SetList(Value: TListView);
var
  DynApp: TDynamicAppearance;
  appObj: TCollectionItem;
begin
  if Value <> FList then
  begin
    FList := Value;
    if not Assigned(FFields) then
      FFields := TList<String>.Create;
    // obtenir les éléments texte
    if FList.ItemAppearance.ItemAppearance = 'DynamicAppearance' then
    begin
      if FList.EditMode
       then  DynApp := TDynamicAppearance(FList.ItemAppearanceObjects.ItemEditObjects)
       else  DynApp := TDynamicAppearance(FList.ItemAppearanceObjects.ItemObjects);
      for appObj in DynApp.ObjectsCollection do
      begin
        if appObj is TAppearanceObjectItem then
          if TAppearanceObjectItem(appObj).Appearance is TTextObjectAppearance
          then
            FFields.Add(TAppearanceObjectItem(appObj).AppearanceObjectName);
      end;
    end
    else
    begin
      FFields.Add('text');
      if LowerCase(FList.ItemAppearance.ItemAppearance).Contains('detail')
       then FFields.Add('detail');
    end;
  end;
end;
 
procedure TISearchInListView.SetMode(Value: TSearchMode);
begin
  FMode := Value;
end;
 
procedure TISearchInListView.SetTestFields
  (Value: System.Generics.Collections.TList<System.string>);
begin
  if not Assigned(FTests) then
    FTests := TList<string>.Create;
  FTests := Value;
end;
 
end.

Mais, une discussion ouverte sur un autre forum à propos de sélection d'éléments, ainsi qu'une re-vision du cours de Marco Cantu sur les interfaces m'amène à diverses nouvelles questions sur le même sujet.

Dans son cours Advanced Interfaces in Delphi : Using interfaces to implement an Adaptater pattern Marco utilise une interface pour "améliorer" un composant TEdit (entre autres)
Je me suis dit que c'était une idée à suivre, j'ai donc rajouté un Interface

Code :

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

1
2
3
4
5
6
7
 IListViewSelectedItems = interface
   ['{3D8B9910-A017-4A10-8260-D44E9F7129B7}']
   procedure init;
   procedure SetSelected(Value : TList<Integer>);
   function  GetSelected :  TList<Integer>;
   property  Selected :  TList<Integer> read GetSelected write SetSelected;
 end;

et créé un adaptateur (soit, en d'autres termes, "dérivé" TListView)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
   TListView = class(FMX.ListView.TListView,IListViewSelectedItems)
   private
     FSelected : TList<Integer>;
   public
     constructor Create(AOwner : TObject); // <<<<<<<<<<<<
     destructor Destroy; override;
     procedure init;
     procedure SetSelected(Value : TList<Integer>);
     function  GetSelected :  TList<Integer>;
     property  Selected :  TList<Integer> read GetSelected write SetSelected;
   end;

Mon nouveau problème se situe dans le constructeur, je ne vois pas comment l'écrire. TListView n'a pas ni constructeur ni évènement OnCreate. Bien que je puisse passer par le code
ListView1.init; le reste pouvant alors fonctionner par exemple ainsi

Code :

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

1
2
3
4
5
6
7
8
procedure TForm1.ListView1ItemClickEx(const Sender: TObject;
  ItemIndex: Integer; const LocalClickPos: TPointF;
  const ItemObject: TListItemDrawable);
begin
 if ListView1.Selected.Contains(ItemIndex)
   then ListView1.Selected.Remove(Itemindex)  
   else ListView1.Selected.Add(Itemindex);
end;

J'aimerais bien créer la propriété FSelected directement. Une brillante idée ?

[SergioMaster]

Bonjour,

Fou que je suis, pas besoin de créer une interface supplémentaire ni de TList<Integer> qui en fait existe déjà et que l'on peut obtenir ainsi

Code :

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

1
2
3
4
5
SelectedItems : TList<Integer>;
unSelectedItem : TList<Integer>;
 
SelectedItems:=  ListView1.Items.CheckedIndexes(true); 
unSelectedItems:=  ListView1.Items.CheckedIndexes(False);

Donc je clôture le sujet sur la recherche dans un TListView ainsi que sur les sélections dans ce même composant

Un résumé sous forme d'article ou de billet(s) verra certainement jour

[SergioMaster]

Bonjour,

ma dernière mouture pour implémenter l'interface ISearchInListView à un TListView. Tout d'abord j'ai scindé le source en deux, d'un côté l'interface

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
unit SearchListViewInterface;
 
interface
 
uses System.SysUtils, System.Types, System.Classes,
  System.Generics.Collections;
 
type
  TSearchMode = (smContains, smStartwith, smEndwith, smEqual);
 
  ISearchInListView = interface
    ['{0AF62378-366E-4AED-9918-28F8BA5859A8}']
 
    function Accept(const AFilter, AValue: string): Boolean;
    function GetTextObjectsNames : TList<String>;
//    procedure SetTextObjectsNames(Value : TList<String>);
    function GetTestFields: TList<String>;
    procedure SetTestFields(Value: TList<String>);
    function GetMode: TSearchMode;
    procedure SetMode(Value: TSearchMode);
    function GetCaseSensitive: Boolean;
    procedure SetCaseSensitive(Value: Boolean);
 
    property TextObjectNames : TList<String> read GetTextObjectsNames; // write SetTextObjectsNames;
    property TestObjectsTextName : TList<String> read GetTestFields write SetTestFields;
    property Mode: TSearchMode read GetMode write SetMode;
    property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive;
  end;
 
 
implementation
 
end.

et de l'autre l'adaptateur

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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
unit ListViewSearchAdapter;
 
 
interface
 uses System.SysUtils, System.Types, System.Classes,
  System.Generics.Collections, System.Generics.Defaults,
  FMX.ListView, SearchListViewInterface;
 
Type
  TListView = Class(FMX.ListView.TListView, ISearchInListView)
  strict private
    FCurrent: SmallInt;
    FObjectsNames : TList<String>;
  private
    FMode: TSearchMode;
    FCaseSensitive: Boolean;
    FObjects2Test : TList<String>;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Accept(const AFilter, AValue: string): Boolean;
    procedure InitObjectsName;
    function GetTextObjectsNames : TList<String>;
//    procedure SetTextObjectsNames(Value : TList<String>);
    function GetTestFields: TList<String>;
    procedure SetTestFields(Value: TList<String>);
    function GetMode: TSearchMode;
    procedure SetMode(Value: TSearchMode);
    function GetCaseSensitive: Boolean;
    procedure SetCaseSensitive(Value: Boolean);
    property Objects2Test : TList<String> read GetTestFields write SetTestFields;
  end;
 
implementation
 
 
uses FMX.ListView.Types,
  FMX.ListView.Appearances,
  FMX.ListView.DynamicAppearance;
 
{ TListView }
 
function TListView.Accept(const AFilter, AValue: string): Boolean;
var
  AVal, AFil : String;
begin
  // récupére le nom des objets TTextObjectAppearance dans la liste
  if FObjectsNames.Count=0 then InitObjectsName;
 
  Result := True;
  if AFilter.IsEmpty then Exit;
 
  AVal := AValue;
  AFil := AFilter;
  if not FCaseSensitive then
  begin
    AVal := LowerCase(AValue);
    AFil := LowerCase(AFilter);
  end;
  case FMode of
    smContains:
      Result := ((FObjects2Test.Count = 0) OR FObjects2Test.Contains(FObjectsNames.Items[FCurrent]))
        AND AVal.Contains(AFil);
    smStartwith:
      Result := ((FObjects2Test.Count = 0) OR FObjects2Test.Contains(FObjectsNames.Items[FCurrent]))
        AND AVal.StartsWith(AFil);
    smEndwith:
      Result := ((FObjects2Test.Count = 0) OR FObjects2Test.Contains(FObjectsNames.Items[FCurrent]))
        AND AVal.EndsWith(AFil);
    smEqual:
      Result := ((FObjects2Test.Count = 0) OR FObjects2Test.Contains(FObjectsNames.Items[FCurrent]))
        AND (AVal = AFil);
  end;
  if Result then
    FCurrent := 0
  else begin
    inc(FCurrent);
    if FCurrent = (FObjectsNames.Count) then  FCurrent := 0;
  end;
end;
 
constructor TListView.Create(AOwner: TComponent);
begin
  inherited;
  FObjectsNames:=TList<String>.Create;
  FObjects2Test:=TList<String>.Create(TComparer<String>.Construct(
    function(const s1, s2: String): Integer
    begin
      Result := CompareText(s1, s2) ;
    end));
  FCurrent:=0;
  FMode:=smContains;
  FCaseSensitive:=False;
end;
 
destructor TListView.Destroy;
begin
  FreeAndNil(FObjectsNames);
  FreeAndnil(FObjects2Test);
  inherited;
end;
 
function TListView.GetCaseSensitive: Boolean;
begin
  Result:=FCaseSensitive;
end;
 
function TListView.GetMode: TSearchMode;
begin
  Result:=FMode;
end;
 
function TListView.GetTextObjectsNames: TList<String>;
begin
result:= FObjectsNames;
end;
 
function TListView.GetTestFields: TList<String>;
begin
result := FObjects2Test;
end;
 
procedure TListView.SetCaseSensitive(Value: Boolean);
begin
 FCaseSensitive:=Value;
end;
 
procedure TListView.InitObjectsName;
var
  DynApp: TDynamicAppearance;
  appObj: TCollectionItem;
begin
   if not Assigned(FObjectsNames) then
      FObjectsNames := TList<String>.Create;
    // obtenir les éléments texte
    if ItemAppearance.ItemAppearance = 'DynamicAppearance' then
    begin
      if EditMode
       then  DynApp := TDynamicAppearance(ItemAppearanceObjects.ItemEditObjects)
       else  DynApp := TDynamicAppearance(ItemAppearanceObjects.ItemObjects);
      for appObj in DynApp.ObjectsCollection do
      begin
        if appObj is TAppearanceObjectItem then
          if TAppearanceObjectItem(appObj).Appearance is TTextObjectAppearance
          then
            FObjectsNames.Add(TAppearanceObjectItem(appObj).AppearanceObjectName);
      end;
    end
    else
    begin
      FObjectsNames.Add('text');
      if LowerCase(ItemAppearance.ItemAppearance).Contains('detail')
       then FObjectsNames.Add('detail');
    end;
end;
 
procedure TListView.SetMode(Value: TSearchMode);
begin
 FMode := Value;
end;
 
//procedure TListView.SetObjectsTextNames(Value: TList<String>);
//begin
//FObjectsName:=Value;
//end;
 
procedure TListView.SetTestFields(Value: TList<String>);
begin
 if not Assigned(FObjects2Test) then
    FObjects2Test := TList<string>.Create;
    FObjects2Test := Value;
end;
 
end.

utilisation

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
unit mainunit;

interface

uses
  FMX.ListView, SearchListViewInterface, ListViewSearchAdapter;

type
   TForm96 = class(TForm)
    ...
    chkCasse: TCheckBox;
    rbTous: TRadioButton;
    rbCompany: TRadioButton;
    rbVille: TRadioButton;
    rbPays: TRadioButton;
    rbContains: TRadioButton;
    rbStartWith: TRadioButton;
    rbEqual: TRadioButton;
    rbEndWith: TRadioButton;
    RbCityOrPays: TRadioButton;
    LVCustomers: TListView;
    procedure LVCustomersFilter(Sender: TObject; const AFilter, AValue: string;
      var Accept: Boolean);
    procedure rbZoneChange(Sender: TObject);
    procedure rbModeChange(Sender: TObject);
    procedure chkCasseChange(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form96: TForm96;

implementation

{$R *.fmx}

procedure TForm96.chkCasseChange(Sender: TObject);
begin
LVCustomers.SetCaseSensitive(chkcasse.IsChecked);
end;

procedure TForm96.LVCustomersFilter(Sender: TObject; const AFilter,
  AValue: string; var Accept: Boolean);
begin
 Accept:=LVCustomers.Accept(AFilter,Avalue);
end;

procedure TForm96.rbModeChange(Sender: TObject);
begin
if TRadioButton(Sender).IsChecked then
 begin
  case TRadioButton(Sender).Tag of
   0 : LVCustomers.SetMode(TSearchMode.smContains);
   1 : LVCustomers.SetMode(TSearchMode.smStartwith);
   2 : LVCustomers.SetMode(TSearchMode.smEqual);
   3 : LVCustomers.SetMode(TSearchMode.smEndwith);
 end;
end;
end;

procedure TForm96.rbZoneChange(Sender: TObject);
begin
LVCustomers.Objects2Test.Clear;
if TRadioButton(Sender).IsChecked then
 begin
  case TRadioButton(Sender).Tag of
   1 : LVCustomers.Objects2Test.Add('company');
   2 : LVCustomers.Objects2Test.Add('city');
   3 : LVCustomers.Objects2Test.Add('country');
   4 : LVCustomers.Objects2Test.AddRange(['city','country']);
  end;
  if LVCustomers.Objects2Test.Count>0 then  Memo1.Lines.Add(LVCustomers.Objects2Test.First);
 end;


end;

end.

j'ai encore quelques points qui me turlupinent

1. pour la partie interface ligne 16, j'ai commenté le "setter" ne sachant pas trop comment le coder dans la partie adaptateur
2. partie adaptateur, j'ai été obligé d'ajouter une procedure InitObjectsName; que j'utilise à la première recherche car je n'ai pas pu remplir la listes des noms d'objets texte FObjectsNames au cours de l'évènement OnCreate

Les deux sont liés, mais je n'arrive vraiment pas à trouver le pourquoi du point 2