一、程序界面
二、程序代码
(一)、主界面代码
//============================================================================== // 主窗口 //============================================================================== 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.
原文地址:https://www.cnblogs.com/LifeStartPoint/p/12229643.html
时间: 2024-08-28 21:20:27