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