TListSort (Delphi)

From RAD Studio Code Examples
Jump to: navigation, search

Description

The following code sorts the objects in a list in alphabetical order, based on their names. It assumes that the list contains only TMyClass references. The CompareNames function performs the comparisons between objects in the list and is of type TListSortCompare. The list is sorted when you click a button.

Code

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TMyClass = class
    MyString: string;
    constructor Create(S: string);
  end;

var
  Form1: TForm1;
  MyList: TList;

implementation

{$R *.dfm}

constructor TMyClass.Create(S: string);
begin
  inherited Create;
  MyString := S;
end;

procedure DisplayTList(TheList: TList);
var
  B: Byte;
  Y: Word;
  str: string;
  Temp: TMyClass;
begin
    { Now paint the items onto the paintbox. }
    Y := 10;             { Variable used in the TextOut function }
    for B := 0 to (TheList.Count - 1) do
    begin
      Temp:= TheList.Items[B];
      if (Temp is TMyClass) then
      begin
        str:= Temp.MyString;   // Clear string.
        Form1.Canvas.TextOut(10, Y, str);
        Y := Y + 30;  { Increment the Y value again. }
      end;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
  MyObject: TMyClass;
begin
  MyList := TList.Create;              { Create a list. }
  for I := 0 to ComponentCount - 1 do
    begin
      MyObject := TMyClass.Create(Components[I].Name);  { Create a class instance. }
      MyList.Add(MyObject);      { Add the instance to the list. }
    end;
end;

function CompareNames(Item1, Item2: Pointer): Integer;
begin
  Result := CompareText(TMyClass(Item1).MyString, TMyClass(Item2).MyString);
//  MessageDlg('Compare ' + TMyClass(Item1).MyString + ' to ' + TMyClass(Item2).MyString,
//                 mtInformation, [mbOk], 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyList.Sort(@CompareNames);
  Refresh;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var B: Byte; Temp: TMyClass;
begin
    for B := 0 to MyList.Count - 1 do begin
      if MyList.Items [B] is TMyClass then begin
        Temp:= MyList.Items[B] as TMyClass;
        Temp.Free()
      end
    end;
    MyList.Free()                         {Free memory for list}
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  DisplayTList(MyList);
end;

Uses