设置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 Const TVM_SETBKCOLOR = 4381&
Private Const TVM_GETBKCOLOR = 4383&
Private Const TVS_HASLINES = 2&

Private Sub ApplyTRVBackColor(ByVal sColor As Long)
Dim lngStyle As Long, iNode As Node
TreeView1.LineStyle = tvwTreeLines
Call SendMessage(TreeView1.hWnd, TVM_SETBKCOLOR, 0, ByVal sColor)
lngStyle = GetWindowLong(TreeView1.hWnd, GWL_STYLE)
Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle - TVS_HASLINES)
Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle)
For Each iNode In TreeView1.Nodes
    iNode.BackColor = sColor
Next
End Sub
如果使用图标,请将imagelist 的backcolor也设置成sColor.
这么做的问题就有上述问题,请教高手解答.

 分享到： 

 

wangxuejun wangxuejun 等级：	#1 得分：0回复于： 2005-07-22 10:00:43 这个问题用简单的API是处理不了的，至少你的图标下无法添充上背景色，看看微软制作帮助文档的HTML Help Workshop， 左侧目录树当设置背景色时图标也 是无法上色的。 我建议你用背景图进行目录区重画，如果你必须使用这种背景色，只需要将选定的背景色去为一个IMAGE图片上图背景， 再用这个IMAGE图形去刷新目录树背景就 可以了， 这种方法还可以用任意图形作目录树背景，效果非常棒。如果你需要我要以帖上处理代码。
	你眼中的程序猿，百万资源等你来 对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理

bjwanghui bjwanghui 等级：	#2 得分：0回复于： 2005-07-23 21:28:39 谢谢你 wangxuejun,图标区是可以上色的,就是将imagelist 的backcolor也设置成sColor,我不能处理的就是那个每一个节点如果 处于该级的最后一个并且 也有childnode 的时候就又出现了白色的背景块的问题,能贴上你的处理方法吗?愿以100分相谢!
	【赠票活动】2013（秋季）CocoaChina开发者大会 对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理

wangxuejun wangxuejun 等级：

#3 得分：20回复于： 2005-07-27 19:38:53 在窗体上放置一IMAGE控件改名为Img（大小无所谓），加载一幅图片（当然可以加载一幅纯单色的图片，这就是你说的背景色了！）; 再放置一个TreeView1， 将以下代码复制帖入窗体 代码中： Option Explicit Private Sub Form_Load() Subclass Me, TreeView1 Dim Root As Node 'Add some items With TreeView1.Nodes Set Root = .Add(, , , "Top-level Node #1") .Add Root.Index, tvwChild, , "Child Node #1" .Add Root.Index, tvwChild, , "Child Node #2" .Add Root.Index, tvwChild, , "Child Node #3" Set Root = .Add(, , , "Top-level Node #2") .Add Root.Index, tvwChild, , "Child Node #1" .Add Root.Index, tvwChild, , "Child Node #2" .Add Root.Index, tvwChild, , "Child Node #3" Set Root = .Add(, , , "Top-level Node #3") .Add Root.Index, tvwChild, , "Child Node #1" .Add Root.Index, tvwChild, , "Child Node #2" .Add Root.Index, tvwChild, , "Child Node #3" Set Root = .Add(, , , "Top-level Node #4") .Add Root.Index, tvwChild, , "Child Node #1" .Add Root.Index, tvwChild, , "Child Node #2" .Add Root.Index, tvwChild, , "Child Node #3" End With End Sub 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   If InProc = True Then       Exit Sub   End If   InProc = True   TVWidth = TreeView1.width  Screen.TwipsPerPixelX   TVHeight = TreeView1.Height  Screen.TwipsPerPixelY   w = ScaleX(Img.Picture.width, vbHimetric, vbPixels)   h = ScaleY(Img.Picture.Height, vbHimetric, vbPixels)   Call BeginPaint(hWnd, ps)   TVDC = ps.hDC   drawDC1 = CreateCompatibleDC(TVDC)   drawBMP1 = CreateCompatibleBitmap(TVDC, TVWidth, TVHeight)   oldBMP1 = SelectObject(drawDC1, drawBMP1)   drawDC2 = CreateCompatibleDC(TVDC)   drawBMP2 = CreateCompatibleBitmap(TVDC, TVWidth, TVHeight)   oldBMP2 = SelectObject(drawDC2, drawBMP2)   SendMessage hWnd, WM_PAINT, drawDC1, ByVal 0&   For y = 0 To TVHeight Step h     For x = 0 To TVWidth Step w       PaintNormalStdPic drawDC2, x, y, w, h, Img.Picture, 0, 0     Next   Next   PaintTransparentDC drawDC2, 0, 0, TVWidth, TVHeight, drawDC1, 0, 0, _ 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) UnSubclass TreeView1 End Sub

