Visual Foxpro Rocks!

How to change VFP tooltips appearance using BINDEVENT()

VFP Tooltips is just another window that was created and the classname was registered by VFP. All you need is to find the window with that classname. To find VFP tooltips window you need to enumerate the window (start from the desktop), and look for the window that has WS_EX_TOOLWINDOW for the extended style.

hDesktop = GetDesktopWindow()
hWnd = 0
lFound = .F.
cClassName = space( 32 )
nLen = GetClassName( _VFP.hWnd, @cClassName, 32 )
If WIN_2K_XP

cClassName = left( cClassName, nLen ) + '3'

else

cClassName = left( cClassName, nLen ) + '2'

endif

Do while !( lFound )

hWnd = FindWindowEx( hDesktop, hWnd, cClassName, Null )
If (hWnd != 0)

nExStyle = GetWindowLong( hWnd, GWL_EXSTYLE )
lFound = (BitAnd( nExStyle, WS_EX_TOOLWINDOW ) != 0)

else

lFound = .T.

endif

enddo

Then bind WM_SHOWWINDOW, WM_ERASEBKGND and WM_WINDOWPOSCHANGED into that window.

If (hWnd != 0)

** hWnd = Handle to Tooltips window
** This = Object handler for Window Messages
** WndProc = name of the Procedure/Method for the callback
This.pOrgProc = GetWindowLong( hWnd, GWL_WNDPROC )
BindEvent( hWnd, WM_SHOWWINDOW, This, 'WndProc' )
BindEvent( hWnd, WM_ERASEBKGND, This, 'WndProc' )
BindEvent( hWnd, WM_WINDOWPOSCHANGED, This, 'WndProc' )

endif

** WndProc
LParameters hWnd, nMsg, wParam, lParam

Do case

Case (nMsg == WM_ERASEBKGND)

This.lEraseBackground = .T.

Case (nMsg == WM_SHOWWINDOW)

** Process WM_SHOWWINDOW if the window is being *shown*
** Otherwise, let default VFP process this message
If (wParam == SW_SHOWNORMAL)

This.On_ShowWindow( hWnd )
Return 0
endif

Case (nMsg == WM_WINDOWPOSCHANGED)

** Only process WM_WINDOWPOSCHANGED after WM_ERASEBKGND
If This.lEraseBackGround

This.On_WindowPosChanged( hWnd )
This.lEraseBackGround = .F.
Return 0
endif

EndCase

Return CallWindowProc( This.pOrgProc, hWnd, nMsg, wParam, lParam )

** On_ShowWindow
LParameters hWnd

Local sRect
Local nLeft, nTop, nRight, nBottom, nWidth, nHeight

sRect = space( RECT_Size )
GetWindowRect( hWnd, @sRect )
With This
nLeft = .Buff2Num( sRect, 1, .T. )
nTop = .Buff2Num( sRect, 5, .T. )
nRight = .Buff2Num( sRect, 9, .T. )
nBottom = .Buff2Num( sRect, 13, .T. )
nWidth = (nRight - nLeft) + .nAddWidth && default .nAddWidth = 14
nHeight = (nBottom - nTop) + .nAddHeight && default .nAddHeight = 12

EndWith

SetWindowPos( hWnd, HWND_TOP, nLeft, nTop+SysMetric(4), ;
nWidth, nHeight, SWP_NOZORDER + SWP_NOACTIVATE )

** On_WindowPosChanged
LParameters hWnd

Local hDC, sRect, hOldBrush
Local nLeft, nTop, nRight, nBottom
Local cText, nLen

cText = replicate( c0, MAX_PATH )
nLen = GetWindowText( hWnd, @cText, MAX_PATH )
If (nLen > 0)
cText = left( cText, nLen )
sRect = space( RECT_Size )
GetClientRect( hWnd, @sRect )
hDC = GetDC( hWnd )
hOldBrush = SelectObject( hDC, GetSysColorBrush( COLOR_INFOBK ))

With This
nLeft = .Buff2Num( sRect, 1, .T. ) - 1
nTop = .Buff2Num( sRect, 5, .T. ) - 1
nRight = .Buff2Num( sRect, 9, .T. ) + 1
nBottom = .Buff2Num( sRect, 13, .T. ) + 1

Rectangle( hDC, nLeft, nTop, nRight, nBottom )
nLeft = nLeft + (.nAddWidth / 2) + 2
nTop = nTop + (.nAddHeight / 2) + 2

EndWith

SetRect( @sRect, nLeft, nTop, nRight, nBottom )
DrawText( hDC, cText, nLen, sRect, DT_LEFT + DT_NOCLIP )
SelectObject( hDC, hOldBrush )
ReleaseDC( hWnd, hDC )

endif

Download VFP Tooltips source code

Go home

Special thanks to:
Malcolm Greene (www.bdurham.com) for providing me this space on their web site