泛型排序器 TComparer

2024-01-16 08:05:34

泛型排序器 TComparer

测试代码文件:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Generics.Collections, Generics.Defaults; {必需的泛型单元}

//构建由 10 个整数组成的动态数组, 然后排序
procedure TForm1.Button1Click(Sender: TObject);
var
  arr: array of Integer;
  i: Integer;
begin
  {构建动态数组}
  Randomize;
  for i := 0 to 9 do begin
    SetLength(arr, Length(arr)+1);
    arr[i] := Random(10);
  end;

  {显示排序前}
  Memo1.Clear;
  for i := 0 to Length(arr) - 1 do Memo1.Lines.Add(IntToStr(arr[i]));

  {排序}
  TArray.Sort<Integer>(arr); {它可以有 1个、2个、4个参数, 这里只用了一个参数, 其他是默认参数}

  {显示排序结果}
  Memo2.Clear;
  for i := 0 to Length(arr) - 1 do Memo2.Lines.Add(IntToStr(arr[i]));
end;

// TArray.Sort 的第二个参数是 IComparer<T> 类型, 其默认值是: TComparer<T>.Default
procedure TForm1.Button2Click(Sender: TObject);
var
  arr: array of Integer;
  i: Integer;
begin
  Randomize;
  for i := 0 to 9 do begin
    SetLength(arr, Length(arr)+1);
    arr[i] := Random(10);
  end;

  Memo1.Clear;
  for i := 0 to Length(arr) - 1 do Memo1.Lines.Add(IntToStr(arr[i]));

  {使用了排序器的默认值排序, 这和忽略这个参数是一样的}
  TArray.Sort<Integer>(arr, TComparer<Integer>.Default);
  Memo2.Clear;
  for i := 0 to Length(arr) - 1 do Memo2.Lines.Add(IntToStr(arr[i]));
end;

//同上两例, 变通了一下写法
procedure TForm1.Button3Click(Sender: TObject);
var
  arr: array of Integer;
  i: Integer;
  Comparer: IComparer<Integer>;
begin
  Randomize;
  for i := 0 to 9 do begin
    SetLength(arr, Length(arr)+1);
    arr[i] := Random(10);
  end;

  Memo1.Clear;
  for i := 0 to Length(arr) - 1 do Memo1.Lines.Add(IntToStr(arr[i]));

  Comparer := TComparer<Integer>.Default;
  TArray.Sort<Integer>(arr, Comparer);
  Memo2.Clear;
  for i := 0 to Length(arr) - 1 do Memo2.Lines.Add(IntToStr(arr[i]));
end;

// TArray.Sort 的后面两个参数可以指定排序范围:
procedure TForm1.Button4Click(Sender: TObject);
var
  arr: array of Integer;
  i: Integer;
  Comparer: IComparer<Integer>;
begin
  Randomize;
  for i := 0 to 9 do begin
    SetLength(arr, Length(arr)+1);
    arr[i] := Random(10);
  end;

  Memo1.Clear;
  for i := 0 to Length(arr) - 1 do Memo1.Lines.Add(IntToStr(arr[i]));

  Comparer := TComparer<Integer>.Default;
  {这里指定从第 1 个元素开始, 只给 3 个元素排序}
  TArray.Sort<Integer>(arr, Comparer, 0, 3);
  Memo2.Clear;
  for i := 0 to Length(arr) - 1 do Memo2.Lines.Add(IntToStr(arr[i]));
end;

//如果要倒排序, 可以建立自己的排序器, 下面就是先构建并实现了一个 TMyComparer, 然后调用:
type
  TMyComparer = class(TComparer<Integer>)
  public
    function Compare(const Left, Right: Integer): Integer; override;
  end;

{ TMyComparer }
function TMyComparer.Compare(const Left, Right: Integer): Integer;
begin
  Result := Right - Left;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  arr: array of Integer;
  i: Integer;
  Comparer: TMyComparer;
begin
  Randomize;
  for i := 0 to 9 do begin
    SetLength(arr, Length(arr)+1);
    arr[i] := Random(10);
  end;

  Memo1.Clear;
  for i := 0 to Length(arr) - 1 do Memo1.Lines.Add(IntToStr(arr[i]));

  Comparer := TMyComparer.Create;
  TArray.Sort<Integer>(arr, Comparer);
  Memo2.Clear;
  for i := 0 to Length(arr) - 1 do Memo2.Lines.Add(IntToStr(arr[i]));
  Comparer.Free;
end;


// 也可以用 TComparer<T>.Construct 方法, 通过一个 TComparison 格式的函数构建排序器, 这样简单一些
function MyFunc1(const Left, Right: Integer): Integer;
begin
  Result := Right - Left;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  arr: array of Integer;
  i: Integer;
  Comparer: IComparer<Integer>;
begin
  Randomize;
  for i := 0 to 9 do begin
    SetLength(arr, Length(arr)+1);
    arr[i] := Random(10);
  end;

  Memo1.Clear;
  for i := 0 to Length(arr) - 1 do Memo1.Lines.Add(IntToStr(arr[i]));

  Comparer := TComparer<Integer>.Construct(MyFunc1);
  TArray.Sort<Integer>(arr, Comparer);
  Memo2.Clear;
  for i := 0 to Length(arr) - 1 do Memo2.Lines.Add(IntToStr(arr[i]));
end;


//如果是给自定义类型的元素排序, 只能是自建排序器
type
  TPerson = record
    name: string;
    age: Word;
  end;

function MyFunc2(const Left, Right: TPerson): Integer;
begin
  Result := Left.age - Right.age;
end;

procedure TForm1.Button7Click(Sender: TObject);
var
  arr: array of TPerson;
  i: Integer;
  Comparer: IComparer<TPerson>;
