高分悬赏VB编程问题高手速度来?
请教VB 如何刷新桌面!!即用语句能达到自动刷新桌面的功能.
(这种我会了,还有没有新方法?)set My_app = WScript.CreateObject("WScript.Shell")
do while True
Wscript.Sleep 1000
My_app.SendKeys "{F5}"
Loop
将其保存到一个记事本中,然后将扩展名.txt改成.vbe,然后运行之,切换到桌面,
追问:系统不支持此格式。。。
追问:系统不支持此格式。。。
答案:这里给个例子,要用到有关注册表的知识。因为安全性,还是先将注册表备份一下~~~~
使用GetRegKeyVALUE函数得到当前桌面的图标大小,
然后把图标大小增大1并利用SetRegKeyVALUE保存至注册表。
再调用SendMessageTimeout函数通知顶层窗口:系统设置已经改变。
这里窗体上放置一个CommandButton,NAME为cmdRefreshIcons,
按下它,使顶层窗口刷新图标以恢复图标原始大小。
如果是自动刷新,你就加个TIMER控件吧。
‘==================================================================
Option Explicit
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const REG_SZ = 1 ' Null terminated string
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As LONG, ByVal lpSubKey As String, ByVal ulOptions As LONG, ByVal samDesired As LONG, phkResult As LONG) As LONG
Private Declare Function RegQueryVALUEEx Lib "advapi32.dll" Alias "RegQueryVALUEExA" (ByVal hKey As LONG, ByVal lpVALUEName As String, ByVal lpReserved As LONG, lpType As LONG, lpData As Any, lpcbData As LONG) As LONG
Private Declare Function RegCLOSEKey Lib "advapi32.dll" (ByVal hKey As LONG) As LONG
Private Declare Function RegSetVALUEEx Lib "advapi32.dll" Alias "RegSetVALUEExA" (ByVal hKey As LONG, ByVal lpVALUEName As String, ByVal Reserved As LONG, ByVal dwType As LONG, lpData As Any, ByVal cbData As LONG) As LONG ' Note that if you declare the lpData parameter as String, you must pass it By VALUE.
Private Const ERROR_SUCCESS = 0&
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const KEY_ALL_ACCESS = _
((STANDARD_RIGHTS_ALL Or _
KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or KEY_CREATE_LINK) And _
(Not SYNCHRONIZE))
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 SPI_SETNONCLIENTMETRICS = 42
Private Const SMTO_ABORTIFHUNG = &H2
Private Const WM_WININICHANGE = &H1A
Private Const WM_SETTINGCHANGE = WM_WININICHANGE
‘==================================================================
' Return a registry key VALUE.
Private Function GetRegKeyVALUE(ByVal root As LONG, ByVal key_NAME As String, ByVal subkey_NAME As String) As String
Dim hKey As LONG
Dim VALUE As String
Dim length As LONG
Dim VALUE_type As LONG
' Open the key.
If RegOpenKeyEx(root, key_NAME, _
0&, KEY_QUERY_VALUE, hKey) <> ERROR_SUCCESS _
Then
MsgBox "Error opening key."
Exit Function
End If
' Get the subkey's size.
If RegQueryVALUEEx(hKey, subkey_NAME, _
0&, VALUE_type, ByVal 0&, length) _
<> ERROR_SUCCESS _
Then
MsgBox "Error getting subkey length."
End If
' Get the subkey's VALUE.
VALUE = Space$(length)
If RegQueryVALUEEx(hKey, subkey_NAME, _
0&, VALUE_type, ByVal VALUE, length) _
<> ERROR_SUCCESS _
Then
MsgBox "Error getting subkey VALUE."
Else
' Remove the trailing null character.
GetRegKeyVALUE = Left$(VALUE, length - 1)
End If
' CLOSE the key.
If RegCLOSEKey(hKey) <> ERROR_SUCCESS Then
MsgBox "Error closing key."
End If
End Function
‘==================================================================
' Return a registry key VALUE.
Private Sub SetRegKeyVALUE(ByVal root As LONG, ByVal key_NAME As String, ByVal subkey_NAME As String, ByVal subkey_VALUE As String)
Dim hKey As LONG
Dim VALUE As String
Dim length As LONG
Dim VALUE_type As LONG
' Open the key.
If RegOpenKeyEx(root, key_NAME, _
0&, KEY_SET_VALUE Or KEY_CREATE_SUB_KEY, _
hKey) <> ERROR_SUCCESS _
Then
MsgBox "Error opening key."
Exit Sub
End If
' Save the VALUE.
subkey_VALUE = subkey_VALUE & vbNullChar
If RegSetVALUEEx(hKey, subkey_NAME, 0, _
REG_SZ, ByVal subkey_VALUE, _
Len(subkey_VALUE)) <> ERROR_SUCCESS _
Then
MsgBox "Error saving VALUE."
Exit Sub
End If
' CLOSE the key.
If RegCLOSEKey(hKey) <> ERROR_SUCCESS Then
MsgBox "Error closing key."
End If
End Sub
‘==================================================================
Private Sub cmdRefreshIcons_Click()
Dim icon_size_string As String
Dim new_icon_size_string As String
Dim result As LONG
' Get the current icon size.
icon_size_string = GetRegKeyVALUE( _
HKEY_CURRENT_US
上一个:VB求助,关于转换的
下一个:VB中的shell函数的一些问题