很好的冒泡提示功能

来源：互联网发布：淘宝全民疯抢在哪里编辑：程序博客网时间：2024/06/09 17:16

具体使用可以参考QQ发送空字符的时候会有“发送内容不能为空，请重新输入”的Hint。

实际函数：

procedure QiPaoShowMessage(h:HWND;text,cap:string;IconType:integer=1;t:integer=2000;left:Integer=0;top:Integer=0);
var
r : TRect;                       //是一个记录（Record），保存了矩形的（左上角右下角两个点）4个坐标或2个点的值。
hTooltip: Cardinal;    //Cardinal是无符号32位整数，取值0到4294967295范围。
ti: TToolInfo;
begin
hToolTip := CreateWindow('Tooltips_Class32', nil, $40, 0, 0, 0, 0, 0, 0, hInstance, nil);
if hToolTip <> 0 then
begin
    //让气泡在最前面
    SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
    ti.cbSize := SizeOf(TToolInfo);
    ti.uFlags := TTF_IDISHWND{ or TTF_TRACK};
    ti.hInst := hInstance;
    ti.lpszText :=pchar(text);
    SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(@ti));
    if (IconType > 3) or (IconType < 0) then IconType:=0;
    SendMessage(hToolTip,WM_USER + 32,IconType,Integer(pchar(cap)));
    GetWindowRect(H,R);             //获取指定控件的坐标,R.Right 、R.Left、R.Bottom、R.Top
    r.Left:=r.Left-left;
    r.Top:=r.Top-top;

    //if   BackColor <> 0   then
    SendMessage(hToolTip,   TTM_SETTIPBKCOLOR,   clSkyBlue,   0);
//        if   TextColor <> 0   then
//        SendMessage(hToolTip,   TTM_SETTIPTEXTCOLOR,   TextColor,   0);

    //定义气泡位置
    SendMessage(hToolTip,TTM_TRACKPOSITION, 0, MAKELONG((r.Right - r.Left) div 2 + r.Left, (r.Bottom - r.Top) div 2 + r.Top));
    SendMessage(hToolTip, TTM_TRACKACTIVATE, Integer(True), Integer(@ti));
    Sleep(t);
    DestroyWindow(hToolTip);

end;
end;

调用说明：如果不能做什么事的情况就给客户一个合理的提示，这样客户就容易明白是怎么一回事了！

提高客户对程序的自主使用，以及对程序的认同。

procedure TfrmEmployeePassSet.ctrEmployeeChanging(Sender: TObject;
Node: TTreeNode; var AllowChange: Boolean);
begin
AllowChange := FormState = fsView;
if not AllowChange then
begin
QiPaoShowMessage(Handle, csNotChangeEmployee, csHint);
end;
end;