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!