Hallo zusammen,
ich habe mal meinen originalen Quelltext angepasst um folgendes Beispiel zu posten (deswegen bitte über Variablennamen und Sinnlosigkeit des Quelltextes nicht äußern, mir geht es um das eigentliche Problem):

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Generics.Collections,
  Generics.Defaults, Math, System.Diagnostics;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

type
  TMyNextData8 = packed record
  const
    Ident = 'TMyNextData8';
  public
    a : String[18];
    b : Word;
    c : Word;
  end;

  TMyNextData7 = packed record
  private
  public
    ItemCount: Integer;
    Items : Array[00..09] of TMyNextData8;
  end;

type
  TMyNextData6 = packed record
  const
    Ident = 'TMyNextData6';
  public
    a : LongWord;
    b : String[18];
    c : String[40];
    d : Double;
    e : String[03];
    f : String[04];
    g : String[01];
    h : String[10];
    i : String[01];

    j : LongWord;
    k : String[12];
    l : String[08];
  end;

  TMyNextData5 = packed record
  private
  public
    ItemCount: Integer;
    Items : Array[0..09] of TMyNextData6;
  end;

type
  TMyNextData4 = packed record
  const
    Ident = 'TMyNextData4';
  public
    a: Word;
    b : LongWord;
    c : String[12];
    d : String[12];
    e : String[12];
    f : String[08];
    g : String[10];
    h : LongWord;
  end;

type
  TMyNextData3 = packed record
  const
    MaxAnz = 10;
  private
  public
    ItemCount: Integer;
    Items : Array[00..MaxAnz-1] of TMyNextData4;
  end;

type
  TMyNextData = packed record
  const
    MyStr = 'TMyNextData';
  public
    a : String[16];

    b : TDate;
    c : TTime;
    d : LongWord;

    e : LongWord;
    f : String[12];
    g : String[12];
    h : String[12];
    i : TMyNextData3;

    j : String[06];
    k : String[18];
    l : String[40];
    m : Double;
    n : String[03];
    o : String[04];
    p : String[10];
    q : TMyNextData5;

    r : LongWord;
    s : String[12];

    t : String[08];
    u : String[08];

    v : String[04];
    w : TDate;
    x : String[10];

    y : String[10];
    z : String[01];
    aa : String[01];
    bb : String[10];

    cc : TMyNextData7;

    dd : Array[0..49] of Byte;
  end;

type
  TMyData = packed record
  const
    MyStr = 'TMyData';
  public
    ID : LongWord;
    ID2 : LongWord;
    ID3 : LongWord;
    First : Boolean;
    Second : Boolean;
    Third : Boolean;


    a : LongWord;
    b : LongWord;
    c : Byte;
    d : Byte;
    e : Word;
    f : TMyNextData;

    g : Word;
    h : LongWord;
    i : String[10];
    j : String[18];
    k : Byte;
    l : String[1];
    m : String[10];
    n : LongWord;
    o : TDateTime;

    p,
    q,
    r,
    s,
    t,
    u,
    v,
    w,
    x : Word;

    y : String[10];
    z : String[4];

    aa,
    bb : Byte;

    cc : String[8];

    dd : String[01];
    ee : Word;
    ff : Boolean;

    gg,
    hh : Byte;


    ii : Byte;
    jj : LongWord;

    kk : Word;
    ll : Word;
    mm : Word;
    nn : Array[0..93] of Byte;
    oo : TDateTime;


    pp : TDateTime;
    qq : TDateTime;

    procedure Clear;
  end;

type
  TMyListe = class(TList<TMyData>)
  private
  public
    function GetFirstItems(var aFirstList: TMyListe): Integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  AllDataList : TMyListe;
  FirstList : TMyListe;
  i : Integer;
  aData : TMyData;
  aMes1,
  aMes2 : TStopWatch;
begin
  AllDataList := TMyListe.Create;
  FirstList := TMyListe.Create;

  aMes1.Create;
  aMes1.Reset;
  aMes1.Start;

  try
    //5000 Einträge erstellen (First=True)
    for i := 1 to 5000 do
    begin
      aData.Clear;
      aData.ID := i;
      aData.First := True;

      AllDataList.Add(aData);
    end;

    //5000 Einträge erstellen (First=False)
    for i := 1 to 5000 do
    begin
      aData.Clear;
      aData.ID2 := i;
      aData.First := False;

      AllDataList.Add(aData);
    end;

    //Schritt1: Rootliste füllen
    aMes2.Create;
    aMes2.Reset;
    aMes2.Start;
    AllDataList.GetFirstItems(FirstList);
    aMes2.Stop;

  finally
    if Assigned(FirstList) then
    begin
      FirstList.Clear;
      FreeAndNil(FirstList);
    end;

    if Assigned(AllDataList) then
    begin
      AllDataList.Clear;
      FreeAndNil(AllDataList);
    end;
  end;

  aMes1.Stop;
  ShowMessage('Zeitmessung 1 (s): ' +
               IntToStr(Round(aMes1.ElapsedMilliseconds/1000)));

  ShowMessage('Zeitmessung 2 (s): ' +
               IntToStr(Round(aMes2.ElapsedMilliseconds/1000)));
