Announcement

Collapse
No announcement yet.

tooltips on a console

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

  • Chris Holbrook
    replied
    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.

    Leave a comment:


  • Chris Holbrook
    replied
    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

    Leave a comment:


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

    No soup for you.

    Leave a comment:


  • Chris Holbrook
    replied
    The depths to which I will descend to get feedback eh?

    Leave a comment:


  • Michael Mattias
    replied
    Code:
          IF @pNMH.code = [b][COLOR="Red"]-522[/COLOR][/b] THEN

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

    Leave a comment:


  • Chris Holbrook
    replied
    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

    Leave a comment:


  • Chris Holbrook
    replied
    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.

    Leave a comment:


  • Roger Garstang
    replied
    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.

    Leave a comment:


  • Chris Holbrook
    replied
    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

    Leave a comment:


  • Michael Mattias
    replied
    ???

    GetCursorPos() should work.

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

    Leave a comment:


  • Chris Holbrook
    started a topic tooltips on a console

    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?
Working...
X