Delphi 显示'；x'；TBalloonHint中的图标

如何在

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;

提示：如果您没有hWnd（例如速度按钮或其他图形组件）或希望在其他位置显示阳台，请在TTM_设置标题后发送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.

首先使用类助手创建一个单元

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;

---

关闭按钮是通过在基础Windows工具提示控件上设置

TTS\u close

样式添加的。但是，我不知道您在Delphi中是如何做到这一点的。

TBalloonHint

源于

TCustomHint

，它包装了一个Windows工具提示控件，但是

TBalloonHint

没有使用

TTS_BALLOON

样式，这是

TTS_CLOSE

所需要的

TBalloonHint

是一个自定义绘制的工具提示，它模仿了引出序号工具提示，但实际上并不是一个，就Windows而言。您可以从

TBalloonHint

派生并覆盖

PaintHint（）

来绘制自己的关闭按钮，但它不会像按钮一样工作。非常好！请注意，在较新版本的Delphi（我使用的是XE5）上，您不应该使用这些常量和TOOLINFO记录，因为它们不是Unicode版本。现在在CommCtrl中定义了正确的。SendMessage中的整数强制转换也应更改为wparam和lparam强制转换。感谢您的更新@MarkF我正在考虑将其作为一个组件，然后我可以修复您刚才列出的问题，效果非常好。在Windows Vista和更高版本上，我们还可以使用以下图标：4=TTI\u INFO\u LARGE，5=TTI\u WARNING\u LARGE，6=TTI\u ERROR\u LARGE（）@Pol感谢您的回复。我已经制作了一个更新版本的工具提示，并更正了您指出的内容。@JensBorrisholt，第二个版本，类帮助器实现，它正确地显示了引出序号提示，但单击它不会隐藏它，直到您单击那个小关闭按钮。当用户单击提示窗口本身（而不仅仅是关闭按钮）时，如何使其隐藏提示窗口？谢谢