作者热门文章
- html - 出于某种原因,IE8 对我的 Sass 文件中继承的 html5 CSS 不友好?
- JMeter 在响应断言中使用 span 标签的问题
- html - 在 :hover and :active? 上具有不同效果的 CSS 动画
- html - 相对于居中的 html 内容固定的 CSS 重复背景?
如何在TBalloonHint
中显示“x”(关闭)图标?
我想以编程方式在表单上的控件附近显示一个气球提示,看起来像系统托盘中的通知。如果这不是 TBalloonHint
可以做到的,我应该使用什么?
最佳答案
首先你需要一个程序来显示你的提示:
uses
CommCtrl;
// hWnd - control window handle to attach the baloon to.
// Icon - icon index; 0 = none, 1 = info, 2 = warning, 3 = error.
// BackCL - background color or clDefault to use system setting.
// TextCL - text and border colors or clDefault to use system setting.
// Title - tooltip title (bold first line).
// Text - tooltip text.
procedure ShowBalloonTip(hWnd: THandle; Icon: integer; BackCL, TextCL: TColor; Title: pchar; Text: PWideChar);
const
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_ALWAYSTIP = $01;
TTS_NOPREFIX = $02;
TTS_BALLOON = $40;
TTF_SUBCLASS = $0010;
TTF_TRANSPARENT = $0100;
TTF_CENTERTIP = $0002;
TTM_ADDTOOL = $0400 + 50;
TTM_SETTITLE = (WM_USER + 32);
ICC_WIN95_CLASSES = $000000FF;
type
TOOLINFO = packed record
cbSize: integer;
uFlags: integer;
hWnd: THandle;
uId: integer;
rect: TRect;
hinst: THandle;
lpszText: PWideChar;
lParam: integer;
end;
var
hWndTip: THandle;
ti: TOOLINFO;
begin
hWndTip := CreateWindow(TOOLTIPS_CLASS, nil, WS_POPUP or TTS_CLOSE or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP, 0, 0, 0, 0, hWnd, 0, HInstance, nil);
if hWndTip <> 0 then
begin
SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
ti.cbSize := SizeOf(ti);
ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
ti.hWnd := hWnd;
ti.lpszText := Text;
Windows.GetClientRect(hWnd, ti.rect);
if BackCL <> clDefault then
SendMessage(hWndTip, TTM_SETTIPBKCOLOR, BackCL, 0);
if TextCL <> clDefault then
SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, TextCL, 0);
SendMessage(hWndTip, TTM_ADDTOOL, 1, integer(@ti));
SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, integer(Title));
//TTM_TRACKACTIVATE => Makes sure you have to close the hint you self
SendMessage(hWndTip, TTM_TRACKACTIVATE, integer(true), integer(@ti));
end;
end;
然后调用它:
ShowBalloonTip(Button1.Handle, 4, clDefault, clRed, 'Baloon Title', 'Baloon text');
提示:如果您没有 hWnd(例如速度按钮或其他图形组件)或想要在其他地方显示气球,请在 TTM_SETTITLE 之后发送 TTM_TRACKPOSITION 消息。
***** 编辑 *****
这也可以通过类助手来完成
首先创建一个带有类助手的单元
unit ComponentBaloonHintU;
interface
uses
Controls, CommCtrl, Graphics;
{$SCOPEDENUMS ON}
type
TIconKind = (None = TTI_NONE, Info = TTI_INFO, Warning = TTI_WARNING, Error = TTI_ERROR, Info_Large = TTI_INFO_LARGE, Warning_Large = TTI_WARNING_LARGE, Eror_Large = TTI_ERROR_LARGE);
TComponentBaloonhint = class helper for TWinControl
public
procedure ShowBalloonTip(Icon: TIconKind; const Title, Text: string);
end;
implementation
uses
Windows;
{ TComponentBaloonhint }
procedure TComponentBaloonhint.ShowBalloonTip(Icon: TIconKind; const Title, Text: string);
var
hWndTip: THandle;
ToolInfo: TToolInfo;
BodyText: pWideChar;
begin
hWndTip := CreateWindow(TOOLTIPS_CLASS, nil, WS_POPUP or TTS_CLOSE or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP, 0, 0, 0, 0, Handle, 0, HInstance, nil);
if hWndTip = 0 then
exit;
GetMem(BodyText, 2 * 256);
try
ToolInfo.cbSize := SizeOf(TToolInfo);
ToolInfo.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
ToolInfo.hWnd := Handle;
ToolInfo.lpszText := StringToWideChar(Text, BodyText, 2 * 356);
SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
ToolInfo.Rect := GetClientRect;
SendMessage(hWndTip, TTM_ADDTOOL, 1, integer(@ToolInfo));
SendMessage(hWndTip, TTM_SETTITLE, integer(Icon), integer(PChar(Title)));
SendMessage(hWndTip, TTM_TRACKACTIVATE, integer(true), integer(@ToolInfo));
finally
FreeMem(BodyText);
end;
end;
end.
然后调用它:
uses
ComponentBaloonHintU;
procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.ShowBalloonTip(TIconKind.Eror_Large, 'Baloon Title', 'Baloon text');
end;
关于delphi - 在 TBalloonHint 中显示 'x' 图标,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/26247528/
当我使用 TBalloonhint (delphi) 组件时,我找不到如何更改默认字体。有什么办法吗? 最佳答案 你有两个选择: 简单但不推荐:您可以使用Screen.HintFont属性来调整字体。
如何在TBalloonHint中显示“x”(关闭)图标? 我想以编程方式在表单上的控件附近显示一个气球提示,看起来像系统托盘中的通知。如果这不是 TBalloonHint 可以做到的,我应该使用什么?
我是一名优秀的程序员,十分优秀!