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

Question

VB中通过注册表的操作来更改了系统的显示属性（这个位置的：HKEY_CURRENT_USER\Control Panel\Desktop），如何能立即生效？
在桌面上右键，进行的设置，点“应用”后就立即生效。
以下是网上查到一些方法无效：
结束并重启资源管理器进程(Explorer.exe)
API方法：BroadcastSystemMessage BSF_POSTMESSAGE, BSM_APPLICATIONS, WM_SYSCOMMAND, SC_MINIMIZE, ByVal 0&

Answer 1

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

Answer 2

我是设置注册表的以下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 = &H2Private 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
各位回复者请测试０Ｋ后在此回复．

Answer 3

没人知道, 不会吧就是
改 HKEY_CURRENT_USER\Control Panel\Desktop\FontSmoothing      的值为0 或 2
改 HKEY_CURRENT_USER\Control Panel\Desktop\FontSmoothingType  的值为0 或 2各位可手动打开注册表来修改后，重启电脑后，浏览器等软件中的字体是否平滑。0 是不平滑有锯齿，2 是平滑现在要解决的是如何立即生效?

Answer 4

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 = &H2Private 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

Answer 5

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

Answer 6

4楼                 Dim   oWSH   As   WshShell 
               Set   oWSH   =   New   WshShell 这个是引用哪个?

Answer 7

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 = &H1SystemParametersInfo ByVal SPI_SETFONTSMOOTHING, True, ByVal "2", SPIF_UPDATEINIFILE

Answer 8

引用 windows script objectSystemParametersInfo可以看看这里
http://www.hosp.ncku.edu.tw/~cww/html/q00218.html

Answer 9

楼上...这个是不错, 但只改了 FontSmoothing 为2 HKEY_CURRENT_USER\Control Panel\Desktop\FontSmoothing
HKEY_CURRENT_USER\Control Panel\Desktop\FontSmoothingTypeFontSmoothingType 未改成 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 LongPrivate 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 SubPrivate 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 SubPrivate Sub Command3_Click()
    WebBrowser1.Document.body.Style.Zoom = 1
End SubPrivate Sub Form_Load()
    WebBrowser1.Navigate "google.com"
End SubPrivate Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    WebBrowser1.Document.body.Style.Zoom = 0.8
End Sub

Answer 10

没人会吗? 网络上有 SystemParametersInfo SPI_SETFONTSMOOTHINGTYPE ...
这个看上去是解决   HKEY_CURRENT_USER\Control Panel\Desktop\FontSmoothingType 的但都是 其它语言的。哪位会知道其它语言的帮助看看。

Answer 11

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

Answer 12

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 = &H0Private Sub Command1_Click()      SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0End Sub
就这么简单，而不用重启资源管理器

Answer 13

http://msdn.microsoft.com/en-us/library/bb762118.aspxSHChangeNotify  函数的介绍