vb6.0 treeview树背景色改变

【实例截图】

【核心代码】

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type PAINTSTRUCT
    hDC As Long
    fErase As Long
    rcPaint As RECT
    fRestore As Long
    fIncUpdate As Long
    rgbReserved As Byte
End Type

Private Declare Function BeginPaint Lib "user32" _
    (ByVal hWnd As Long, lpPaint As PAINTSTRUCT) As Long
Private Declare Function EndPaint Lib "user32" _
    (ByVal hWnd As Long, lpPaint As PAINTSTRUCT) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
    (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
    (ByVal hDC As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
    (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long
Private 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
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long) As Long
Private Declare Function InvalidateRect Lib "user32" _
    (ByVal hWnd As Long, ByVal lpRect As Long, _
    ByVal bErase As Long) As Long

Private Const WM_PAINT = &HF
Private Const WM_ERASEBKGND = &H14
Private Const WM_HSCROLL = &H114
Private Const WM_VSCROLL = &H115
Private Const WM_MOUSEWHEEL = &H20A


Private Sub Form_Load()

'Subclass the TreeView to trap messages
'that we'll need to respond to
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)

'Prevent recursion with this variable
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
    'Prepare some variables we'll use
    TVWidth = TreeView1.width \ Screen.TwipsPerPixelX
    TVHeight = TreeView1.Height \ Screen.TwipsPerPixelY

    w = ScaleX(Img.Picture.width, vbHimetric, vbPixels)
    h = ScaleY(Img.Picture.Height, vbHimetric, vbPixels)

    'Begin painting. This API must be called in
    'response to the WM_PAINT message or you'll see
    'some odd visual effects :-)
    Call BeginPaint(hWnd, ps)
    TVDC = ps.hDC

    'Create a few canvases in memory to
    'draw on
    drawDC1 = CreateCompatibleDC(TVDC)
    drawBMP1 = CreateCompatibleBitmap(TVDC, TVWidth, TVHeight)
    oldBMP1 = SelectObject(drawDC1, drawBMP1)

    drawDC2 = CreateCompatibleDC(TVDC)
    drawBMP2 = CreateCompatibleBitmap(TVDC, TVWidth, TVHeight)
    oldBMP2 = SelectObject(drawDC2, drawBMP2)

    'This actually causes the TreeView to paint
    'itself onto our memory DC!
    SendMessage hWnd, WM_PAINT, drawDC1, ByVal 0&
    'Tile the bitmap and draw the TreeView
    'over it transparently
    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)
    'Draw to the target DC
    BitBlt TVDC, 0, 0, TVWidth, TVHeight, _
        drawDC2, 0, 0, vbSrcCopy

    'Cleanup
    SelectObject drawDC1, oldBMP1
    SelectObject drawDC2, oldBMP2
    DeleteObject drawBMP1
    DeleteObject drawBMP2

    EndPaint hWnd, ps

    RetVal = 0
    UseRetVal = True
    InProc = False

ElseIf wMsg = WM_ERASEBKGND Then
    'Return TRUE
    RetVal = 1
    UseRetVal = True

ElseIf wMsg = WM_HSCROLL Or wMsg = WM_VSCROLL Or wMsg = WM_MOUSEWHEEL Then
    'Force a repaint to keep the bitmap
    'tiles lined up
    InvalidateRect hWnd, 0, 0

End If

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
MsgBox "If you liked it then please vote for me.", , "Treeview Example"
End Sub

Private Sub Form_Unload(Cancel As Integer)

'Kill subclassing routine for exit
UnSubclass TreeView1

End Sub