sortering af multi array

Her er kode som viser hvordan man sorterer et 2D array af integers
efter kolonnen med index 3:

program MultiDimSort;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  mda = array of array of integer;

procedure init(var a : mda; n, m : integer);

var
  i, j : integer;

begin
  randomize;
  setlength(a, n);
  for i := low(a) to high(a) do begin
      setlength(a[i], m);
      for j := low(a[i]) to high(a[i]) do begin
        a[i,j] := random(100);
      end;
  end;
end;

procedure print(var a : mda);

var
  i, j : integer;

begin
  for i := low(a) to high(a) do begin
      for j := low(a[i]) to high(a[i]) do begin
        write(' ', a[i,j]);
      end;
      writeln;
  end;
end;

procedure sort(var a : mda);

var
  i, j, k, tmp : integer;

begin
  for i := low(a) to (high(a) - 1) do begin
      for j := (i + 1) to high(a) do begin
        if a[i,3] > a[j,3] then begin
            for k := low(a[i]) to high(a[i]) do begin
              tmp := a[i,k];
              a[i,k] := a[j,k];
              a[j,k] := tmp;
            end;
        end;
      end;
  end;
end;

var
  a : mda;

begin
  init(a, 10, 5);
  writeln('before');
  print(a);
  sort(a);
  writeln('after');
  print(a);
end.

Hvorfor lave det på den måde? Hvorfor ikke lave et TPerson objekt og fylde dem ind i en TObjectList (jeg gentager mig selv, ved det godt). Nedenstående genererer en liste på grundlag af resultatet af aQDOQuery.

Din Person Unit:
----------------

type
  TPerson = class
  private
    fID : integer;
    fName : string;
  public
    constructor Create(aId : integer; aName : string);
    property ID : integer read fID;
    property Name : string read fName;
  end;

  TPersonList = class(TObjectList)
  private
    function GetPerson(aIndex : integer) : TPerson;
  public
    constructor Create(aQuery : TADOQuery);
    destructor Destroy; override;
    procedure Sort;
    property Items[aIndex : integer] : TPerson read GetPerson; default;
  end;

implementation

constructor TPerson.Create(aId : integer; aName : string);
begin
  inherited Create;
  fID := aID;
  fName := aName;
end;

function TPersonList.GetPerson(aIndex : integer) : TPerson;
begin
  result := TPerson(inherited Items[aIndex]);
end;

constructor TPersonList.Create(aQuery : TADOQuery);
begin
  inherited Create;

  aQuery.First;
  while not aQuery.Eof do begin
    Add(TPerson.Create(aQuery.FieldByName('ID').AsInteger,
                      aQuery.FieldByName('Name').AsString));
    aQuery.Next;
  end; // while
end;

function SortPerson(aItem1, aItem2 : pointer) : integer;
var
  p1, p2 : TPerson;
begin
  p1 := aItem1; p2 := aItem2;

  if p1.Name < p2.Name then // First try sorting by name
    result := 1
  else if p1.Name > p2.Name then
    result := -1
  else begin // If same the try sort by ID
    if p1.ID < p2.ID then
      result := 1
    else if p2.ID > p2.ID then
      result := -1
    else // The're alike.
      result := 0;
  end;
end;

procedure TPersonList.Sort;
begin
  inherited Sort(SortPerson);
end;

------------------ o ------------------

Din mainform:
-------------

type

  TForm1 = class(TForm)
    Button1 : TButton;

    procedure OnCreate(aOwner : TObject); // OnCreate event
    procedure OnDestroy(aOwner : TObject); // OnDestroy event
    procedure OnButtonClick(aOwner : TObject); // a Button click
    ...
  private
    fPersonList : TPersonList;
  end;

implementation

procedure Form1.OnCreate(aOwner : TObject);
begin
  try
    ADOQuery1.Sql := 'select id, name from person order by name, id';
    ADOQuery1.Open;

    fPersonList := TPersonList.Create(ADOQuery1);
  finally
    ADOQuery.Close;
  end;
end;

procedure Form1.OnDestroy(aOwner : TObject);
begin
  fPersonList.Free;
end;

procedure Form1.OnButtonClick(aOwner : TObject);
var
  i : integer;
  Person : TPerson;
begin
  fPersonList.Sort; // Sort the list...

  for i := 0 to fPersonList.Count - 1 do begin
    Person := fPersonList[i];
    Memo1.Lines.Add(format('%d: %s',[Person.Id,Person.Name]));
  end; // for
end;

Det er noget smukkere end den løsning du har valgt og den er meget, meget mere fleksibel, hvis f.eks. du vil tilføje et adresse felt. Selvom det er simpel indkapsling, så ser det helt objektorienteret ud.

Du må endelig spørge løs hvis du er interesseret i løsningen. Der jeg er meget glad for at vise denne løsning (som jeg har gjort 1-2 allerede).

Humlen i ovenstående eksempel er den lille funktion: SortPerson som ikke hører til klasserne. Den fodrer man fObjectList.Sort-proceduren og så sorteres listen - lynhurtigt.

Idet du skal have listen sorteret efter id og navn (i den rækkefølge) så skal SortPerson se sådan her ud:

function SortPerson(aItem1, aItem2 : pointer) : integer;
var
  p1, p2 : TPerson;
begin
  p1 := aItem1; p2 := aItem2;

  // First compare ID's
  if p1.ID < p2.ID then
    result := 1
  else if p2.ID > p2.ID then
    result := -1
  else begin // The're alike. Try names instead.
    if p1.Name < p2.Name then
      result := 1
    else if p1.Name > p2.Name then
      result := -1
    else
      result := 0;
  end;
end;

Endelig skal SQL.scriptet ændres til:

  ADOQuery1.Sql := 'select id, name from person order by id, name';

Egentlig burde TPersonList.Create kaldes med TADOConnection så objektet kunne oprette en TADOQuery selv - den behøver ikke findes på mainform'en.

Det gik vist lidt hurtigt med en af de afsluttende kommentarer: Du må endelig spørge løs hvis du er interesseret i løsningen, da jeg er meget glad for at vise denne løsning (som jeg har gjort det 1-2 gange allerede).

I øvrigt: TObjectList findes i ContNrs.

PUha.. jeg ved næsten ikke hvor jeg skal begynde..

Først vil jeg lige prøve at nørkle lidt med det selv.. også vil jeg vende tilbage.. med nogle mere præcise spørgsmål. Jeg har aldrig prøvet at kode på denne facon - men det ser smart ud.!

Tror det kaldes let objektorienteret programmering ;-) Der er mange forskellige lister i Delphi og TObjectList er en af de bedre. Når du nedlægger den, så fjernes objekterne på listen automatisk. Det mest normale alternativ er TList'en, men her skal man selv frigive de objekter der må sidde på listen:

destructor MyList.Destroy()
var
  i : integer;
begin
  try
    for i := Count - 1 downto 0 do
      TObject(Items[i]).Free;
  finally
    inherited;
  end;
end;

De andre steder hvor der slettes (delete og remove) skal man lave samme operation på en nedarvet klasse.

Eneste anke med TObjectList er at dens constructor tager en boolsk parameter der angiver om listen ejer de objekter man hælder i den eller om de frigives andetsteds.
Har kigget i VCL-koden og den har p.t. ingen betydning. Ulempen er, at det kan den pludselig få og man skal være opmærksom på dette ved opdatering. Jeg burde have oprettet sådan: fPersonList := TPersonList.Create(true); men det glemte jeg.

Jeg kan godt sende dig et eksempel hvis du vil se det (uden ADO), men med en liste over drenge og pigenavne. Skriv til: hrc_public snabela hotmail dot com