一、程序界面

二、程序代码

  (一)、主界面代码

//==============================================================================
// 主窗口
//============================================================================== 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.

深入delphi编程理解之消息(六)无窗口单元消息的创建、接受及dispatch模式编程的更多相关文章

  1. VS2010/MFC编程入门之十六(对话框:消息对话框)

    前面几节鸡啄米讲了属性页对话框,我们可以根据所讲内容方便的建立自己的属性页对话框.本节讲解Windows系统中最常用最简单的一类对话框--消息对话框. 我们在使用Windows系统的过程中经常会见到消 ...

  2. 工作总结:VS2010/MFC编程入门之十六(对话框:消息对话框)

    原文地址:http://www.jizhuomi.com/software/171.html 我们在使用Windows系统的过程中经常会见到消息对话框,提示我们有异常发生或提出询问等.因为在软件开发中 ...

  3. 深入delphi编程理解之消息(一)WINDOWS原生窗口编写及消息处理过程

    通过以sdk方式编制windows窗口程序,对理解windows消息驱动机制和delphi消息编程有很大的帮助. sdk编制windows窗口程序的步骤: 1.对TWndClass对象进行赋值; 2. ...

  4. 深入delphi编程理解之消息(二)发送消息函数及消息编号、消息结构体的理解

    一.delphi发送消息的函数主要有以下三个: (一).SendMessage函数,其原型如下: function SendMessage( hWnd: HWND; {目标句柄} Msg: UINT; ...

  5. 网络编程懒人入门(六):深入浅出,全面理解HTTP协议

    本文引用了自简书作者“涤生_Woo”的文章,内容有删减,感谢原作者的分享. 1.前言 HTTP(全称超文本传输协议,英文全称HyperText Transfer Protocol)是互联网上应用最为广 ...

  6. Java并发编程原理与实战三十六:阻塞队列&消息队列

    一.阻塞队列 1.阻塞队列BlockingQueue ---->可以理解成生产者消费者的模式---->消费者要等待到生产者生产出来产品.---->而非阻塞队列ConcurrentLi ...

  7. 第3章 窗口与消息_3.1Windows编程模型

    第3章窗口与消息 3.1 Windows_编程模型 (1)窗口程序的运行过程   ①设计窗口   ②注册窗口类(RegisterClassEx).在注册之前,要先填写RegisterClassEx的参 ...

  8. 关于Delphi XE2的FMX的一点点研究之消息篇

    Delphi XE2出来了一阵子了,里面比较抢眼的东西,除了VCLStyle这个换肤的东西之外,另外最让人眼亮的应该是FMX这个东西了.万一的博客上都连载了一票的关于FMX的使用心得了.我还是没咋去关 ...

  9. 深入浅出理解基于 Kafka 和 ZooKeeper 的分布式消息队列

    消息队列中间件是分布式系统中重要的组件,主要解决应用耦合,异步消息,流量削锋等问题.实现高性能,高可用,可伸缩和最终一致性架构,是大型分布式系统不可缺少的中间件. 本场 Chat 主要内容: Kafk ...

随机推荐

  1. 关于EasyUI DataGrid行编辑时嵌入时间控件

    本人做一个名为“安徽中控”项目时,为快速开发基础数据增删改模块,遂采用EasyUIDatagrid将所有增删改查的操作都集中于表格中,并且所有增删改查操作都集中于泛型对象,从而不必为每个表写具体的增删 ...

  2. 二、vim的保存文件和退出命令

    vim的保存文件和退出命令   命令 简单说明 :w 保存编辑后的文件内容,但不退出vim编辑器.这个命令的作用是把内存缓冲区中的数据写到启动vim时指定的文件中. :w! 强制写文件,即强制覆盖原有 ...

  3. opensuse安装pycharm

    最近在学习python,所以查询了很多资料,大多都推荐pycharm进行pychon项目开发.于是查阅一些资料,整理出这个安装步骤.(仅供参考!!!仅供参考!!!仅供参考!!!) 仅供参考!!!仅供参 ...

  4. ORA-01476: 除数为 0

    假设是a/bdecode(b,0,null,a/b) 这样如果b为0,输出null,不为0输出a/b decode():将查询结果翻译成其他值,类似三目运算符 比较1个参数时      decode( ...

  5. 转载:android audio flinger

    https://blog.csdn.net/innost/article/details/6142812 https://blog.csdn.net/zyuanyun/article/details/ ...

  6. centos7 tar.gz zip 解压命令

    tar负责打包,gzip负责压缩 tar -c: 建立压缩档案 -x:解压 -t:查看内容 -r:向压缩归档文件末尾追加文件 -u:更新原压缩包中的文件 这五个是独立的命令,压缩解压都要用到其中一个, ...

  7. python中一行字符串太多写不下时怎么写

    ‘123456789‘ 见此博客    https://www.cnblogs.com/wanderingzj/p/5244451.html str1=('123 '455' '789') 这样的话, ...

  8. 53最大子序和.py

    题目:给定一个整数数组 nums ,找到一个具有最大和的连续子数组(子数组最少包含一个元素),返回其最大和. 来源:https://leetcode-cn.com/problems/maximum-s ...

  9. JQ 遍历--(祖先,后代,同胞,过滤)

    祖先 <style> .one,.one *{ display: block; border: 2px solid lightgrey; color: lightgrey; padding ...

  10. python3 求一个list的所有子集

    python3 求一个list的所有子集 def PowerSetsBinary(items): N = len(items) for i in range(2 ** N):#子集的个数 combo ...