在delphi程序中创建一个鼠标事件类，为何该事件类的实例数量不能超过两个？谢

Question

type  TObjectProcedure = procedure of object;  TEventObject = class(TInterfacedObject, IDispatch)
  private
    FOnEvent: TObjectProcedure;
  protected
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  public
    constructor Create(const OnEvent: TObjectProcedure);
    property OnEvent: TObjectProcedure read FOnEvent write FOnEvent;
  end;
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);  private
    procedure Document_OnMouseOver;
    procedure Document_OnMouseOver0;
    procedure Document_OnMouseOver1;//提示错误：Unsatisfied forward or external declaration: 'Tform1.Document_OnMouseOver1'
  public  end;在delphi程序中创建一个鼠标事件类，为何该事件类的实例数量不能超过两个？当创建第3个实例procedure Document_OnMouseOver1时提示错误Unsatisfied forward or external declaration: 'Tform1.Document_OnMouseOver1'
，为什么？怎么办呢？谢了

Answer 1

事件只能关联一个事件处理过程，不过你可以在事件处理过程内循环调用你的其它事件处理过程。我这里有个事件处理过程列表类，可以实现多个事件处理过程的调用。unit MethodList;interfaceuses
  Classes, Types, SysUtils, LinkList;type
  PObjectMethodInfo = ^TObjectMethodInfo;  TObjectMethodInfo = record
    Method:TMethod;
  end;
  
  TObjectMethodList=class
  private
    FList:TSingleLinkList;
    function InternalAdd:PObjectMethodInfo;
    procedure DoDisposeItemData(aData : Pointer);        
    function Find(AObject:TObject; AMethodPointer:Pointer):PObjectMethodInfo;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function Exists(AObject:TObject; AMethodPointer:Pointer):Boolean;
    function MoveFirst:TMethod;
    function MoveNext:TMethod;
    procedure AddPublished(AObject:TObject; const MethodName:string); overload;
    procedure AddCustom(AObject:TObject; AMethodPointer:Pointer);
    procedure Remove(AObject:TObject; AMethodPointer:Pointer);
    procedure RmoveAll;
  end;  TEventList=class(TObjectMethodList)
  protected
    procedure DoExecute(AMethod:TMethod); virtual; abstract;
  public
    procedure Execute;
  end;
  
(*
    调用方法如下：
    TForm1 = class(TForm)
      Button1: TButton;
      procedure FormCreate(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
      procedure Button1Click(Sender: TObject);
    private
      { Private declarations }
      Events:TObjectMethodList;
    public
      { Public declarations }
      procedure DoClick1(Sender:TObject);
      procedure DoClick2(Sender:TObject);
      procedure DoClick3(Sender:TObject);
    end;    ..........................    procedure TForm1.DoClick1(Sender: TObject);
    begin
      ShowMessage('容器处理');
    end;    procedure TForm1.DoClick2(Sender: TObject);
    begin
      ShowMessage('选择集处理');
    end;    procedure TForm1.DoClick3(Sender: TObject);
    begin
      ShowMessage('连接线处理');
    end;    procedure TForm1.FormCreate(Sender: TObject);
    var
      AProc:TNotifyEvent;
    begin
      Events:=TObjectMethodList.Create;
      AProc:=DoClick1;
      Events.Add(Self, @AProc);
      AProc:=DoClick2;
      Events.Add(Self, @AProc);
      AProc:=DoClick3;
      Events.Add(Self, @AProc);
    end;    procedure TForm1.FormDestroy(Sender: TObject);
    begin
      Events.Free;
    end;    procedure TForm1.Button1Click(Sender: TObject);
    var
      AMethod:TMethod;
      AProc:TNotifyEvent;
    begin
      AMethod:=Events.MoveFirst;
      while AMethod.Code<>nil do
      begin
        AProc:=TNotifyEvent(AMethod);
        AProc(Self);
        AMethod:=Events.MoveNext;
      end;
    end;*)
implementation{ TObjectMethodList }procedure TObjectMethodList.AddCustom(AObject:TObject;
  AMethodPointer: Pointer);
var
  AItem:PObjectMethodInfo;
begin
  if (AObject<>nil) and (AMethodPointer<>nil) then
    if Find(AObject, AMethodPointer)=nil then
    begin
      AItem:=InternalAdd;
      AItem.Method.Data:=AObject;
      AItem.Method.Code:=AMethodPointer;
    end;
end;function TObjectMethodList.InternalAdd: PObjectMethodInfo;
begin
  GetMem(Result,SizeOf(TObjectMethodInfo));
  FList.Add(Result);
end;procedure TObjectMethodList.AddPublished(AObject:TObject;
  const MethodName: string);
var
  AMethodPointer:Pointer;
begin
  AMethodPointer:=AObject.MethodAddress(MethodName);
  if AMethodPointer=nil then
    raise Exception.Create('类['+AObject.ClassName+']的'+MethodName+'方法不存在或者没有放在Published区域内！');
  AddCustom(AObject, AMethodPointer);
end;constructor TObjectMethodList.Create;
begin
  inherited Create;
  FList:=TSingleLinkList.Create;
  FList.OnDisposeData:=DoDisposeItemData;
end;destructor TObjectMethodList.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;procedure TObjectMethodList.DoDisposeItemData(aData : Pointer);
begin
  FreeMem(aData, SizeOf(TObjectMethodInfo));
end;function TObjectMethodList.Exists(AObject: TObject;
  AMethodPointer: Pointer): Boolean;
begin
  Result:=Find(AObject, AMethodPointer)<>nil;
end;function TObjectMethodList.Find(AObject:TObject;
  AMethodPointer: Pointer): PObjectMethodInfo;
var
  ANode:PslNode;
begin
  Result:=nil;
  if FList.IsEmpty then Exit;
  ANode:=FList.MoveFirst;
  while ANode<>nil do
  begin
    with PObjectMethodInfo(ANode.slnData)^.Method do
      if (Data=AObject)and(Code=AMethodPointer) then
      begin
        Result:=ANode.slnData;
        Break;
      end;
    ANode:=FList.MoveNext;
  end;
end;function TObjectMethodList.MoveFirst: TMethod;
var
  ANode:PslNode;
begin
  ANode:=FList.MoveFirst;
  if ANode<>nil then
    Result:=PObjectMethodInfo(ANode.slnData)^.Method
  else begin
    Result.Data:=nil;
    Result.Code:=nil;
  end;
end;function TObjectMethodList.MoveNext: TMethod;
var
  ANode:PslNode;
begin
  ANode:=FList.MoveNext;
  if ANode<>nil then
    Result:=PObjectMethodInfo(ANode.slnData)^.Method
  else begin
    Result.Data:=nil;
    Result.Code:=nil;
  end
end;procedure TObjectMethodList.Remove(AObject:TObject;
  AMethodPointer: Pointer);
var
  PData:PObjectMethodInfo;
begin
  PData:=Find(AObject, AMethodPointer);
  if PData<>nil then FList.Remove(PData);
end;procedure TObjectMethodList.RmoveAll;
begin
  FList.Clear;
end;{ TEventList }procedure TEventList.Execute;
var
  AMethod:TMethod;
begin
  if FList.IsEmpty then Exit;
  AMethod:=MoveFirst;
  while AMethod.Code<>nil do
  begin
    DoExecute(AMethod);
    AMethod:=MoveNext;
  end;
end;end.