A more reliable timer (unstoppable)

VFP Timer is known not so reliable. Under certain conditions, the VFP timer event can be pending/stopped. In Win32API There is a more reliable timer, SetTimer() API. However, since the older VFP version does not support the callback, many VFP'er go to C/C++ for the solution.

In VFP9, there is a way to use the SetTimer() API. BindEvent() can make this possible. Since our apps is under VFP control, there might a bit delay before the timer is fired. Anyway, again, thanks to enhanced of BindEvent() command :)

Actually, I had shown how to use SetTimer() in my OwnerDrawn Menu class. But you might not noticed that or maybe you don't get the idea about how it works. Here is the explanation.

Let's see the SetTimer declaration first:
[code]
Declare Long SetTimer in User32 ;
Long nhWnd, Long nEventId, Long uElapse, Long lpTimerFunc
[/code]

As you see, the last parameter of SetTimer is pointer to a function (callback procedure). So how can you use this function. Very simple, pass in NULL pointer. Once you pass a NULL pointer, the OS will post a WM_TIMER message instead of calling the procedure. Now, simply bind the WM_TIMER into your top-level form. That would be all. For more info on SetTimer, take a look at MSDN (as usual)

This example will show you one condition that will pending/stopped the VFP timer, while SetTimer() will continue running.
[code]
Clear
? 'Using VFP Timer. Do you see the wait window?'
? 'Press ESC key or click on cancel button when ready...'
oVFPTimer = CreateObject( 'VFP_Timer' )
GetFile()
oVFPTimer = Null

?
? 'Using SetTimer() API. Watch for the wait window counting'
oWMTimer = CreateObject( 'TimerProc', _VFP.hWnd )
GetFile()
oWMTimer = Null

****************

Define Class VFP_Timer as Timer
Interval = 500
Enabled = .T.
nCounter = 0

Procedure Timer
*** You won't see the wait window
Wait 'Using VFP Timer: ' + transform( This.nCounter ) window nowait
This.nCounter = This.nCounter + 1
EndProc
EndDefine


Define Class TimerProc as Custom
#Define WM_TIMER 0x0113
#Define IDT_TIMER 1

nCounter = 0
hWnd = 0

Procedure Init( th_Wnd )
Declare Long SetTimer in User32 ;
Long nhWnd, Long nEventId, Long uElapse, Long lpTimerFunc

Declare Long KillTimer in User32 Long nhWnd, Long nEventId

** Bind the event first before SetTimer
BindEvent( th_Wnd, WM_TIMER, This, 'TimerProc' )
SetTimer( th_Wnd, IDT_TIMER, 500, 0 )
This.hWnd = th_Wnd
EndProc

Procedure TimerProc( th_Wnd, tn_Msg, t_wParam, t_lParam )
Wait 'Using BindEvent (WM_TIMER): ' + transform( This.nCounter ) window nowait
This.nCounter = This.nCounter + 1
Return 0
EndProc

Procedure Destroy
KillTimer( This.hWnd, IDT_TIMER )
UnBindEvents( This.hWnd )
EndProc
EndDefine
[/code]

Happy coding :)

Detecting WinXP Active Theme

Many recent VFP applications is designed to be look more consistent with WinXP. One of the important factor is to know what is the active theme that the user is using.

There are two API Theme functions that comes in handy for this purpose, IsThemeActive() and GetCurrentThemeName().

Here is how to use them:
[code]
#Define MAX_WCHAR 512

Declare Long IsThemeActive in uxTheme
Declare Long GetCurrentThemeName in uxTheme ;
String @ O_pwszThemeFileName, Integer nMaxNameChars, ;
String @ O_pwszColorBuff, Integer nMaxColorChars, ;
String @ O_pwszSizeBuff, Integer nMaxSizeChars

Local lw_ThemeFileName, lw_ColorBuff, lw_SizeBuff
Local lc_ColorBuff, lc_SizeBuff, ll_Themed

If (IsThemeActive() == 1)
lw_ThemeFileName = space( MAX_WCHAR )
lw_ColorBuff = space( MAX_WCHAR )
lw_SizeBuff = space( MAX_WCHAR )
ll_Themed = (GetCurrentThemeName( @lw_ThemeFileName, MAX_WCHAR, @lw_ColorBuff, MAX_WCHAR, ;
@lw_SizeBuff, MAX_WCHAR ) == 0)

? 'Theme filename : '
If ll_Themed
?? MakeANSI( lw_ThemeFileName )
lc_ColorBuff = MakeANSI( lw_ColorBuff )

? 'Color scheme : '
Do case
Case (lc_ColorBuff == 'NormalColor')
?? 'Default'
Case (lc_ColorBuff == 'Metallic')
?? 'Silver'
Otherwise
?? 'Olive Green'
EndCase
?? ' ( ' + lc_ColorBuff + ' )'

? 'Font size : '
lc_SizeBuff = MakeANSI( lw_SizeBuff )
Do case
Case (lc_SizeBuff == 'NormalSize')
?? 'Normal'
Case (lc_SizeBuff == 'LargeFonts')
?? 'Large Fonts'
Otherwise
?? 'Extra Large Fonts'
EndCase
?? ' ( ' + lc_SizeBuff + ' )'
else
?? 'NONE ( Windows Classic )'
endif
else
? 'Theme is not active ( Windows Classic )'
endif
Clear DLLs


Procedure MakeANSI( tw_String )
Local lc_String, ln_Pos

lc_String = strconv( strconv( tw_String, 6 ), 2 )
ln_Pos = at( chr(0), lc_String )
If (ln_Pos > 0)
lc_String = left( lc_String, ln_Pos - 1 )
endif

Return lc_String
EndProc
[/code]

To make your apps sensing the theme changes, you can bind the apps top-level form to WM_THEMECHANGED. Then use the code above (in your procedure handler) to detect the new theme.

Happy coding!

Updated OwnerDrawn menu class

Today, the OwnerDrawn menu class has been updated (the article was published on UT Magazine October 2005 edition). A few bug has been fixed. And few features has been added based on e-mail I received lately.

I hope you enjoy the new class,
happy coding!

Download OwnerDrawn Menus class & sample

Hello foxer!

Today is my first time posting. I 'd like to share my first tips about changing the VFP tooltips appearance (margin, font, color, etc..). This idea is based on a UT thread by Malcolm Greene who is also greatly supported and encouraging me for months. Malcolm is also a team member for my blogger. So, my special thanks to Malcolm :)

Anyway, here is the tips:

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.

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( 0, 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 method
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 method
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 method
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

Enjoy the tips. And we (me and Malcolm) hope to put more contents here soon.
Long live VFP!