在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堆的方式。