关注CSDN论坛微博 送CSDN积分大礼包 对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理

wangxuejun wangxuejun 等级：

#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 Declare Function EndPaint Lib "user32" (ByVal hWnd As Long, lpPaint As PAINTSTRUCT) As Long Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth 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 Public Const WM_ERASEBKGND = &H14 Public Const WM_HSCROLL = &H114 Public Const WM_VSCROLL = &H115 Public Const WM_MOUSEWHEEL = &H20A 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 Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight 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 Const DSna = &H220326 Public Const giINVALID_PICTURE As Integer = 481 Public Function TranslateColor(inCol As Long) As Long Dim retCol As Long OleTranslateColor inCol, 0&, retCol TranslateColor = retCol End Function 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

对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理

 

wangxuejun wangxuejun 等级：

#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, _ 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, _ ByVal clrMask As OLE_COLOR, _ Optional ByVal hPal As Long = 0) Dim hdcSrc As Long Dim hbmMemSrcOld As Long Dim hbmMemSrc As Long Dim udtRect As RECT Dim hbrMask As Long Dim lMaskColor As Long Dim hdcScreen As Long Dim hPalOld As Long If picSource Is Nothing Then GoTo PaintTransparentStdPic_InvalidParam Select Case picSource.Type   Case vbPicTypeBitmap     hdcScreen = GetDC(0&)     If hPal = 0 Then hPal = m_hpalHalftone     hdcSrc = CreateCompatibleDC(hdcScreen)     hbmMemSrcOld = SelectObject(hdcSrc, picSource.Handle)     hPalOld = SelectPalette(hdcSrc, hPal, True)     RealizePalette hdcSrc     PaintTransparentDC hdcDest, xDest, yDest, width, Height, hdcSrc, xSrc, ySrc, clrMask, hPal     SelectObject hdcSrc, hbmMemSrcOld     SelectPalette hdcSrc, hPalOld, True     RealizePalette hdcSrc     DeleteDC hdcSrc     ReleaseDC 0&, hdcScreen   Case vbPicTypeIcon     hdcScreen = GetDC(0&)     If hPal = 0 Then hPal = m_hpalHalftone     hdcSrc = CreateCompatibleDC(hdcScreen)     hbmMemSrc = CreateCompatibleBitmap(hdcScreen, width, Height)     hbmMemSrcOld = SelectObject(hdcSrc, hbmMemSrc)     hPalOld = SelectPalette(hdcSrc, hPal, True)     RealizePalette hdcSrc     udtRect.Bottom = Height     udtRect.Right = width     OleTranslateColor clrMask, 0&, lMaskColor     hbrMask = CreateSolidBrush(lMaskColor)     FillRect hdcSrc, udtRect, hbrMask     DeleteObject hbrMask     DrawIconEx hdcSrc, 0, 0, picSource.Handle, 0, 0, 0, 0, DI_NORMAL     PaintTransparentDC hdcDest, xDest, yDest, width, Height, hdcSrc, 0, 0, lMaskColor, hPal     DeleteObject SelectObject(hdcSrc, hbmMemSrcOld)     SelectPalette hdcSrc, hPalOld, True     RealizePalette hdcSrc     DeleteDC hdcSrc     ReleaseDC 0&, hdcScreen   Case Else     GoTo PaintTransparentStdPic_InvalidParam End Select Exit Sub PaintTransparentStdPic_InvalidParam: End Sub Public Sub Subclass(frm As Form, tv As TreeView) Dim lProc As Long If GetProp(tv.hWnd, "VBTWndProc") <> 0 Then Exit Sub lProc = GetWindowLong(tv.hWnd, GWL_WNDPROC) SetProp tv.hWnd, "VBTWndProc", lProc SetProp tv.hWnd, "VBTWndPtr", ObjPtr(frm) SetWindowLong tv.hWnd, GWL_WNDPROC, AddressOf WndProcTV End Sub Public Sub UnSubclass(tv As TreeView) Dim lProc As Long lProc = GetProp(tv.hWnd, "VBTWndProc") If lProc = 0 Then Exit Sub SetWindowLong tv.hWnd, GWL_WNDPROC, lProc RemoveProp tv.hWnd, "VBTWndProc" RemoveProp tv.hWnd, "VBTWndPtr" End Sub 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 lProc = GetProp(hWnd, "VBTWndProc") lPtr = GetProp(hWnd, "VBTWndPtr") CopyMemory tmpForm, lPtr, 4 tmpForm.TreeViewMessage hWnd, wMsg, wParam, lParam, lRetVal, bUseRetVal CopyMemory tmpForm, 0&, 4 If bUseRetVal = True Then   WndProcTV = lRetVal Else   WndProcTV = CallWindowProc(lProc, hWnd, wMsg, wParam, lParam) End If End Function '这帖和上帖都放入一个模块Module1中，然后运行看看效果吧！