end;

{ TMyListe }

function TMyListe.GetFirstItems(var aFirstList: TMyListe): Integer;
var
  i: Integer;
  tmpData: TMyData;
begin
  if Assigned(aFirstList) then
  begin
    aFirstList.Clear;
    i := 0;
    while i < Self.Count do
    begin
      if (Self.Items[i].First) then
      begin
        tmpData := Self.Items[i];
        Self.Delete(i);
        aFirstList.Add(tmpData);
      end
      else begin
        inc(i);
      end;
    end;
  end;
  Result := aFirstList.Count;
end;

{ TMyData }

procedure TMyData.Clear;
begin
  FillChar(Self, SizeOf(Self), 0);
end;

end.

Ein einfaches Formular, ein Button drauf und die Routine aufrufen.
Die SizeOf meiner "TMyData" Struktur beträgt 2732 Bytes.

Wenn ich jetzt in der AllDataList meine Testeinträge hinzugefügt habe und möchte dann mit der Funktion "GetFirstItems" nur eine bestimmte Anzahl von diesen Einträgen in einer anderen Liste zurück haben, dann dauert es 11Sekunden auf meinen Rechner, bis die Funktion "GetFirstItems" abgearbeitet wurde. Diese Funktion löscht aus der Originalen Liste und added die Einträge in eine separate Liste.

Könnt ihr mir sagen, was man hier anders machen könnte, damit es schneller geht?
Ich denke eine Liste mit 10000 Einträgen, die dann 5000 davon in eine andere Liste hinzufügt und diese 5000 bei sich löscht, kann doch keine 11 Sekunden dauern oder doch?

Viele Grüße

Benutze Win 8.1 mit XE7

Doch, das kann so lange dauern.

Schliesslich wird hier 2 x 5000 x 2732 Bytes Speicher angefordert und auch wieder freigegeben. Das dauert eben seine Zeit.

Das var in der GetFirstItems ist natürlich Unfug, weil du in der Methode keine neue Liste erzeugst und somit dem Parameter auch keinen Wert zuweist.

Und if Assigned( aFirstList ) kannst du dir auch schenken, denn die Methode wird so trotz allem eine Exception werfen. (s. letzte Zeile der Methode)

Stimmt, bei den beiden Anpassungen hast du natürlich Recht.

Gibt es denn eine Möglichkeit, soetwas schneller zu machen?

Viele Grüße

Ja, kleine Veränderung

zusammenfalten · markieren

Delphi-Quellcode:

unit Types.MyTypes;

interface

uses
  System.Generics.Collections;

type
  TMyNextData8 = packed record
  const
    Ident = 'TMyNextData8';
  public
    a: string[ 18 ];
    b: Word;
    c: Word;
  end;

  TMyNextData7 = packed record
  private
  public
    ItemCount: Integer;
    Items : array [ 00 .. 09 ] of TMyNextData8;
  end;

type
  TMyNextData6 = packed record
  const
    Ident = 'TMyNextData6';
  public
    a: LongWord;
    b: string[ 18 ];
    c: string[ 40 ];
    d: Double;
    e: string[ 03 ];
    f: string[ 04 ];
    g: string[ 01 ];
    h: string[ 10 ];
    i: string[ 01 ];

    j: LongWord;
    k: string[ 12 ];
    l: string[ 08 ];
  end;

  TMyNextData5 = packed record
  private
  public
    ItemCount: Integer;
    Items : array [ 0 .. 09 ] of TMyNextData6;
  end;

type
  TMyNextData4 = packed record
  const
    Ident = 'TMyNextData4';
  public
    a: Word;
    b: LongWord;
    c: string[ 12 ];
    d: string[ 12 ];
    e: string[ 12 ];
    f: string[ 08 ];
    g: string[ 10 ];
    h: LongWord;
  end;

type
  TMyNextData3 = packed record
  const
    MaxAnz = 10;
  private
  public
    ItemCount: Integer;
    Items : array [ 00 .. MaxAnz - 1 ] of TMyNextData4;
  end;

