zoukankan      html  css  js  c++  java
  • 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) = -1 then
        FAppEvents.Add(AppEvent);
    end;

        事情已经很明白了,每当Application的一个事件触发时,MultiCaster必定会在事件处理处理方法中遍历所有的ApplicationEvents并触发它们的事件。比如Application的OnMessage事件触发时,MultiCasterDoMessage得到调用,在它里面会调用所有ApplicationEventsDoMessage方法。

    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;

        ApplicationEventsDoMessage方法里触发一个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 - 2and (X <= FLeft + 2and
        (Y > FTop + 2and (Y < FTop + FHeight - 3then
        Result := mitLeft
      else if (X >= FLeft + FWidth - 3and (X <= FLeft + FWidth)
        and (Y > FTop + 2and (Y < FTop + FHeight - 3then
        Result := mitRight
      else if (Y >= FTop - 2and (Y <= FTop + 2and
        (X > FLeft + 2and (X < FLeft + FWidth - 3then
        Result := mitTop
      else if (Y >= FTop + FHeight - 3and (Y <= FTop + FHeight)
        and (X > FLeft + 2and (X < FLeft + FWidth - 3then
        Result := mitBottom
      else if (X >= FLeft - 2and (X <= FLeft + 2and
        (Y >= FTop - 2and (Y <= FTop + 2then
        Result := mitLeftTop
      else if (X >= FLeft - 2and (X <= FLeft + 2and
        (Y >= FTop + FHeight - 3and (Y <= FTop + FHeight) then
        Result := mitLeftBottom
      else if (X >= FLeft + FWidth - 3and (X <= FLeft + FWidth) and
        (Y >= FTop - 2and (Y <= FTop + 2then
        Result := mitRightTop
      else if (X >= FLeft + FWidth - 3and (X <= FLeft + FWidth) and
        (Y >= FTop + FHeight - 3and (Y <= FTop + FHeight) then
        Result := mitRightBottom
      else if (X > FLeft + 2and (X < FLeft + FWidth - 3and
        (Y > FTop + 2and (Y < FTop + FHeight - 3then
        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的两个方法BeforeRectChangeDoRectChange,这两个方法又会遍历所有的TRectEvents类并触发它们的事件。只要调用TEventBroadcastAddRectEvent即可创建一个TRectEvents对象并加到列表中,所以外部如果要接收TRectangle的事件,则要调用AddRectEvent方法得到一个TRectEvents,再引用这个TRectEvents类的事件。

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

        另外三个单元分别是MainFrm:主窗体包含两个FrameDrawFme:矩形所在的画布;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
        { Private declarations }
      public
        { Public declarations }
      end;

    var
      frmMain: TfrmMain;

    implementation

    {$R *.dfm}

    procedure TfrmMain.FormCreate(Sender: TObject);
    var
      RectEvents: TRectEvents;
    begin
      Rectangle := TRectangle.Create;
      //引用矩形类的事件
      RectEvents := Rectangle.EventBroadcast.AddRectEvent;
      RectEvents.OnRectChange := fmeDraw.OnRectChange;
      RectEvents.OnBeforeRectChange := fmeDraw.OnBeforeRectChange;

      RectEvents := Rectangle.EventBroadcast.AddRectEvent;
      RectEvents.OnRectChange := fmeInfo.OnRectChange;

      //初始化画布的属性
      Rectangle.Width := 100;
      Rectangle.Height := 100;
    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
        { Private declarations }
      public
        { Public declarations }
        procedure OnRectChange(Rectangle: TRectangle);
      end;

    implementation

    {$R *.dfm}

    { TfmeInfo }

    procedure TfmeInfo.OnRectChange(Rectangle: TRectangle);
    begin
      edtLeft.Text := IntToStr(Rectangle.Left);
      edtTop.Text := IntToStr(Rectangle.Top);
      edtWidth.Text := IntToStr(Rectangle.Width);
      edtHeight.Text := IntToStr(Rectangle.Height);
    end;

    procedure TfmeInfo.edtLeftChange(Sender: TObject);
    begin
      Rectangle.Left := StrToIntDef(edtLeft.Text, 0);
    end;

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

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

    procedure TfmeInfo.edtHeightChange(Sender: TObject);
    begin
      Rectangle.Height := StrToIntDef(edtHeight.Text, 100);
    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

  • 相关阅读:
    vue2手写vuex
    200.岛屿数量(DFS M-岛屿系列)
    739.每日温度(栈M)
    150.逆波兰表达式求值(栈M)
    20.有效的括号(栈L)
    前端性能优化与SEO优化整理
    Typescript:类型断言
    如何在浏览器中快速调试Typescript
    Typescript:枚举
    Typescript:接口
  • 原文地址:https://www.cnblogs.com/findumars/p/5277628.html
Copyright © 2011-2022 走看看