ListView лагает при прокрутке загруженного списка

[FleXik]

procedure TForm1.PopulateIDList(ShellFolder: IShellFolder);
const
  Flags = SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN;
var
  ID: PItemIDList;
  EnumList: IEnumIDList;
  NumIDs: LongWord;
  SaveCursor: TCursor;
  ShellItem: PShellItem;
begin
  SaveCursor := Screen.Cursor;
  try
    Screen.Cursor := crHourglass;
    OleCheck(
      ShellFolder.EnumObjects(
        Application.Handle,
        Flags,
        EnumList)
    );

    FIShellFolder := ShellFolder;
    ClearIDList;
    while EnumList.Next(1, ID, NumIDs) = S_OK do
    begin
      ShellItem := New(PShellItem);
      ShellItem.ID := ID;
      ShellItem.DisplayName := GetDisplayName(FIShellFolder, ID, False);
      ShellItem.Empty := True;
      FIDList.Add(ShellItem);
    end;

    FIDList.Sort(ListSortFunc);

    //We need to tell the ListView how many items it has.
    ListView.Items.Count := FIDList.Count;

    ListView.Repaint;
  finally
    Screen.Cursor := SaveCursor;
  end;
end;

procedure TForm1.SetPath(const Value: string);
var
  P: PWideChar;
  NewPIDL: PItemIDList;
  Flags,
  NumChars: LongWord;
begin
  NumChars := Length(Value);
  Flags := 0;
  P := StringToOleStr(Value);

  OLECheck(
    FIDesktopFolder.ParseDisplayName(
      Application.Handle,
      nil,
      P,
      NumChars,
      NewPIDL,
      Flags)
   );
  SetPath(NewPIDL);
end;

procedure TForm1.SetPath(ID: PItemIDList);
var
  Index: Integer;
  NewShellFolder: IShellFolder;
begin
   OLECheck(
     FIDesktopFolder.BindToObject(
            ID,
            nil,
            IID_IShellFolder,
            Pointer(NewShellFolder))
   );

  ListView.Items.BeginUpdate;
  try
    PopulateIDList(NewShellFolder);
    FPIDL := ID;
    FPath := GetDisplayName(FIDesktopFolder, FPIDL, True);
    Index := cbPath.Items.IndexOf(FPath);
    if (Index < 0) then
    begin
      cbPath.Items.InsertObject(0, FPath, Pointer(FPIDL));
      cbPath.Text := cbPath.Items[0];
    end
    else begin
      cbPath.ItemIndex := Index;
      cbPath.Text := cbPath.Items[cbPath.ItemIndex];
    end;

    if ListView.Items.Count > 0 then
    begin
      ListView.Selected := ListView.Items[0];
      ListView.Selected.Focused := True;
      ListView.Selected.MakeVisible(False);
    end;
  finally
    ListView.Items.EndUpdate;
  end;
end;

//ROUTINES FOR MANAGING VIRTUAL DATA

procedure TForm1.CheckShellItems(StartIndex, EndIndex: Integer);

 function ValidFileTime(FileTime: TFileTime): Boolean;
 begin
   Result := (FileTime.dwLowDateTime <> 0) or (FileTime.dwHighDateTime <> 0);
 end;

var
  FileData: TWin32FindData;
  FileInfo: TSHFileInfo;
  SysTime: TSystemTime;
  I: Integer;
  LocalFileTime: TFILETIME;
