Delphi事件的广播 good

明天就是五一节了，辛苦了好几个月，借此机会应该尽情放松一番。可是想到Blog好久没有写文章，似乎缺些什么似的。这几个月来在项目中又增长了许多经验，学到许多实际应用的知识。不如把一些比较有用的记录下来，供朋友们参考可好。

我想到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) = - 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 -  downto  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;
  ) and (X <= FLeft + ) and
    (Y > FTop + ) and (Y < FTop + FHeight - ) then
    Result := mitLeft
  else if (X >= FLeft + FWidth - ) and (X <= FLeft + FWidth)
    and (Y > FTop + ) and (Y < FTop + FHeight - ) then
    Result := mitRight
  else if (Y >= FTop - ) and (Y <= FTop + ) and
    (X > FLeft + ) and (X < FLeft + FWidth - ) then
    Result := mitTop
  else if (Y >= FTop + FHeight - ) and (Y <= FTop + FHeight)
    and (X > FLeft + ) and (X < FLeft + FWidth - ) then
    Result := mitBottom
  else if (X >= FLeft - ) and (X <= FLeft + ) and
    (Y >= FTop - ) and (Y <= FTop + ) then
    Result := mitLeftTop
  else if (X >= FLeft - ) and (X <= FLeft + ) and
    (Y >= FTop + FHeight - ) and (Y <= FTop + FHeight) then
    Result := mitLeftBottom
  else if (X >= FLeft + FWidth - ) and (X <= FLeft + FWidth) and
    (Y >= FTop - ) and (Y <= FTop + ) then
    Result := mitRightTop
  else if (X >= FLeft + FWidth - ) and (X <= FLeft + FWidth) and
    (Y >= FTop + FHeight - ) and (Y <= FTop + FHeight) then
    Result := mitRightBottom
  else if (X > FLeft + ) and (X < FLeft + FWidth - ) and
    (Y > FTop + ) and (Y < FTop + FHeight - ) 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;

to FEventList.Count -  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
   to FEventList.Count -  do
    TRectEvents(FEventList[i]).DoRectChange(Rectangle);
end;

end.

单元中的类结构并不复杂，TRectangle拥有TEventBroadcast，而TRectangle的事件皆由TEventBroadcast去处理，当矩形类的大小位置改变时，都会调用TEventBroadcast的两个方法BeforeRectChange和DoRectChange，这两个方法又会遍历所有的TRectEvents类并触发它们的事件。只要调用TEventBroadcast的AddRectEvent即可创建一个TRectEvents对象并加到列表中，所以外部如果要接收TRectangle的事件，则要调用AddRectEvent方法得到一个TRectEvents，再引用这个TRectEvents类的事件。

至于其他代码，大都是实现矩形的拖放功能，这里就略去不讲了。

另外三个单元分别是MainFrm：主窗体包含两个Frame；DrawFme：矩形所在的画布；InfoFme：矩形的信息显示。

MainFrm很简单，看下面的代码：

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, DrawFme, InfoFme, wdRect;

type
  TfrmMain = class(TForm)
    pnlInfo: TPanel;
    pnlDraw: TPanel;
    fmeDraw: TfmeDraw;
    fmeInfo: TfmeInfo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    ;
  Rectangle.Height := ;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  Rectangle.Free;
end;

end.

主窗体创建Rectangle类，并在FormCreate中引用它的事件。

InfoFme主要是显示Rectangle的信息，并可以通过输入矩形的位置和大小来改变它：

unit InfoFme;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, wdRect;

type
  TfmeInfo = class(TFrame)
    edtLeft: TEdit;
    edtTop: TEdit;
    edtWidth: TEdit;
    edtHeight: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure edtLeftChange(Sender: TObject);
    procedure edtTopChange(Sender: TObject);
    procedure edtWidthChange(Sender: TObject);
    procedure edtHeightChange(Sender: TObject);
  private
    );
end;

procedure TfmeInfo.edtTopChange(Sender: TObject);
begin
  Rectangle.Top := StrToIntDef(edtTop.Text, );
end;

procedure TfmeInfo.edtWidthChange(Sender: TObject);
begin
  Rectangle.Width := StrToIntDef(edtWidth.Text, );
end;

procedure TfmeInfo.edtHeightChange(Sender: TObject);
begin
  Rectangle.Height := StrToIntDef(edtHeight.Text, );
end;

end.

DrawFme处理了矩形的一些事件，并对鼠标的事件作一些处理，代码也并不复杂：

unit DrawFme;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, wdRect;

