Virtual List View item ekleme count problemi

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
carsoft
Üye
Mesajlar: 138
Kayıt: 01 Ağu 2014 12:27

Virtual List View item ekleme count problemi

Mesaj gönderen carsoft »

Bu List View Unit'İ Kullanıyorum Ancak

Kod: Tümünü seç

for i := 0 to 200000 - 1 do
şeklinde problem yok ama

Kod: Tümünü seç

for i := 0 to ListView1.Items.Count-1 do
şeklinde eklemiyor.

neden acaba

Kullanımı

Kod: Tümünü seç

procedure TForm1.Button2Click(Sender: TObject);
var
  Item: TVirtualItem;
  i: Integer;
begin
  VirtualData.BeginUpdate;
  try
    for i := 0 to 200000 - 1 do // Problem yok - > Bu şekilde eklemiyor neden acaba for i := 0 to ListView1.Items.Count-1 do şeklinde
      begin
        Item := VirtualData.Add;
        Item.Caption := 'Eklendi ' + IntToStr(i);
        Item.SubItems.Add(IntToStr(i));
        Item.SubItems.Add(IntToStr(i));
      end;
  finally
    VirtualData.EndUpdate;
  end;

end;

VirualList View Unit

Kod: Tümünü seç

unit VirtualListData;

interface

////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;

////////////////////////////////////////////////////////////////////////////////
//  Classes
////////////////////////////////////////////////////////////////////////////////
type
  TVirtualItem      =  class(TCollectionItem)
  private
     // Private declarations
     FCaption:      String;
     FSubItems:     TStringList;
     FImageIndex:   Integer;
  protected
     // Protected declaration
     function       GetSubItems: TStrings;
     procedure      OnStringsChange(Sender: TObject);
     procedure      SetSubItems(Value: TStrings);
     procedure      SetCaption(Value: String);
     procedure      SetImageIndex(Value: Integer);
  public
     // Public declarations
     constructor    Create(Collection: TCollection); override;
     destructor     Destroy; override;
     property       Caption: String read FCaption write SetCaption;
     property       ImageIndex: Integer read FImageIndex write SetImageIndex;
     property       SubItems: TStrings read GetSubItems write SetSubItems;
  end;

type
  TVirtualData      =  class(TCollection)
  private
     // Private declarations
     FCount:        Integer;
     FListView:     TListView;
     function       GetItem(Index: Integer): TVirtualItem;
     procedure      SetItem(Index: Integer; Value: TVirtualItem);
  protected
     // Protected declarations
     procedure      OnData(Sender: TObject; Item: TListItem);
     procedure      OnDataFind(Sender: TObject; Find: TItemFind; const FindString: string; const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean; var Index: Integer);
     procedure      Update(Item: TCollectionItem); override;
  public
     // Public declarations
     constructor    Create(ListView: TListView);
     destructor     Destroy; override;
     function       Add: TVirtualItem;
     property       Items[Index: Integer]: TVirtualItem read GetItem write SetItem; default;
  end;

implementation

procedure TVirtualData.Update(Item: TCollectionItem);
begin

  // Set count if required
  if (Count <> FCount) then
  begin
     // Update the count
     FCount:=Count;
     // Update the list view items count
     FListView.Items.Count:=FCount;
  end;

  // Force the list view to repaint
  InvalidateRect(FListView.Handle, nil, True);

end;

function TVirtualData.GetItem(Index: Integer): TVirtualItem;
begin

  // Return item as TVirtualItem
  result:=TVirtualItem(inherited GetItem(Index));

end;

procedure TVirtualData.SetItem(Index: Integer; Value: TVirtualItem);
begin

  // Set item as TVirtualItem
  inherited SetItem(Index, Value);

end;

procedure TVirtualData.OnData(Sender: TObject; Item: TListItem);
var  viData:        TVirtualItem;
     dwIndex:       Integer;
begin

  // Make sure the item index is in range of our virtual items
  if (Item.Index <= Count) then
  begin
     // Get the virtual data item
     viData:=Items[Item.Index];
     // Set caption
     Item.Caption:=viData.Caption;
     // Set image index
     Item.ImageIndex:=viData.ImageIndex;
     // Check for report style
     if (FListView.ViewStyle = vsReport) then
     begin
        // Walk the subitems strings
        for dwIndex:=0 to Pred(viData.SubItems.Count) do
        begin
           // Add the string
           Item.SubItems.Add(viData.SubItems[dwIndex]);
        end;
     end;
  end;

end;

procedure TVirtualData.OnDataFind(Sender: TObject; Find: TItemFind; const FindString: string; const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean; var Index: Integer);
var  dwIndex:       Integer;
     bFound:        Boolean;
begin

  // Set starting index
  dwIndex:=StartIndex;

  // Check match type
  if (Find = ifExactString) or (Find = ifPartialString) then
  begin
     // Loop
     repeat
        // Check for wrap around
        if (dwIndex = Pred(Count)) then
        begin
           // Should we wrap?
           if Wrap then
              // Set index to zero
              dwIndex:=0
           else
              // Exit out
              exit;
        end;
        // Check for match
        bFound:=(Pos(UpperCase(FindString), UpperCase(Items[dwIndex].Caption)) = 1);
        // Increment search index
        Inc(dwIndex);
     // Break if we found the item or we are back at the starting index
     until bFound or (dwIndex = StartIndex);
     // If we found the item we need to back off by one
     if bFound then Index:=Pred(dwIndex);
  end;

end;

function TVirtualData.Add: TVirtualItem;
begin

  // Add item
  result:=TVirtualItem(inherited Add);

end;

