ListView mit OwnerData schneller machen?

[Sir Rufo]

Weil das mit den Generics und Anonymen Methoden so schön geht, habe ich hier mal eine kleine Virtual-ListView Demo gemacht.

Vom Start weg erzeugt die 100.000 zufällige Personen, die dann noch bearbeitet/gelöscht/hinzugefügt werden können.
Der größte Zeitfresser ist hier die Sortierung, was aber auch nichts macht, da ich die Aktionen (anlegen, speichern, sortieren) im Hintergrund ausführen lasse und der Anwender so lange eine modale Form angezeigt bekommt, damit dem nicht langweilig wird

Evtl. kann das hier ja als Anregung dienen.

Achtung: Das Beispiel ist nur unter den aktuelleren Delphis (ab XE3?) lauffähig (im Anhang befindet sich auch eine kompilierte Version)

Haupt-Form:

Delphi-Quellcode:

unit UI_Form_Main;

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.Generics.Collections, System.Actions, System.SysUtils, System.Variants,
  System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.ActnList, Vcl.ExtCtrls,
  UI_Form_Base,
  Model_Person;

type
  TMainForm = class( TBaseForm )
    Persons_ListView : TListView;
    NewPerson_Button : TButton;
    EditPerson_Button : TButton;
    ActionList1 : TActionList;
    NewPerson_Action : TAction;
    EditPerson_Action : TAction;
    Action_Panel : TPanel;
    DeletePerson_Action : TAction;
    DeletePerson_Button : TButton;
    procedure Persons_ListViewData( Sender : TObject; Item : TListItem );
    procedure Persons_ListViewEdited( Sender : TObject; Item : TListItem; var S : string );
    procedure Persons_ListViewChange( Sender : TObject; Item : TListItem; Change : TItemChange );
    procedure NewPerson_ActionExecute( Sender : TObject );
    procedure EditPerson_ActionExecute( Sender : TObject );
    procedure EditPerson_ActionUpdate( Sender : TObject );
    procedure DeletePerson_ActionUpdate( Sender : TObject );
    procedure DeletePerson_ActionExecute( Sender : TObject );
  private
    { Person-ID Generator }
    FNextPersonId : Integer;
    function GetNextPersonId : Integer;
  private
    { Model }
    FPersons : TList<TPerson>;
    FCurrentPersonIndex : Integer;
    function GetCurrentPerson : TPerson;
    procedure SetCurrentPerson( const Value : TPerson );
  protected
    { Binding }
    procedure DoLoadFromModel; override;
    procedure DoSaveToModel; override;
  private
    { Background }
    procedure DoCreateSomePersons( Count : Integer );
    procedure DoSave( Person : TPerson );
    procedure DoSort;
  private
    { Facade Methods }
    function EditPerson( Person : TPerson ) : TPerson;
    procedure CreateSomePersons( Count : Integer );
    procedure SaveAndSort( Person : TPerson );
  public
    { Facade }
    procedure AddNewPerson;
    procedure EditCurrentPerson;
    procedure DeleteCurrentPerson;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  public
    property CurrentPerson : TPerson read GetCurrentPerson write SetCurrentPerson;
  end;

var
  MainForm : TMainForm;

implementation

{$R *.dfm}

uses
  System.DateUtils,
  UI_Form_Person_Edit,
  UI_Form_BackgroundWorker;

{ TMainForm }

procedure TMainForm.AddNewPerson;
begin
  CreateSomePersons( 1 );
  LoadFromModel;
end;

procedure TMainForm.AfterConstruction;
begin
  inherited;
  FPersons := TObjectList<TPerson>.Create( TPerson.EqualityComparer );
  FCurrentPersonIndex := FPersons.Count - 1;

  CreateSomePersons( 100000 );
  LoadFromModel;
end;

procedure TMainForm.BeforeDestruction;
begin
  inherited;
  FPersons.Free;
end;

procedure TMainForm.NewPerson_ActionExecute( Sender : TObject );
begin
  inherited;
  AddNewPerson;
end;

function TMainForm.EditPerson( Person : TPerson ) : TPerson;
var
  LPersonEdit : TEditPersonForm;
begin
  if Assigned( Person )
  then
  begin
    LPersonEdit := TEditPersonForm.Create( nil );
    try
      LPersonEdit.Person := Person;
      if LPersonEdit.ShowModal = mrOk
      then
      begin
        SaveAndSort( LPersonEdit.Person );
      end;
    finally
      LPersonEdit.Free;
    end;
  end;
  Result := Person;
end;

procedure TMainForm.EditPerson_ActionExecute( Sender : TObject );
begin
  inherited;
  EditCurrentPerson;
end;

procedure TMainForm.EditPerson_ActionUpdate( Sender : TObject );
begin
  inherited;
  ( Sender as TAction ).Enabled := Assigned( CurrentPerson );
end;

procedure TMainForm.CreateSomePersons( Count : Integer );
var
  LPerson : TPerson;
begin
  DoCreateSomePersons( Count );
  LPerson := FPersons.Last;
  DoSort;
  CurrentPerson := LPerson;
