VB中通过注册表的操作来更改了系统的显示属性（这个位置的：HKEY_CURRENT_USER\Control Panel\Desktop），如何能立即生效？

[redsuntv]

VB中通过注册表的操作来更改了系统的显示属性（这个位置的：HKEY_CURRENT_USER\Control Panel\Desktop），如何能立即生效？
在桌面上右键，进行的设置，点“应用”后就立即生效。


以下是网上查到一些方法无效：
结束并重启资源管理器进程(Explorer.exe)
API方法：BroadcastSystemMessage BSF_POSTMESSAGE, BSM_APPLICATIONS, WM_SYSCOMMAND, SC_MINIMIZE, ByVal 0&

[redsuntv]

我是设置注册表的以下2个位置的值
HKEY_CURRENT_USER\Control Panel\Desktop\FontSmoothing
HKEY_CURRENT_USER\Control Panel\Desktop\FontSmoothingType
若都设为2，系统的字体能圆滑显示；都设为0则无效果。(XP系统默认为后者)


按楼上介绍的方法无效。做了个实例，不知是否有问题：
Option Explicit
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As String, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Const HWND_BROADCAST = &HFFFF&
Private Const WM_SETTINGCHANGE = &H1A
Private Const SMTO_ABORTIFHUNG = &H2

Private Sub Form_Load()
Dim A As Long: A = InputBox("", "", 2)
'设置注册表的值
SetKeyValue HKEY_CURRENT_USER, "Control Panel\Desktop", "FontSmoothing", A, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "Control Panel\Desktop", "FontSmoothingType", A, REG_DWORD

Dim ret As Long
SendMessageTimeout HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0, SMTO_ABORTIFHUNG, 5000, ret
End Sub


各位回复者请测试０Ｋ后在此回复．

[redsuntv]

没人知道, 不会吧

就是
改 HKEY_CURRENT_USER\Control Panel\Desktop\FontSmoothing 的值为0 或 2
改 HKEY_CURRENT_USER\Control Panel\Desktop\FontSmoothingType 的值为0 或 2

各位可手动打开注册表来修改后，重启电脑后，浏览器等软件中的字体是否平滑。0 是不平滑有锯齿，2 是平滑



现在要解决的是如何立即生效?

[supergreenbean]

...
Dim ret As long
SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0, SMTO_ABORTIFHUNG, 5000, ret)

[redsuntv]

5楼的是没用的...

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Const SPI_SETFONTSMOOTHING = 75
Const SPIF_UPDATEINIFILE = &H1

SystemParametersInfo ByVal SPI_SETFONTSMOOTHING, True, ByVal "2", SPIF_UPDATEINIFILE

[supergreenbean]

引用 windows script object

SystemParametersInfo可以看看这里
http://www.hosp.ncku.edu.tw/~cww/html/q00218.html

[supergreenbean]

Option Explicit
Private Declare Function SendMessageTimeout Lib "user32 " Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Const HWND_BROADCAST = &HFFFF&
Private Const WM_SETTINGCHANGE = &H1A
Private Const SMTO_ABORTIFHUNG = &H2

Private Sub Form_Load()
Dim oWSH As WshShell
Set oWSH = New WshShell

Dim A As Long
A = InputBox(" ", " ", 2)

'设置注册表的值
oWSH.RegWrite "HKCU\Control Panel\Desktop\FontSmoothing", A, "REG_SZ"
oWSH.RegWrite "HKCU\Control Panel\Desktop\FontSmoothingType", A, "REG_DWORD"

Dim ret As Long
SendMessageTimeout HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0, SMTO_ABORTIFHUNG, 5000, ret
End Sub

[supergreenbean]

进行这个设置,你可以直接用
SystemParametersInfo(ByVal SPI_SETFONTSMOOTHING, True, ByVal "2", SPIF_UPDATEINIFILE)
来做吧

[redsuntv]

楼上...这个是不错, 但只改了 FontSmoothing 为2

HKEY_CURRENT_USER\Control Panel\Desktop\FontSmoothing
HKEY_CURRENT_USER\Control Panel\Desktop\FontSmoothingType

FontSmoothingType 未改成 2


要2个值都为2时才有用的. 不然对汉字无效的


完整源代码发给你试.. 要加一个webbrowser控件


Option Explicit
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long

Private Const SPIF_UPDATEINIFILE = &H1
Private Const SPIF_SENDWININICHANGE = &H2
Private Const SPI_SETFONTSMOOTHING = 75
Private Const SPIF_SENDCHANGE = 2
Private Const SPI_SETFONTSMOOTHINGTYPE = &H200B
Private Const FE_FONTSMOOTHINGCLEARTYPE = 2
Private Const SPI_GETFONTSMOOTHINGTYPE = &H200A
Private FontSmoothingType As Integer
Private Sub Command1_Click()
SystemParametersInfo SPI_SETFONTSMOOTHING, 1&, ByVal vbNullString, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE
Me.Cls
Me.FontSize = 48
Me.ForeColor = 0
Me.Print "Honey"
WebBrowser1.Refresh
End Sub

Private Sub Command2_Click()
SystemParametersInfo SPI_SETFONTSMOOTHING, 0&, ByVal vbNullString, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE
Me.Cls
Me.FontSize = 48
Me.ForeColor = 0
Me.Print "Honey"
WebBrowser1.Refresh
End Sub

Private Sub Command3_Click()
WebBrowser1.Document.body.Style.Zoom = 1
End Sub

Private Sub Form_Load()
WebBrowser1.Navigate "google.com"
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
WebBrowser1.Document.body.Style.Zoom = 0.8
End Sub

[redsuntv]

4楼

Dim oWSH As WshShell
Set oWSH = New WshShell

这个是引用哪个?

[redsuntv]

没人会吗?

网络上有 SystemParametersInfo SPI_SETFONTSMOOTHINGTYPE ...
这个看上去是解决 HKEY_CURRENT_USER\Control Panel\Desktop\FontSmoothingType 的

但都是 其它语言的。哪位会知道其它语言的帮助看看。

[zzyong00]

又见绿豆

[hpygzhx520]

SystemParametersInfo SPI_SETFONTSMOOTHING, 1&, ByVal 0&, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE
SystemParametersInfo SPI_SETFONTSMOOTHINGTYPE, 0&, ByVal FE_FONTSMOOTHINGCLEARTYPE, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE

[meiZiNick]

好像没那么简单,呵呵.

[临岩听雨]

Private Declare Sub SHChangeNotify Lib "shell32" _
(ByVal wEventId As Long, _
ByVal uFlags As Long, _
ByVal dwItem1 As Long, _
ByVal dwItem2 As Long)

Private Const SHCNE_ASSOCCHANGED = &H8000000
Private Const SHCNF_IDLIST = &H0

Private Sub Command1_Click()

SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0

End Sub


就这么简单，而不用重启资源管理器

[临岩听雨]

http://msdn.microsoft.com/en-us/library/bb762118.aspx

SHChangeNotify 函数的介绍