posted February 15, 2006 07:06 PM            

'o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o
'  ToolTips2.inc  Last Modified by Bob Scott on 2/16/2006
'  11/30/2004 Changed so added controls are only updated
'  02/16/2006 per Michael Mattias input added %TTS_NOPREFIX style
'
' Based upon an original ToolTips.inc file by William Burns
'  http://www.powerbasic.com/support/forums/Forum7/HTML/002157.html  
'
'  Used to add or remove balloon style tooltips to dialog items.
'  Free to use as you see fit.
'
'  Example Usage:
'CallBack Function DLGPROC
'   Select Case CbMsg
'      Case %WM_INITDIALOG
'             This will add tooltip to a control
'         SetToolTip hWnd, %IDCANCEL, "Press this to close"
'             This will add tooltip to the main dialog background
'         SetToolTip hWnd, 0, "Program made by Me Inc."
'..................................................................
'         This will remove tooltip from a control
'         RemoveToolTip hWnd, %IDCANCEL    ' <===== Scott 11/30/04
'         This will remove tooltip from the main dialog background
'         RemoveToolTip hWnd, 0            ' <===== Scott 11/29/04
'
'o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o
' NOTE:   This include file uses the CommCtrl.Inc file too.  So if
'         you also need to use CommCtrl.Inc in your program, you
'         will need to place the #Include "CommCtrl.Inc" line'
'         before inlcuding this file, and make sure you do not use
'         the %NOTOOLTIPS
'o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o
#IF NOT %DEF(%WINAPI)
    #INCLUDE "win32api.inc"     'add win32api if not already added
#ENDIF
#IF NOT %DEF(%COMMCTRL_INC)
    %NOANIMATE         = 1
    %NOBUTTON          = 1
    %NOCOMBO           = 1
    %NOCOMBOEX         = 1
    %NODATETIMEPICK    = 1
    %NODRAGLIST        = 1
    %NOEDIT            = 1
    %NOFLATSBAPIS      = 1
    %NOHEADER          = 1
    %NOHOTKEY          = 1
    %NOIMAGELIST       = 1
    %NOIPADDRESS       = 1
    %NOLIST            = 1
    %NOLISTVIEW        = 1
    %NOMENUHELP        = 1
    %NOMONTHCAL        = 1
    %NOMUI             = 1
    %NONATIVEFONTCTL   = 1
    %NOPAGESCROLLER    = 1
    %NOPROGRESS        = 1
    %NOREBAR           = 1
    %NOSTATUSBAR       = 1
    %NOSYSLINK         = 1
    %NOTABCONTROL      = 1
    %NOTOOLBAR         = 1
'    %NOTOOLTIPS        = 1  ' Tool tips
    %NOTRACKBAR        = 1
    %NOTRACKMOUSEEVENT = 1
    %NOTREEVIEW        = 1
    %NOUPDOWN          = 1
    #INCLUDE "CommCtrl.Inc"   'add if not already added
#ENDIF
TYPE DLLVERINFO
  cbSize            AS DWORD
  dwMajorVersion    AS DWORD
  dwMinorVersion    AS DWORD
  dwBuildNumber     AS DWORD
  dwPlatformID      AS DWORD