begin
  //Here all the data that wasn't initialized in PopulateIDList is
  //filled in.
  for I := StartIndex to EndIndex do
  begin
    if ShellItem(I)^.Empty then
    with ShellItem(I)^ do
    begin
      FullID := ConcatPIDLs(FPIDL, ID);
      ImageIndex := GetShellImage(FullID, ListView.ViewStyle = vsIcon, False);

      //File Type
      SHGetFileInfo(
        PChar(FullID),
        0,
        FileInfo,
        SizeOf(FileInfo),
        SHGFI_TYPENAME or SHGFI_PIDL
      );
      TypeName := FileInfo.szTypeName;

      //Get File info from Windows
      FillChar(FileData, SizeOf(FileData), #0);
      SHGetDataFromIDList(
        FIShellFolder,
        ID,
        SHGDFIL_FINDDATA,
        @FileData,
        SizeOf(FileData)
      );

      //File Size, in KB
      Size := (FileData.nFileSizeLow + 1023 ) div 1024;
      if Size = 0 then Size := 1;

      //Modified Date
      FillChar(LocalFileTime, SizeOf(TFileTime), #0);
      with FileData do
        if ValidFileTime(ftLastWriteTime)
        and FileTimeToLocalFileTime(ftLastWriteTime, LocalFileTime)
        and FileTimeToSystemTime(LocalFileTime, SysTime) then
        try
          ModDate := DateTimeToStr(SystemTimeToDateTime(SysTime))
        except
          on EConvertError do ModDate := '';
        end
        else
          ModDate := '';

      //Attributes
      Attributes := FileData.dwFileAttributes;

      //Flag this record as complete.
      Empty := False;
    end;
  end;
end;

[FleXik]

procedure TForm1.ListViewDataHint(Sender: TObject; StartIndex,
  EndIndex: Integer);
begin
  //OnDataHint is called before OnData. This gives you a chance to
  //initialize only the data structures that need to be drawn.
  //You should keep track of which items have been initialized so no
  //extra work is done.
  if (StartIndex > FIDList.Count) or (EndIndex > FIDList.Count) then Exit;
  CheckShellItems(StartIndex, EndIndex);
end;

procedure TForm1.ListViewData(Sender: TObject; Item: TListItem);
var
  Attrs: string;
begin
  //OnData gets called once for each item for which the ListView needs
  //data. If the ListView is in Report View, be sure to add the subitems.
  //Item is a "dummy" item whose only valid data is it's index which
  //is used to index into the underlying data.
  if (Item.Index > FIDList.Count) then Exit;
  with ShellItem(Item.Index)^ do
  begin
    Item.Caption := DisplayName;
    Item.ImageIndex := ImageIndex;

    if ListView.ViewStyle <> vsReport then Exit;

    if not IsFolder(FIShellFolder, ID) then
      Item.SubItems.Add(Format('%dKB', [Size]))
    else
      Item.SubItems.Add('');
    Item.SubItems.Add(TypeName);
    try
      Item.SubItems.Add(ModDate);
    except
    end;

    if Bool(Attributes and FILE_ATTRIBUTE_READONLY) then Attrs := Attrs + 'R';
    if Bool(Attributes and FILE_ATTRIBUTE_HIDDEN) then Attrs := Attrs + 'H';
    if Bool(Attributes and FILE_ATTRIBUTE_SYSTEM) then Attrs := Attrs + 'S';
    if Bool(Attributes and FILE_ATTRIBUTE_ARCHIVE) then Attrs := Attrs + 'A';
  end;
  Item.SubItems.Add(Attrs);
end;

procedure TForm1.ListViewDataFind(Sender: TObject; Find: TItemFind;
  const FindString: String; const FindPosition: TPoint; FindData: Pointer;
  StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean;
  var Index: Integer);
//OnDataFind gets called in response to calls to FindCaption, FindData,
//GetNearestItem, etc. It also gets called for each keystroke sent to the
//ListView (for incremental searching)
var
  I: Integer;
  Found: Boolean;
begin
  I := StartIndex;
  if (Find = ifExactString) or (Find = ifPartialString) then
  begin
    repeat
      if (I = FIDList.Count-1) then
        if Wrap then I := 0 else Exit;
      Found := Pos(UpperCase(FindString), UpperCase(ShellItem(I)^.DisplayName)) = 1;
      Inc(I);
    until Found or (I = StartIndex);
    if Found then Index := I-1;
  end;
end;

procedure TForm1.ListViewCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  Attrs: Integer;
begin
  if Item = nil then Exit;
  Attrs := ShellItem(Item.Index).Attributes;
  if Bool(Attrs and FILE_ATTRIBUTE_READONLY) then
    ListView.Canvas.Font.Color := clGrayText;
  if Bool(Attrs and FILE_ATTRIBUTE_HIDDEN) then
    ListView.Canvas.Font.Style :=
       ListView.Canvas.Font.Style + [fsStrikeOut];
  if Bool(Attrs and FILE_ATTRIBUTE_SYSTEM) then
    Listview.Canvas.Font.Color := clHighlight;
end;

procedure TForm1.ListViewCustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
  if SubItem = 0 then Exit;
  ListView.Canvas.Font.Color := GetSysColor(COLOR_WINDOWTEXT);
  //workaround for Win98 bug.
end;

procedure TForm1.btnBackClick(Sender: TObject);
var
  Temp: PItemIDList;
begin
  Temp := CopyPIDL(FPIDL);
  if Assigned(Temp) then
    StripLastID(Temp);
  if Temp.mkid.cb <> 0 then
    SetPath(Temp)
  else
    Beep;
end;

procedure TForm1.Form1Close(Sender: TObject; var Action: TCloseAction);
begin
  ClearIDList;
  FIDList.Free;
end;

end.

Ну что, кому-то что-то из этого понятно?

[eval]

кому надо тому и понятно, а если предложите нормальные деньги, то будет кому пожелаете

[doktor255]

Вместо тучи кода лучше бы скинул проект. Собирать проект с нуля из этого кода, чтоб посмотреть как он работает, и где именно ошибки лично у меня вообще не возникает желания.

[eval]

он уже давно собран, автор просто не может его понять

[FleXik]

doktor255, скоро скину проэкт (10-15мин)

очень странно, сделал проэкт наполняющийся по 7 цифр в каждой колонке - лагов вообще нет, список из 10 000 строк, у меня же в проэкте текст (не сильно длинные по количествам букв) но лаги жуткие

началась веселуха, найдена проблема которая тормозила и очень сильно грузила ListView, вот она

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  i:integer;
begin

    for i:=0 to Form1.ListView1.Items.Count-1 do
    begin
      Form1.ListView1.Items[i].ImageIndex:=-1;
      Form1.ListView1.Items[i].Indent:=-1;
      Form1.ListView1.Items[i].Caption:=IntToStr(i+1);
    end;

end;

убрал этот кусок кода, и ListView даже с 10 000 перестал лагать о_О, но тем не менее этот кусок кода обновлял нумерацию пунктов в ListView после удаления некоторых пунктов, буду шаманить с процедурой Repaint

doktor255, тебе спасибо, если бы ты не попросил меня скинуть проэкт я бы не догадался в чем проблема.

--------------------------

ох и наколхозил я))) некоторые части кода не в те события кинул

