Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#14

AW: TListView - viele Daten - viel Zeit ...

  Alt 17. Jul 2014, 10:34
Nur mal so aus Spaß ... komplett dynamisch

Zwei Listen (Personen, Adressen) werden in einer ListView präsentiert. Klick auf Button1 zeigt die Personen, Klick auf Button2 die Adressen.

Das Umschalten zwischen den beiden Listen benötigt bei 9000 Personen ca. 675ms
Der Refresh der Personen-Liste benötigt bei 9000 Personen ca. 330ms

Das Umschalten zwischen den beiden Listen benötigt bei 10000 Adressen ca. 1065ms
Der Refresh der Adressen-Liste benötigt bei 10000 Adressen ca. 740ms

Hier die ganzen Code-Schnipsel (sollte auch mit Delphi 7 so laufen)
Delphi-Quellcode:
unit FormMain;

interface

uses
  {Winapi.} Windows, {Winapi.} Messages,
  {System.} SysUtils, {System.} Variants, {System.} Classes, {System.} Contnrs,
  {Vcl.} Graphics, {Vcl.} Controls, {Vcl.} Forms, {Vcl.} Dialogs, {Vcl.} StdCtrls, {Vcl.} ComCtrls,

  DataListContainer;

type
  TForm1 = class( TForm )
    ListView1 : TListView;
    Button1 : TButton;
    Button2 : TButton;
    Label1 : TLabel;
    procedure Button1Click( Sender : TObject );
    procedure Button2Click( Sender : TObject );
  private
    FPersons : TObjectList;
    FAddresses : TObjectList;
    FPersonsPresenter : TDataListContainer;
    FAddressPresenter : TDataListContainer;
    procedure ShowInfo( AStart, AStop : TDateTime; ACount : Integer );
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

var
  Form1 : TForm1;

implementation

{$R *.dfm}

uses
  {System.} DateUtils,
  DataListToListView,
  Person, Address;

{ TForm1 }

procedure TForm1.AfterConstruction;
var
  LIdx : Integer;
begin
  inherited;
  // Musterdaten erstellen
  FPersons := TObjectList.Create( True );
  for LIdx := 1 to 3000 do
    begin
      FPersons.Add( TPerson.Create( 'Lustig, Peter', EncodeDate( 1975, 1, 1 ) ) );
      FPersons.Add( TPerson.Create( 'Traurig, Walter', EncodeDate( 1975, 2, 1 ) ) );
      FPersons.Add( TPerson.Create( 'Mustermann, Erika', EncodeDate( 1975, 3, 1 ) ) );
    end;
  
  // Definition der Spalten
  FPersonsPresenter := TDataListContainer.Create;
  FPersonsPresenter.AddColumn( 'Name', 'Fullname', 150 );
  FPersonsPresenter.AddColumn( 'Geburtstag', 'DOB', 80 );
  FPersonsPresenter.DataList := FPersons;

  // Musterdaten erstellen
  FAddresses := TObjectList.Create( True );
  for LIdx := 1 to 2500 do
    begin
      FAddresses.Add( TAddress.Create( 'Am Walde 23', 12345, 'Hinterm Berg' ) );
      FAddresses.Add( TAddress.Create( 'Im Weiher 12', 23456, 'Vordem Berg' ) );
      FAddresses.Add( TAddress.Create( 'Auf der Hecke 5', 34567, 'Beidem Berg' ) );
      FAddresses.Add( TAddress.Create( 'Nebenstollen 5', 45678, 'Unterm Berg' ) );
    end;

  // Definition der Spalten
  FAddressPresenter := TDataListContainer.Create;
  FAddressPresenter.AddColumn( 'Straße', 'Street', 150 );
  FAddressPresenter.AddColumn( 'PLZ', 'ZipCode', 80 );
  FAddressPresenter.AddColumn( 'Ort', 'City', 80 );
  FAddressPresenter.DataList := FAddresses;
end;

procedure TForm1.BeforeDestruction;
begin
  inherited;
  FPersonsPresenter.Free;
  FPersons.Free;
  FAddressPresenter.Free;
  FAddresses.Free;
end;

procedure TForm1.Button1Click( Sender : TObject );
var
  LStart, LStop : TDateTime;
begin
  LStart := Now;
  PresentData( ListView1, FPersonsPresenter );
  LStop := Now;
  ShowInfo( LStart, LStop, FPersonsPresenter.DataList.Count );
end;

procedure TForm1.Button2Click( Sender : TObject );
var
  LStart, LStop : TDateTime;
begin
  LStart := Now;
  PresentData( ListView1, FAddressPresenter );
  LStop := Now;
  ShowInfo( LStart, LStop, FAddressPresenter.DataList.Count );
end;

procedure TForm1.ShowInfo( AStart, AStop : TDateTime; ACount : Integer );
begin
  Label1.Caption := Format( '%d Einträge in %dms', [ACount, MilliSecondsBetween( AStop, AStart )] );
end;

end.
Delphi-Quellcode:
unit Person;

interface

type
  TPerson = class
  private
    FFullname : string;
    FDOB : TDate;
  public
    constructor Create( const Fullname : string; DOB : TDate );
  published
    property Fullname : string read FFullname write FFullname;
    property DOB : TDate read FDOB write FDOB;
  end;

implementation

{ TPerson }

