Как проверить, указывают ли два события на одну и ту же процедуру в Delphi?

Скажем, у меня есть событие Button1.OnClick, связанное с процедурой Button1Click. У меня также есть Button2.OnClick, связанный с какой-либо другой процедурой. Как проверить, что оба события связаны с другой или той же процедурой из среды выполнения?

Я попытался проверить, если:

Button1.OnClick = Button2.OnClick, но это дало мне ошибку (недостаточно фактических параметров)
@(Button1.OnClick) = @(Button2.OnClick), ошибка снова (недостаточно фактических параметров)

Как проверить его правильно?

Ответ 1

Ссылка на метод может быть разбита на две части, указатель на объект и указатель на сам метод. Существует удобный тип записи, определенный в модуле System под названием TMethod, который позволяет нам это разрушить.

С помощью этого знания мы можем написать примерно следующее:

function SameMethod(AMethod1, AMethod2: TNotifyEvent): boolean;
begin
  result := (TMethod(AMethod1).Code = TMethod(AMethod2).Code) 
            and (TMethod(AMethod1).Data = TMethod(AMethod2).Data);   
end;

Надеюсь, это поможет.:)

Изменить: просто чтобы выложить в лучшем формате проблему, которую я пытаюсь решить здесь (как указано в комментариях).

Если у вас две формы, оба экземпляра из одного базового класса:

Form1 := TMyForm.Create(nil);
Form2 := TMyForm.Create(nil);

и вы назначаете тот же метод из этих форм на две кнопки:

Button1.OnClick := Form1.ButtonClick;
Button2.OnClick := Form2.ButtonClick;

И сравните два свойства OnClick, вы обнаружите, что Code одинаков, но Data отличается. Это потому, что он тот же метод, но на двух разных экземплярах класса...

Теперь, если у вас было два метода на одном и том же объекте:

Form1 := TMyForm.Create(nil);

Button1.OnClick := Form1.ButtonClick1;
Button2.OnClick := Form1.ButtonClick2;

Тогда их Data будут одинаковыми, но их Code будут разными.

Ответ 2

Я делаю это с помощью этой функции:

function MethodPointersEqual(const MethodPointer1, MethodPointer2): Boolean;
var
  Method1: System.TMethod absolute MethodPointer1;
  Method2: System.TMethod absolute MethodPointer2;
begin
  Result := (Method1.Code=Method2.Code) and (Method1.Data=Method2.Data)
end;

Это работает, но если кто-то знает менее хакерский способ сделать это, я хотел бы услышать об этом!

Ответ 3

Я знаю, что это старый вопрос... но вот мои 2центы...

Это ответ похож на Nat, но не ограничивает нас только TNotifyEvents... и отвечает на вопрос Дэвида о том, как это сделать, если это будет взлом...

function CompareMethods(aMethod1, aMethod2: TMethod): boolean;
begin
  Result := (aMethod1.Code = aMethod2.Code) and
            (aMethod1.Data = aMethod2.Data);
end;

Я использую его так

procedure TDefaultLoop.RemoveObserver(aObserver: TObject; aEvent: TNotifyEvent);
var
  a_Index: integer;
begin
  for a_Index := 0 to FNotifyList.Count - 1 do
    if Assigned(FNotifyList[a_Index]) and
     (TNotify(FNotifyList[a_Index]).Observer = aObserver) and
      CompareMethods(TMethod(TNotify(FNotifyList[a_Index]).Event), TMethod(aEvent))     then
begin
  FNotifyList.Delete(a_Index);
  FNotifyList[a_Index] := nil;
end;

Также быстрая и грязная демонстрация

procedure TForm53.Button1Click(Sender: TObject);
var
  a_Event1, a_Event2: TMethod;
begin
  if Sender is TButton then
  begin
     a_Event1 := TMethod(Button1.OnClick);
     a_Event2 := TMethod(Button2.OnClick);
    if CompareMethods(TMethod(TButton(Sender).OnClick), a_Event1) then
       ShowMessage('Button1Click Same Method');
    if CompareMethods(TMethod(TButton(Sender).OnClick), a_Event2) then
       ShowMessage('Button2Click Same Method');
  end;
end;


procedure TForm53.Button2Click(Sender: TObject);
var
  a_Event1, a_Event2: TMethod;
begin
  if Sender is TButton then
  begin
     a_Event1 := TMethod(Button1.OnClick);
     a_Event2 := TMethod(Button2.OnClick);
    if CompareMethods(TMethod(TButton(Sender).OnClick), a_Event1) then
       ShowMessage('Button1Click Same Method');
    if CompareMethods(TMethod(TButton(Sender).OnClick), a_Event2) then
       ShowMessage('Button2Click Same Method');
  end;
end;