FMX : Recherche dans un TListView

procedure TForm1.ListView1Filter(Sender: TObject; const AFilter, AValue: string; var Accept: Boolean);
begin
Accept:=AFilter.IsEmpty OR AValue.StartsWith(AFilter,false);
// le second paramètre de StartsWith permet d’indiquer la sensibilité  
// à la casse
end;

   nombredobjets:=1;
   if LowerCase(aList.ItemAppearance.ItemAppearance).Contains('detail')
     then Inc(nombredobjets);

nombredobjets:=0;
if aList.ItemAppearance.ItemAppearance='DynamicAppearance'
 then begin // apparence dynamique      DynApp:=TDynamicAppearance(aList.ItemAppearanceObjects.ItemObjects);
   for appObj in DynApp.ObjectsCollection do
    begin
      if (appobj is TAppearanceObjectItem) AND
         (TAppearanceObjectItem(AppObj).Appearance is TTextObjectAppearance)
        then inc(nombredobjets);
    end;
 end ;

uses FMX.ListView.DynamicAppearance;
...

function TMainForm.HowManyTextObjects(const aList: TListView): integer;
var DynApp : TDynamicAppearance;
    appObj : TCollectionItem;
begin
result:=0;
if aList.ItemAppearance.ItemAppearance='DynamicAppearance'
 then begin
   DynApp:=TDynamicAppearance(aList.ItemAppearanceObjects.ItemObjects);
   for appObj in DynApp.ObjectsCollection do
    begin
      if (appobj is TAppearanceObjectItem) AND
         (TAppearanceObjectItem(AppObj).Appearance is TTextObjectAppearance)
        then inc(result);
    end;
 end
 else begin
   result:=1;
   if LowerCase(aList.ItemAppearance.ItemAppearance).Contains('detail')
     then Inc(result);
 end;
end;

procedure GetTextObjectNames(aList : TListView);
 var DynApp : TDynamicAppearance;
    appObj : TCollectionItem;
 begin
 if aList.ItemAppearance.ItemAppearance='DynamicAppearance'
 then begin
   DynApp:=TDynamicAppearance(Alist.ItemAppearanceObjects.ItemObjects);
   for appObj in DynApp.ObjectsCollection do
    begin
      if appobj is TAppearanceObjectItem then
        if TAppearanceObjectItem(AppObj).Appearance is TTextObjectAppearance
        then begin
             Memo1.lines.Add(TAppearanceObjectItem(AppObj).AppearanceObjectName);
        end;
    end;
 end
 else begin
   Memo1.Lines.Add('text');
   if LowerCase(aList.ItemAppearance.ItemAppearance).Contains('detail')
     then Memo1.Lines.Add('detail');
 end;
 end;

TSearchMode = (smContains, smStartwith, smEndwith, smEqual);

TSearchinList = Class(TObject)
 strict private
  ParentList : TListView;
  Fields : TList<String>;
  CurIndice : smallint;
 public
  TestFields : TList<String>;
  Mode : TSearchMode;
  CaseSensitive : Boolean;
  constructor Create(AOwner : TListView);
  destructor  Destroy; override;
  function Accept(const aFilter, aValue: string) : Boolean;
end;

constructor TSearchinList.Create(AOwner: TListView);
var DynApp : TDynamicAppearance;
    appObj : TCollectionItem;
begin
inherited Create;
Parent:=AOwner;
CurIndice:=0;
Mode:=smContains;
TextObjectsNames:=TList<String>.Create;
// TestFields sera une liste insensible à la casse
Objects2Test:=TList<String>.Create(TComparer<String>.Construct(
    function(const s1, s2: String): Integer
    begin
      Result := CompareText(s1, s2) ;
    end));
// Remplissage de la liste des noms des TTextObjectAppearance
if Parent.ItemAppearance.ItemAppearance='DynamicAppearance'
 then begin
   DynApp:=TDynamicAppearance(Parent.ItemAppearanceObjects.ItemObjects);
   for appObj in DynApp.ObjectsCollection do
    begin
      if appobj is TAppearanceObjectItem then
        if TAppearanceObjectItem(AppObj).Appearance is TTextObjectAppearance
        then TextObjectsNames.Add(TAppearanceObjectItem(AppObj).AppearanceObjectName);
    end;
 end
 else begin
   TextObjectsNames.Add('text');
   if LowerCase(Parent.ItemAppearance.ItemAppearance).Contains('detail')
     then begin
       TextObjectsNames.Add('detail');
     end;
 end;