end;

procedure TMainForm.DeleteCurrentPerson;
begin
  if Assigned( CurrentPerson )
  then
  begin
    FPersons.Remove( CurrentPerson );
    Dec( FCurrentPersonIndex );
  end;
  LoadFromModel;
end;

procedure TMainForm.DeletePerson_ActionExecute( Sender : TObject );
begin
  inherited;
  DeleteCurrentPerson;
end;

procedure TMainForm.DeletePerson_ActionUpdate( Sender : TObject );
begin
  inherited;
  ( Sender as TAction ).Enabled := Assigned( CurrentPerson );
end;

procedure TMainForm.DoCreateSomePersons( Count : Integer );
begin
  PerformInBackground(
      procedure
    var
      LPerson : TPerson;
      LIdx : Integer;
    begin
      for LIdx := 1 to Count do
      begin
        LPerson := TPerson.Create( GetNextPersonId );
        try
          LPerson.Firstname := C_FIRSTNAMES[Random( Length( C_FIRSTNAMES ) )];
          LPerson.Lastname := C_LASTNAMES[Random( Length( C_LASTNAMES ) )];
          LPerson.DisplayAs := LPerson.Lastname + ', ' + LPerson.Firstname;
          LPerson.DOB := Date - ( Random( 365 * 60 ) + 18 * 365 );
          FPersons.Add( TPerson.Create( LPerson ) );
        finally
          LPerson.Free;
        end;
      end;
    end, Format( 'Erzeuge %d Einträge...', [Count] ) );
end;

procedure TMainForm.DoLoadFromModel;
begin
  inherited;
  // Anzahl der Einträge festlegen
  Persons_ListView.Items.Count := FPersons.Count;
  // Aktuelle Auswahl festlegen
  Persons_ListView.ItemIndex := FCurrentPersonIndex;
  // sieht komisch aus, ist aber notwendig damit der aktuelle Eintrag auch
  // sichtbar wird
  Persons_ListView.Items.Count := FPersons.Count;
  // Falls Änderungen an den Daten vorgenommen wurden, einfach mal neuzeichnen lassen
  Persons_ListView.Invalidate;
end;

procedure TMainForm.DoSave( Person : TPerson );
begin
  PerformInBackground(
    procedure
    begin
      if FPersons.Contains( Person )
      then
        FPersons[FPersons.IndexOf( Person )].Assign( Person )
      else
        FPersons.Add( TPerson.Create( Person ) );
    end, Format( 'Speichern von %s', [Person.ToString] ) );
end;

procedure TMainForm.DoSaveToModel;
begin
  inherited;
  FCurrentPersonIndex := Persons_ListView.ItemIndex;
end;

procedure TMainForm.DoSort;
begin
  PerformInBackground(
    procedure
    begin
      FPersons.Sort( TPerson.SortComparer );
    end, Format( 'Sortiere %d Einträge...', [FPersons.Count] ) );
end;

procedure TMainForm.EditCurrentPerson;
begin
  CurrentPerson := EditPerson( CurrentPerson );
  LoadFromModel;
end;

function TMainForm.GetCurrentPerson : TPerson;
begin
  if FCurrentPersonIndex < 0
  then
    Result := nil
  else
    Result := FPersons[FCurrentPersonIndex];
end;

function TMainForm.GetNextPersonId : Integer;
begin
  Result := FNextPersonId;
  Inc( FNextPersonId );
end;

procedure TMainForm.Persons_ListViewChange( Sender : TObject; Item : TListItem; Change : TItemChange );
begin
  inherited;
  SyncWithModel;
end;

procedure TMainForm.Persons_ListViewData( Sender : TObject; Item : TListItem );
var
  LPerson : TPerson;
begin
  inherited;
  LPerson := FPersons[Item.Index];
  Item.Caption := LPerson.ToString;
  Item.SubItems.Add( LPerson.Lastname );
  Item.SubItems.Add( LPerson.Firstname );
  Item.SubItems.Add( DateToStr( LPerson.DOB ) );
  Item.SubItems.Add( IntToStr( YearsBetween( Date, LPerson.DOB ) ) );
end;

procedure TMainForm.Persons_ListViewEdited( Sender : TObject; Item : TListItem; var S : string );
var
  LPerson : TPerson;
begin
  inherited;
  LPerson := TPerson.Create( FPersons[Item.Index] );
  try
    if LPerson.DisplayAs <> S
    then
    begin
      LPerson.DisplayAs := S;
      EditPerson( LPerson );
      CurrentPerson := LPerson;
    end;
  finally
    LPerson.Free;
  end;
end;

procedure TMainForm.SaveAndSort( Person : TPerson );
begin
  DoSave( Person );
  DoSort;
end;

procedure TMainForm.SetCurrentPerson( const Value : TPerson );
begin
  if not Assigned( Value )
  then
    FCurrentPersonIndex := - 1
  else
    FCurrentPersonIndex := FPersons.IndexOf( Value );
  LoadFromModel;
end;

end.