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