Delphi 是否可以使用自定义排序比较器对TListBox进行排序？

我需要对我的TListBox进行排序，但我意识到如果我说制作一个TStringList，对它进行排序，然后将这些项目复制到Listbox中，那么修改我的代码需要做很多工作。这需要大量工作的主要原因是，我在代码中有许多地方修改了列表框的内容，我想我必须对它们进行编辑，以便在添加、删除或其他内容时强制进行排序

我更倾向于使用自定义排序逻辑将方法附加到列表框中进行排序

---

这有可能吗？

如果您使用的是Delphi XE或更高版本，我有一个可能性

请注意，我说的是“可能性”，而不是“解决方案”，因为它比其他任何东西都更像是一种黑客行为，我不会在生产代码中真正批准它，除非它是最后的手段

据我所知，您实际上试图实现的是重写Add函数的行为（这是虚拟的），使其基于自定义顺序插入到正确的位置。（如果还需要替代插入，也可以使用此选项）。如果有可能覆盖TStrings后代TListbox的使用，那将很简单，但我们没有那么幸运

DelphiXE引入了一个名为TVirtualMethodInterceptor（Rtti单元）的新类，该类允许拦截虚拟方法来执行我们想用它执行的任何操作。我们可以检查和修改参数，调用其他函数，或者随意取消调用而什么也不做

下面是我制作的概念验证的样子：

//type
//  TCompareFunc<T1> = reference to function (const Arg1, Arg2 : T1) : Integer;
procedure TForm4.FormCreate(Sender: TObject);
var vCompareFunc : TCompareFunc<string>;
    RttiContext : TRttiContext;
    vAddMethod  : TRttiMethod;
    vRttiType : TRttiType;
begin
  RttiContext := TRttiContext.Create;
  vRttiType := RttiContext.GetType(TStrings);
  vAddMethod := vRttiType.GetMethod('Add');

  vCompareFunc :=  MyCompareFunc;
  Fvmi := TVirtualMethodInterceptor.Create(Listbox1.Items.ClassType);

  Fvmi.OnBefore :=   procedure(Instance: TObject; Method: TRttiMethod;
                        const Args: TArray<TValue>; out DoInvoke: Boolean; out Result: TValue)
                      var
                        idx : Integer;
                      begin
                        if Method = vAddMethod then
                        begin //if it's the Add method, map it to Insert at the right position
                          DoInvoke := False;
                          BinarySearch(TStrings(Instance), Args[0].AsString, vCompareFunc,idx);
                          TStrings(Instance).Insert(idx, Args[0].AsString);
                        end;
                      end;


  Fvmi.Proxify(Listbox1.Items);

end;

//类型
//TCompareFunc=对函数的引用（常量Arg1，Arg2:T1）：整数；
程序TForm4.FormCreate（发送方：TObject）；
var vCompareFunc:TCompareFunc；
RttiContext:TRttiContext；
vadd法：trtti法；
vRttiType:TRttiType；
开始
RttiContext:=TRttiContext.Create；
vRttiType:=RttiContext.GetType（TStrings）；
vAddMethod:=vRttiType.GetMethod（'Add'）；
vCompareFunc:=MyCompareFunc；
Fvmi:=TVirtualMethodInterceptor.Create（Listbox1.Items.ClassType）；
Fvmi.OnBefore:=过程（实例：TObject；方法：TRttiMethod；
常量参数：TArray；out-DoInvoke:Boolean；out-Result:TValue）
变量
idx：整数；
开始
如果Method=vAddMethod，则
开始//如果是Add方法，请将其映射到正确位置的Insert
DoInvoke:=假；
BinarySearch（TStrings（实例），Args[0]。AsString，vCompareFunc，idx）；
TStrings（Instance）.Insert（idx，Args[0].AsString）；
结束；
结束；
Fvmi.Proxify（列表框1.项目）；
结束；

此概念验证拦截对TStrings.add的调用，并将其映射到binarysearch/Insert，以便列表中的项始终按正确的顺序排列。这不会覆盖Insert或Assign函数，也不会覆盖修改列表的任何其他函数。如果您想使用这种方法，您需要覆盖所有“违规”函数

