Probleme mit VirtualListView

[bluescreen25]

Hallo, wir haben bei dem Listview eine 1000fach angesprochene Verlangsamung drin.
Haben da auch die CodeSchnipsel versucht zu interpretieren.
Leider bekommen wir das mit dem VirtualListView nicht hin.
Kann da jemand mal einen Ansatz geben ?

Delphi-Quellcode:

//Dateien und Ordner in die ListView eintragen
procedure ShowFiles(ShowList: TListView; Rekursive: Boolean; ShowDir: Boolean);
var
  FileLst, DirLst: TStrings;
  I: Integer;
begin
  if ShowList.Name = 'media' then
  begin
    if ShowList.Selected <> nil then Path := Copy(ListMedia.Selected.SubItems.Text,0, length(ListMedia.Selected.SubItems.Text)- 2);
    if FileExists(Path) then //Ist der Pfad eine Datei ?
    begin
      Path := GetPreviousDirectory(Path);
      Path := GetPreviousDirectory(Path);
    end;
    DirLst := TStringList.Create; //Temponäre Listen erstellen
    FileLst := TStringList.Create;
    FindAllFiles(DirLst, FileLst, Path, FileMask, Rekursive, True, True); //Alle Ordner und Dateien in Liste schreiben
    ShowList.Clear;
    if ShowDir then  //Ordner anzeigen wenn True
    begin
      for I := 0 to DirLst.Count-1 do //Ordner in ListView eintragen
      begin //Die Ordner kommen zuerst in das ListView
        with ShowList.Items.Add do //Neuen Ordner hizufügen
        begin
          Caption := ExtractFilename(DirLst[I]); //Wir wollen nur den Ordnernamen
          SubItems.Text := DirLst[I]; //Den Pfad brauchen wir auch
          ImageIndex := 0; //Ordner-Icon zuweisen
        end;
      end;
    end;
    for I := 0 to FileLst.Count-1 do //Dateien in ListView eintragen
    begin //Die Dateien werden unter den Ordnern angezeigt
      with ShowList.Items.Add do //Neue Datei hinzufügen
      begin
        Caption := ExtractFilename(FileLst[I]); //Wir wollen nur den Dateinamen
        SubItems.Text := FileLst[I]; //Den Pfad brauchen wir auch
        ImageIndex := 1; //Datei-Icon zuweisen
      end;
    end;
    DirLst.Free; //Temponäre Listen freigeben
    FileLst.Free;
  end;
end;

Delphi-Quellcode:

procedure FindAllFiles(DirList:TStrings; FileList: TStrings; RootFolder: string; Mask: string; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
  procedure LFindAllFiles(AParentFolder: String);
  var LSearchRec: TSearchRec;
  begin
    Application.ProcessMessages;
    if FindFirst(AParentFolder + '*', faAnyFile, LSearchRec) = 0 then
    begin
      repeat
        if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then
        begin
          if LSearchRec.Attr and faDirectory = faDirectory then
          begin
            if AddFolderNames and
               (IgnoreMaskAtFolderNames or Like(AnsiLowerCase(LSearchRec.Name), Mask)) then
              DirList.AddObject(AParentFolder + LSearchRec.Name, TObject(True));
            if Recurse then
              LFindAllFiles(AParentFolder + LSearchRec.Name + '\');
          end
          else if Like(AnsiLowerCase(LSearchRec.Name), Mask) then
            FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(False));
        end;
      until FindNext(LSearchRec) <> 0;
      FindClose(LSearchRec);
    end;
  end;
begin
  Mask := AnsiLowerCase(Mask);
  LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder));
end;

Viele Grüße, bluescreen25

[marabu]

Hallo,

nicht zuletzt weil du die ListView auch als Daten-Container benutzt, solltest du alle Zugriffe auf die Items (Clear, Add) mit BeginUpdate und EndUpdate einfassen.

Grüße vom marabu

[bluescreen25]

Zitat von marabu:

Hallo,

nicht zuletzt weil du die ListView auch als Daten-Container benutzt, solltest du alle Zugriffe auf die Items (Clear, Add) mit BeginUpdate und EndUpdate einfassen.

Grüße vom marabu

Das war hier im Forum eine beschriebene Methode, welche nur bedingt Geschwindigkeit bringt.
Soweit ich gelesen habe, gibt es die Möglichkeit die ListView virtual zu machen, nur bekomme ich das aktuell an meinem Code nicht hin. Es geht hier um z.T. viele Einträge.

