再谈 Delphi MessageBox 系统消息框的扩展

  在笔者《Delphi MessageBox消息框应用窗口居中实用解决方案-CSDN博客》中,提到了用新线程操作 MessageBox 消息对话框,使其显示在 HWND 窗口中央而不是桌面中央。其实,在新线程中还可以对消息框做更多的操作。本文就增加一个定时回答默认按钮的功能,可在一定时间后自动选择默认选项,关闭消息对话框,从而让程序自动进行下去。只增加几行代码和一个指定等待时间的全局变量就能实现这个功能。具体代码如下:

implementation

{$R *.dfm}

//============从这里开始到下面结束这段代码放在调用程序之前即可================

type
  TMyThread = class(TThread)        //定义新线程
  protected
    procedure Execute; override;      //新线程创建后即运行
  end;

var
  hMain: HWND;                
  MsgTitle: string;
  WaitColse: integer;                          //全局变量,通过它们向新线程传递相关参数

procedure TMyThread.Execute;                  //新线程执行程序
var
  mR, pR, sR: TRect;
  X, Y: Integer;
  hMsg: HWND;
begin
  FreeOnTerminate := True; { 这可以让线程执行完毕后随即释放 }
  sleep(5);                                    // 等消息框建立
  hMsg := FindWindow(nil, PChar(MsgTitle));    //根据消息窗口标题获取其句柄

  GetWindowRect(hMsg, mR);                     // 取消息框窗口矩形位置大小
  GetWindowRect(hMain, pR);                    // 取父窗口矩形位置大小
  GetWindowRect(GetDesktopWindow, sR);         // 取屏幕桌面矩形位置大小

  X := pR.Left + (pR.Width - mR.Width) div 2;
  Y := pR.Top + (pR.Height - mR.Height) div 2; //将消息框座标设定在HWND窗口中央

  if X < 0 then
    X := 0;
  if X > sR.Width - mR.Width then
    X := sR.Width - mR.Width;
  if Y < 0 then
    Y := 0;
  if Y > sR.Height - mR.Height then
    Y := sR.Height - mR.Height;              //将消息框限制在桌面内

  SetWindowPos(hMsg, HWND_TOP, X, Y, 0, 0, SWP_NOSIZE or SWP_SHOWWINDOW or
    SWP_NOOWNERZORDER);                      //将消息框移动到 HWND 窗口中央。

  if WaitColse = 0 then                      //如果等待时间为0,则与原来一样,等待用户响应
    exit;

  sleep(1000 * WaitColse );                  //等待WaitColse秒。

  PostMessage(hMsg, WM_KEYDOWN, 13, 0);
  PostMessage(hMsg, WM_KEYUP, 13, 0);        //向消息框窗口发送回车,选择默认按钮
end;

// 主函数。在HWND中央显示消息框。Wait为等待时间(秒),为0或省略则一直等待用户选择。 
function MsgBox(const HWND: HWND; const msg, title: string;
  const mbType: WORD; const Wait: integer = 0): WORD;
begin
  hMain := HWND;
  if not IsWindow(hMain) then
    hMain := GetDesktopWindow;  //如果HWND不存在则为桌面
  if title <> '' then
    MsgTitle := title
  else
    MsgTitle := #32;            //如果消息对话框无标题则将标题设为空格方便新线程查找
  WaitColse := Wait;              
  TMyThread.Create(False);      //创建新线程且立即运行
  result := MessageBox(HWND, PChar(msg), PChar(MsgTitle), mbType + MB_TOPMOST);
end;
// ===========================代码结束=================================


  扩展后的函数为 MsgBox,如果HWND = 0且省略 Wait 参数,则与 MessageBox 完全一样。扩展用法:

  如果 HWND 存在,MessageBox 窗口将显示在该窗口的中央,否则显示在桌面中央;
  如果有 Wait 参数且不为0,则用户如果在 Wait 秒内没有选择按钮,到时自动选择默认按钮。

  例如:

procedure TForm3.Button1Click(Sender: TObject);
begin
 if MsgBox(handle, '消息内容', '消息标题', MB_YESNO or MB_DEFBUTTON2, 5) = mrYes then
   close;
end;


   按  Form3 中的 Button1 按钮后,消息框会显示在 Form3 窗口中央。在5秒内用户如果按Yes,则关闭 Form3,如果5秒后还未操作,则自动按默认选项 No,关闭消息对话框。 

  • 3
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 2
    评论
应用程序在运行当中经常要输出各种即时信息,Delphi提供了多种形式的消息对话可以满足这些要求,尽管可以使用各种标志定制一个消息,但仍不能将自己的图标放在消息内,也不能修改其标准行为去创建自己的消息,其实通过调用函数MessageBoxIndirect()就很容易绕过这些明确的限制,这是一个功能很强、易于使用的函数。 ---- 此函数在WINDOWS单元里面,文件位于Delphi安装路径Source\Rtl\Win里面,需要指出的是,Delphi的原代码中它的返回值类型是BOOL型,而实质上它的返回值应为Integer。修改方法:在WINDOWS单元中找到此函数后,把BOOL改为Integer,共有三处要修改,然后在Delphi安装路径Lib中找到WINDOWS.DCU文件,把它改名或者删除,并把修改后的WINDOWS.PAS源码复制到Lib路径中。 ---- 该函数只有一个参数,类型是TMsgBoxParams,它的结构及说明如下: tagMSGBOXPARAMSA = packed record cbSize: UINT; {数据结构的长度} hwndOwner: HWND; {所有者窗口句柄} hInstance: HINST; {应用程序实例句柄} lpszText: PAnsiChar; {在消息客户区内显示的文本} lpszCaption: PAnsiChar; {标题栏文本} dwStyle: DWORD; {确定消息内按钮和图符 的数量及种类的MB_标志} lpszIcon: PAnsiChar; {从资源文件中取出的一个 图符资源的名字} dwContextHelpId: DWORD; {指定帮助文本的ID号} lpfnMsgBoxCallback: TPRMsgBoxCallback; {当用户按下HELP按钮时调用的一个回 调函数} dwLanguageId: DWORD; {显示在按钮内文本的语言定义} end; ---- 由于直接使用此函数比较复杂,我们可以自定义一个函数来封装此函数,对它进行简化,在用法上尽量做到与Delphi消息相一致,自定义函数代码如下: function MessageEx (lText,lCaption:PChar; lStyle:DWord;lIcon:PChar):Integer; var Msg:TMsgBoxParams; begin Msg.cbSize:=Sizeof(Msg); Msg.hwndOwner:=Application.Handle; Msg.hInstance:=hinstance; Msg.lpszText:=lText; Msg.lpszCaption:=lCaption; Msg.dwStyle:=lStyle; Msg.lpszIcon:=lIcon; Msg.dwContextHelpId:=1; Msg.lpfnMsgBoxCallback:=nil; Msg.dwLanguageId:=LANG_NEUTRAL; Result:=MessageBoxIndirect(Msg); end; ---- 要想在消息中显示自己的图标,先准备一个装有图标的资源文件,加在程序中,如{$R c:\mydir\myres.res},在lStyle参数里除了所需的MB_标志外还要加上MB_USERICON标志,并在最后一个参数里写上资源文件中图标的名字,如果不想使用自定义的图标,可将最后一个参数设为nil。函数的其它用法和返回值的处理与Delphi提供的消息一样。 ---- 强烈建议把自定义函数放在一个单元文件里,并把此文件放在Delphi的搜索路径如Lib下,以后只需要把此单元加在uses语句里,就可以直接使用自定义函数,非常方便。

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 2
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值