delphiwinapiballoon-tip

Displaying 'x' icon in TBalloonHint


How to display 'x' (close) icon in TBalloonHint?

enter image description here

I want to programmatically display near a control on form a balloon hint that looks like notifications in system tray. If this is not what TBalloonHint can do, what should I use?


Solution

  • First you need a procedure to show your hint :

    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;
    

    Then call it :

    ShowBalloonTip(Button1.Handle, 4, clDefault, clRed, 'Baloon Title', 'Baloon text');
    

    Hint: if you don’t have hWnd (e.g. Speed Buttons or other graphic component) or want to show the baloon elsewhere send TTM_TRACKPOSITION message after TTM_SETTITLE.

    ***** EDIT *****

    This could also be done via a class helper

    First create a unit with a Class helper

    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.
    

    Then call it:

    uses
      ComponentBaloonHintU;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      Button1.ShowBalloonTip(TIconKind.Eror_Large, 'Baloon Title', 'Baloon text');
    end;