Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal _
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) _
As Long
Private Declare Function SendMessageP Lib "user32" Alias "SendMessageA" (ByVal _
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) _
As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, _
lpSysColor As Long, lpColorValues As Long) As Long
Const LVM_FIRST = &H1000
Const LVM_GETITEMCOUNT = LVM_FIRST + 4
Const LVM_SETTEXTCOLOR = LVM_FIRST + 36
Const LVM_REDRAWITEMS = LVM_FIRST + 21
Const LVM_SETTEXTBKCOLOR = LVM_FIRST + 38
Const LVM_SETITEMPOSITION = LVM_FIRST + 15
Const COLOR_DESKTOP = 1
'RestoreColor函数回复默认的图标文字颜色和背景
Sub RestoreColor()
Dim lColor As Long
lColor = GetSysColor(COLOR_DESKTOP)
SetSysColors 1, COLOR_DESKTOP, lColor
End Sub
Sub SetIconText(clFore, clBack As Long, bTrans As Boolean)
Dim hWindow As Long
Dim lItemCount As Long
'通过三步查找到放置桌面图表的窗口
hWindow = FindWindow("Progman", "Program Manager")
hWindow = FindWindowEx(hWindow, 0, "SHELLDLL_DefView", "")
hWindow = FindWindowEx(hWindow, 0, "SysListView32", "")
If bTrans Then '透明背景
SendMessage hWindow, LVM_SETTEXTBKCOLOR, 0, &HFFFFFFFF
Else '非透明背景
SendMessage hWindow, LVM_SETTEXTBKCOLOR, 0, clBack
End If
'设置图标文字的颜色
SendMessage hWindow, LVM_SETTEXTCOLOR, 0, clFore
'重新绘制所有的图标
lItemCount = SendMessage(hWindow, LVM_GETITEMCOUNT, 0, 0)
SendMessage hWindow, LVM_REDRAWITEMS, 0, lItemCount - 1
'更新窗口
UpdateWindow hWindow
End Sub
Sub ArrangeDesktopIcon(iWidth As Integer, iHeight As Integer)
Dim hWindow As Long
Dim i1, i2, i, iCount As Integer
Dim po As POINTAPI
'通过三步查找到放置桌面图表的窗口
hWindow = FindWindow("Progman", "Program Ma
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal _
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) _
As Long
Private Declare Function SendMessageP Lib "user32" Alias "SendMessageA" (ByVal _
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) _
As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, _
lpSysColor As Long, lpColorValues As Long) As Long
Const LVM_FIRST = &H1000
Const LVM_GETITEMCOUNT = LVM_FIRST + 4
Const LVM_SETTEXTCOLOR = LVM_FIRST + 36
Const LVM_REDRAWITEMS = LVM_FIRST + 21
Const LVM_SETTEXTBKCOLOR = LVM_FIRST + 38
Const LVM_SETITEMPOSITION = LVM_FIRST + 15
Const COLOR_DESKTOP = 1
'RestoreColor函数回复默认的图标文字颜色和背景
Sub RestoreColor()
Dim lColor As Long
lColor = GetSysColor(COLOR_DESKTOP)
SetSysColors 1, COLOR_DESKTOP, lColor
End Sub
Sub SetIconText(clFore, clBack As Long, bTrans As Boolean)
Dim hWindow As Long
Dim lItemCount As Long
'通过三步查找到放置桌面图表的窗口
hWindow = FindWindow("Progman", "Program Manager")
hWindow = FindWindowEx(hWindow, 0, "SHELLDLL_DefView", "")
hWindow = FindWindowEx(hWindow, 0, "SysListView32", "")
If bTrans Then '透明背景
SendMessage hWindow, LVM_SETTEXTBKCOLOR, 0, &HFFFFFFFF
Else '非透明背景
SendMessage hWindow, LVM_SETTEXTBKCOLOR, 0, clBack
End If
'设置图标文字的颜色
SendMessage hWindow, LVM_SETTEXTCOLOR, 0, clFore
'重新绘制所有的图标
lItemCount = SendMessage(hWindow, LVM_GETITEMCOUNT, 0, 0)
SendMessage hWindow, LVM_REDRAWITEMS, 0, lItemCount - 1
'更新窗口
UpdateWindow hWindow
End Sub
Sub ArrangeDesktopIcon(iWidth As Integer, iHeight As Integer)
Dim hWindow As Long
Dim i1, i2, i, iCount As Integer
Dim po As POINTAPI
'通过三步查找到放置桌面图表的窗口
hWindow = FindWindow("Progman", "Program Ma
相关文章
 我来说两句 |
对此文章发表了评论 |
评论列表 （最新 评论仅限网友观点！）
推荐文章