[northener]

скоро скину проэкт

<OFFTOP>Ещё один "купил машинку с турецким акцентом" </OFFTOP>

[doktor255]

но тем не менее этот кусок кода обновлял нумерацию пунктов в ListView после удаления некоторых пунктов, буду шаманить с процедурой Repaint

Ну и получишь на выходе ту же шляпу. Не Repaint, а отдельная процедура, к которой будешь обращаться, когда это необходимо, а не когда ListView пожелает себя перерисовать (а желает он это часто).

[FleXik]

Не Repaint, а отдельная процедура, к которой будешь обращаться, когда это необходимо, а не когда ListView пожелает себя перерисовать (а желает он это часто).

я это уже понял да и к тому же уже все реализовал...

после удаления нескольких пунктов у меня идет в этом же событии перерисовка нумерации первой колонки

  for j:=0 to Form1.ListView1.Items.Count-1 do
  begin
    Form1.ListView1.Items[j].Caption:=IntToStr(j+1);
  end;

т.к без удаления строк нумерация не проставляется - делаем дополнительную нумерацию в процедуре thread.ListViewAdd

procedure thread.ListViewAdd;
begin
  Item:=Form1.ListView1.Items.Add; // 1 колонка
  Item.Caption:=IntToStr(Item.Index+1); // нумерация
  Item.SubItems.Add('2 колонка');
  Item.SubItems.Add('3 колонка');
  Item.SubItems.Add('4 колонка');
  Item.SubItems.Add('5 колонка');
end;

все отлично работает

P.S в прошлый раз я кидал код на событие OnCustomDraw (как видим код сильно не отличается), из-за этого список ListView так сильно и лагал при прокрутке