VB6使用API即时改变桌面图标大小
窗体拖入控件：Command1
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const LVM_FIRST = &H1000
Private Const LVM_SETICONSPACING = LVM_FIRST + 53
Private Sub Command1_Click()
Dim hWnd As Long
Dim hListView As Long
Dim lStyle As Long
Dim lResult As Long
Dim iIconSize As Integer
'获取桌面窗口句柄
hWnd = GetDesktopWindow()
'获取桌面ListView控件句柄
hListView = FindWindowEx(hWnd, 0, "Progman", vbNullString)
hListView = FindWindowEx(hListView, 0, "SHELLDLL_DefView", vbNullString)
hListView = FindWindowEx(hListView, 0, "SysListView32", vbNullString)
'获取当前图标大小
lStyle = GetWindowLong(hListView, GWL_STYLE)
If lStyle And &H4000 Then
iIconSize = 32
Else
iIconSize = 48
End If
'切换图标大小
If iIconSize = 32 Then
lResult = SendMessage(hListView, LVM_SETICONSPACING, 0, ByVal CLng(48 * 65536 + 48))
SetWindowLong hListView, GWL_STYLE, lStyle And Not &H4000
Else
lResult = SendMessage(hListView, LVM_SETICONSPACING, 0, ByVal CLng(32 * 65536 + 32))
SetWindowLong hListView, GWL_STYLE, lStyle Or &H4000
End If
'刷新桌面
SendMessage hWnd, &H111, &HB, ByVal 0&
End Sub