constructor TPerson.Create( const Fullname : string; DOB : TDate );
begin
  inherited Create;
  FFullname := Fullname;
  FDOB := DOB;
end;

end.
Delphi-Quellcode:
unit Address;

interface

type
  TAddress = class
  private
    FStreet : string;
    FZipCode : Integer;
    FCity : string;
  public
    constructor Create( const Street : string; ZipCode : Integer; const City : string );
  published
    property Street : string read FStreet write FStreet;
    property ZipCode : Integer read FZipCode write FZipCode;
    property City : string read FCity write FCity;
  end;

implementation

{ TAddress }

constructor TAddress.Create( const Street : string; ZipCode : Integer; const City : string );
begin
  inherited Create;
  FStreet := Street;
  FZipCode := ZipCode;
  FCity := City;
end;

end.
Delphi-Quellcode:
unit DataListContainer;

interface

uses
  Contnrs;

type
  TDataColumnDef = record
    Caption : string;
    PropertyName : string;
    Width : Integer;
    Visible : Boolean;
  end;

  TDataColumnDefs = array of TDataColumnDef;

  TDataListContainer = class
  private
    FDataList : TObjectList;
    FColumnDefs : TDataColumnDefs;
  public
    procedure AddColumn( ACaption, APropertyName : string; AWidth : Integer; AVisible : Boolean = true );

    property ColumnDefs : TDataColumnDefs read FColumnDefs;
    property DataList : TObjectList read FDataList write FDataList;
  end;

implementation

{ TDataListContainer }

procedure TDataListContainer.AddColumn( ACaption, APropertyName : string; AWidth : Integer; AVisible : Boolean );
var
  LIdx : Integer;
begin
  LIdx := Length( FColumnDefs );
  SetLength( FColumnDefs, LIdx + 1 );
  FColumnDefs[LIdx].Caption := ACaption;
  FColumnDefs[LIdx].PropertyName := APropertyName;
  FColumnDefs[LIdx].Width := AWidth;
  FColumnDefs[LIdx].Visible := AVisible;
end;

end.
Delphi-Quellcode:
unit DataListToListView;

interface

uses
  {Vcl.} ComCtrls,
  DataListContainer;

procedure PresentData( AListView : TListView; AContainer : TDataListContainer );
procedure PrepareColumns( AListView : TListView; AContainer : TDataListContainer );
procedure FillData( AListView : TListView; AContainer : TDataListContainer );

implementation

uses
  {System.} TypInfo;

procedure PresentData( AListView : TListView; AContainer : TDataListContainer );
begin
  PrepareColumns( AListView, AContainer );
  FillData( AListView, AContainer );
end;

procedure PrepareColumns( AListView : TListView; AContainer : TDataListContainer );
var
  LCount : Integer;
  LIdx : Integer;
  LColumn : TListColumn;
begin
  AListView.Columns.BeginUpdate;
  try

    LCount := Length( AContainer.ColumnDefs );

    // Spalten hinzufügen, wenn nicht ausreichend vorhanden
    while AListView.Columns.Count < LCount do
      AListView.Columns.Add;

    for LIdx := 0 to AListView.Columns.Count - 1 do
      begin
        LColumn := AListView.Columns.Items[LIdx];
        if LIdx < LCount
        then
          begin
            LColumn.Caption := AContainer.ColumnDefs[LIdx].Caption;
            if AContainer.ColumnDefs[LIdx].Visible
            then
              LColumn.Width := AContainer.ColumnDefs[LIdx].Width
            else
              LColumn.Width := 0;
          end
        else
          begin
            LColumn.Caption := '';
            LColumn.Width := 0;
          end;
      end;

  finally
    AListView.Columns.EndUpdate;
  end;
end;

procedure FillData( AListView : TListView; AContainer : TDataListContainer );
var
  LIdx : Integer;
  LCount : Integer;
  LItem : TListItem;
  LDataItem : TObject;
  LColIdx : Integer;
  LColCount : Integer;
  LPropValue : string;
begin
  AListView.Items.BeginUpdate;
  try

    if Assigned( AContainer.DataList )
    then
      LCount := AContainer.DataList.Count
    else
      LCount := 0;

    if AListView.Items.Count - LCount > LCount
    then
      AListView.Items.Clear;

    // Zeilen hinzufügen, wenn nicht ausreichend vorhanden
    while AListView.Items.Count < LCount do
      AListView.Items.Add;

    // Zeilen entfernen, wenn zuviel
    while AListView.Items.Count > LCount do
      // Löschen immer vom Ende her, das spart Zeit
      AListView.Items.Delete( AListView.Items.Count - 1 );

    for LIdx := 0 to LCount - 1 do
      begin
        LItem := AListView.Items[LIdx];
        LDataItem := AContainer.DataList.Items[LIdx];
        LColCount := Length( AContainer.ColumnDefs );

        // SubItems
        LItem.SubItems.BeginUpdate;
        try
          LItem.SubItems.Clear;

          for LColIdx := 0 to LColCount - 1 do
            begin
              LPropValue := GetPropValue( LDataItem, AContainer.ColumnDefs[LColIdx].PropertyName, True );

              if LColIdx = 0
              then
                // Caption
                LItem.Caption := LPropValue
              else
                LItem.SubItems.Add( LPropValue );

            end;

        finally
          LItem.SubItems.EndUpdate;
        end;
      end;

  finally
    AListView.Items.EndUpdate;
  end;
end;

end.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat