Есть ли базовый тип для указателей методов?

Question

В следующем коде у меня есть два типа указателей метода. Мне нужна другая процедура, которая принимает параметр любого из этих типов и использует его на основе других значений. Но я не могу найти базовый тип для этих двух типов, чтобы иметь возможность пройти как в процедуру:

type 
    TIntProc: procedure (I: Integer) of object; 
    TStrProc: procedure (S: string) of object; 

.... 

    procedure TForm1.CallbackTest(A: Integer; Callback: procedure of object {What type should I use here?}); 
    var 
    IntProc: TIntProc; 
    StrProc: TStrProc; 
    begin 
    if A = 1 then begin 
     IntProc:= TIntProc(Callback); 
     IntProc(100); 
    end else begin 
     StrProc:= TStrProc(Callback); 
     StrProc('Hello'); 
    end; 
    end; 

    procedure TForm1.MyIntProc(I: Integer); 
    begin 
    ShowMessage(IntToStr(I)); 
    end; 

    procedure TForm1.MyStrProc(S: string); 
    begin 
    ShowMessage(S); 
    end; 

я должен быть в состоянии написать:

CallbackTest(1, MyIntProc); 

, а также:

CallbackTest(2, MyStrProc); 

Но, конечно, я получаю ошибки на обоих, потому что procedure of object, используемый как тип второго параметра, не является базовым типом для procedure (I: Integer) of object и procedure (S: string) of object. Есть идеи, как это сделать?

Answer 1

Наследование не производится для процедурных типов. Вы не можете иметь безопасный способ передачи любого типа с помощью одного аргумента. Вам нужно будет бросить. Например, вы можете typecast между переменными процедурного типа и TMethod.

// Health warning, this code is for illustration, I do not endorse its use 

procedure Foo(A: Integer; Callback: TMethod); 
begin 
    if A = 1 then 
    TIntProc(Callback)(100) 
    else 
    TStrProc(Callback)('Hello'); 
end; 

.... 

Foo(1, TMethod(IntProc)); 
Foo(2, TMethod(StrProc)); 

Но я бы не рекомендовал этот подход, если бы был лучший. Не в последнюю очередь потому, что вам нужно использовать непроверенные броски, и поэтому даже не используйте проверку времени выполнения, которая доступна для классов с помощью оператора as.

Лично я бы решить это по-другому:

public 
    procedure Foo(Callback: TIntProc); overload; 
    procedure Foo(Callback: TStrProc); overload; 

Если вам нужен единый режим для того чтобы обрабатывать оба метода обратного вызова, сделать дополнительные частные перегрузки:

private 
    procedure Foo(IntCallback: TIntProc; StrCallback: TStrProc); overload; 

Implement, как это:

procedure TMyClass.Foo(IntCallback: TIntProc; StrCallback: TStrProc); 
begin 
    if Assigned(IntCallback) then 
    .... 
    if Assigned(StrCallback) then 
    .... 
end; 

А затем реализовать общественные перегрузки следующим образом:

procedure TMyClass.Foo(Callback: TIntProc); 
begin 
    Foo(Callback, nil); 
end; 

procedure TMyClass.Foo(Callback: TStrProc); 
begin 
    Foo(nil, Callback); 
end; 

Answer 2

С небольшой помощью родового это возможно:

program Project14; 

{$APPTYPE CONSOLE} 

uses 
    System.SysUtils,TypInfo; 

Type 
    TMyProcedures = record 
    procedure MyIntProc(I: Integer); 
    procedure MyStrProc(S: String); 
    end; 

    TMyRec = record 
    public 
     class procedure CallbackTest<T>(Callback: TProc<T>); static; 
    end; 

class procedure TMyRec.CallbackTest<T>(Callback: TProc<T>); 
begin 
    case GetTypeKind(T) of 
    tkInteger: 
    begin 
     if GetTypeData(TypeInfo(T))^.OrdType = otSLong then 
     TProc<Integer>(Callback)(100); 
    end; 
    tkUString: 
    TProc<String>(Callback)('Hello'); 
    end; 
    else raise Exception.Create('Callback type can only be string or integer'); 
end; 

procedure TMyProcedures.MyIntProc(I: Integer); 
begin 
    WriteLn(IntToStr(I)); 
end; 

procedure TMyProcedures.MyStrProc(S: string); 
begin 
    WriteLn(S); 
end; 

var 
    myProcedures: TMyProcedures; 

begin 
    TMyRec.CallbackTest<Integer>(myProcedures.MyIntProc); 
    TMyRec.CallbackTest<String>(myProcedures.MyStrProc); 
    ReadLn; 
end. 

Вид метода решается с помощью TypeInfo вызова, и напечатанный фиксирует метод обратного вызова.

Для версий до Delphi XE7 вы можете использовать следующий код для CallBackTest

class procedure TMyRec.CallbackTest<T>(Callback: TProc<T>); 
begin 
    if TypeInfo(T) = TypeInfo(Integer) then begin 
     if GetTypeData(TypeInfo(T))^.OrdType = otSLong then 
     TProc<Integer>(Callback)(100); 
    end 
    else if TypeInfo(T) = TypeInfo(String) then begin 
    TProc<String>(Callback)('Hello'); 
    end 
    else raise Exception.Create('Callback type can only be string or integer'); 
end; 

---

_{Обновленного с типизированным образом отделить фактический порядковый тип в целое число и код, который будет работать на Delphi 2009..XE6.}