zoukankan      html  css  js  c++  java
  • 设置TreeView背景色

    以下为在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

  • 相关阅读:
    MySQL+Navicat for MySQL安装
    intellij idea14 +svn配置
    java重载(实现同一方法名,不同参数)
    Java连接MySQL数据库及操作
    通过Chrome的inspect对手机webview进行调试
    使用fiddler对手机上的程序进行抓包
    开始一个Android的appium实例
    Android模拟器内安装应用
    Appium的inspector使用
    python webdriver启动IE浏览器
  • 原文地址:https://www.cnblogs.com/rosesmall/p/3326226.html
Copyright © 2011-2022 走看看