Dein Stichwort ist Datencontainer und da solls auch so gehen, das man diesen verlagert, na ich habe da keinen Ansatz....

Hier nochmal etwas aus dem Forum:

Delphi-Quellcode:

Procedure TForm1.FillData (aCount : Integer);
Begin
  ListView1.OwnerData := True;
  ListView1.Items.Count := aCount;
  ListView1.OnData := ListView1Data;
End;


procedure TfmEditCustomer.ListView1Data(Sender: TObject; Item: TListItem);
begin
  Item.Caption := MyUserData[Item.Index].MainTitle;
  Item.ImageIndex := MyUserData[Item.Index].DataType;
...
End;

[marabu]

Apropos Ansatz - auch das hier findest du im Forum: klick

Es ist recht überschaubar und in Verbindung mit der Delphi Online Hilfe könntest du versuchen es nachzuvollziehen.

Grüße

[bluescreen25]

Zitat von marabu:

Apropos Ansatz - auch das hier findest du im Forum: klick

Es ist recht überschaubar und in Verbindung mit der Delphi Online Hilfe könntest du versuchen es nachzuvollziehen.

Grüße

Ich habe es mir mal ausgedruckt, versuche dies mal umzusetzen.

Erstmal Danke marabu !

[bluescreen25]

Hmm klappt irgendwie nicht. Ich erzeuge das Listview dynamisch.

Delphi-Quellcode:

for iIndex := 0 to 1 do
    begin
      iString := lowercase(Ini.ReadString(Menu,'List' + IntToStr(iIndex) + 'Function','0'));
      If iString = '0' then Goto ListEnde;
      SkinList := TListView.create(SkinForm);
      with SkinList do
      begin
        Parent := SkinForm;
        Name := iString;
        Doublebuffered := True;
        HelpKeyword := iString;
        SetBounds(Ini.ReadInteger(Menu,'List' + IntToStr(iIndex) + 'X',0),Ini.ReadInteger(Menu,'List' + IntToStr(iIndex) + 'Y',0),Ini.ReadInteger(Menu,'List' + IntToStr(iIndex) + 'Width',0),Ini.ReadInteger(Menu,'List' + IntToStr(iIndex) + 'Height',0));
        ViewStyle := vsSmallIcon;
        SmallImages := IL;
        BorderStyle := bsnone;
        OwnerData := true;
        Color := HTMLColorToColor(Ini.ReadString(Menu,'List' + IntToStr(iIndex) + 'BackColor','&HFFFFFF'));
        Font.Color := HTMLColorToColor(Ini.ReadString(Menu,'List' + IntToStr(iIndex) + 'FontColor','&H000000'));
        Font.Name := Ini.ReadString(Menu,'List' + IntToStr(iIndex) + 'Font','Arial');
        Font.Size := Ini.ReadInteger(Menu,'List' + IntToStr(iIndex) + 'FontSize',0);
        OnClick := Form1.SkinListClick;
        OnDblClick := Form1.SkinListDblClick;
      end;
      if SkinList.Name = 'media' then ListMedia := SkinList;
    end;

Nur scheint mir die
procedure TForm1.ListMediaData(Sender: TObject; Item: TListItem); nicht zu greifen. Ich deklariere die auch, aber es klappt nicht.

Ich bitte nochmal um Hilfe.

Grüße bluescreen25

[marabu]

Da scheint mir etwas zu fehlen:

Delphi-Quellcode:

begin
  // ...
  with SkinList do
  begin
    // ...
    OnData := ListMediaData;
    // ...
  end;
  // ...
end;

Grüße

[bluescreen25]

Danke marabu

Das kann doch nicht wahr sein Die ganze Zeit keine Anzeige.

So klappt es dann: (Listmedia wird ja erst später bekannt)

Delphi-Quellcode:

