深入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单元，主要负责消息分发

//==============================================================================
// 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.