在Delphi

Question

实现函数指针的堆栈我们已经宣布它可以作为一个进度回调类型（如一个巨大的日志文件中每10,000行加载）：

// Declared in some base unit 
TProcedureCallback = procedure() of object; 

// Declared in the class that loads the events 
procedure ReadEvents(callback: TProcedureCallback); 

// Implementation of above method 
procedure TEvents.ReadEvents(callback: TProcedureCallback); 
var 
    nEvents: Integer; 
begin 
    nEvents := 0; 

    // Read some events... 
    Inc(nEvents); 
    // ...and repeat until end of log file 

    // Every 10,000 events, let the caller know (so they update 
    // something like a progress bar) 
    if ((nEvents mod 10000) = 0) then 
     callback(); 
end; 

// And the caller uses it like this 
public 
    procedure EventsLoadCallBack(); 

// Implementation of callback 
procedure TfrmLoadEvents.EventsLoadCallBack(); 
begin 
    // Update some GUI control... 
end; 

// And the events are loaded like this 
events.ReadEvents(EventsLoadCallBack); 

这一切都工作得很好。 ..但我想扩展到TObjectStack容器，以便我们可以实现自动注销功能。这个想法是，当每个表单被创建时，它会注册一个回调（即将其推送到某个系统级堆栈）。当表单被销毁时，它会将回调从堆栈中弹出。如果自动注销发生，您只需展开堆栈并将用户返回到主窗体，然后执行与自动注销相关的其余工作。

但是，我无法得到它的工作...当我试着推TProcedureCallback对象到堆栈中，我得到编译器错误：

// Using generic containers unit from Delphi 7 
uses 
    Contnrs; 

// Declare stack 
stackAutoLogOff: TObjectStack; 

// Initialise stack 
stackAutoLogOff := TObjectStack.Create(); 

// Attempt to use stack 
stackAutoLogOff.Push(callback); 
stackAutoLogOff.Push(TObject(callback)); 

// Clean up... 
stackstackAutoLogOff.Free(); 

首届回报Incompatible types和第二Invalid typecast。什么是实现一堆函数指针的正确方法？

Answer 1

问题是，TObjectStack预计将包含TObject类型的对象，您的回调是TMethod类型，它是一个包含两个指针的记录。

如果您使用的是现代版本的Delphi，一个简单的解决方案是使用泛型。例如：

TObjectProc = procedure of object; 
TMyCallbackStack = TStack<TObjectProc>; 

没有泛型，您需要构建自己的堆栈类来管理回调的存储。这是一个相当简单的类构建，并在其最基本的，可能是这个样子：

program Project1; 
{$APPTYPE CONSOLE} 

uses 
    SysUtils; 
type 
    TMyClass = class 
    procedure foo; 
    end; 

    TObjProc = procedure of object; 
    TObjProcStack = class(TObject) 
    private 
     FList: array of TObjProc; 
    public 
     function Count: Integer; 
     procedure Push(AItem: TObjProc); 
     function Pop: TObjProc; inline; 
     function Peek: TObjProc; inline; 
    end; 


function TObjProcStack.Peek: TObjProc; 
begin 
    Result := FList[Length(FList)-1]; 
end; 

function TObjProcStack.Pop: TObjProc; 
begin 
    Result := Peek(); 
    SetLength(FList, Length(FList) - 1); 
end; 

procedure TObjProcStack.Push(AItem: TObjProc); 
begin 
    SetLength(FList, Length(FList) + 1); 
    FList[Length(FList)-1] := AItem; 
end; 

function TObjProcStack.Count: Integer; 
begin 
    Result := Length(FList); 
end; 


{TMyClass} 
procedure TMyClass.Foo; 
begin 
    WriteLn('foo'); 
end; 

var 
    LMyClass : TMyClass; 
    LStack : TObjProcStack; 
begin 
    LStack := TObjProcStack.Create; 
    LMyClass := TMyClass.Create; 
    try 
    LStack.Push(LMyClass.foo); 
    LStack.Pop; {executes TMyClass.Foo - outputs 'foo' to console} 
    finally 
    LStack.Free; 
    LMyClass.Free; 
    end; 
    ReadLn; 
end. 

Answer 2

你可以用回调中的对象，然后使用标准协议栈选项。通过在自己的类包装是，你有一个完整的解决方案，如：

unit UnitCallbackStack; 

interface 

uses 
    Contnrs; 

type 
    TProcedureCallback = procedure() of object; 


type 
    TMyCallbackObject = class // wrapper for callback 
    private 
    FCallBack : TProcedureCallback; 
    protected 
    public 
    constructor Create(ACallback : TProcedureCallback); reintroduce; 
    property CallBack : TProcedureCallback 
      read FCallBack; 
    end; 

type 
    TCallBackStack = class(TObjectStack) 
    private 
    public 
    function Push(ACallback: TProcedureCallback): TProcedureCallback; reintroduce; 
    function Pop: TProcedureCallback; reintroduce; 
    function Peek: TProcedureCallback; reintroduce; 

    end; 

implementation 

{ TCallBackStack } 

function TCallBackStack.Peek: TProcedureCallback; 
var 
    iObject : TMyCallbackObject; 
begin 
    iObject := inherited Peek as TMyCallbackObject; 
    if assigned(iObject) then 
    begin 
    Result := iObject.CallBack; // no delete here as reference not removed 
    end 
    else 
    begin 
    Result := nil; 
    end; 
end; 

function TCallBackStack.Pop: TProcedureCallback; 
var 
    iObject : TMyCallbackObject; 
begin 
    iObject := inherited Pop as TMyCallbackObject; 
    if assigned(iObject) then 
    begin 
    Result := iObject.CallBack; 
    iObject.Free; // popped, so no longer needed 
    end 
    else 
    begin 
    Result := nil; 
    end; 
end; 

function TCallBackStack.Push(ACallback: TProcedureCallback): TProcedureCallback; 
begin 
    inherited Push(TMyCallbackObject.Create(ACallBack)); 
end; 


{ TMyCallbackObject } 

constructor TMyCallbackObject.Create(ACallback: TProcedureCallback); 
begin 
    inherited Create; 
    fCallBack := ACallBack; 
end; 

end. 

然后可以使用TCallBackStack你要使用T堆的方式。