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