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 manager")
hwindow = findwindowex(hwindow, 0, "shelldll_defview", "")
hwindow = findwindowex(hwindow, 0, "syslistview32", "")
i1 = 20: i2 = 20
icount = sendmessage(hwindow, lvm_getitemcount, 0, 0)
for i = 0 to icount - 1
po.x = i1: po.y = i2
'发送lvm_setitemposition消息排列图标
call sendmessage(hwindow, lvm_setitemposition, i, i2 * 65536 + i1)
i1 = i1 + iwidth
if i1 > ((screen.width / 15) - 32) then
i1 = 20
i2 = i2 + iheight
end if
next i
sendmessage hwindow, lvm_redrawitems, 0, icount - 1
'更新窗口
updatewindow hwindow
end sub
private sub command1_click()
'设置图标文字的颜色为蓝色，背景色为黑色，背景为透明
seticontext vbblue, vbblack, true
end sub
private sub command2_click()
restorecolor
end sub
private sub command3_click()
'以100x100像素为单位排列图标
arrangedesktopicon 100, 100
end sub
private sub form_load()
command1.caption = "设置文字背景"
command2.caption = "恢复文字背景"
command3.caption = "排列桌面图标"
end sub
运行程序，点击command1，可以看到桌面图标的文本景色变成了蓝色，如果你设置了桌面图片，还可以看到文字
的背景变成了透明的而不是在下面有一个难看的色块，点击command2可以恢复windows的默认设置，点击command3可以
使你的桌面图标以横排的方式排列，不过前提是要将桌面图标的自动排列属性设置为false。
以上程序在vb6,windows98,windows2000下运行通过。
