File "ToolTip.inc"

Path: /nimoworld/inc/ToolTip.inc
File size: 2.71 KB
MIME-type:
Charset: 8 bit

' =========== USAGE ================================================
'
' In a CallBack (important), e.g. in the CASE %WM_INITDIALOG
'
'    CALL tooltip_settooltip (GetDlgItem(CB.HNDL, %IDC_LABEL1), "bla bla bla") ' in this case the label must have the %SS_NOTIFY property
'    CALL tooltip_settooltip (GetDlgItem(CB.HNDL, %IDC_BUTTON2), "bla bla bla")
'    CALL tooltip_settooltip (GetDlgItem(CB.HNDL, %IDC_TEXTBOX3), "bla bla bla")
'    ...
'
' ==================================================================

TYPE TOOLINFO
  cbSize AS DWORD
  uFlags AS DWORD
  hwnd AS DWORD
  uId AS DWORD
  rec AS RECT
  hinst AS DWORD
  lpszText AS ASCIIZ PTR
  lParam AS LONG
  lpReserved AS DWORD
END TYPE

'------------------------------------------
GLOBAL htooltips AS LONG
'------------------------------------------
%tts_alwaystip     = &h01
%tts_balloon       = &h40
%ttf_idishwnd      = &h0001
%ttf_subclass      = &h0010
%ttm_addtool       = %WM_USER +  4
%ttm_deltool       = %WM_USER +  5
%ttm_gettoolinfo   = %WM_USER +  8
%ttm_setmaxtipwidth  = %WM_USER + 24
'------------------------------------------
$txtcrlf = CHR$(13)
'------------------------------------------

'
' internal use only - create tooltips control if needed.
'
FUNCTION tooltip_create (BYVAL hwnd AS LONG) AS LONG
  IF htooltips = 0 THEN
     IF hwnd = 0 THEN hwnd = getactivewindow()
     IF hwnd = 0 THEN EXIT FUNCTION
     htooltips = createwindowex(0, "tooltips_class32", "", %tts_alwaystip OR %tts_balloon, _
             0, 0, 0, 0, hwnd, BYVAL 0&, getmodulehandle(BYVAL %NULL), BYVAL %null)
     DIALOG SEND htooltips, %ttm_setmaxtipwidth, 0, 300
  END IF
  FUNCTION = htooltips
END FUNCTION

'
' add a tooltip to a window/control - original code by e.b. knoppert
'
FUNCTION tooltip_settooltip (BYVAL hwnd AS LONG, BYVAL TXT AS STRING) AS LONG
  LOCAL ti AS toolinfo

  IF tooltip_create(getparent(hwnd)) = 0 THEN EXIT FUNCTION 'ensure creation

  REPLACE "|" WITH $txtcrlf IN TXT

  ti.cbsize   = LEN(ti)
  ti.uflags   = %ttf_subclass OR %ttf_idishwnd
  ti.hwnd     = getparent(hwnd)
  ti.uid      = hwnd

  'remove existing tooltip
  IF sendmessage (htooltips, %ttm_gettoolinfo, 0, BYVAL VARPTR(ti)) THEN
     sendmessage htooltips, %ttm_deltool, 0, BYVAL VARPTR(ti)
  END IF

  ti.cbsize   = LEN(ti)
  ti.uflags   = %ttf_subclass OR %ttf_idishwnd
  ti.hwnd     = getparent(hwnd)
  ti.uid      = hwnd
  ti.lpsztext = STRPTR(TXT)

  FUNCTION = sendmessage(htooltips, %ttm_addtool, 0, BYVAL VARPTR(ti)) 'add tooltip
END FUNCTION