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函數(shù)回復默認的圖標文字顏色和背景
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
'設(shè)置圖標文字的顏色
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
'發(fā)送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()
'設(shè)置圖標文字的顏色為藍色，背景色為黑色，背景為透明
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 = "設(shè)置文字背景"
command2.caption = "恢復文字背景"
command3.caption = "排列桌面圖標"
end sub
運行程序，點擊command1，可以看到桌面圖標的文本景色變成了藍色，如果你設(shè)置了桌面圖片，還可以看到文字
的背景變成了透明的而不是在下面有一個難看的色塊，點擊command2可以恢復windows的默認設(shè)置，點擊command3可以
使你的桌面圖標以橫排的方式排列，不過前提是要將桌面圖標的自動排列屬性設(shè)置為false。
以上程序在vb6,windows98,windows2000下運行通過。