type
  TMyNextData = packed record
  const
    MyStr = 'TMyNextData';
  public
    a: string[ 16 ];

    b: TDate;
    c: TTime;
    d: LongWord;

    e: LongWord;
    f: string[ 12 ];
    g: string[ 12 ];
    h: string[ 12 ];
    i: TMyNextData3;

    j: string[ 06 ];
    k: string[ 18 ];
    l: string[ 40 ];
    m: Double;
    n: string[ 03 ];
    o: string[ 04 ];
    p: string[ 10 ];
    q: TMyNextData5;

    r: LongWord;
    s: string[ 12 ];

    t: string[ 08 ];
    u: string[ 08 ];

    v: string[ 04 ];
    w: TDate;
    x: string[ 10 ];

    y : string[ 10 ];
    z : string[ 01 ];
    aa: string[ 01 ];
    bb: string[ 10 ];

    cc: TMyNextData7;

    dd: array [ 0 .. 49 ] of Byte;
  end;

type
  TMyData = packed record
  const
    MyStr = 'TMyData';
  public
    ID : LongWord;
    ID2 : LongWord;
    ID3 : LongWord;
    First : Boolean;
    Second: Boolean;
    Third : Boolean;

    a: LongWord;
    b: LongWord;
    c: Byte;
    d: Byte;
    e: Word;
    f: TMyNextData;

    g: Word;
    h: LongWord;
    i: string[ 10 ];
    j: string[ 18 ];
    k: Byte;
    l: string[ 1 ];
    m: string[ 10 ];
    n: LongWord;
    o: TDateTime;

    p, q, r, s, t, u, v, w, x: Word;

    y: string[ 10 ];
    z: string[ 4 ];

    aa, bb: Byte;

    cc: string[ 8 ];

    dd: string[ 01 ];
    ee: Word;
    ff: Boolean;

    gg, hh: Byte;

    ii: Byte;
    jj: LongWord;

    kk: Word;
    ll: Word;
    mm: Word;
    nn: array [ 0 .. 93 ] of Byte;
    oo: TDateTime;

    pp: TDateTime;
    qq: TDateTime;

    procedure Clear;
  end;

type
  TMyListe = class( TList<TMyData> )
  private
  public
    function GetFirstItems( var aFirstList: TMyListe ): Integer;
  end;

implementation

{ TMyListe }

function TMyListe.GetFirstItems( var aFirstList: TMyListe ): Integer;
var
  i : Integer;
  tmpData: TMyData;
begin
  if Assigned( aFirstList )
  then
    begin
      aFirstList.Clear;
      i := 0;
      while i < Self.Count do
        begin
          if ( Self.Items[ i ].First )
          then
            begin
              tmpData := Self.Items[ i ];
              Self.Delete( i );
              aFirstList.Add( tmpData );
            end
          else
            begin
              inc( i );
            end;
        end;
    end;
  Result := aFirstList.Count;
end;

{ TMyData }

procedure TMyData.Clear;
begin
  FillChar( Self, SizeOf( Self ), 0 );
end;

end.

zusammenfalten · markieren

Delphi-Quellcode:

unit Types.MyClassTypes;

interface

uses
  System.Generics.Collections,
  System.SysUtils,
  Types.MyTypes;

type
  TMyDataObj = class
  const
    MyStr = 'TMyDataObj';
  public
    ID : LongWord;
    ID2 : LongWord;
    ID3 : LongWord;
    First : Boolean;
    Second: Boolean;
    Third : Boolean;

    a: LongWord;
    b: LongWord;
    c: Byte;
    d: Byte;
    e: Word;
    f: TMyNextData;

    g: Word;
    h: LongWord;
    i: string[ 10 ];
    j: string[ 18 ];
    k: Byte;
    l: string[ 1 ];
    m: string[ 10 ];
    n: LongWord;
    o: TDateTime;

    p, q, r, s, t, u, v, w, x: Word;

    y: string[ 10 ];
    z: string[ 4 ];

    aa, bb: Byte;

    cc: string[ 8 ];

    dd: string[ 01 ];
    ee: Word;
    ff: Boolean;

    gg, hh: Byte;

    ii: Byte;
    jj: LongWord;

    kk: Word;
    ll: Word;
    mm: Word;
    nn: array [ 0 .. 93 ] of Byte;
    oo: TDateTime;

    pp: TDateTime;
    qq: TDateTime;

  end;

type
  TMyObjListe = class( TObjectList<TMyDataObj> )
  private
  public
    function GetFirstItems( const aFirstList: TMyObjListe ): Integer;
  end;

implementation

{ TMyObjListe }