begin
  SetLength(arr, 4);
  arr[0].name := 'AA'; arr[0].age := 22;
  arr[1].name := 'BB'; arr[1].age := 33;
  arr[2].name := 'CC'; arr[2].age := 44;
  arr[3].name := 'DD'; arr[3].age := 11;

  Memo1.Clear;
  for i := 0 to Length(arr) - 1 do
    Memo1.Lines.Add(Format('%s : %d', [arr[i].name, arr[i].age]));

  Comparer := TComparer<TPerson>.Construct(MyFunc2);
  TArray.Sort<TPerson>(arr, Comparer);
  Memo2.Clear;
  for i := 0 to Length(arr) - 1 do
    Memo2.Lines.Add(Format('%s : %d', [arr[i].name, arr[i].age]));
end;

// TStringComparer.Ordinal 是官方实现的用于 string 的排序器, 可直接使用.
//但它好像有问题(Delphi 2010 - 14.0.3513.24210), 以后的版本应该能改过来.
procedure TForm1.Button8Click(Sender: TObject);
var
  arr: array of string;
  i: Integer;
begin
  SetLength(arr, 4);
  arr[0] := '222';
  arr[1] := '111';
  arr[2] := 'bbb';
  arr[3] := 'aaa';

  Memo1.Clear;
  for i := 0 to Length(arr) - 1 do Memo1.Lines.Add(arr[i]);

  TArray.Sort<string>(arr, TStringComparer.Ordinal);
  Memo2.Clear;
  for i := 0 to Length(arr) - 1 do Memo2.Lines.Add(arr[i]);
end;

//下面是实现字符串数组的到排序
function MyComparerFunc(const s1,s2: string): Integer;
begin
  Result := CompareText(s2, s1);
  //Result := -CompareText(s1, s2); {或者这样}
end;

procedure TForm1.Button9Click(Sender: TObject);
var
  arr: array of string;
  i: Integer;
  Comparer: IComparer<string>;
begin
  Memo1.Clear;
  Memo1.Lines.CommaText := '11,33,22,AAA,CCC,BBB';
  SetLength(arr, Memo1.Lines.Count);
  for i := 0 to Length(arr) - 1 do arr[i] := Memo1.Lines[i];

  Comparer := TComparer<string>.Construct(MyComparerFunc);
  TArray.Sort<string>(arr, Comparer);

  Memo2.Clear;
  for i := 0 to Length(arr) - 1 do Memo2.Lines.Add(arr[i]);
end;

//可以把上一个程序简写为:
procedure TForm1.Button10Click(Sender: TObject);
var
  arr: array of string;
  i: Integer;
  Comparer: IComparer<string>;
begin
  Memo1.Clear;
  Memo1.Lines.CommaText := '11,33,22,AAA,CCC,BBB';
  SetLength(arr, Memo1.Lines.Count);
  for i := 0 to Length(arr) - 1 do arr[i] := Memo1.Lines[i];

  Comparer := TComparer<string>.Construct(
    function (const s1,s2: string): Integer
    begin
      Result := CompareText(s2, s1);
    end);
  TArray.Sort<string>(arr, Comparer);

  Memo2.Clear;
  for i := 0 to Length(arr) - 1 do Memo2.Lines.Add(arr[i]);
end;

end.

测试窗体文件(之所以附上窗体文件, 是为了再次测试方便):
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 321
  ClientWidth = 318
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 0
    Top = 0
    Width = 89
    Height = 321
    Align = alLeft
    Lines.Strings = (
      'Memo1')
    TabOrder = 0
    ExplicitHeight = 299
  end
  object Button1: TButton
    Left = 120
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 120
    Top = 39
    Width = 75
    Height = 25
    Caption = 'Button2'
    TabOrder = 2
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 120
    Top = 70
    Width = 75
    Height = 25
    Caption = 'Button3'
    TabOrder = 3
    OnClick = Button3Click
  end
  object Memo2: TMemo
    Left = 219
    Top = 0
    Width = 99
    Height = 321
    Align = alRight
    Lines.Strings = (
      'Memo2')
    TabOrder = 4
    ExplicitHeight = 299
  end
  object Button4: TButton
    Left = 120
    Top = 101
    Width = 75
    Height = 25
    Caption = 'Button4'
    TabOrder = 5
    OnClick = Button4Click
  end
  object Button5: TButton
    Left = 120
    Top = 132
    Width = 75
    Height = 25
    Caption = 'Button5'
    TabOrder = 6
    OnClick = Button5Click
  end
  object Button6: TButton
    Left = 120
    Top = 163
    Width = 75
    Height = 25
    Caption = 'Button6'
    TabOrder = 7
    OnClick = Button6Click
  end
  object Button7: TButton
    Left = 120
    Top = 194
    Width = 75
    Height = 25
    Caption = 'Button7'
    TabOrder = 8
    OnClick = Button7Click
  end
  object Button8: TButton
    Left = 120
    Top = 225
    Width = 75
    Height = 25
    Caption = 'Button8'
    TabOrder = 9
    OnClick = Button8Click
  end
  object Button9: TButton
    Left = 120
    Top = 256
    Width = 75
    Height = 25
    Caption = 'Button9'
    TabOrder = 10
    OnClick = Button9Click
  end
  object Button10: TButton
    Left = 120
    Top = 287
    Width = 75
    Height = 25
    Caption = 'Button10'
    TabOrder = 11
    OnClick = Button10Click
  end
end
posted on 2009-10-10 16:53  万一  阅读(4714)  评论(5)  编辑  收藏
上一篇：CentOS7上部署Ghost博客系统


下一篇：远航技术 Ghost Win10 LTSC 纯净版/装机版 2020.11.14