for iIndex := 0 to 1 do
    begin
      iString := lowercase(Ini.ReadString(Menu,'List' + IntToStr(iIndex) + 'Function','0'));
      If iString = '0' then Goto ListEnde;
      SkinList := TListView.create(SkinForm);
      with SkinList do
      begin
        Parent := SkinForm;
        Name := iString;
        Doublebuffered := True;
        HelpKeyword := iString;
        SetBounds(Ini.ReadInteger(Menu,'List' + IntToStr(iIndex) + 'X',0),Ini.ReadInteger(Menu,'List' + IntToStr(iIndex) + 'Y',0),Ini.ReadInteger(Menu,'List' + IntToStr(iIndex) + 'Width',0),Ini.ReadInteger(Menu,'List' + IntToStr(iIndex) + 'Height',0));
        ViewStyle := vsSmallIcon;
        SmallImages := IL;
        BorderStyle := bsnone;
        OwnerData := true;
        Color := HTMLColorToColor(Ini.ReadString(Menu,'List' + IntToStr(iIndex) + 'BackColor','&HFFFFFF'));
        Font.Color := HTMLColorToColor(Ini.ReadString(Menu,'List' + IntToStr(iIndex) + 'FontColor','&H000000'));
        Font.Name := Ini.ReadString(Menu,'List' + IntToStr(iIndex) + 'Font','Arial');
        Font.Size := Ini.ReadInteger(Menu,'List' + IntToStr(iIndex) + 'FontSize',0);
        OnClick := Form1.SkinListClick;
        OnDblClick := Form1.SkinListDblClick;
      end;
      if SkinList.Name = 'media' then ListMedia := SkinList;
      ListMedia.OnData := Form1.ListMediaData;
    end;

[bluescreen25]

noch ein klitzekleines Problem:

wie bekomme ich die Einträge von Dir und Files in der Listview untereinander rein ?
Es funktioniert das mit den Directories, aber beides?

Delphi-Quellcode:

//Dateien und Ordner in die ListView eintragen
procedure ShowFiles(ShowList: TListView; Rekursive: Boolean; ShowDir: Boolean);
var
  I: Integer;
begin
  if ShowList.Name = 'media' then
  begin
    if ShowList.Selected <> nil then Path := Copy(ListMedia.Selected.SubItems.Text,0, length(ListMedia.Selected.SubItems.Text)- 2);
    if FileExists(Path) then //Ist der Pfad eine Datei ?
    begin
      Path := GetPreviousDirectory(Path);
      Path := GetPreviousDirectory(Path);
    end;
    DirLst := TStringList.Create; //Temponäre Listen erstellen
    FileLst := TStringList.Create;
    FindAllFiles(DirLst, FileLst, Path, FileMask, Rekursive, True, True); //Alle Ordner und Dateien in Liste schreiben
    ShowList.Clear;
    if ShowDir then  //Ordner anzeigen wenn True
    begin
      for I := 0 to DirLst.Count-1 do //Dir-List durchzählen
      begin
        with ListMedia do //Neuen Ordner hizufügen
        begin
          Items.Count := DirLst.Count;
        end;
      end;
    end;
    for I := 0 to FileLst.Count-1 do //File-List durchzählen
    begin //Die Dateien werden unter den Ordnern angezeigt
        with ListMedia do
      begin
        //Items.Count := FileLst.Count;
      end;
    end;
  end;
end;


procedure TForm1.ListMediaData(Sender: TObject; Item: TListItem);
begin
  if (Item=nil) then Exit;
  with Item do
  begin
    Caption:= ExtractFilename(DirLst.Strings[index]);
    SubItems.Add(DirLst[index]);
    ImageIndex := 0; //Ordner-Icon zuweisen

    //Caption:= ExtractFilename(FileLst.Strings[index]);
    //SubItems.Add(FileLst[index]);
    //ImageIndex := 1; //Datei-Icon zuweisen
  end; // with Item
end;

Grüße, bluescreen25

[marabu]

Auf die Schnelle:

Delphi-Quellcode:

procedure ShowFiles(ShowList: TListView; Rekursive: Boolean; ShowDir: Boolean); 
begin
    // ...
    //Alle Ordner und Dateien in Liste schreiben
    FindAllFiles(DirLst, FileLst, Path, FileMask, Rekursive, True, True); 
    // Liste dimensionieren
    ShowList.Items.Count := DirLst.Count + FileLst.Count;
    // Liste bei Gelegenheit neu zeichnen
    ShowList.Invalidate;
    // ...
end;

procedure TForm1.ListMediaData(Sender: TObject; Item: TListItem);
var
  s: TStrings;
  idx: Integer;
begin
  if not Assigned(Item) then 
    Exit;
  with Item do
  begin
    if index < DirLst.Count then 
    begin
      s := DirLst;
      idx := index;
    end else
    begin
      s := FileLst;
      idx := index - DirLst.Count;
    end;    
    Caption := ExtractFilename(s[idx]);
    SubItems.Add(s[idx]);   // idx und nicht index ...
    // Ordner- oder File-Icon zuweisen
    ImageIndex := Ord(idx < index); 
  end; // with Item
end;

Grüße