function TMyObjListe.GetFirstItems( const aFirstList: TMyObjListe ): Integer;
var
  i : Integer;
  tmpData: TMyDataObj;
begin
  if not Assigned( aFirstList )
  then
    raise EArgumentNilException.Create( 'aFirstList' );

  aFirstList.Clear;
  i := 0;
  while i < Self.Count do
    begin
      if ( Self.Items[ i ].First )
      then
        begin
          tmpData := Self.Items[ i ];
          aFirstList.Add( Self.Extract( tmpData ) );
        end
      else
        begin
          inc( i );
        end;
    end;
  Result := aFirstList.Count;
end;

end.

Und nun

zusammenfalten · markieren

Delphi-Quellcode:

unit Forms.MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class( TForm )
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click( Sender: TObject );
    procedure Button2Click( Sender: TObject );
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  System.Diagnostics,
  Types.MyTypes, Types.MyClassTypes;

procedure TForm1.Button1Click( Sender: TObject );
var
  AllDataList : TMyListe;
  FirstList : TMyListe;
  i : Integer;
  aData : TMyData;
  aMes1, aMes2: TStopWatch;
begin
  AllDataList := TMyListe.Create;
  FirstList := TMyListe.Create;

  aMes1.Create;
  aMes1.Reset;
  aMes1.Start;

  try
    // 5000 Einträge erstellen (First=True)
    for i := 1 to 5000 do
      begin
        aData.Clear;
        aData.ID := i;
        aData.First := True;

        AllDataList.Add( aData );
      end;

    // 5000 Einträge erstellen (First=False)
    for i := 1 to 5000 do
      begin
        aData.Clear;
        aData.ID2 := i;
        aData.First := False;

        AllDataList.Add( aData );
      end;

    // Schritt1: Rootliste füllen
    aMes2.Create;
    aMes2.Reset;
    aMes2.Start;
    AllDataList.GetFirstItems( FirstList );
    aMes2.Stop;

  finally
    if Assigned( FirstList )
    then
      begin
        FirstList.Clear;
        FreeAndNil( FirstList );
      end;

    if Assigned( AllDataList )
    then
      begin
        AllDataList.Clear;
        FreeAndNil( AllDataList );
      end;
  end;

  aMes1.Stop;
  ShowMessage( 'Zeitmessung 1 (s): ' + IntToStr( Round( aMes1.ElapsedMilliseconds / 1000 ) ) );

  ShowMessage( 'Zeitmessung 2 (s): ' + IntToStr( Round( aMes2.ElapsedMilliseconds / 1000 ) ) );
end;

procedure TForm1.Button2Click( Sender: TObject );
var
  AllDataList : TMyObjListe;
  FirstList : TMyObjListe;
  i : Integer;
  aData : TMyDataObj;
  aMes1, aMes2: TStopWatch;
begin
  AllDataList := TMyObjListe.Create( True );
  FirstList := TMyObjListe.Create( True );

  aMes1.Create;
  aMes1.Reset;
  aMes1.Start;

  try
    // 5000 Einträge erstellen (First=True)
    for i := 1 to 5000 do
      begin
        aData := TMyDataObj.Create;
        aData.ID := i;
        aData.First := True;

        AllDataList.Add( aData );
      end;

    // 5000 Einträge erstellen (First=False)
    for i := 1 to 5000 do
      begin
        aData := TMyDataObj.Create;
        aData.ID2 := i;
        aData.First := False;

        AllDataList.Add( aData );
      end;

    // Schritt1: Rootliste füllen
    aMes2.Create;
    aMes2.Reset;
    aMes2.Start;
    AllDataList.GetFirstItems( FirstList );
    aMes2.Stop;

  finally
    FreeAndNil( FirstList );
    FreeAndNil( AllDataList );
  end;

  aMes1.Stop;
  ShowMessage( 'Zeitmessung 1 (s): ' + IntToStr( Round( aMes1.ElapsedMilliseconds / 1000 ) ) );

  ShowMessage( 'Zeitmessung 2 (s): ' + IntToStr( Round( aMes2.ElapsedMilliseconds / 1000 ) ) );
end;

end.

dauert das nur noch 0 Sekunden

Schneller gehts nicht, aber ich sehe es schon:
"Ich muss aber bei packed records bleiben!"

Stimmt
Sorry für meine unprofessionelle konkretisierte Fragestellung

Ich benötige ein packed record.

Also ich würde mich freuen, wenn ihr eine schnellere Variante mit packed records hättet bzw. mir vorschlagen könntet

Viele Grüße

Zitat von TiGü:

Schneller gehts nicht, aber ich sehe es schon:
"Ich muss aber bei packed records bleiben!"

Jepp.