Kod: Tümünü seç
for i := 0 to 200000 - 1 do
Kod: Tümünü seç
for i := 0 to ListView1.Items.Count-1 do
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;