设置TreeView背景色

时间:2021-05-08 14:48:00

以下为在Csdn上找到的Treeview资源管理器代码,怎样改变其背景色?
用:SendMessage SysTreeWindow,TVM_SETBKCOLOR,0,byval RGB(255,255,255)来改变背景色是可以,但图标有白底。
请问怎样使图标背景透明?
Option Explicit
'资源管理器树型目录模块TreeView

Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSELECTION = (WM_USER + 102)
Private Const WM_MOVE = &H3
Private Const GWL_WNDPROC = (-4)
Private Const GWL_STYLE As Long = (-16)

Private lpPrevWndProc As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent 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 Any) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) 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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Const GW_NEXT = 2
Private Const GW_CHILD = 5
Private Const WM_CLOSE = &H10
Private Const TVM_SETBKCOLOR = 4381&
Private Const TVM_SETTEXTCOLOR = 4382&

Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Public NewForm As Form
Public m_CurrentDirectory As String
Public DialogContainer As Object
Dim DialogWindow As Long
Dim SysTreeWindow As Long
Dim CancelbuttonWindow As Long

Public Sub BrowseForFolder(StartDir As String)
Dim lpIDList As Long
Dim szTitle As String
Dim sBuffer As String
Dim tBrowseInfo As BrowseInfo
m_CurrentDirectory = StartDir & vbNullChar
With tBrowseInfo
.hwndOwner = GetDesktopWindow
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_STATUSTEXT
.lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
End Sub


Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
Dim lpIDList As Long
Dim ret As Long
Dim sBuffer As String
Dim hwnda As Long, ClWind As String * 14, ClCaption As String * 100
On Error Resume Next
DialogWindow = hwnd
Select Case uMsg
Case BFFM_INITIALIZED
Call MoveWindow(DialogWindow, -Screen.Width, 0, 480, 480, True)
Call SendMessage(hwnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
hwnda = GetWindow(hwnd, GW_CHILD)
Do While hwnda <> 0
GetClassName hwnda, ClWind, 14
If Left(ClWind, 6) = "Button" Then
GetWindowText hwnda, ClCaption, 100
If UCase(Left(ClCaption, 6)) = "CANCEL" Then
CancelbuttonWindow = hwnda
End If
End If
If Left(ClWind, 13) = "SysTreeView32" Then
SysTreeWindow = hwnda
<span style="color: #FF0000;">SendMessage SysTreeWindow, TVM_SETBKCOLOR, 0, ByVal vbBlack</span>
SendMessage SysTreeWindow, TVM_SETTEXTCOLOR, 0, ByVal vbWhite
End If
hwnda = GetWindow(hwnda, GW_NEXT)
Loop
GrabTV DialogContainer
Case BFFM_SELCHANGED
sBuffer = Space(MAX_PATH)
ret = SHGetPathFromIDList(lp, sBuffer)
m_CurrentDirectory = Left(sBuffer, InStr(sBuffer, Chr(0)) - 1)
NewForm.PathChange
End Select
BrowseCallbackProc = 0
End Function

Private Function GetAddressofFunction(add As Long) As Long
GetAddressofFunction = add
End Function

Private Sub GrabTV(mNewOwner As Object)
Dim R As RECT
SetParent SysTreeWindow, mNewOwner.hwnd
GetWindowRect mNewOwner.hwnd, R
SizeTV 0, 0, mNewOwner.ScaleWidth, mNewOwner.ScaleHeight
DialogHook
End Sub

Public Sub CloseUp()
SetParent SysTreeWindow, DialogWindow
SendMessage DialogWindow, WM_CLOSE, 1, ByVal 0&
DestroyWindow DialogWindow
End Sub

Private Sub TaskbarHide()
ShowWindow DialogWindow, 0
DialogUnhook
End Sub

Public Sub Main()
Set NewForm = Form1
NewForm.Show
Set DialogContainer = NewForm.PicBrowse
BrowseForFolder "c:\"
End Sub

Private Sub DialogHook()
lpPrevWndProc = SetWindowLong(DialogWindow, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub DialogUnhook()
SetWindowLong DialogWindow, GWL_WNDPROC, lpPrevWndProc
End Sub

Private Function WindowProc(ByVal mHwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_MOVE
TaskbarHide
End Select
WindowProc = CallWindowProc(lpPrevWndProc, mHwnd, uMsg, wParam, lParam)
End Function

Public Sub SizeTV(mLeft As Long, mTop As Long, mWidth As Long, mHeight As Long)
Dim lby As Long
Call MoveWindow(SysTreeWindow, mLeft, mTop, mWidth, mHeight, True)

lby = GetWindowLong(SysTreeWindow, GWL_STYLE)
Call SetWindowLong(SysTreeWindow, GWL_STYLE, lby And Not &H2)
End Sub

Public Sub ChangePath(mPath As String)
m_CurrentDirectory = mPath
Call SendMessage(DialogWindow, BFFM_SETSELECTION, 1, m_CurrentDirectory)
End Sub