// Ein TListview wird durchsucht.

// Getestet mit D4 unter XP

// 1. Variante: Nur nach Caption suchen:

var start: integer = 0; 
 
procedure suchCaption(lv: TListview; such: string; ganzesWort: boolean); 
var li: TListitem; 
  s: string; 
begin 
  li := lv.FindCaption(start, such, not ganzesWort, false, false); 
  if li <> nil then begin 
    start := li.index; 
    lv.selected := li; 
    li.MakeVisible(False);
    lv.setfocus; 
  end else begin 
    if start > 0 then s := 'weiter ' 
    else s := ''; 
    start := 0; 
    showmessage('Nichts ' + s + 'gefunden'); 
  end; 
end; 
 
// Beispielaufruf 
 
procedure TFraster.Button3Click(Sender: TObject); 
begin 
  suchCaption(Listview1, 'Müll', false); 
end; 

//---------------------------------------------------------------------

// 2. Variante: Erweiterung
//              EarlyWord: Der Suchbegriff stellt den Wortanfang dar
//              WholeWord: Es werden ganze Begriife gefunden (mehrere Wörter)
//              MatchCase: Groß- und Kleinschreibung muss stimmen
//              Subitems:  Es werden auch Subitems durchsucht

var 
  start: integer = 0; 
 
function LvSearch(lv: TListview; such: string; 
  EarlyWord, WholeWord, MatchCase, SubItems: boolean): integer; 
var x, y: integer; 
  s: string; 
  procedure beiFund; 
  begin 
    result := x + 1; 
    lv.selected := lv.items[x]; 
    lv.items[x].MakeVisible(False); 
    lv.setfocus; 
  end; 
  function gefunden(was: string): boolean; 
  begin 
    if MatchCase then was := ansiuppercase(was); 
    if WholeWord then result := 
      such = was else begin 
      if EarlyWord then 
        result := ansipos(such, was) = 1 else 
        result := ansipos(such, was) > 0; 
    end; 
  end; 
begin 
  if MatchCase then 
    such := ansiuppercase(such); 
  for x := start to lv.items.count - 1 do 
    if gefunden(lv.items[x].caption) then begin 
      beiFund; 
      exit; 
    end else if SubItems then 
      for y := 0 to lv.items[x].subitems.count - 1 do 
        if gefunden(lv.items[x].subitems[y]) then begin 
          beiFund; 
          exit; 
        end; 
  if start > 0 then s := 'weiter ' 
  else s := ''; 
  result := 0; 
  showmessage('Nichts ' + s + 'gefunden'); 
end; 
 
 
procedure TFFaslch.Button1Click(Sender: TObject); 
begin 
  start := LvSearch(Listview1, 'müll', true, false, true, false); 
end;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke