Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

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

AW: String in Array einlesen

  Alt 5. Jun 2013, 10:45
Evtl. handelt es sich hier um das Hummel-Paradoxon.
Mein Code weiß nicht, dass er gar nicht funktionieren darf, und macht es trotzdem

Ein kleines Testprogramm mit und ohne Generics
Delphi-Quellcode:
program ListSort;

{$APPTYPE CONSOLE}
{$R *.res}
// Generics-Switch
{$IF CompilerVersion>=20}
{$DEFINE GENERICS}
{$IFEND}
//

uses
{$IFDEF GENERICS}
  System.Generics.Defaults,
  System.Generics.Collections,
{$ENDIF}
  Classes,
  SysUtils;

type
  PMyData = ^TMyData;

  TMyData = record
    Col1, Col2, Col3 : string;
  end;

{$IFDEF GENERICS}

procedure WriteList( AList : TList<TMyData> );
var
  LIdx : Integer;
begin
  for LIdx := 0 to AList.Count - 1 do
    Writeln( AList[LIdx].Col1, ',', AList[LIdx].Col2, ',', AList[LIdx].Col3 );
end;

procedure Test;
var
  LList : TList<TMyData>;
  LRec : TMyData;
begin
  Writeln( 'Generic Version' );
  Writeln;

  LList := TList<TMyData>.Create;
  try
    // Add Data

    LRec.Col1 := 'a';
    LRec.Col3 := 'c';

    LRec.Col2 := 'z';
    LList.Add( LRec );

    LRec.Col2 := 'a';
    LList.Add( LRec );

    LRec.Col2 := 'm';
    LList.Add( LRec );

    // Output Data
    Writeln( 'Before Sort' );
    WriteList( LList );
    Writeln;

    // Sort Data

    LList.Sort( TComparer<TMyData>.Construct(
      function( const Left, Right : TMyData ) : Integer
      begin
        Result := CompareStr( Left.Col2, Right.Col2 );
      end ) );

    // Output Data
    Writeln( 'After Sort' );
    WriteList( LList );
    Writeln;

  finally
    LList.Free;
  end;
end;

{$ELSE}

function CompareMyDataCol2( Item1, Item2 : Pointer ) : Integer;
begin
  Result := CompareStr( PMyData( Item1 ).Col2, PMyData( Item2 ).Col2 );
end;

procedure WriteList( AList : TList );
var
  LIdx : Integer;
begin
  for LIdx := 0 to AList.Count - 1 do
    Writeln( PMyData( AList[LIdx] ).Col1, ',', PMyData( AList[LIdx] ).Col2, ',', PMyData( AList[LIdx] ).Col3 );
end;

procedure AddData( AList : TList; ARec : TMyData );
var
  LNewRec : PMyData;
begin
  New( LNewRec );
  LNewRec^ := ARec;
  AList.Add( LNewRec );
end;

procedure Test;
var
  LList : TList;
  LRec : TMyData;
begin
  Writeln( 'NON-Generic Version' );
  Writeln;

  LList := TList.Create;
  try

    // Add Data

    LRec.Col1 := 'a';
    LRec.Col3 := 'c';

    LRec.Col2 := 'z';
    AddData( LList, LRec );

    LRec.Col2 := 'a';
    AddData( LList, LRec );

    LRec.Col2 := 'm';
    AddData( LList, LRec );

    // Output Data
    Writeln( 'Before Sort' );
    WriteList( LList );
    Writeln;

    // Sort Data

    LList.Sort( @CompareMyDataCol2 );

    // Output Data
    Writeln( 'After Sort' );
    WriteList( LList );
    Writeln;

  finally
    LList.Free;
  end;
end;
{$ENDIF}

begin
  try

    Test;

  except
    on E : Exception do
      Writeln( E.ClassName, ': ', E.Message );
  end;

  ReadLn;

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