免责声明：由于我从未真正使用过这一技巧，所以不要把这个例子当作TVirtualMethodInterceptor用法的黄金法则。它确实有效，但可能会对性能产生影响，或者其他我不知道的影响

需要提及的一个要点（来自巴里·凯利的博客，见下文）

但是，TVirtualMethodInterceptor类没有一件事， 是一种解开（解除锁定）对象的方法。如果对象永远不存在 解除挂钩，重要的是物体不会比目标寿命长 拦截器，因为拦截器需要分配可执行文件 内存，以创建它重定向的小存根 方法调用事件

如果你想深入挖掘，这里有一篇关于这个主题的不错的文章：

---

如果您使用的是Delphi XE或更高版本，我有一个可能性

请注意，我说的是“可能性”，而不是“解决方案”，因为它比其他任何东西都更像是一种黑客行为，我不会在生产代码中真正批准它，除非它是最后的手段

据我所知，您实际上试图实现的是重写Add函数的行为（这是虚拟的），使其基于自定义顺序插入到正确的位置。（如果还需要替代插入，也可以使用此选项）。如果有可能覆盖TStrings后代TListbox的使用，那将很简单，但我们没有那么幸运

DelphiXE引入了一个名为TVirtualMethodInterceptor（Rtti单元）的新类，该类允许拦截虚拟方法来执行我们想用它执行的任何操作。我们可以检查和修改参数，调用其他函数，或者随意取消调用而什么也不做

下面是我制作的概念验证的样子：

//type
//  TCompareFunc<T1> = reference to function (const Arg1, Arg2 : T1) : Integer;
procedure TForm4.FormCreate(Sender: TObject);
var vCompareFunc : TCompareFunc<string>;
    RttiContext : TRttiContext;
    vAddMethod  : TRttiMethod;
    vRttiType : TRttiType;
begin
  RttiContext := TRttiContext.Create;
  vRttiType := RttiContext.GetType(TStrings);
  vAddMethod := vRttiType.GetMethod('Add');

  vCompareFunc :=  MyCompareFunc;
  Fvmi := TVirtualMethodInterceptor.Create(Listbox1.Items.ClassType);

  Fvmi.OnBefore :=   procedure(Instance: TObject; Method: TRttiMethod;
                        const Args: TArray<TValue>; out DoInvoke: Boolean; out Result: TValue)
                      var
                        idx : Integer;
                      begin
                        if Method = vAddMethod then
                        begin //if it's the Add method, map it to Insert at the right position
                          DoInvoke := False;
                          BinarySearch(TStrings(Instance), Args[0].AsString, vCompareFunc,idx);
                          TStrings(Instance).Insert(idx, Args[0].AsString);
                        end;
                      end;


  Fvmi.Proxify(Listbox1.Items);

end;

//类型
//TCompareFunc=对函数的引用（常量Arg1，Arg2:T1）：整数；
程序TForm4.FormCreate（发送方：TObject）；
var vCompareFunc:TCompareFunc；
RttiContext:TRttiContext；
vadd法：trtti法；
vRttiType:TRttiType；
开始
RttiContext:=TRttiContext.Create；
vRttiType:=RttiContext.GetType（TStrings）；
vAddMethod:=vRttiType.GetMethod（'Add'）；
vCompareFunc:=MyCompareFunc；
Fvmi:=TVirtualMethodInterceptor.Create（Listbox1.Items.ClassType）；
Fvmi.OnBefore:=过程（实例：TObject；方法：TRttiMethod；
常量参数：TArray；out-DoInvoke:Boolean；out-Result:TValue）
变量
idx：整数；
开始
如果Method=vAddMethod，则
开始//如果是Add方法，请将其映射到正确位置的Insert
DoInvoke:=假；
BinarySearch（TStrings（实例），Args[0]。AsString，vCompareFunc，idx）；
TStrings（实例）.Insert（idx，参数[0].AsStrin