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

设置TreeView背景色的更多相关文章

  1. 设置Treeview背景色的问题1

    有没有哪位兄弟在VB中使用sendmessage对TreeView改变背景色?我现在遇到一个问题,如果把linestyle设为1 的时候,展开节点的时候root部位会 有一个下拉的白色块,如果设为1  ...

  2. Android Material适配 为控件设置指定背景色和点击波纹效果

    Android Material适配 为控件设置指定背景色和点击波纹效果,有需要的朋友可以参考下. 大部分时候,我们都需要为控件设置指定背景色和点击效果 4.x以下可以使用selector,5.0以上 ...

  3. C# WinForm设置TreeView选中节点

    这里假定只有两级节点,多级方法类似.遍历节点,根据选中节点文本找到要选中的节点.treeView.SelectedNode = selectNode; /// <summary> /// ...

  4. React Native 设置RGBA背景色

    React Native 设置RGBA背景色: 可以先用Mac自带吸色工具,获取RGB值,然后设置背景如下: backgroundColor: 'rgba(52, 52, 52, 0.8)', 透明度 ...

  5. 由设置body线性背景色引发的问题-----当声明文档类型时,对body设置线性背景色,页面背景色无法整体线性过渡

    问题:当声明文档类型时,对body设置线性背景色,页面背景色无法整体线性过渡 不声明文档类型时,对body设置线性背景色 <HTML> <head> <meta char ...

  6. CSS布局与定位——height百分比设置无效/背景色不显示

    CSS布局与定位——height百分比设置无效/背景色不显示 html元素属性width和height的值有两种表达方式,一是固定像素如“100px”,一是百分比如“80%”, 使用百分比的好处是元素 ...

  7. JS---案例:点击按钮设置div背景色渐变

    案例:点击按钮设置div背景色渐变 背景色渐变:设置透明度 <div id="dv"></div> <input type="button& ...

  8. Java 为 Excel 中的行设置交替背景色

    在制作Excel表格时,通过将数据表中上下相邻的两行用不同的背景色填充,可以使各行的数据看起来更清楚,避免看错行,同时也能增加Excel表格的美观度.本文将介绍如何在Java程序中为 Excel 奇数 ...

  9. 使用POI设置excel背景色

    HSSFCellStyle setBorder1 = workbook.createCellStyle(); HSSFFont font1 = workbook.createFont(); font1 ...

随机推荐

  1. PPT文化

    PPT文化,yes or no? 知识是有体系的,有的时候刚接触的时候可以 推导技术 ,汇报.吹牛都可以应用上,并且可以让别人想想. 但是实际应用技术,就需要涉及很多详细的技术细节,如果少掉一个看似极 ...

  2. win7 启动管理器修改默认启动项

    最近给我的超级本做了系统备份,以防万一,但是备份完成后,系统启动的时候总会首先进入Windows启动管理器,且默认启动项是Ghost,还需要选择一下才能进入Win7系统,如何解决这个问题呢? 方案一: ...

  3. umlの活动图

    在介绍了曾经的类图和用例图等之后,因为对象图是描写叙述类图的某一个时刻的快照,所以类图没有详细的赋值可是对象图能够有详细的值.而包图是蕴含在画uml图之中的,对类图和对象图等进行分类的图,就像wind ...

  4. RobotFramework自动化2-自定义关键字

    前言 有时候一个页面上有多个对象需要操作,如果一个个去定位的话,比较繁琐,这时候就可以定位一组对象.Selenium2library提供了Get Webelements 关键字,用于定位一组元素 以百 ...

  5. DAO,Service接口与实现类设计

    DAO接口 为每个DAO声明接口的好处在于 1. 可以在尚未实现具体DAO的时候编写上层代码,如Service里对DAO的调用 2. 可以为DAO进行多实现,例如有JDBCDAO实现,MyBatisD ...

  6. 【BZOJ】【3611】【HEOI2014】大工程

    虚树+树形DP 本题100W的点数……不用虚树真的好吗…… Orz ZYF 我的感悟: dp的过程跟SPOJ 1825 FTOUR2 的做法类似,依次枚举每个子树,从当前子树和之前的部分中各找一条最长 ...

  7. Mongodb安全认证及Java调用

    Mongodb安全认证在单实例和副本集两种情况下不太一样,单实例相对简单,只要在启动时加上 --auth参数即可,但副本集则需要keyfile. 一.单实例 1.启动服务(先不要加auth参数) 2. ...

  8. how to configure logback for Mybatis to print my SQL

    To log SQL statements for particular mybatis mapper set DEBUG (TRACE to see query parameters and res ...

  9. 寻路DEMO

    网格场景的寻路算法DEMO 灰色格子为默认正常蓝色格子表示为障碍物,不可进入红色细条在格子周围,表示格子的墙,用于阻碍行走紫色为当前鼠标选中格子黄色为寻路的起始位置和结束位置.鼠标左键设置,CTRL+ ...

  10. linux下永久添加静态路由

    在linux下永久添加静态路由有两种方法: 添加路由的命令: 1,route add route add -net 192.56.76.0 netmask 255.255.255.0 dev eth0 ...