首页  编辑  

显示Balloon Tooltip

Tags: /超级猛料/User.自定义类、函数单元/   Date Created:

How to Show Balloon tooltip in my program?

{ copyright kingron }

procedure ShowBalloonTip ( Control : TWinControl ; Icon : integer ; 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 ;

  hWnd : THandle ;

begin

  hWnd := Control . Handle ;

  hWndTip := CreateWindow ( TOOLTIPS_CLASS , nil ,

    WS_POPUP 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 );

    SendMessage ( hWndTip , TTM_ADDTOOL , 1 , integer (@ ti ));

    SendMessage ( hWndTip , TTM_SETTITLE , Icon mod 4 , Integer ( Title ));

  end ;

end ;

procedure TForm1 . Button1Click ( Sender : TObject );

begin

  ShowBalloonTip ( Button1 , 1 , 'Title' ,

    'Balloon tooltip,http://kingron.myetang.com' );

end ;

img_28881.bmp (160.5KB)