CaseSensitive:=False;
end;

Objects2Test:=TList<String>.Create(TComparer<String>.Construct(
    function(const s1, s2: String): Integer
    begin
      Result := CompareText(s1, s2) ;
    end));

destructor TSearchinList.Destroy;
begin
TextObjectsNames.Free;
Objects2Test.Free;
inherited Destroy;
end;

function TSearchinList.Accept(const AFilter, AValue: string): Boolean;
var AVal, AFil, test : String;
begin
if AFilter.IsEmpty then Exit(True);
Result:=False;
// si aucun objet texte spécifique demandé alors tous les objets
if (Objects2Test.Count=0)
  OR (Objects2Test.Indexof(TextObjectsNames[CurIndice])>-1)
then begin
  AVal:=AValue;
  AFil:=AFilter;
  // sensibilité à la casse
  if not casesensitive then
    begin
      AVal:=LowerCase(AValue);
      AFil:=LowerCase(AFilter);
    end;
  // mode de recherche
  case Self.Mode of
   smContains  : Result:= AVal.Contains(AFil);
   smStartwith : Result:= AVal.StartsWith(AFil);
   smEndwith   : Result:= AVal.EndsWith(AFil);
   smEqual     : Result:= AVal=AFil;
  end;
end;
if Result then CurIndice:=0      // trouvé
          else inc(CurIndice);   // prochain objet
if CurIndice>TextObjectsNames.Count-1 then CurIndice:=0; // tous les objets texte ont été testés
end;

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>;
    function GetTestFields: TList<String>;
    procedure SetTestFields(Value: TList<String>);
    function GetMode: TSearchMode;
    procedure SetMode(Value: TSearchMode);
    function GetCaseSensitive: Boolean;
    procedure SetCaseSensitive(Value: Boolean);
    property TextObjectsNames : TList<String> read GetTextObjectsNames;        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.

unit ListViewSearchAdapter;


interface
 uses System.SysUtils, System.Types, System.Classes,
  System.Generics.Collections, System.Generics.Defaults,
  FMX.ListView, SearchListViewInterface;

Type
  // surclassement de TListView, ajout de l’interface
  TListView = Class(FMX.ListView.TListView, ISearchInListView)
  strict private
    FCurrent: SmallInt;
    FObjectsNames : TList<String>;
  private
    FMode: TSearchMode;
    FCaseSensitive: Boolean;
    FObjects2Test : TList<String>;
  public
    // ajout des éléments de l’interface 
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Accept(const AFilter, AValue: string): Boolean;
    function GetTextObjectsNames : 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;
    procedure InitObjectsName;

  end;

implementation


uses FMX.ListView.Types,
  FMX.ListView.Appearances,
  FMX.ListView.DynamicAppearance;

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;

// CaseSensitive 
function TListView.GetCaseSensitive: Boolean;
begin
  Result:=FCaseSensitive;
end;

procedure TListView.SetCaseSensitive(Value: Boolean);
begin
 FCaseSensitive:=Value;
end;

// Mode 
function TListView.GetMode: TSearchMode;
begin
  Result:=FMode;
end;

procedure TListView.SetMode(Value: TSearchMode);
begin
 FMode := Value;
end;

procedure TListView.SetTestFields(Value: TList<String>);
begin
 if not Assigned(FObjects2Test) then
    FObjects2Test := TList<string>.Create;
    FObjects2Test := Value;
end;

function TListView.GetTestFields: TList<String>;
begin
result := FObjects2Test;
end;

function TListView.GetTextObjectsNames: TList<String>;
begin
result:= FObjectsNames;
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;

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;
if AFilter.IsEmpty then Exit(True);
Result:=False;
// si aucun objet texte spécifique demandé alors tous les objets
if (Objects2Test.Count=0)
  OR (Objects2Test.Indexof(FObjectsNames[FCurrent])>-1)
then begin
    AVal := AValue;
    AFil := AFilter;
    if not FCaseSensitive then
    begin
      AVal := LowerCase(AValue);
      AFil := LowerCase(AFilter);
    end;
    case FMode of
      smContains : Result := AVal.Contains(AFil);
      smStartwith: Result := AVal.StartsWith(AFil);
      smEndwith  : Result := AVal.EndsWith(AFil);
      smEqual    : Result := AVal = AFil;
    end;
 end;
  if Result then
    FCurrent := 0
  else begin
    inc(FCurrent);
    if FCurrent = (FObjectsNames.Count) then  FCurrent := 0;
  end;
end;