type
  TfmeDraw = class(TFrame)
    imgDraw: TPaintBox;
    procedure imgDrawMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgDrawMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgDrawMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgDrawPaint(Sender: TObject);
  private
    { Private declarations }
    mitType: TMouseInType;
    FDown: Boolean;
    FOrgX, FOrgY: Integer;
  public
    procedure OnRectChange(Rectangle: TRectangle);
    procedure OnBeforeRectChange(Rectangle: TRectangle);
    { Public declarations }
  end;

implementation

{$R *.dfm}

{ TfmeDraw }

procedure TfmeDraw.OnRectChange(Rectangle: TRectangle);
begin
  Rectangle.Draw(imgDraw.Canvas);
end;

procedure TfmeDraw.imgDrawMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  //确定光标的类型
  case Rectangle.MouseInRect(X, Y) of
    mitNone: Cursor := crDefault;
    mitInner: Cursor := crSizeAll;
    mitLeft, mitRight: Cursor := crSizeWE;
    mitTop, mitBottom: Cursor := crSizeNS;
    mitLeftTop, mitRightBottom: Cursor := crSizeNWSE;
    mitLeftBottom, mitRightTop: Cursor := crSizeNESW;
  end;
  //对矩形的拖放控制
  if FDown then
  begin
    if (mitType = mitInner) then
    begin
      Rectangle.Left := Rectangle.Left + (X - FOrgX);
      Rectangle.Top := Rectangle.Top + (Y - FOrgY);
    end
    else if (mitType = mitLeft) then
    begin
      Rectangle.Left := Rectangle.Left + (X - FOrgX);
      Rectangle.Width := Rectangle.Width - (X - FOrgX);
    end
    else if (mitType = mitTop) then
    begin
      Rectangle.Top := Rectangle.Top + (Y - FOrgY);
      Rectangle.Height := Rectangle.Height - (Y - FOrgY);
    end
    else if (mitType = mitRight) then
    begin
      Rectangle.Width := Rectangle.Width + (X - FOrgX);
    end
    else if (mitType = mitBottom) then
    begin
      Rectangle.Height := Rectangle.Height + (Y - FOrgY);
    end
    else if (mitType = mitLeftTop) then
    begin
      Rectangle.Left := Rectangle.Left + (X - FOrgX);
      Rectangle.Width := Rectangle.Width - (X - FOrgX);
      Rectangle.Top := Rectangle.Top + (Y - FOrgY);
      Rectangle.Height := Rectangle.Height - (Y - FOrgY);
    end
    else if (mitType = mitLeftBottom) then
    begin
      Rectangle.Left := Rectangle.Left + (X - FOrgX);
      Rectangle.Width := Rectangle.Width - (X - FOrgX);
      Rectangle.Height := Rectangle.Height + (Y - FOrgY);
    end
    else if (mitType = mitRightTop) then
    begin
      Rectangle.Top := Rectangle.Top + (Y - FOrgY);
      Rectangle.Height := Rectangle.Height - (Y - FOrgY);
      Rectangle.Width := Rectangle.Width + (X - FOrgX);
    end
    else if (mitType = mitRightBottom) then
    begin
      Rectangle.Height := Rectangle.Height + (Y - FOrgY);
      Rectangle.Width := Rectangle.Width + (X - FOrgX);
    end;
    FOrgX := X;
    FOrgY := Y;
  end;
end;

procedure TfmeDraw.imgDrawMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    FDown := True;
  mitType := Rectangle.MouseInRect(X, Y);
  if mitType <> mitNone then
  begin
    FOrgX := X;
    FOrgY := Y;
  end;
end;

procedure TfmeDraw.imgDrawMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    FDown := False;
  Rectangle.AdjustRect;
end;

procedure TfmeDraw.OnBeforeRectChange(Rectangle: TRectangle);
begin
  Rectangle.Erase(imgDraw.Canvas);
end;

procedure TfmeDraw.imgDrawPaint(Sender: TObject);
begin
  imgDraw.Canvas.Pen.Mode := pmNot;
  imgDraw.Canvas.Brush.Style := bsClear;
  Rectangle.Draw(imgDraw.Canvas);
end;

end.

上面就是所有代码，相信仔细读一下就可理解，把上面的代码拷进你的工程中，运行看看效果，你可以拖动这个矩形，也可以拉动它的大小，还可以在信息框中同时看到矩形信息，你更可以在信息框中输入矩形的位置大小并在画布中立刻看到效果。如果需要完整代码的，请发邮件给我。

通过上面的例子，可以看出矩形的事件变成了一个类，并被另一个类管理着，事件的机制和矩形类的实现分离出来了。

下一篇我将介绍另一种方法，采用Observer模式来实现事件的广播，欲知详细如何，且听下回分晓。

http://blog.csdn.net/linzhengqun/article/details/711525

http://blog.csdn.net/dropme/article/details/975736