constructor TVirtualData.Create(ListView: TListView);
begin

  // Perform inherited
  inherited Create(TVirtualItem);

  // Set base count
  FCount:=0;

  // Check control
  if not(Assigned(ListView)) then
     // Can't continue without a list view
     raise Exception.Create('A ListView is required!')
  else
  begin
     // Set control
     FListView:=ListView;
     // Bind events
     FListView.OnData:=OnData;
     FListView.OnDataFind:=OnDataFind;
     FListView.OwnerData:=True;
  end;

end;

destructor TVirtualData.Destroy;
begin

  // Resource protection
  try
     // Check list view
     if Assigned(FListView) then
     begin
        // Clear the list
        Clear;
        // Turn off owner handling
        FListView.OwnerData:=False;
        // Unbind events
        FListView.OnData:=nil;
        FListView.OnDataFind:=nil;
     end;
  finally
     // Perform inherited
     inherited Destroy;
  end;

end;

//// TVirtualItem //////////////////////////////////////////////////////////////
function TVirtualItem.GetSubItems: TStrings;
begin

  // Return sub items
  result:=FSubItems;

end;

procedure TVirtualItem.SetSubItems(Value: TStrings);
begin

  // Check passed value
  if Assigned(Value) then
     // Assign from passed list
     FSubItems.Assign(Value)
  else
     // Clear list
     FSubItems.Clear;

  // Update
  Changed(False);

end;

procedure TVirtualItem.SetCaption(Value: String);
begin

  // Check passed value
  if (FCaption <> Value) then
  begin
     // Update the caption
     FCaption:=Value;
     // Update
     Changed(False);
  end;

end;

procedure TVirtualItem.SetImageIndex(Value: Integer);
begin

  // Check passed value
  if (FImageIndex <> Value) then
  begin
     // Update the caption
     FImageIndex:=Value;
     // Update
     Changed(False);
  end;

end;

procedure TVirtualItem.OnStringsChange(Sender: TObject);
begin

  // String list has changed
  Changed(False);

end;

constructor TVirtualItem.Create(Collection: TCollection);
begin

  // Perform inherited
  inherited Create(Collection);

  // Set default values
  FImageIndex:=(-1);
  SetLength(FCaption, 0);
  FSubItems:=TStringList.Create;
  FSubItems.OnChange:=OnStringsChange;

end;

destructor TVirtualItem.Destroy;
begin

  // Resource protection
  try
     // Unbind the string list event
     FSubItems.OnChange:=nil;
     // Free the string list
     FSubItems.Free;
  finally
     // Perform inherited
     inherited Destroy;
  end;

end;

end.

Kullanımı

uses
VirtualListData;

Kod: Tümünü seç

private
    { Private declarations }
    VirtualData: TVirtualData;
.....

Kod: Tümünü seç

procedure TForm1.FormCreate(Sender: TObject);
begin
  FVirtualData:=TVirtualData.Create(ListView1);
end;

Kod: Tümünü seç

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FVirtualData.Free;
end;
Kullanıcı avatarı
SimaWB
Üye
Mesajlar: 1316
Kayıt: 07 May 2009 10:42
Konum: İstanbul
İletişim:

Re: Virtual List View item ekleme count problemi

Mesaj gönderen SimaWB »

Döngü içinde ListView1'e ekleme yapıyorsanız ondan olabilir.
There's no place like 127.0.0.1
carsoft
Üye
Mesajlar: 138
Kayıt: 01 Ağu 2014 12:27

Re: Virtual List View item ekleme count problemi

Mesaj gönderen carsoft »

Evet bu satırı silince ekleme yapıyor for i := 0 to ListView1.Items.Count-1 do - fakat item count sayısını alamıyorum alamadığım içinde dosyayı
pc den silemiyorum çözümü yokmu
Kullanıcı avatarı
SimaWB
Üye
Mesajlar: 1316
Kayıt: 07 May 2009 10:42
Konum: İstanbul
İletişim:

Re: Virtual List View item ekleme count problemi

Mesaj gönderen SimaWB »

Siz ListView1'e ekleme yapıyorsanız, ListView1.Items.Count sürekli arttığı için döngü sonsuza dek çalışır.
There's no place like 127.0.0.1
Kullanıcı avatarı
SimaWB
Üye
Mesajlar: 1316
Kayıt: 07 May 2009 10:42
Konum: İstanbul
İletişim:

Re: Virtual List View item ekleme count problemi

Mesaj gönderen SimaWB »

Yapmak istediğinizi tam anlayamadım.
Ama döngüden önce ListView1.Items.Count'u bir değişkene atın. Sonra döngüyü bu değişkene kadar olacak şekilde yapın, belki probleminiz çözülür.
There's no place like 127.0.0.1
carsoft
Üye
Mesajlar: 138
Kayıt: 01 Ağu 2014 12:27

Re: Virtual List View item ekleme count problemi

Mesaj gönderen carsoft »

tamam dediginiz gibi yaptım countu aldım
ama bu defada listviewdeki dosyaları pcden silmek isteyince 2 tane silip duruyor anlamadım gitti

Kod: Tümünü seç

procedure TForm1.Button3Click(Sender: TObject);
var
  i : Integer;
  Dir : string;
begin
   with ListView1 do
 begin
  for i := 0 to Items.Count -1 do
 begin
   Dir := (Items[i].SubItems[0]);
 if FileExists(Items[i].SubItems[0]) then
 begin
     DeleteFile(PChar(Dir));
 end;
 end;
 end;
end;
carsoft
Üye
Mesajlar: 138
Kayıt: 01 Ağu 2014 12:27

Re: Virtual List View item ekleme count problemi

Mesaj gönderen carsoft »

Problem çözülmüştür teşşekürler.
Cevapla