设置Treeview背景色的问题1
有没有哪位兄弟在VB中使用sendmessage对TreeView改变背景色?我现在遇到一个问题,如果把linestyle设为1 的时候,展开节点的时候root部位会
有一个下拉的白色块,如果设为1 的时候,可以消除这种情况,但是新的问题是每一个节点如果处于该级的最后一个并且也有childnode 的时候就又出现了
白色的背景块?如何解决?
我的源码是:
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long,_ ByVal wParam As Long, lParam 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, _ ByVal nIndex As Long,_
ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = -16& Private Sub ApplyTRVBackColor(ByVal sColor As Long) 分享到:
|
|
|
#1 得分:0回复于: 2005-07-22 10:00:43
这个问题用简单的API是处理不了的,至少你的图标下无法添充上背景色,看看微软制作帮助文档的HTML Help Workshop,
左侧目录树当设置背景色时图标也
是无法上色的。
我建议你用背景图进行目录区重画,如果你必须使用这种背景色,只需要将选定的背景色去为一个IMAGE图片上图背景, 再用这个IMAGE图形去刷新目录树背景就
可以了,
这种方法还可以用任意图形作目录树背景,效果非常棒。如果你需要我要以帖上处理代码。
|
|
|
#2 得分:0回复于: 2005-07-23 21:28:39
谢谢你 wangxuejun,图标区是可以上色的,就是将imagelist 的backcolor也设置成sColor,我不能处理的就是那个\每一个节点如果
处于该级的最后一个并且
也有childnode 的时候就又出现了白色的背景块的问题,能贴上你的处理方法吗?愿以100分相谢!
|
|
#3 得分:20回复于: 2005-07-27 19:38:53
在窗体上放置一IMAGE控件改名为Img(大小无所谓),加载一幅图片(当然可以加载一幅纯单色的图片,这就是你说的背景色了!);
再放置一个TreeView1,
将以下代码复制帖入窗体
代码中:
Option Explicit Public Sub TreeViewMessage(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _ ByVal lParam As Long, _
RetVal As Long, _
UseRetVal As Boolean)
Static InProc As Boolean Dim ps As PAINTSTRUCT Dim TVDC As Long, drawDC1 As Long, drawDC2 As Long Dim oldBMP1 As Long, drawBMP1 As Long Dim oldBMP2 As Long, drawBMP2 As Long Dim x As Long, y As Long, w As Long, h As Long Dim TVWidth As Long, TVHeight As Long If wMsg = WM_PAINT Then TranslateColor(vbWindowBackground)
BitBlt TVDC, 0, 0, TVWidth, TVHeight, drawDC2, 0, 0, vbSrcCopy SelectObject drawDC1, oldBMP1 SelectObject drawDC2, oldBMP2 DeleteObject drawBMP1 DeleteObject drawBMP2 EndPaint hWnd, ps RetVal = 0 UseRetVal = True InProc = False ElseIf wMsg = WM_ERASEBKGND Then RetVal = 1 UseRetVal = True ElseIf wMsg = WM_HSCROLL Or wMsg = WM_VSCROLL Or wMsg = WM_MOUSEWHEEL Then InvalidateRect hWnd, 0, 0 End If End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) |
|
|
#4 得分:0回复于: 2005-07-27 19:40:57
Option Explicit
Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Public Type PAINTSTRUCT hDC As Long fErase As Long rcPaint As RECT fRestore As Long fIncUpdate As Long rgbReserved As Byte End Type Declare Function BeginPaint Lib "user32" (ByVal hWnd As Long, lpPaint As PAINTSTRUCT) As Long ByVal nHeight As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _ ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, _ ByVal nWidth As Long,_
ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, ByVal lpRect As Long, _ ByVal bErase As Long) As Long
Public Const WM_PAINT = &HF Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSrc As Any,_ ByVal dwLen As Long)
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _ ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long,_ ByVal nIndex As Long,_
ByVal dwNewLong As Long) As Long
Const GWL_WNDPROC = (-4) 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
Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, _ ByVal lpString As String) As Long
Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, _ ByVal lpString As String, _
ByVal hData As Long) As Long
Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, _ ByVal lpString As String) As Long
Private m_hpalHalftone As Long ByVal nPlanes As Long, _
ByVal nBitCount As Long,_
lpBits As Any) As Long
Declare Function GetBkColor Lib "gdi32" (ByVal hDC As Long) As Long Declare Function GetTextColor Lib "gdi32" (ByVal hDC As Long) As Long Declare Function SelectPalette Lib "gdi32" (ByVal hDC As Long, ByVal hPalette As Long,_ ByVal bForceBackground As Long) As Long
Declare Function RealizePalette Lib "gdi32" (ByVal hDC As Long) As Long Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, _ ByVal lHPalette As Long,_
lColorRef As Long) As Long
Declare Function DrawIconEx Lib "user32" (ByVal hDC As Long, ByVal xLeft As Long, _ ByVal yTop As Long, _
ByVal hIcon As Long,_
ByVal cxWidth As Long,_
ByVal cyHeight As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, _
ByVal diFlags As Long) As Long
Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, _ ByVal hBrush As Long) As Long
Public Const DI_NORMAL = &H3 Public Function TranslateColor(inCol As Long) As Long Public Sub PaintNormalStdPic(ByVal hdcDest As Long, ByVal xDest As Long, _ ByVal yDest As Long, _
ByVal width As Long, _
ByVal Height As Long,ByVal picSource As Picture, ByVal xSrc As Long, ByVal ySrc As Long, _
Optional ByVal hPal As Long = 0)
Dim hdcTemp As Long
Dim hPalOld As Long Dim hbmMemSrcOld As Long Dim hdcScreen As Long Dim hbmMemSrc As Long If picSource Is Nothing Then GoTo PaintNormalStdPic_InvalidParam Select Case picSource.Type Case vbPicTypeBitmap If hPal = 0 Then hPal = m_hpalHalftone hdcScreen = GetDC(0&) hdcTemp = CreateCompatibleDC(hdcScreen) hPalOld = SelectPalette(hdcTemp, hPal, True) RealizePalette hdcTemp hbmMemSrcOld = SelectObject(hdcTemp, picSource.Handle) BitBlt hdcDest, xDest, yDest, width, Height, hdcTemp, xSrc, ySrc, vbSrcCopy SelectObject hdcTemp, hbmMemSrcOld SelectPalette hdcTemp, hPalOld, True RealizePalette hdcTemp DeleteDC hdcTemp ReleaseDC 0&, hdcScreen Case vbPicTypeIcon DrawIconEx hdcDest, xDest, yDest, picSource.Handle, 0, 0, 0&, 0&, DI_NORMAL Case Else GoTo PaintNormalStdPic_InvalidParam End Select Exit Sub PaintNormalStdPic_InvalidParam: Err.Raise giINVALID_PICTURE End Sub |
|
#5 得分:0回复于: 2005-07-27 19:42:02
Public Sub PaintTransparentDC(ByVal hdcDest As Long, ByVal xDest As Long, _
ByVal yDest As Long, _
ByVal width As Long, _
ByVal Height As Long,
ByVal hdcSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal clrMask As OLE_COLOR, _
Optional ByVal hPal As Long = 0)
Dim hdcMask As Long Dim hdcColor As Long Dim hbmMask As Long Dim hbmColor As Long Dim hbmColorOld As Long Dim hbmMaskOld As Long Dim hPalOld As Long Dim hdcScreen As Long Dim hdcScnBuffer As Long Dim hbmScnBuffer As Long Dim hbmScnBufferOld As Long Dim hPalBufferOld As Long Dim lMaskColor As Long hdcScreen = GetDC(0&) If hPal = 0 Then hPal = m_hpalHalftone End If OleTranslateColor clrMask, hPal, lMaskColor hbmScnBuffer = CreateCompatibleBitmap(hdcScreen, width, Height) hdcScnBuffer = CreateCompatibleDC(hdcScreen) hbmScnBufferOld = SelectObject(hdcScnBuffer, hbmScnBuffer) hPalBufferOld = SelectPalette(hdcScnBuffer, hPal, True) RealizePalette hdcScnBuffer BitBlt hdcScnBuffer, 0, 0, width, Height, hdcDest, xDest, yDest, vbSrcCopy hbmColor = CreateCompatibleBitmap(hdcScreen, width, Height) hbmMask = CreateBitmap(width, Height, 1, 1, ByVal 0&) hdcColor = CreateCompatibleDC(hdcScreen) hbmColorOld = SelectObject(hdcColor, hbmColor) hPalOld = SelectPalette(hdcColor, hPal, True) RealizePalette hdcColor SetBkColor hdcColor, GetBkColor(hdcSrc) SetTextColor hdcColor, GetTextColor(hdcSrc) BitBlt hdcColor, 0, 0, width, Height, hdcSrc, xSrc, ySrc, vbSrcCopy hdcMask = CreateCompatibleDC(hdcScreen) hbmMaskOld = SelectObject(hdcMask, hbmMask) SetBkColor hdcColor, lMaskColor SetTextColor hdcColor, vbWhite BitBlt hdcMask, 0, 0, width, Height, hdcColor, 0, 0, vbSrcCopy SetTextColor hdcColor, vbBlack SetBkColor hdcColor, vbWhite BitBlt hdcColor, 0, 0, width, Height, hdcMask, 0, 0, DSna BitBlt hdcScnBuffer, 0, 0, width, Height, hdcMask, 0, 0, vbSrcAnd BitBlt hdcScnBuffer, 0, 0, width, Height, hdcColor, 0, 0, vbSrcPaint BitBlt hdcDest, xDest, yDest, width, Height, hdcScnBuffer, 0, 0, vbSrcCopy DeleteObject SelectObject(hdcColor, hbmColorOld) SelectPalette hdcColor, hPalOld, True RealizePalette hdcColor DeleteDC hdcColor DeleteObject SelectObject(hdcScnBuffer, hbmScnBufferOld) SelectPalette hdcScnBuffer, hPalBufferOld, True RealizePalette hdcScnBuffer DeleteDC hdcScnBuffer DeleteObject SelectObject(hdcMask, hbmMaskOld) DeleteDC hdcMask ReleaseDC 0&, hdcScreen End Sub Public Sub PaintTransparentStdPic(ByVal hdcDest As Long, _ Dim hdcSrc As Long Select Case picSource.Type Public Sub Subclass(frm As Form, tv As TreeView) Public Sub UnSubclass(tv As TreeView) Public Function WndProcTV(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _ ByVal lParam As Long) As Long
On Error Resume Next Dim lProc As Long Dim lPtr As Long Dim tmpForm As Form Dim bUseRetVal As Boolean Dim lRetVal As Long bUseRetVal = False '这帖和上帖都放入一个模块Module1中,然后运行看看效果吧! |
最新文章
- 把HBITMAP 保存图片文件.
- html使用心得
- php全面获取url地址栏及各种参数
- 读书笔记——OpenGL超级宝典
- paper 41:正交变换
- Watir资源列表【转】
- How to write a product backlog step by step
- 好记心不如烂笔头,ssh登录 The authenticity of host 192.168.0.xxx can't be established. 的问题
- wzplayer2 for windows ActiveX 试用地址
- 奇怪的Lisp和难懂的计算机程序的构造和解释
- WAMP集成环境
- Android源码学习(一) 数据集观察者
- 如何安装使用Impala
- call,apply和bind,其实很简单
- poj 3278 简单BFS
- Jmeter性能测试之进阶BeanShell的使用
- 04-Python入门学习-流程控制
- SSM框架中各层的含义和联系
- MySQL主从备份配置实例
- 结构型模式之Adapter模式
热门文章
- composer安装Workerman报错:Installation failed, reverting ./composer.json to its original content.
- iOS开发者帐号申请指南
- C#程序集系列06,程序集清单,EXE和DLL的区别
- 如何更改linux文件目录拥有者及用户组
- Sublime Text3 配置 Python2 Python3
- 《Head First 设计模式》学习笔记——策略模型
- Spring3数据库事务管理机制
- Linux 防火墙 iptables基本操作
- key-value 多线程server的Linux C++实现
- Go 语言简介(上)— 语法