深入delphi编程理解之消息（六）无窗口单元消息的创建、接受及dispatch模式编程

//==============================================================================
// 主窗口
//==============================================================================

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Unit2, Unit4,Unit3;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    fNotFormMsg: TMyNotFormMsg;
    fMyDispatcher: TMyDispatcher;
    fObjectProc: TObjectProc;
  public
     property MyDispatcher:TMyDispatcher read fMyDispatcher;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
begin
  PostMessage(HWND_BROADCAST, fMyDispatcher.GetMsgID(MyMP1), 1, 0)
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
PostMessage(HWND_BROADCAST, fMyDispatcher.GetMsgID(MyMP2), 2, 0)
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 PostMessage(HWND_BROADCAST, fMyDispatcher.GetMsgID(MyMP3), 3, 0)
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  fMyDispatcher := TMyDispatcher.create;
  fObjectProc := TObjectProc.Create;
  fNotFormMsg := TMyNotFormMsg.Create;
  fMyDispatcher.AddMyMessageProc(MyMP1, fObjectProc.Proc1);
  fMyDispatcher.AddMyMessageProc(MyMP2, fObjectProc.Proc2);
  fMyDispatcher.AddMyMessageProc(MyMP3, fObjectProc.Proc3);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  fNotFormMsg.Free;
  fMyDispatcher.Free;
  fObjectProc.Free;
end;

end.

//==============================================================================
// dispatchÄ£¿é
//==============================================================================

unit Unit2;

interface

uses
  Messages, Classes, SysUtils, Dialogs, Windows;

const
  MyMP1 = ‘MyMp1‘;
  MyMP2 = ‘MyMp2‘;
  MyMP3 = ‘MyMP3‘;
  MaxMsgCount = 10;

type
  TMyMessageProc = procedure(var AMessage: TMessage) of object;

  PMsgR = ^TMsgR;

  TMsgR = packed record
    MsgInfo: PAnsiChar;
    Msg: Cardinal;
    MyMessageProc: TMyMessageProc;
  end;

  TMyDispatcher = class(TObject)
  private
    DispatcherList: TList;
  public
    constructor Create;
    destructor destroy; override;
    function GetBaseIndex(MsgID: Integer): Integer;
    procedure AddMyMessageProc(MsgInfo: PAnsiChar; MessageProc: TMyMessageProc);
    procedure SendMessage(var Amessage: TMessage);
    function RegMessages(MsgInfo: PAnsiChar): Integer;
    function GetMsgID(MsgInfo: PAnsiChar): Integer;
  end;

implementation

function Tmydispatcher.GetMsgID(MsgInfo: PAnsiChar): Integer;
var
  I: Integer;
begin
  for I := 0 to DispatcherList.Count - 1 do
    if Trim(Tmsgr(DispatcherList[I]^).MsgInfo) = Trim(MsgInfo) then
    begin
      Result := Tmsgr(DispatcherList[I]^).Msg;
      break;
    end;
end;

function TMyDispatcher.RegMessages(MsgInfo: PAnsiChar): Integer;
begin
  Result := RegisterWindowMessage(MsgInfo);
end;

constructor TMyDispatcher.Create;
begin
  inherited Create;
  DispatcherList := TList.Create;
end;

destructor TMyDispatcher.destroy;
var
  I:Integer;
  PmP:PMsgR;
begin
  for I:=DispatcherList.Count-1 downto 0 do
   begin
     pmp:=DispatcherList[I];
     Dispose(PmP);
     DispatcherList.Delete(I);
   end;
  DispatcherList.Free;
  inherited destroy;
end;


function TMyDispatcher.GetBaseIndex(MsgID: Integer): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to DispatcherList.Count - 1 do
  begin
    if Tmsgr(DispatcherList[I]^).Msg = MsgID then
    begin
      Result := I;
      Break;
    end;

  end;
end;

procedure TMyDispatcher.AddMyMessageProc(MsgInfo: PAnsiChar; MessageProc: TMyMessageProc);
var
  PMP: PMsgR;
begin
  New(PMP);
  PMP^.MyMessageProc := MessageProc;
  PMP^.MsgInfo := MsgInfo;
  PMP^.Msg:=RegMessages(MsgInfo);
  DispatcherList.Add(PMP);
end;

procedure TMyDispatcher.SendMessage(var Amessage: TMessage);
begin
  if Assigned(Tmsgr(DispatcherList[GetBaseIndex(Amessage.Msg)]^).MyMessageProc) then
    Tmsgr(DispatcherList[GetBaseIndex(Amessage.Msg)]^).MyMessageProc(Amessage);
end;

end.

unit Unit3;

//==============================================================================
// ¹¦Äܺ¯Êýµ¥Ôª
//==============================================================================


interface

uses
  messages, SysUtils,Dialogs;

type
  TObjectProc = class(TObject)
  public
    procedure Proc1(var Amessage: TMessage);
    procedure Proc2(var Amessage: TMessage);
    procedure Proc3(var Amessage: TMessage);
  end;

implementation
  procedure Tobjectproc.Proc1(var Amessage: TMessage);
  begin
    showmessage(‘函数1，消息编号 ‘+IntToStr(Amessage.Msg));
  end;
   procedure Tobjectproc.Proc2(var Amessage: TMessage);
  begin
    showmessage(‘函数2，消息编号 ‘+IntToStr(Amessage.Msg));
  end;
   procedure Tobjectproc.Proc3(var Amessage: TMessage);
  begin
    showmessage(‘函数3，消息编号‘+IntToStr(Amessage.Msg));   
  end;
end.

//==============================================================================
// ÎÞ´°¿Ú½ÓÊÜÏûÏ¢µ¥Ôª
//==============================================================================

unit Unit4;

interface

uses
  Messages, Classes, SysUtils, Unit2, Unit3;

type
  TMyNotFormMsg = class
  private
    fHWND: THandle;
  public
    constructor Create;
    destructor destroy;
    procedure MyMsgMethod(var Message: TMessage);
  end;

implementation
   uses Unit1;
constructor TMyNotFormMsg.Create;
begin
  fHWND := AllocateHWnd(MyMsgMethod);       {´´½¨ÎÞ´°¿ÚÏûÏ¢}
end;

destructor TMyNotFormMsg.destroy;
begin
  FreeAndNil(fHWND);
end;

procedure TMyNotFormMsg.MyMsgMethod(var Message: TMessage);
begin
  if Form1.MyDispatcher.GetBaseIndex(Message.Msg) > -1 then
    Form1.MyDispatcher.SendMessage(Message);

end;

end.