以下为在Csdn上找到的Treeview资源管理器代码,怎样改变其背景色?
用:SendMessage SysTreeWindow,TVM_SETBKCOLOR,0,byval RGB(255,255,255)来改变背景色是可以,但图标有白底。
请问怎样使图标背景透明?
Option Explicit
'资源管理器树型目录模块TreeViewPrivate 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 TypePublic 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
                    SendMessage SysTreeWindow, TVM_SETBKCOLOR, 0, ByVal vbBlack
                    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 FunctionPrivate Function GetAddressofFunction(add As Long) As Long
    GetAddressofFunction = add
End FunctionPrivate 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 SubPublic Sub CloseUp()
    SetParent SysTreeWindow, DialogWindow
    SendMessage DialogWindow, WM_CLOSE, 1, ByVal 0&
    DestroyWindow DialogWindow
End SubPrivate Sub TaskbarHide()
    ShowWindow DialogWindow, 0
    DialogUnhook
End SubPublic 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 SubPrivate Sub DialogUnhook()
    SetWindowLong DialogWindow, GWL_WNDPROC, lpPrevWndProc
End SubPrivate 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

解决方案 »

  1.   

    设置背景色就是TVM_SETBKCOLOR啊
    图标有白底,自己去看ImageList控件。
      

  2.   

    ImageList控件的设置我知道,但这段代码是调用系统的浏览文件夹SetParent到图片框中的,所以不知道如何设置啊?
      

  3.   

    你贴的模块,根本无法运行,谁知道你在说什么?NewForm.PicBrowse这是啥东东?
      

  4.   

    NewForm.PicBrowse 是Form1上的一个图片框,用以装载浏览文件夹窗口,Form1的代码如下:VERSION 5.00
    Begin VB.Form Form1 
       Caption         =   "Form1"
       ClientHeight    =   6870
       ClientLeft      =   60
       ClientTop       =   450
       ClientWidth     =   10245
       LinkTopic       =   "Form1"
       ScaleHeight     =   6870
       ScaleWidth      =   10245
       StartUpPosition =   3  '窗口缺省
       Begin VB.PictureBox PicBrowse 
          Height          =   6675
          Left            =   60
          ScaleHeight     =   6615
          ScaleWidth      =   4155
          TabIndex        =   0
          Top             =   60
          Width           =   4215
       End
    End
    Attribute VB_Name = "Form1"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    Option ExplicitPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
        Call CloseUp
    End Sub
      

  5.   

    把TV背景色设置成白色或者把ImageList背景色设置为黑色。
    设置ImageList背景色有API。
      

  6.   

    就是想知道不知道设置ImageList背景色的API啊,楼上能介绍一下不胜感激!
      

  7.   


    Private Declare Function ImageList_SetBkColor& Lib "comctl32" (ByVal imagel As Long, ByVal Color As Long)这参数不用多介绍了吧,颜色就是RGB值。
      

  8.   

    非常感谢a1875566250。
    若是自己创建的imagelist可用以上api来设置背景色,但上面的程序中没有imagelist的句柄,就不知道如何设置了,能不能获得Treeview的imagelist的句柄啊?
      

  9.   


    有个TVM消息可以获取TREEVIEW的IAMGELIST的句柄,MSDN上有介绍。
      

  10.   

    搞定!再次谢谢a1875566250,使用TVM_GETIMAGELIST可以获取ImageList的句柄,再用ImageList_SetBkColor来设置背景色。