' =========== 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