Vyhledavani v treeview – Delphi – Fórum – Programujte.com

Zdravim vsechny..

mam TreeView naplnenej adresarema s fotkama.
mam funkci na vyhledavani:

function TVNajdiNode(Strom : TTreeView; Slovo:String): TTreeNode;
var
    Node: TTreeNode;
begin
  Result := nil;
  if ATree.Items.Count = 0 then Exit;
  Node := Strom.Items[0];
  while Node <> nil do
  begin
    if UpperCase(Node.Text) = UpperCase(Slovo) then
    begin
      Result := Node;
    end;
    Node := Node.GetNext;
  end;
end;

Vyhledavam udalosti OnClick
 

procedure TForm1.NajdiClick(Sender: TObject);
var
  nasel : TTreeNode;
begin
   nasel:=TVNajdiNode(TreeView1,Edit1.Text);
   if nasel = nil then
    ShowMessage('Not found!')
   else
    begin
      TreeView1.SetFocus;
      tnnasel.Selected := True;
    end;
end;

funguje paradne, najde to sice jen prvni adresar toho jmena
jenze ja bych potreboval, abych nemusel do Editu psat celej presnej nazev, ale kdyz mam treba adresare:
Narozeniny Robert
Narozeniny Adam
Narozeniny Anicka 3
Narozeniny Anicka 5
a podobne, aby stacilo do Editu napsat jen treba narozeniny, nebo Anicka a naslo to vsechny,co obsahuji tenhle text, v tom pripade by se musel TreeView smazat a vypsat do nej jen ty adresare, ktery se nasly,dejme tomu,ze i s nadrazenyma adresarema.

Pomuzete mi s tim nekdo prosim ??

s tim prepisovanim TreeView me napadlo upravit proceduru na vykreslovani o radek :
 

procedure GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode; IncludeFiles: Boolean);
var
  SearchRec: TSearchRec;
  ItemTemp: TTreeNode;
begin

  Includefiles:=false;
  Tree.Items.BeginUpdate;
  if Directory[Length(Directory)] <> '\' then
  Directory := Directory + '\';
  if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 then
  begin
    repeat
      if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') then
      begin
        if (SearchRec.Attr and faDirectory > 0) then
// -----------------------------------------------------------------------
            If SearchRec.Name = (Form1.Edit1.Text) then
// -----------------------------------------------------------------------
            begin
          Item := Tree.Items.AddChild(Item, SearchRec.Name);
        ItemTemp := Item.Parent;
        GetDirectories(Tree, Directory + SearchRec.Name, Item, IncludeFiles);
        Item := ItemTemp;
        end
      end
      else if IncludeFiles then
        if SearchRec.Name[1] <> '.' then
          Tree.Items.AddChild(Item, SearchRec.Name);
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
  Tree.Items.EndUpdate;
end;

to je dobry,ale po prvnim nalezenym zaznamu to skonci. 
jinymi slovy mam v tom TV nekolik adresaru Nova slozka, ted to najde prvni a skonci to, ty dalsi uz nevypise.

Když chceš hledat, jestli nějaký název obsahuje nějaký řetězec, tak nemůžeš přeci hledat přesnou shodu. Musíš použít hledání substringu, takže by to mohlo být nějak takto: 

If (AnsiContainsText(SearchRec.Name, Form1.Edit1.Text)) then

ale to už si když tak dovynajdeš sám :).

super, to je ono, dikec

tak jsem upravil vyhledavani podle liborb, a vlozil procedurku,ktera  vsechny nalezeny adresare prepise tucnym pismem ..:

procedure SetNodeBoldState(Node: TTreeNode; Value: Boolean);
var
  TVItem: TTVItem;
begin
if not Assigned(Node) then Exit;
with TVItem do
begin
  mask := TVIF_STATE or TVIF_HANDLE;
  hItem := Node.ItemId;
  stateMask := TVIS_BOLD;
  if Value then state := TVIS_BOLD
                else state := 0;
  TreeView_SetItem(Node.Handle, TVItem);
end;
end;

ale kdyz chci hledat dalsi zaznam, tak potrebuju,aby se ty tucny adresare zmenili na normalni a zvyraznili se zase ty  z novyho hledani.
myslel jsem, ze pouziju tu samou proceduru, prejmenuju ji treba na UnSetNodeState, do promenne ulozim starej hledanej text,spustim ji pred procedurou na poTucneni a zmenim v ni TVIS_BOLD na treba TVIS_NORMAL, ...  ale ouha nejde to ..
hledal jsem teda neco o TTVItem.State a nasel jsem vsechny mozny zapisy, ale ani jeden neni na zmenu zpatky, nebo na default nastaveni ..  viz

Poradite mi prosim ... 

a jak by vypadal zapis,kdybych chtel zmenit barvu pisma ..(teda jestli to vubec jde ..)
dekuji

#6 liborb
Dekuju,

chapu,ze to vypada tak jak pises,ze ty kody nezkoumam, ale bohuzel to tak neni, jsem proste jen tupej. (tohle me melo napadnout)
ale musim rict,ze na spoustu veci se neptam, 1.den mi to treba nedocvakne,ale jak to resim dal, tak me napadaji ruzny veci a vyresim to sam. To se tady ale nedozvite. Na veci, ze jsem porad lama to ale nic nemeni.

takze dekuju , polepsim se.

Nemyslel jsem to nijak zle, ale už to tu jednou bylo, s tím hledání souborů, jestli si pamatuješ, tak mi to nedalo :). A klidně se ptej dál, maximálně se ti stane, že ti nikdo neodpoví ;).

Zasláno z mobilního telefonu.

#8 liborb
v pohode, kritika na miste, obcas, kdyz se moc snazim mi to proste nesepne ...  :o)