END TYPE
DECLARE FUNCTION DllVer(DVI AS DLLVERINFO) AS LONG
GLOBAL hWnd_ToolTip  AS DWORD
'o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o
FUNCTION SetToolTip(BYVAL hDlg AS DWORD, BYVAL CtlID AS LONG, _
                       BYVAL szText AS ASCIIZ * 1000) AS LONG
   LOCAL TI             AS TOOLINFO
   LOCAL szLastText     AS ASCIIZ * 1000  ' <===== Scott 11/29/04
 
   'Does tooltipclass window already exist?  If not create one.
   IF IsWindow(hWnd_ToolTip) = 0 THEN
      LOCAL iRet        AS LONG
      LOCAL iStyle      AS LONG
      LOCAL DVI         AS DLLVERINFO
      LOCAL hDll        AS DWORD
      LOCAL dProcAddr   AS DWORD
      InitCommonControls
      iStyle = %TTS_NOPREFIX  'in case common control ver is old
      'the following ver check was suggested by MCM.   Thanks
      'Get the handle of the loaded common control DLL
      hDll = GetModuleHandle("COMCTL32.DLL")
      IF ISTRUE hDll THEN
         'get the procedure address from the DLL
         dProcAddr = GetProcAddress(hDll, "DllGetVersion")
         IF ISTRUE dProcAddr THEN
            DVI.CbSize = SIZEOF (DVI)
            CALL DWORD dProcAddr USING DllVer(DVI) TO iRet
            IF iRet = %NOERROR THEN
             'MsgBox "Common Controls Ver " + _
             '       FORMAT$(DVI.dwMajorVersion) + _
             '       "." + FORMAT$(DVI.dwMinorVersion),,"Testing"
               IF DVI.dwMajorVersion > 5 OR _
                 (DVI.dwMajorVersion = 5 AND _
                  DVI.dwMinorVersion => 80) THEN
                 '   new enough version, so use fancy ballon type
                 ' added %TTS_NOPREFIX on 2/16/2006 per MCM input
                 ' Thanks Michael
                 iStyle = %TTS_ALWAYSTIP OR %TTS_BALLOON _
                                         OR %TTS_NOPREFIX
               END IF
            END IF
         END IF
      END IF
      hWnd_ToolTip = _
        CreateWindowEx( 0, "tooltips_class32", "", iStyle, 0, _
                                     0, 0, 0, hDlg, BYVAL 0&, _
                            GetModuleHandle(BYVAL 0&), BYVAL 0&)
      '   suggested by Fred Buffington.  Thanks
      DIALOG SEND hWnd_ToolTip, %TTM_SETMAXTIPWIDTH, 0, 300
      '     Set Tooltip time 15 sec
      DIALOG SEND hWnd_ToolTip, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, _
                                                              15000
   END IF
 
   'Do we have a good handle?
   IF hWnd_ToolTip THEN
      TI.cbSize = SIZEOF(TI)
      TI.uFlags = %TTF_SUBCLASS OR %TTF_IDISHWND
      TI.hWnd = hDlg
 
      IF CtlID = 0 THEN
         TI.uId = hDlg  ' add tooltip to main dialog area
      ELSE
         TI.uId = GetDlgItem(hDlg, CtlID)  'add tooltip to control
      END IF
 
      ' Get Last ToolTip Text              ' <===== Scott 11/29/04
      TI.lpszText = VARPTR(szLastText)     ' <===== Scott 11/29/04
      SendMessage(hWnd_ToolTip, %TTM_GETTEXT, 0, _
                         BYVAL VARPTR(TI)) ' <===== Scott 11/29/04
      TI.lpszText = VARPTR(szText) ' Set new ToolTip Text
 
      ' If Control ID ToolTip Text existed then
      ' just update text                   ' <===== Scott 11/28/04
      IF szLastText <> "" THEN             ' <===== Scott 11/29/04
         '    Update if new text is different
         IF szText <> szLastText THEN      ' <===== Scott 11/29/04
           FUNCTION = SendMessage(hWnd_ToolTip, _
                          %TTM_UPDATETIPTEXT, 0, _
                          BYVAL VARPTR(TI))' <===== Scott 11/29/04
         END IF                            ' <===== Scott 11/28/04
      ELSE                                 ' <===== Scott 11/28/04
         FUNCTION = SendMessage(hWnd_ToolTip, %TTM_ADDTOOL, 0, _
                                                BYVAL VARPTR(TI))
      END IF                               ' <===== Scott 11/28/04
   END IF
END FUNCTION
'o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--
FUNCTION RemoveToolTip(BYVAL hDlg AS DWORD, BYVAL CtlID AS LONG) _
                                                          AS LONG
   ' This routine added by Bob Scott 11/30/04
   LOCAL TI             AS TOOLINFO
   'Does tooltipclass window already exist?  If not exit.
   IF IsWindow(hWnd_ToolTip) = 0 THEN EXIT FUNCTION
   'Do we have a good handle?
   IF hWnd_ToolTip THEN
      TI.cbSize = SIZEOF(TI)
      TI.uFlags = %TTF_SUBCLASS OR %TTF_IDISHWND
      TI.hWnd = hDlg
      IF CtlID = 0 THEN
         TI.uId = hDlg 'if CtrlID = 0 then tooltip in main dialog
      ELSE
         TI.uId = GetDlgItem(hDlg, CtlID) ' ToolTip in control
      END IF
      FUNCTION = SendMessage(hWnd_ToolTip, %TTM_DELTOOL, 0, _
                                             BYVAL VARPTR(TI))
   END IF
END FUNCTION
'o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--