Delphi笔记-自定义提示窗口

unit pbHint;

interface

uses
  Windows, Controls, Forms, Graphics;

type
  TPBHint=class(THintWindow) //要自定义提示窗口类,必须从THintWindow类继承
  private
    FRegion:THandle;  //保存当前提示窗口的区域句柄,用来设置窗口的形状
    procedure FreeCurrentRegion;  //释当前的区域句柄
    procedure SetRegion(Rect:TRect);
  public
    Destructor Destroy;override;  //复盖析构函数
    procedure ActivateHint(Rect:TRect;const AHint:String);override;  //复盖该方法,在提示窗口弹出前,设置窗口的形状
    procedure CreateParams(var params:TCreateParams);override; //复盖该方法,去掉WS_Border属性
    procedure Paint;override; //复盖该方法,改变画笔的颜色,然后再画出提示内容
  end;

implementation

{ TPBHint }

procedure TPBHint.ActivateHint(Rect: TRect; const AHint: String);
begin
  with Rect do
  begin
    Right:=Right+Canvas.TextWidth('WWWW'); //这一句是为了让提示窗口的宽度增大4个字符
    Bottom:=Bottom+Canvas.TextHeight('WWWWWW');
  end;
  SetRegion(Rect);
  inherited;
end;

procedure TPBHint.CreateParams(var params: TCreateParams);
begin
  inherited;
  params.Style:=params.Style and (not WS_BORDER);
end;

destructor TPBHint.Destroy;
begin
  FreeCurrentRegion;
  inherited;
end;

procedure TPBHint.FreeCurrentRegion;
begin
  if FRegion<>0 then
  begin
    SetWindowRgn(Self.Handle,0,true);
    DeleteObject(FRegion);
    FRegion:=0;
  end;
end;

procedure TPBHint.Paint;
var tempRect:TRect;
begin
  tempRect:=ClientRect;
  Inc(tempRect.top,12);
  Canvas.Font.Color:=clRed;
  Canvas.Brush.Color:=clWhite;
  DrawText(Canvas.Handle,PChar(Caption),Length(Caption),tempRect,DT_NOPREFIX or DT_WORDBREAK or DT_CENTER or DT_VCENTER);
end;

procedure TPBHint.SetRegion(Rect: TRect);
var tempRgn:HRGN;
begin
  BoundsRect:=Rect;
  FreeCurrentRegion;
  with BoundsRect do
  begin
    FRegion:=CreateRoundRectRgn(0,0,Width,Height,15,15);
    tempRgn:=CreateRectRgn(0,0,Width div 2-2,10);
    CombineRgn(FRegion,FRegion,tempRgn,RGN_DIFF);
    tempRgn:=CreateRectRgn(Width div 2+2,0,Width,10);
    CombineRgn(FRegion,FRegion,tempRgn,RGN_DIFF);
  end;
  if FRegion<>0 then
    SetWindowRgn(Self.Handle,FRegion,true);
end;

initialization
  Application.ShowHint:=false;  //先禁止提示窗口
  HintWindowClass:=TPBHint;   //将自定义的提示窗口类赋值给全局变量HintWindowClass,就可以替换掉原来的提示窗口了
  Application.ShowHint:=true; //开启提示窗口
  Application.HintColor:=clBlue; //改变提示窗口的背景颜色
  
end.

 

转载于:https://www.cnblogs.com/yzryc/p/6386073.html

  • 1
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
应用程序在运行当中经常要输出各种即时信息,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语句里,就可以直接使用自定义函数,非常方便。
应用程序在运行当中经常要输出各种即时信息,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语句里,就可以直接使用自定义函数,非常方便。
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值