我想到Delphi的事件,那可真是个方便的东西,初学者在窗体上拉几个控件,并指定它们的事件,写几句代码,立刻就得到他们想要的效果。可是事件在方便的同时也有一个不足之处,就是只能指定一个接收事件的对象,这在某些应用中会受收限制,比如多视图对应一个业务逻辑时,当一个业务对象想通知视图更新它们的状态,如果用事件,那只能有一个视图得到通知。
有没有办法让对象触发事件时,多个对象同时能收到呢?其实仔细一想,还是有挺多的,根本的就是维护一张接收事件对象的列表,事件发生时,遍历列表并调用相应的方法。本文介绍两种方法,这两种方法都比较好用。
第一种方法是从ApplicationEvents控件的实现方式学来的。ApplicationEvents是为了方便地处理Application的所有事件,一个程序中放多个ApplicationEvents,它们都能同时传递Application的事件到事件接收类中,下面是一个例子,在一个窗体上放两个ApplicationEvents控件,并指定它们的OnMessage事件,并写如下代码:
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
Edit1.Text := IntToStr(i1);
Inc(i1);
end;
procedure TForm1.ApplicationEvents2Message(var Msg: tagMSG;
var Handled: Boolean);
begin
Edit2.Text := IntToStr(i2);
Inc(i2);
end;
运行程序,可以看到两个事件处理方法都发生了,i1和i2疯狂的增长。也就是说Application通过ApplicationEvents这个控件使得它的事件可以被多个对象同时接收,显然ApplicationEvents不是简单地传递Application的事件,一定是运用了某些技巧,看看它的源码如何。
打开AppEvnts这个单元,发现里面的代码并不多,在初始节中有这样的代码:
initialization
... ...
MultiCaster := TMultiCaster.Create(Application);
end.
MultiCaster是TMultiCaster类的一个全局对象,构造函数传进Appication对象,可以肯定,在里面MultiCaster将接收Application的所有事件,看看源码就知道了。
constructor TMultiCaster.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAppEvents := TComponentList.Create(False);
with Application do
begin
OnActionExecute := DoActionExecute;
OnActionUpdate := DoActionUpdate;
OnActivate := DoActivate;
OnDeactivate := DoDeactivate;
OnException := DoException;
OnHelp := DoHelp;
OnHint := DoHint;
OnIdle := DoIdle;
OnMessage := DoMessage;
OnMinimize := DoMinimize;
OnRestore := DoRestore;
OnShowHint := DoShowHint;
OnShortCut := DoShortcut;
OnSettingChange := DoSettingChange;
OnModalBegin := DoModalBegin;
OnModalEnd := DoModalEnd;
end;
end;
上面也可以看到有一个FAppEvents列表类,它应该就是保存所有的ApplicationEvents的列表,再看看ApplicationEvents的构造函数。
constructor TCustomApplicationEvents.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if Assigned(MultiCaster) then
MultiCaster.AddAppEvent(Self);
end;
每创建一个ApplicationEvents,它就将自己加进MultiCaster全局对象的列表中。
procedure TMultiCaster.AddAppEvent(AppEvent: TCustomApplicationEvents);
begin
if FAppEvents.IndexOf(AppEvent) = -1 then
FAppEvents.Add(AppEvent);
end;
事情已经很明白了,每当Application的一个事件触发时,MultiCaster必定会在事件处理处理方法中遍历所有的ApplicationEvents并触发它们的事件。比如Application的OnMessage事件触发时,MultiCaster的DoMessage得到调用,在它里面会调用所有ApplicationEvents的DoMessage方法。
procedure TMultiCaster.DoMessage(var Msg: TMsg; var Handled: Boolean);
var
I: Integer;
begin
BeginDispatch;
try
for I := Count - 1 downto 0 do
begin
AppEvents[I].DoMessage(Msg, Handled);
if FCancelDispatching then Break;
end;
finally
EndDispatch;
end;
end;
而ApplicationEvents的DoMessage方法里触发一个OnMessage事件。
procedure TCustomApplicationEvents.DoMessage(var Msg: TMsg; var Handled: Boolean);
begin
if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
end;
原来Application是借由MultiCaster这个全局对象,将它的所有事件广播给ApplicationEvents,再由ApplicationEvents去触发自己的事件。整个过程就是这么简单。
依据这个原理,我们也可以设计自己的事件广播机制,首先我们的业务对象不一定像Application是全局对象,所以当任MultiCaster这样角色的对象也不一定是全局对象,”MultiCaster”必须在”Application”的生命周期中才有效,既然如此,应该让” MultiCaster”成为”Application”的私有成员,另外像” ApplicationEvents”也不必是独立的组件类,只需要是”MultiCaster”的一个方法即可,假设这个方法为AddObjEvents。如此一来,所有事件机制就都集成到”MultiCaster”一个类中了。
多说无益,用一个简单的例子来说明这种方法的应用最有效。为了尽可能地简单,我将一个画图程序简化为一个拖放矩形的程序:程序中有两个区,一个是画板区,画板区存在一个矩形,现要求可以用鼠标拖动这个矩形,也可以改变它的大小;另一个区是信息区,显示矩形的位置和大小,也可以通过填写信息区的矩形位置和大小信息来改变矩形。
从上面的要求可以看出,矩形就相当于业务对象,我们设计矩形类为TRectangle,两个区是业务对象的两种视图,为了让代码分离以便于以后的维护和扩展,两个区用两个Frame分离出来,这两个区都必须能够接收TRectangle的事件。我们用上面描述的方法去实现TRectangle类,且看下面的代码:
unit wdRect;
interface
uses
Classes, Graphics, Contnrs;
type
TRectangle = class;
TOnRectChange = procedure(Rectangle: TRectangle) of object;
//光标在矩形类中的位置标识
TMouseInType = (mitNone, mitLeft, mitTop, mitRight, mitBottom, mitInner,
mitLeftTop, mitLeftBottom, mitRightTop, mitRightBottom);
{ 矩形的事件触发类 }
TRectEvents = class
private
FOnRectChange: TOnRectChange;
FOnBeforeRectChange: TOnRectChange;
public
procedure DoRectChange(Rectangle: TRectangle);
procedure BeforeRectChange(Rectangle: TRectangle);
property OnRectChange: TOnRectChange read FOnRectChange write FOnRectChange;
property OnBeforeRectChange: TOnRectChange read FOnBeforeRectChange
write FOnBeforeRectChange;
end;
{ 矩形的事件广播类 }
TEventBroadcast = class
private
FEventList: TObjectList; //用于保存事件类
procedure DoRectChange(Rectangle: TRectangle);
procedure BeforeRectChange(Rectangle: TRectangle);
public
function AddRectEvent: TRectEvents;
constructor Create;
destructor Destroy; override;
end;
TRectangle = class
private
FLeft: Integer;
FTop: Integer;
FWidth: Integer;
FHeight: Integer;
FEventBroadcast: TEventBroadcast;
procedure SetHeight(const Value: Integer);
procedure SetLeft(const Value: Integer);
procedure SetTop(const Value: Integer);
procedure SetWidth(const Value: Integer);
public
constructor Create;
destructor Destroy; override;
//画自己
procedure Draw(Canvas: TCanvas);
//擦除自己
procedure Erase(Canvas: TCanvas);
//光标在什么位置
function MouseInRect(X, Y: Integer): TMouseInType;
//调整位置大小属性
procedure AdjustRect;
property Left: Integer read FLeft write SetLeft;
property Top: Integer read FTop write SetTop;
property Width: Integer read FWidth write SetWidth;
property Height: Integer read FHeight write SetHeight;
property EventBroadcast: TEventBroadcast read FEventBroadcast;
end;
var
Rectangle: TRectangle;
implementation
{ TRectangle }
procedure TRectangle.AdjustRect;
begin
{由于对矩形拖放之后,位置大小属性可以有些不同,所以需要一些调整}
if FLeft >= FLeft + FWidth then
FLeft := FLeft + FWidth;
if FTop >= FTop + FHeight then
FTop := FTop + FHeight;
FWidth := Abs(FWidth);
FHeight := Abs(FHeight);
end;
constructor TRectangle.Create;
begin
FEventBroadcast := TEventBroadcast.Create;
end;
destructor TRectangle.Destroy;
begin
FEventBroadcast.Free;
inherited;
end;
procedure TRectangle.Draw(Canvas: TCanvas);
begin
Canvas.Rectangle(FLeft, FTop, FLeft + FWidth, FTop + FHeight);
end;
procedure TRectangle.Erase(Canvas: TCanvas);
begin
Canvas.Rectangle(FLeft, FTop, FLeft + FWidth, FTop + FHeight);
end;
function TRectangle.MouseInRect(X, Y: Integer): TMouseInType;
begin
//计算鼠标是否在矩形的特定区域中
if (X >= FLeft - 2) and (X <= FLeft + 2) and
(Y > FTop + 2) and (Y < FTop + FHeight - 3) then
Result := mitLeft
else if (X >= FLeft + FWidth - 3) and (X <= FLeft + FWidth)
and (Y > FTop + 2) and (Y < FTop + FHeight - 3) then
Result := mitRight
else if (Y >= FTop - 2) and (Y <= FTop + 2) and
(X > FLeft + 2) and (X < FLeft + FWidth - 3) then
Result := mitTop
else if (Y >= FTop + FHeight - 3) and (Y <= FTop + FHeight)
and (X > FLeft + 2) and (X < FLeft + FWidth - 3) then
Result := mitBottom
else if (X >= FLeft - 2) and (X <= FLeft + 2) and
(Y >= FTop - 2) and (Y <= FTop + 2) then
Result := mitLeftTop
else if (X >= FLeft - 2) and (X <= FLeft + 2) and
(Y >= FTop + FHeight - 3) and (Y <= FTop + FHeight) then
Result := mitLeftBottom
else if (X >= FLeft + FWidth - 3) and (X <= FLeft + FWidth) and
(Y >= FTop - 2) and (Y <= FTop + 2) then
Result := mitRightTop
else if (X >= FLeft + FWidth - 3) and (X <= FLeft + FWidth) and
(Y >= FTop + FHeight - 3) and (Y <= FTop + FHeight) then
Result := mitRightBottom
else if (X > FLeft + 2) and (X < FLeft + FWidth - 3) and
(Y > FTop + 2) and (Y < FTop + FHeight - 3) then
Result := mitInner
else Result := mitNone;
end;
procedure TRectangle.SetHeight(const Value: Integer);
begin
if FHeight <> Value then
begin
FEventBroadcast.BeforeRectChange(Self);
FHeight := Value;
FEventBroadcast.DoRectChange(Self);
end;
end;
procedure TRectangle.SetLeft(const Value: Integer);
begin
if FLeft <> Value then
begin
FEventBroadcast.BeforeRectChange(Self);
FLeft := Value;
FEventBroadcast.DoRectChange(Self);
end;
end;
procedure TRectangle.SetTop(const Value: Integer);
begin
if FTop <> Value then
begin
FEventBroadcast.BeforeRectChange(Self);
FTop := Value;
FEventBroadcast.DoRectChange(Self);
end;
end;
procedure TRectangle.SetWidth(const Value: Integer);
begin
if FWidth <> Value then
begin
FEventBroadcast.BeforeRectChange(Self);
FWidth := Value;
FEventBroadcast.DoRectChange(Self);
end;
end;
{ TRectEvents }
procedure TRectEvents.BeforeRectChange(Rectangle: TRectangle);
begin
if Assigned(FOnBeforeRectChange) then
FOnBeforeRectChange(Rectangle);
end;
procedure TRectEvents.DoRectChange(Rectangle: TRectangle);
begin
if Assigned(FOnRectChange) then
FOnRectChange(Rectangle);
end;
{ TEventBroadcast }
function TEventBroadcast.AddRectEvent: TRectEvents;
var
RectEvents: TRectEvents;
begin
//增加一个事件类
RectEvents := TRectEvents.Create;
FEventList.Add(RectEvents);
Result := RectEvents;
end;
procedure TEventBroadcast.BeforeRectChange(Rectangle: TRectangle);
var
i: Integer;
begin
//向外广播事件
for i := 0 to FEventList.Count - 1 do
TRectEvents(FEventList[i]).BeforeRectChange(Rectangle);
end;
constructor TEventBroadcast.Create;
begin
FEventList := TObjectList.Create;
end;
destructor TEventBroadcast.Destroy;
begin
FEventList.Free;
inherited;
end;
procedure TEventBroadcast.DoRectChange(Rectangle: TRectangle);
var
i: Integer;
begin
//向外广播事件
for i := 0 to FEventList.Count - 1 do
TRectEvents(FEventList[i]).DoRectChange(Rectangle);
end;
end.
单元中的类结构并不复杂,TRectangle拥有TEventBroadcast,而TRectangle的事件皆由TEventBroadcast去处理,当矩形类的大小位置改变时,都会调用TEventBroadcast