Announcement

Collapse
No announcement yet.

tooltips on a console

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • tooltips on a console

    Thinking about how to do tooltips on a console. Presumably one could create a tiny window to "host" the tooltip, and place it at the cursor position, but how to work out the the cursor position on the graphics screen?

  • #2
    ???

    GetCursorPos() should work.

    (Note in same sentence you ask about the "console" and a "GRAPHICS screen". Two different animals.)
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

    Comment


    • #3
      progress

      Well, it works but is at the "horrible" stage. Any help appreciated.
      Code:
      '
      '  a way of putting tooltips on a console screen.
      '  Left-Click on the item to get a little tootip owner window. I know.
      '  Left-click it again to dismiss the tooltip owner window.
      '  to do:
      '      make tooltip owner window the same size as the console screen "object"
      '      and make it transparent.
      '      find a better way to dismiss the tooltip.
      '
      '    Chris Holbrook Aug 2008.
      '
      #COMPILE EXE
      #DIM ALL
      #INCLUDE "COMMCTRL.INC"
      #INCLUDE "win32api.inc"
      
      '------------------------------------------------------------------------
      GLOBAL  ghwnd AS DWORD
      GLOBAL hWndToolTip  AS DWORD
      '-----------------------------------------------------------------
      SUB CreateTip( tl AS DWORD, Tip AS STRING )
      STATIC Crt          AS CREATESTRUCT
      STATIC TlInfo       AS TOOLINFO
      STATIC hInst        AS LONG
      LOCAL hdlg          AS DWORD
          IF hWndToolTip THEN 'it's been initialized
      
              IF tl = 0 THEN EXIT IF
              TlInfo.hwnd = tl
              TlInfo.uId = tl
              TlInfo.lpszText = STRPTR(Tip)
              SendMessage( hWndToolTip, %TTM_ADDTOOL, 0, VARPTR( TlInfo ) )
              SendMessage( hWndToolTip, %TTM_ACTIVATE, 1, 0 )
      
          ELSE 'just initializing this time through
              LOCAL ice AS INIT_COMMON_CONTROLSEX
              ice.dwSize = SIZEOF(ice)
              ice.dwICC = %ICC_WIN95_CLASSES
              InitCommonControlsEx(ice)
              hdlg = getparent(tl)
              hInst = GetModuleHandle("")
              Tip = "ToolTip"
              Crt.lpCreateParams = 0
              Crt.hInstance    = hInst
              Crt.hMenu        = 0
              Crt.hwndParent   = getparent(tl)
              Crt.style        = %WS_POPUP OR %TTS_NOPREFIX OR %TTS_ALWAYSTIP
              Crt.lpszName     = STRPTR(Tip)
              Tip = $TOOLTIPS_CLASS
              Crt.lpszClass    = STRPTR(Tip)
              Crt.dwExStyle    = %WS_EX_TOPMOST
      
              hWndToolTip = CreateWindowEx( %WS_EX_TOPMOST, $TOOLTIPS_CLASS, "", _
              %WS_POPUP OR %TTS_NOPREFIX OR %TTS_ALWAYSTIP OR %TTS_BALLOON, _
                  %CW_USEDEFAULT, %CW_USEDEFAULT, %CW_USEDEFAULT, _
                  %CW_USEDEFAULT, hDlg, 0, hInst, Crt )
      
      
              SENDmessage hWndToolTip, %TTM_SETMAXTIPWIDTH, 0, 200
      
              SetWindowPos( hWndToolTip, %HWND_TOPMOST, 100, 100, 300, 300, _
                  %SWP_NOMOVE OR %SWP_NOSIZE OR %SWP_NOACTIVATE )
      
              SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_INITIAL, 100 ) 'time a pointer must remain stationary before the tooltip appears
              SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 5000 ) 'time a tooltip window remains visible If the Pointer is stationary
              SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_RESHOW, 500 ) 'time before subsequent tooltips to appear
      
              '------------------------------
              TlInfo.cbSize = SIZEOF( TOOLINFO )
              TlInfo.uFlags = %TTF_SUBCLASS OR %TTS_ALWAYSTIP OR %TTS_BALLOON OR %TTF_CENTERTIP
              TlInfo.hinst = hInst
      
          END IF 'hWndToolTip
      
      END SUB 'CreateTip
      
      '--------------------------------------------------------------------------
      FUNCTION WndProc( BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
          BYVAL wParam AS LONG, _
          BYVAL lParam AS LONG ) EXPORT AS LONG
          LOCAL sz AS ASCIZ * 32
          LOCAL pNMH AS NMHDR PTR
      
      '    sz = getmsgtxt(wmsg)
          SELECT CASE AS LONG wMsg
              CASE %WM_LBUTTONDOWN
                  sendmessage hwnd, %WM_CLOSE,0,0
              CASE %WM_DESTROY
                  postquitmessage(0)
          END SELECT
      
          FUNCTION = DefWindowProc( hWnd, wMsg, wParam, lParam )
      
      END FUNCTION
      '------------------------------------------------------------------------------
      FUNCTION startwindow(x AS LONG, y AS LONG, stip AS STRING ) AS LONG
          LOCAL tmsg          AS tagMsg                   ' message information
          LOCAL hWnd, hinst, i, lresult          AS DWORD
          LOCAL szClassName   AS ASCIIZ * 32       ' class name
          LOCAL tWCX          AS WndClassEx               ' class information
      
          '
          hinst = getmodulehandle(BYVAL 0)
          szClassName = "mineallmine"
          twcx.cbSize        = SIZEOF(twcx)                               ' size of WNDCLASSEX structure
          twcx.style         = %CS_DBLCLKS                                ' class styles
          twcx.lpfnWndProc   = CODEPTR(WndProc)                           ' address of window procedure used by class
          twcx.cbClsExtra    = 0                                          ' extra class bytes
          twcx.cbWndExtra    = 0                                          ' extra window bytes
          twcx.hInstance     = hinst                                      ' instance of the EXE/DLL that is registering the window
          twcx.hIcon         = LoadIcon(hinst, BYVAL %IDI_APPLICATION)    ' handle of class icon
          twcx.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)        ' handle of class cursor
          twcx.hbrBackground = GetSysColorBrush(%COLOR_3DFACE)            ' brush used to fill background of window's client area
          twcx.lpszMenuName  = %NULL                                      ' resource identifier of the class menu
          twcx.lpszClassName = VARPTR(szClassName)                        ' class name
          twcx.hIconSm       = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)    ' handle of small icon shown in caption/system Taskbar
          IF ISFALSE RegisterClassEx(twcx) THEN
              FUNCTION = %FALSE
          ELSE
              FUNCTION = %TRUE
          END IF
          
          ghWnd = CreateWindowEx(%WS_EX_WINDOWEDGE OR %WS_EX_TOPMOST , _
                                szclassName, _
                                "...",_
                                %WS_POPUP OR %WS_OVERLAPPED OR %WS_CHILD OR %WS_VISIBLE OR %SS_NOTIFY, _
                                 x, y, 6, 6, _
                                %NULL, %NULL, hInst, BYVAL %NULL)    ' fail if window is not created
          IF ISFALSE ghWnd THEN
              FUNCTION = %FALSE
              EXIT FUNCTION
          END IF
          CreateTip ghwnd, stip
          WHILE ISTRUE GetMessage(tmsg, BYVAL %NULL, 0, 0)
              IF ISFALSE IsDialogMessage(ghWnd, tmsg) THEN
                  TranslateMessage tmsg
                  DispatchMessage tmsg
              END IF
          WEND
          FUNCTION = tmsg.wParam
      END FUNCTION
      
      '--------------------------------------------------
      FUNCTION PBMAIN () AS LONG
          LOCAL s, stip AS STRING
          LOCAL point AS POINTAPI
          LOCAL mx, my AS LONG
      
          CONSOLE SET SCREEN 10,40
          MOUSE ON
              MOUSE 3, DOUBLE, DOWN
          COLOR 7,8
          CLS
          LOCATE 3, 10: COLOR ,4: PRINT SPACE$(6)
          
          LOCATE 6, 20: COLOR ,2: PRINT SPACE$(6)
          CreateTip getparent(ghwnd), ""     'initialize tooltips
          DO
              SLEEP 10
              s = WAITKEY$
              IF LEN(s) = 4 THEN ' mouse event
                  stip = ""
                  my = MOUSEY: mx = MOUSEX
                  IF (MOUSEY) = 3 AND (MOUSEX >=3) AND (MOUSEX <= 16) THEN stip = "red"
                  IF (MOUSEY) = 6 AND (MOUSEX >=6) AND (MOUSEX <= 26) THEN stip = "green"
                  IF LEN(stip) THEN
                      getcursorpos( point)
                      startwindow(point.x, point.Y, stip)
                  END IF
              ELSE
                  IF s = $ESC THEN  sendmessage ghwnd, %WM_CLOSE, 0, 0
              END IF
      
          LOOP
          s = WAITKEY$
      
      END FUNCTION

      Comment


      • #4
        I have a few Tooltip code pieces posted around here that may help. You want the most recent though...if I recall a couple early posts had issues with an Optional ByRef value or something.

        ToolTips can be associated with a Window/Control or an area. Unless you just want it popping up on the edges of the Console you will want to link it to an area to make it popup by a part of the console.

        My Contest Entry here should be new...I no longer have Charter, so the link to the EXE of the app doesn't work, but the code is there.

        http://www.powerbasic.com/support/pb...ad.php?t=35486

        If you search in advanced for my name and tooltips you will find other threads including a thread or so on why I check for DLL/OS versions for Balloon Tips the way I do.
        Last edited by Roger Garstang; 22 Aug 2008, 12:26 AM.
        sigpic
        Mobile Solutions
        Sys Analyst and Development

        Comment


        • #5
          Originally posted by Roger Garstang View Post
          ToolTips can be associated with a Window/Control or an area.
          Yes, I have played with the "area" method following an example of Dominic Mitchell's here but so far without banana.

          Comment


          • #6
            This maps a transparent window over a block of characters on the console screen. Clicking on the area thus defined shows a tooltip which remains subject to its timing parameters. Moving the cursor away from the area dismisses the transparent window.

            Code:
            '
            '  a way of putting tooltips on a console screen.
            '  Left-Click on the item to get a little tootip owner window. I know.
            '  move cursor away from area to dismiss the tooltip owner window.
            '  to do:
            '      (done) make tooltip owner window the same size as the console screen "object"
            '      (done) and make it transparent.
            '      (done) find a better way to dismiss the tooltip.
            '      (done) find the correct mapping of pixels to character area
            '
            '    Chris Holbrook Aug 2008.
            '
            #COMPILE EXE
            #DIM ALL
            #INCLUDE "COMMCTRL.INC"
            #INCLUDE "win32api.inc"
            '#include "getmsgtxt.inc"
            '------------------------------------------------------------------------
            GLOBAL  ghwnd AS DWORD
            GLOBAL hWndToolTip  AS DWORD
            '-----------------------------------------------------------------
            SUB CreateTip( tl AS DWORD, Tip AS STRING )
            STATIC Crt          AS CREATESTRUCT
            STATIC TlInfo       AS TOOLINFO
            STATIC hInst        AS LONG
            LOCAL hdlg          AS DWORD
                IF hWndToolTip THEN 'it's been initialized
            
                    IF tl = 0 THEN EXIT IF
                    TlInfo.hwnd = tl
                    TlInfo.uId = tl
                    TlInfo.lpszText = STRPTR(Tip)
                    SendMessage( hWndToolTip, %TTM_ADDTOOL, 0, VARPTR( TlInfo ) )
                    SendMessage( hWndToolTip, %TTM_ACTIVATE, 1, 0 )
            
                ELSE 'just initializing this time through
                    LOCAL ice AS INIT_COMMON_CONTROLSEX
                    ice.dwSize = SIZEOF(ice)
                    ice.dwICC = %ICC_WIN95_CLASSES
                    InitCommonControlsEx(ice)
                    hdlg = getparent(tl)
                    hInst = GetModuleHandle("")
                    Tip = "ToolTip"
                    Crt.lpCreateParams = 0
                    Crt.hInstance    = hInst
                    Crt.hMenu        = 0
                    Crt.hwndParent   = getparent(tl)
                    Crt.style        = %WS_POPUP OR %TTS_NOPREFIX OR %TTS_ALWAYSTIP
                    Crt.lpszName     = STRPTR(Tip)
                    Tip = $TOOLTIPS_CLASS
                    Crt.lpszClass    = STRPTR(Tip)
                    Crt.dwExStyle    = %WS_EX_TOPMOST
            
                    hWndToolTip = CreateWindowEx( %WS_EX_TOPMOST, $TOOLTIPS_CLASS, "", _
                    %WS_POPUP OR %TTS_NOPREFIX OR %TTS_ALWAYSTIP OR %TTS_BALLOON, _
                        %CW_USEDEFAULT, %CW_USEDEFAULT, %CW_USEDEFAULT, _
                        %CW_USEDEFAULT, hDlg, 0, hInst, Crt )
            
            
                    SENDmessage hWndToolTip, %TTM_SETMAXTIPWIDTH, 0, 200
            
                    SetWindowPos( hWndToolTip, %HWND_TOPMOST, 100, 100, 300, 300, _
                        %SWP_NOMOVE OR %SWP_NOSIZE OR %SWP_NOACTIVATE )
            
                    SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_INITIAL, 100 ) 'time a pointer must remain stationary before the tooltip appears
                    SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 5000 ) 'time a tooltip window remains visible If the Pointer is stationary
                    SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_RESHOW, 500 ) 'time before subsequent tooltips to appear
            
                    '------------------------------
                    TlInfo.cbSize = SIZEOF( TOOLINFO )
                    TlInfo.uFlags = %TTF_SUBCLASS OR %TTS_ALWAYSTIP OR %TTS_BALLOON OR %TTF_CENTERTIP
                    TlInfo.hinst = hInst
            
                END IF
            END SUB
            '--------------------------------------------------------------------------
            FUNCTION WndProc( BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                BYVAL wParam AS LONG, _
                BYVAL lParam AS LONG ) EXPORT AS LONG
                LOCAL sz AS ASCIZ * 128
                LOCAL r AS rect
                LOCAL x AS LONG, y AS LONG
                LOCAL pNMH AS NMHDR PTR
            
                'sz = getmsgtxt(wmsg)
                'sendmessage CONSHNDL, %WM_settext, 0, BYVAL VARPTR(sz)
            
                SELECT CASE AS LONG wMsg
                    CASE %WM_create
                        'setcapture(hwnd)
                    CASE %WM_LBUTTONDOWN
                        sendmessage hwnd, %WM_CLOSE,0,0
            
                    CASE %WM_NOTIFY
                        pNMH = lparam
                        IF @pNMH.code = -522 THEN
                            sendmessage hwnd, %WM_CLOSE,0,0
                        END IF
            
                    CASE %WM_DESTROY
                        postquitmessage(0)
                END SELECT
            
                FUNCTION = DefWindowProc( hWnd, wMsg, wParam, lParam )
            
            END FUNCTION
            '------------------------------------------------------------------------------
            ' the coordinate parameters define an area on the console screen
            ' over which a transparent window is placed. The tooltip is targetted to this window
            ' which is dismissed when the cursor move outside of it, detected by %WM_NOTIFY
            FUNCTION starttt(stip AS STRING, x AS LONG, y AS LONG, w AS LONG, h AS LONG ) AS LONG
                LOCAL tmsg          AS tagMsg                   ' message information
                LOCAL hWnd, hinst, i, lresult          AS DWORD
                LOCAL szClassName   AS ASCIIZ * 32       ' class name
                LOCAL tWCX          AS WndClassEx               ' class information
            
                '
                hinst = getmodulehandle(BYVAL 0)
                szClassName = "mineallmine"
                twcx.cbSize        = SIZEOF(twcx)                               ' size of WNDCLASSEX structure
                twcx.style         = %CS_DBLCLKS                                ' class styles
                twcx.lpfnWndProc   = CODEPTR(WndProc)                           ' address of window procedure used by class
                twcx.cbClsExtra    = 0                                          ' extra class bytes
                twcx.cbWndExtra    = 0                                          ' extra window bytes
                twcx.hInstance     = hinst                                      ' instance of the EXE/DLL that is registering the window
                twcx.hIcon         = LoadIcon(hinst, BYVAL %IDI_APPLICATION)    ' handle of class icon
                twcx.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)        ' handle of class cursor
                twcx.hbrBackground = GetSysColorBrush(-2)'%COLOR_3DFACE)            ' brush used to fill background of window's client area
                twcx.lpszMenuName  = %NULL                                      ' resource identifier of the class menu
                twcx.lpszClassName = VARPTR(szClassName)                        ' class name
                twcx.hIconSm       = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)    ' handle of small icon shown in caption/system Taskbar
                IF ISFALSE RegisterClassEx(twcx) THEN
                    FUNCTION = %FALSE
                ELSE
                    FUNCTION = %TRUE
                END IF
            
                ghWnd = CreateWindowEx(%WS_EX_WINDOWEDGE OR %WS_EX_TOPMOST , _
                                      szclassName, _
                                      "...",_
                                      %WS_POPUP OR %WS_OVERLAPPED OR %WS_CHILD OR %WS_VISIBLE OR %SS_NOTIFY, _
                                       x, y, w, h, _
                                      %NULL, %NULL, hInst, BYVAL %NULL)    ' fail if window is not created
                IF ISFALSE ghWnd THEN
                    FUNCTION = %FALSE
                    EXIT FUNCTION
                END IF
                CreateTip ghwnd, stip
                WHILE ISTRUE GetMessage(tmsg, BYVAL %NULL, 0, 0)
                    IF ISFALSE IsDialogMessage(ghWnd, tmsg) THEN
                        TranslateMessage tmsg
                        DispatchMessage tmsg
                    END IF
                WEND
                FUNCTION = tmsg.wParam
            END FUNCTION
            
            '--------------------------------------------------
            FUNCTION PBMAIN () AS LONG
                LOCAL s, stip AS STRING
                LOCAL point AS POINTAPI
                LOCAL mx, my, orgX, orgY, w, h, x, y, initialH, initialW, lineheight, chrwidth AS LONG
            
                initialH = 10: initialW = 40
                CONSOLE SET SCREEN 10,40
                MOUSE ON
                    MOUSE 3, DOUBLE, DOWN
                COLOR 7,8
                CLS
                LOCATE 3, 10: COLOR ,4: PRINT SPACE$(6)
            
                LOCATE 6, 20: COLOR ,2: PRINT SPACE$(6)
                CreateTip getparent(ghwnd), ""     'initialize tooltips
                DO
                    SLEEP 20
                    s = WAITKEY$
                    IF LEN(s) = 4 THEN ' mouse event
                        stip = ""
                        my = MOUSEY: mx = MOUSEX
                        CONSOLE GET LOC TO orgx, orgy
                        CONSOLE GET SIZE TO w, h
                        lineheight = h \ initialh
                        chrwidth = w \ initialW
            
                        IF (MOUSEY) = 3 AND (MOUSEX >=3) AND (MOUSEX <= 16) THEN
                            y = (3-1) * lineheight : h = lineheight -1
                            x = 9 * chrwidth : w = 6 * chrwidth
                            stip = "red"
                            starttt(stip, x + orgX + GetSystemMetrics(%SM_CXdlgframe) _
                                                       + GetSystemMetrics(%SM_CXsizeframe), _
                                              y + OrgY +  GetSystemMetrics(%SM_CYcaption), _
                                              w, h)
                        END IF
            
                    ELSE
                        IF s = $ESC THEN  sendmessage ghwnd, %WM_CLOSE, 0, 0
                    END IF
                LOOP
            END FUNCTION

            Comment


            • #7
              Code:
                    IF @pNMH.code = [b][COLOR="Red"]-522[/COLOR][/b] THEN

              Code:
                 IF @pMNH.code = [B]%TTN_POP [/B]THEN
              Michael Mattias
              Tal Systems (retired)
              Port Washington WI USA
              [email protected]
              http://www.talsystems.com

              Comment


              • #8
                The depths to which I will descend to get feedback eh?

                Comment


                • #9
                  You've been around long enough to know better than to use 'magic numbers' like that.

                  No soup for you.
                  Michael Mattias
                  Tal Systems (retired)
                  Port Washington WI USA
                  [email protected]
                  http://www.talsystems.com

                  Comment


                  • #10
                    This version works on mouse over, almost... it needs additional criteria for dismissing the window to which the tooltip has been attached. Suggestions?

                    Code:
                    '
                    '  a way of putting tooltips on a console screen.
                    '  roll over the item to show the tooltip.
                    '  move cursor away from area to dismiss the tooltip owner window. DOESN'T WORK
                    '  to do/done:
                    '      (done) make tooltip owner window the same size as the console screen "object"
                    '      (done) and make it transparent.
                    '      (to do) find a better way to dismiss the tooltip.
                    '      (almost done) find the correct mapping of pixels to character area
                    '      (done) improve deveoloper interface to allow tooltips to be pre-defined for a form
                    '      (done) make it work on mouseover
                    '
                    '    Chris Holbrook Aug 2008.
                    '
                    #COMPILE EXE
                    #DIM ALL
                    #INCLUDE "COMMCTRL.INC"
                    #INCLUDE "win32api.inc"
                    '#INCLUDE "getmsgtxt.inc"
                    '------------------------------------------------------------------------
                    TYPE tooltiptabletype
                        tip AS ASCIZ * 227   ' tip text
                        chrr   AS rect    ' character rect for area, origin at 1,1
                        pxlr   AS rect    ' pixel rect for area
                    END TYPE
                    GLOBAL tttable() AS tooltiptabletype
                    '------------------------------------------------------------------------
                    GLOBAL  ghwnd AS DWORD
                    GLOBAL hWndToolTip  AS DWORD
                    '-----------------------------------------------------------------
                    SUB CreateTip( tl AS DWORD, Tip AS STRING )
                    STATIC Crt          AS CREATESTRUCT
                    STATIC TlInfo       AS TOOLINFO
                    STATIC hInst        AS LONG
                    LOCAL hdlg          AS DWORD
                        IF hWndToolTip THEN 'it's been initialized
                    
                            IF tl = 0 THEN BEEP: EXIT SUB
                            TlInfo.hwnd = tl
                            TlInfo.uId = tl
                            TlInfo.lpszText = STRPTR(Tip)
                            SendMessage( hWndToolTip, %TTM_ADDTOOL, 0, VARPTR( TlInfo ) )
                            SendMessage( hWndToolTip, %TTM_ACTIVATE, 1, 0 )
                    
                        ELSE 'just initializing this time through
                            LOCAL ice AS INIT_COMMON_CONTROLSEX
                            ice.dwSize = SIZEOF(ice)
                            ice.dwICC = %ICC_WIN95_CLASSES
                            InitCommonControlsEx(ice)
                            hdlg = getparent(tl)
                            hInst = GetModuleHandle("")
                            Tip = "ToolTip"
                            Crt.lpCreateParams = 0
                            Crt.hInstance    = hInst
                            Crt.hMenu        = 0
                            Crt.hwndParent   = getparent(tl)
                            Crt.style        = %WS_POPUP OR %TTS_NOPREFIX OR %TTS_ALWAYSTIP
                            Crt.lpszName     = STRPTR(Tip)
                            Tip = $TOOLTIPS_CLASS
                            Crt.lpszClass    = STRPTR(Tip)
                            Crt.dwExStyle    = %WS_EX_TOPMOST
                    
                            hWndToolTip = CreateWindowEx( %WS_EX_TOPMOST, $TOOLTIPS_CLASS, "", _
                            %WS_POPUP OR %TTS_NOPREFIX OR %TTS_ALWAYSTIP OR %TTS_BALLOON, _
                                %CW_USEDEFAULT, %CW_USEDEFAULT, %CW_USEDEFAULT, _
                                %CW_USEDEFAULT, hDlg, 0, hInst, Crt )
                    
                    
                            SENDmessage hWndToolTip, %TTM_SETMAXTIPWIDTH, 0, 200
                    
                            SetWindowPos( hWndToolTip, %HWND_TOPMOST, 100, 100, 300, 300, _
                                %SWP_NOMOVE OR %SWP_NOSIZE OR %SWP_NOACTIVATE )
                    
                            SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_INITIAL, 100 ) 'time a pointer must remain stationary before the tooltip appears
                            SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 5000 ) 'time a tooltip window remains visible If the Pointer is stationary
                            SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_RESHOW, 500 ) 'time before subsequent tooltips to appear
                    
                            '------------------------------
                            TlInfo.cbSize = SIZEOF( TOOLINFO )
                            TlInfo.uFlags = %TTF_SUBCLASS OR %TTS_ALWAYSTIP OR %TTS_BALLOON OR %TTF_CENTERTIP
                            TlInfo.hinst = hInst
                    
                        END IF
                    END SUB
                    '--------------------------------------------------------------------------
                    FUNCTION WndProc( BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                        BYVAL wParam AS LONG, _
                        BYVAL lParam AS LONG ) EXPORT AS LONG
                        LOCAL s AS STRING
                        LOCAL r AS rect
                        LOCAL x AS LONG, y AS LONG
                        LOCAL pNMH AS NMHDR PTR
                    
                    '    s = getmsgtxt(wmsg)
                    '    sendmessage CONSHNDL, %WM_SETTEXT, 0, STRPTR(s)
                    '    SLEEP 500
                        SELECT CASE AS LONG wMsg
                            CASE %WM_LBUTTONDOWN
                                sendmessage hwnd, %WM_CLOSE,0,0
                    
                            CASE %WM_NOTIFY
                                pNMH = lparam
                                IF @pNMH.code = %TTN_POP THEN
                                    sendmessage hwnd, %WM_CLOSE,0,0
                                END IF
                    
                            CASE %WM_DESTROY
                                postquitmessage(0)
                        END SELECT
                    
                        FUNCTION = DefWindowProc( hWnd, wMsg, wParam, lParam )
                    
                    END FUNCTION
                    '------------------------------------------------------------------------------
                    ' the coordinate parameters define an area on the console screen
                    ' over which a transparent window is placed. The tooltip is targetted to this window
                    ' which is dismissed when the cursor move outside of it, detected by %WM_NOTIFY
                    FUNCTION starttt(stip AS STRING, x AS LONG, y AS LONG, w AS LONG, h AS LONG ) AS LONG
                        LOCAL tmsg          AS tagMsg                   ' message information
                        LOCAL hWnd, hinst, i, lresult          AS DWORD
                        LOCAL szClassName   AS ASCIIZ * 32       ' class name
                        LOCAL tWCX          AS WndClassEx               ' class information
                    
                        '
                        hinst = getmodulehandle(BYVAL 0)
                        szClassName = "mineallmine"
                        twcx.cbSize        = SIZEOF(twcx)                               ' size of WNDCLASSEX structure
                        twcx.style         = %CS_DBLCLKS                                ' class styles
                        twcx.lpfnWndProc   = CODEPTR(WndProc)                           ' address of window procedure used by class
                        twcx.cbClsExtra    = 0                                          ' extra class bytes
                        twcx.cbWndExtra    = 0                                          ' extra window bytes
                        twcx.hInstance     = hinst                                      ' instance of the EXE/DLL that is registering the window
                        twcx.hIcon         = LoadIcon(hinst, BYVAL %IDI_APPLICATION)    ' handle of class icon
                        twcx.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)        ' handle of class cursor
                        twcx.hbrBackground = GetSysColorBrush(-2)'%COLOR_3DFACE)            ' brush used to fill background of window's client area
                        twcx.lpszMenuName  = %NULL                                      ' resource identifier of the class menu
                        twcx.lpszClassName = VARPTR(szClassName)                        ' class name
                        twcx.hIconSm       = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)    ' handle of small icon shown in caption/system Taskbar
                        IF ISFALSE RegisterClassEx(twcx) THEN
                            FUNCTION = %FALSE
                        ELSE
                            FUNCTION = %TRUE
                        END IF
                    
                        ghWnd = CreateWindowEx(%WS_EX_WINDOWEDGE OR %WS_EX_TOPMOST , _
                                              szclassName, _
                                              "...",_
                                              %WS_POPUP OR %WS_OVERLAPPED OR %WS_CHILD OR %WS_VISIBLE OR %SS_NOTIFY, _
                                               x, y, w, h, _
                                              %NULL, %NULL, hInst, BYVAL %NULL)    ' fail if window is not created
                        IF ISFALSE ghWnd THEN
                            FUNCTION = %FALSE
                            EXIT FUNCTION
                        END IF
                        CreateTip ghwnd, stip
                        WHILE ISTRUE GetMessage(tmsg, BYVAL %NULL, 0, 0)
                            IF ISFALSE IsDialogMessage(ghWnd, tmsg) THEN
                                TranslateMessage tmsg
                                DispatchMessage tmsg
                            END IF
                        WEND
                        FUNCTION = tmsg.wParam
                    END FUNCTION
                    '------------------------------------------------------------------------
                    SUB settip ( stip AS STRING, x AS LONG, y AS LONG, w AS LONG, h AS LONG)
                        LOCAL i, pxoriginX, pxoriginY, pxw, pxh, _
                              chinitH, chinitW, pxlineheight, pxchrwidth AS LONG
                    
                        GLOBAL tttable() AS tooltiptabletype
                        i = UBOUND(tttable) + 1
                        IF i = 0 THEN createtip ( CONSHNDL,"")
                        REDIM PRESERVE tttable(0 TO i) AS GLOBAL tooltiptabletype
                        tttable(i).tip  = stip
                        setrect tttable(i).chrr, x, y, x + w, y + h
                    END SUB
                    '------------------------------------------------------------------------
                    SUB dottip ( x AS LONG, y AS LONG)
                        LOCAL p AS pointapi
                        LOCAL i AS LONG
                        LOCAL r AS rect
                        LOCAL s AS STRING
                        LOCAL pxoriginX, pxoriginY, pxw, pxh, _
                              chinitH, chinitW, pxlineheight, pxchrwidth, chw, chh AS LONG
                    
                        p.x = x: p.y = y
                        FOR i = 0 TO UBOUND(tttable)
                            r = tttable(i).chrr
                            IF ISFALSE(ptinrect( r, X, Y)) THEN ITERATE
                            CONSOLE GET SCREEN TO  chinitH, chinitW
                            CONSOLE GET SIZE TO pxw, pxh
                            CONSOLE GET LOC TO pxOriginX, pxOriginY
                            pxlineheight = (pxh -GetSystemMetrics(%SM_CYcaption) _
                                                - 2*GetSystemMetrics(%SM_CYsizeframe)) \ chinitH
                            pxchrwidth   = pxw \ chinitW
                            tttable(i).pxlr.nleft = ((tttable(i).chrr.nleft - 1) * pxchrwidth) _
                                                    + pxOriginX + GetSystemMetrics(%SM_CXdlgframe) _
                                                    + GetSystemMetrics(%SM_CXsizeframe)
                            tttable(i).pxlr.ntop  = ((tttable(i).chrr.ntop - 1) * pxlineheight) _
                                                    + pxOriginY +  GetSystemMetrics(%SM_CYcaption) _
                                                    + GetSystemMetrics(%SM_CYdlgframe) _
                                                    + GetSystemMetrics(%SM_CYdlgframe)
                    
                            chw = tttable(i).chrr.nright - tttable(i).chrr.nleft
                            chh = tttable(i).chrr.nbottom - tttable(i).chrr.ntop
                            tttable(i).pxlr.nright   = tttable(i).pxlr.nleft + ( chw * pxchrwidth)
                            tttable(i).pxlr.nbottom  = tttable(i).pxlr.ntop  + ( chh * pxlineheight)
                    '
                            r = tttable(i).pxlr
                            starttt( TRIM$(tttable(i).tip, ANY $SPC + $NUL), r.nleft, r.ntop, r.nright - r.nleft, r.nbottom - r.ntop)
                            EXIT SUB
                        NEXT
                    END SUB
                    '----------------------------------------------------------------------------
                    FUNCTION PBMAIN () AS LONG
                        LOCAL s, scolor, stip AS STRING
                        LOCAL point AS POINTAPI
                        LOCAL i AS LONG
                    
                        CONSOLE SET SCREEN 8,15
                        MOUSE ON
                            MOUSE 3, MOVE
                        COLOR 7,8
                        CLS: CURSOR OFF
                        FOR i = 2 TO 7
                            scolor = READ$(i - 1)
                            LOCATE i, 5: COLOR ,i: PRINT SPACE$(6): settip ( scolor, 5, i, 6, 1)
                        NEXT
                        CreateTip CONSHNDL, ""     'initialize tooltips
                        DO
                            SLEEP 20
                            s = WAITKEY$
                            IF LEN(s) = 4 THEN ' mouse event
                                IF ASC(MID$(s,3)) = 1 THEN ' movement
                                    dottip MOUSEX, MOUSEY
                                END IF
                            ELSE
                                IF s = $ESC THEN  sendmessage ghwnd, %WM_CLOSE, 0, 0
                            END IF
                        LOOP
                    DATA "hounds","greyhounds","mongrels","spaniels","curs","shoughs","water-rugs","demi-wolves"
                    END FUNCTION

                    Comment


                    • #11
                      Added a timer to the window to which the tooltip is attached so that it closes itself automatically if the TTN_POP message does not show up.

                      Comment

                      Working...
                      X