Announcement

**Michael Mattias** · 21 Aug 2008, 09:21 AM

???

GetCursorPos() should work.

(Note in same sentence you ask about the "console" and a "GRAPHICS screen". Two different animals.)

**Chris Holbrook** · 21 Aug 2008, 05:31 PM

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

**Roger Garstang** · 22 Aug 2008, 01:21 AM

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.

PowerBASIC Peer Support Community

http://www.powerbasic.com/support/pbforums/showthread.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.

**Chris Holbrook** · 22 Aug 2008, 05:12 AM

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.

**Chris Holbrook** · 23 Aug 2008, 04:35 PM

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

**Michael Mattias** · 24 Aug 2008, 11:35 AM

Code:

      IF @pNMH.code = [b][COLOR="Red"]-522[/COLOR][/b] THEN

Code:

   IF @pMNH.code = [B]%TTN_POP [/B]THEN

**Chris Holbrook** · 24 Aug 2008, 01:11 PM

The depths to which I will descend to get feedback eh?

**Michael Mattias** · 24 Aug 2008, 06:53 PM

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

No soup for you.

**Chris Holbrook** · 25 Aug 2008, 08:25 AM

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

**Chris Holbrook** · 25 Aug 2008, 12:29 PM

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.

Announcement

tooltips on a console

tooltips on a console

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment