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?
Announcement
Collapse
No announcement yet.
tooltips on a console
Collapse
X
-
???
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
-
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
-
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.
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, 01:26 AM.sigpic
Mobile Solutions
Sys Analyst and Development
Comment
-
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
-
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
-
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
-
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
Comment