热情软件屋

 

如何给Treeview控件加背景图片


编号:QA003245
建立日期: 2000年8月21日 最后修改日期:2001年3月26日
所属类别:

blur:
    操作系统:win98
    编程工具:vb6
    问题:请问如何给Treeview控件加背景图片??

回答:

    tristram的意见:
    我曾经向你们问过这个问题,但没有得到答复。后来偶然找到下面这个例子,具体网址不记得了,现将全文粘贴如下(主持人注:该例子来自http://www.vbthunder.com/default.asp?srcget=10):
    (该例子用5.0或6.0版的treeview控件都可以,但运行似乎有点问题:当频繁展开、收起节点后,背景图片的重绘出现
    马赛克现象,而且对图片也有一定的限制,但我的水平有限,无法改进,就当提供点思路吧,希望能将完善的结果告诉我,
    

 
Common Controls - Background on a TreeView

 Visual Basic Version: 5.0, perhaps 6.0
A TreeView with a background image Okay, so all this is is a nifty user interface doodad that's not really essential to your application. Still, if you're developing an app that needs some flash in the UI, this is a nice trick to tuck under your belt.
Note: I first wrote this example using an API-created TreeView control, and then ported it to the TreeView from VB's Common Controls OCX. Unfortunately, I soon learned that there are some annoying quirks in the OCX TreeView that can make the background paint oddly when you have a version of ComCtl32.dll that "slides" child items in and out of view. The background is still visible, but it isn't quite tiled the way it should be. For this reason you should probably use a background bitmap in which this visual anomaly won't be as noticeable, such as the one pictured above.

 

 Standard Module modSubclass.bas:
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (lpDest As Any, lpSrc As Any, _
    ByVal dwLen 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_WNDPROC = (-4)
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 GetProp Lib "user32" Alias _
    "GetPropA" (ByVal hWnd As Long, _
    ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias _
    "SetPropA" (ByVal hWnd As Long, _
    ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32" Alias _
    "RemovePropA" (ByVal hWnd As Long, _
    ByVal lpString As String) As Long


Public Sub Subclass(frm As Form, tv As TreeView)

'Subclass the TreeView and store an object
'pointer to the form.

Dim lProc As Long

If GetProp(tv.hWnd, "VBTWndProc") <> 0 Then
    Exit Sub
End If

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
End If

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")
'Copy the form's object pointer into an
'object variable and call the message handler.
CopyMemory tmpForm, lPtr, 4
tmpForm.TreeViewMessage hWnd, wMsg, wParam, lParam, _
    lRetVal, bUseRetVal
CopyMemory tmpForm, 0&, 4
'我将以上三句中的"tmpForm" 替换成"frmMain"后才能运行。
If bUseRetVal = True Then
    'Use the return value from the form's
    'handler
    WndProcTV = lRetVal
Else
    'Pass on to original wndproc
    WndProcTV = CallWindowProc(lProc, hWnd, wMsg, _
        wParam, lParam)
End If

End Function

'--end block--'
   

 Standard Module Paint.bas:
Option Explicit

'================================================
'Paint.bas
'Visual Basic Thunder
'http://www.vbthunder.com
'
'These routines taken (and later modified) from
'Microsoft's Visual Basic 5.0 Owner's Area.
'================================================

'Halftone created for default palette use
Private m_hpalHalftone As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function CreateSolidBrush Lib "gdi32" _
    (ByVal crColor As Long) 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 SetBkColor Lib "gdi32" _
    (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
    (ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
    (ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
    (ByVal hWnd As Long, 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 DeleteObject Lib "gdi32" _
    (ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" _
    (ByVal hWnd As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" _
    (ByVal hDC As Long, ByVal crColor As Long) As Long
Private 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
Private Declare Function GetBkColor Lib "gdi32" _
    (ByVal hDC As Long) As Long
Private Declare Function GetTextColor Lib "gdi32" _
    (ByVal hDC As Long) As Long
Private Declare Function SelectPalette Lib "gdi32" _
    (ByVal hDC As Long, ByVal hPalette As Long, _
    ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" _
    (ByVal hDC As Long) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" _
    (ByVal lOleColor As Long, ByVal lHPalette As Long, _
    lColorRef As Long) As Long
Private 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
Private Declare Function FillRect Lib "user32" _
    (ByVal hDC As Long, lpRect As RECT, _
    ByVal hBrush As Long) As Long

'DrawIconEx Flags
Private Const DI_MASK = &H1
Private Const DI_IMAGE = &H2
Private Const DI_NORMAL = &H3
Private Const DI_COMPAT = &H4
Private Const DI_DEFAULTSIZE = &H8

'Raster Operation Codes
Private Const DSna = &H220326 '0x00220326

'VB Errors
Private Const giINVALID_PICTURE As Integer = 481


Public Function TranslateColor(inCol As Long) As Long

'A simple wrapper for OleTranslateColor
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
    'Validate that a bitmap was passed in
    If picSource Is Nothing Then GoTo PaintNormalStdPic_InvalidParam
    Select Case picSource.Type
        Case vbPicTypeBitmap
            If hPal = 0 Then
                hPal = m_hpalHalftone
            End If
            hdcScreen = GetDC(0&)
            'Create a DC to select bitmap into
            hdcTemp = CreateCompatibleDC(hdcScreen)
            hPalOld = SelectPalette(hdcTemp, hPal, True)
            RealizePalette hdcTemp
            'Select bitmap into DC
            hbmMemSrcOld = SelectObject(hdcTemp, picSource.Handle)
            'Copy to destination DC
            BitBlt hdcDest, xDest, yDest, width, Height, hdcTemp, xSrc, ySrc, vbSrcCopy
            'Cleanup
            SelectObject hdcTemp, hbmMemSrcOld
            SelectPalette hdcTemp, hPalOld, True
            RealizePalette hdcTemp
            DeleteDC hdcTemp
            ReleaseDC 0&, hdcScreen
        Case vbPicTypeIcon
            'Create a bitmap and select it into an DC
            'Draw Icon onto DC
            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

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        'HDC of the created mask image
    Dim hdcColor As Long       'HDC of the created color image
    Dim hbmMask As Long        'Bitmap handle to the mask image
    Dim hbmColor As Long       'Bitmap handle to the color image
    Dim hbmColorOld As Long
    Dim hbmMaskOld As Long
    Dim hPalOld As Long
    Dim hdcScreen As Long
    Dim hdcScnBuffer As Long   'Buffer to do all work on
    Dim hbmScnBuffer As Long
    Dim hbmScnBufferOld As Long
    Dim hPalBufferOld As Long
    Dim lMaskColor As Long
    
    hdcScreen = GetDC(0&)
    'Validate palette
    If hPal = 0 Then
        hPal = m_hpalHalftone
    End If
    OleTranslateColor clrMask, hPal, lMaskColor
    
    'Create a color bitmap to server as a copy of the destination
    'Do all work on this bitmap and then copy it back over the destination
    'when it's done.
    hbmScnBuffer = CreateCompatibleBitmap(hdcScreen, width, Height)
    'Create DC for screen buffer
    hdcScnBuffer = CreateCompatibleDC(hdcScreen)
    hbmScnBufferOld = SelectObject(hdcScnBuffer, hbmScnBuffer)
    hPalBufferOld = SelectPalette(hdcScnBuffer, hPal, True)
    RealizePalette hdcScnBuffer
    'Copy the destination to the screen buffer
    BitBlt hdcScnBuffer, 0, 0, width, Height, hdcDest, xDest, yDest, vbSrcCopy
    
    'Create a (color) bitmap for the cover (can't use CompatibleBitmap with
    'hdcSrc, because this will create a DIB section if the original bitmap
    'is a DIB section)
    hbmColor = CreateCompatibleBitmap(hdcScreen, width, Height)
    'Now create a monochrome bitmap for the mask
    hbmMask = CreateBitmap(width, Height, 1, 1, ByVal 0&)
    'First, blt the source bitmap onto the cover.  We do this first
    'and then use it instead of the source bitmap
    'because the source bitmap may be
    'a DIB section, which behaves differently than a bitmap.
    '(Specifically, copying from a DIB section to a monochrome bitmap
    'does a nearest-color selection rather than painting based on the
    'backcolor and forecolor.
    hdcColor = CreateCompatibleDC(hdcScreen)
    hbmColorOld = SelectObject(hdcColor, hbmColor)
    hPalOld = SelectPalette(hdcColor, hPal, True)
    RealizePalette hdcColor
    'In case hdcSrc contains a monochrome bitmap, we must set the destination
    'foreground/background colors according to those currently set in hdcSrc
    '(because Windows will associate these colors with the two monochrome colors)
    SetBkColor hdcColor, GetBkColor(hdcSrc)
    SetTextColor hdcColor, GetTextColor(hdcSrc)
    BitBlt hdcColor, 0, 0, width, Height, hdcSrc, xSrc, ySrc, vbSrcCopy
    'Paint the mask.  What we want is white at the transparent color
    'from the source, and black everywhere else.
    hdcMask = CreateCompatibleDC(hdcScreen)
    hbmMaskOld = SelectObject(hdcMask, hbmMask)

    'When bitblt'ing from color to monochrome, Windows sets to 1
    'all pixels that match the background color of the source DC.  All
    'other bits are set to 0.
    SetBkColor hdcColor, lMaskColor
    SetTextColor hdcColor, vbWhite
    BitBlt hdcMask, 0, 0, width, Height, hdcColor, 0, 0, vbSrcCopy
    'Paint the rest of the cover bitmap.
    '
    'What we want here is black at the transparent color, and
    'the original colors everywhere else.  To do this, we first
    'paint the original onto the cover (which we already did), then we
    'AND the inverse of the mask onto that using the DSna ternary raster
    'operation (0x00220326 - see Win32 SDK reference, Appendix, "Raster
    'Operation Codes", "Ternary Raster Operations", or search in MSDN
    'for 00220326).  DSna [reverse polish] means "(not SRC) and DEST".
    '
    'When bitblt'ing from monochrome to color, Windows transforms all white
    'bits (1) to the background color of the destination hdc.  All black (0)
    'bits are transformed to the foreground color.
    SetTextColor hdcColor, vbBlack
    SetBkColor hdcColor, vbWhite
    BitBlt hdcColor, 0, 0, width, Height, hdcMask, 0, 0, DSna
    'Paint the Mask to the Screen buffer
    BitBlt hdcScnBuffer, 0, 0, width, Height, hdcMask, 0, 0, vbSrcAnd
    'Paint the Color to the Screen buffer
    BitBlt hdcScnBuffer, 0, 0, width, Height, hdcColor, 0, 0, vbSrcPaint
    'Copy the screen buffer to the screen
    BitBlt hdcDest, xDest, yDest, width, Height, hdcScnBuffer, 0, 0, vbSrcCopy
    'All done!
    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         'HDC that the source bitmap is selected into
    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
    'Verify that the passed picture is a Bitmap
    If picSource Is Nothing Then
        GoTo PaintTransparentStdPic_InvalidParam
    End If

    Select Case picSource.Type
        Case vbPicTypeBitmap
            hdcScreen = GetDC(0&)
            'Validate palette
            If hPal = 0 Then
                hPal = m_hpalHalftone
            End If
            'Select passed picture into an HDC
            hdcSrc = CreateCompatibleDC(hdcScreen)
            hbmMemSrcOld = SelectObject(hdcSrc, picSource.Handle)
            hPalOld = SelectPalette(hdcSrc, hPal, True)
            RealizePalette hdcSrc
            'Draw the bitmap
            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
            'Create a bitmap and select it into an DC
            hdcScreen = GetDC(0&)
            'Validate palette
            If hPal = 0 Then
                hPal = m_hpalHalftone
            End If
            hdcSrc = CreateCompatibleDC(hdcScreen)
            hbmMemSrc = CreateCompatibleBitmap(hdcScreen, width, Height)
            hbmMemSrcOld = SelectObject(hdcSrc, hbmMemSrc)
            hPalOld = SelectPalette(hdcSrc, hPal, True)
            RealizePalette hdcSrc
            'Draw Icon onto DC
            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
            'Draw Transparent image
            PaintTransparentDC hdcDest, xDest, yDest, width, Height, hdcSrc, 0, 0, lMaskColor, hPal
            'Clean up
            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:
    'Err.Raise giINVALID_PICTURE
    Exit Sub
End Sub

'--end block--'
   

 Form frmMain.frm

For this example you will need:
- A TreeView control named tvBG
- An Image control named img
Set the Picture property of img to a bitmap that is
conducive to tiling. (Or any old bitmap, if you really want!)
Once the bitmap is in place, it's time to insert the code:

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, tvBG

Dim Root As Node

'Add some items
With tvBG.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 = tvBG.width \ Screen.TwipsPerPixelX
    TVHeight = tvBG.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_Unload(Cancel As Integer)

'Kill subclassing routine for exit
UnSubclass tvBG

End Sub

'--end block--'
   

 Finishing Up
  
Save and run the project. The bitmap that you loaded into the Image control is tiled onto the TreeView's background! I haven't tried this code in VB6, so I'm not sure if it works with the new OCX.

    
    杨勇的意见:
    一个基本的方法是将树控制绘制在一个内存设备上,并透明的覆盖在背景图像上。如果你学过VC,你可去编程地带看看,那里有相关的VC文章与源代码,你可以借鉴一下。http://pzone.yeah.net
    相关问题:
    QA002144 "TreeCtrl如何添加背景图片"
    
    Specner Yang的意见:
    1)程序码请用big5< -- > GB 转换软体,可以看到有关程序码注解。
    2)不建议这么做,影响显示速度至钜。
    3)具体范例,请到纪文和网站『VB入门网』
    http://www.vbguide.com.tw/webback.asp
     式
    看看「个个击破」 单元中的
    ---------------------------------------
    406: 如何使用Treeview展示阶层式资料(使用多维数组为中介角色)?---------------------------------------
    (1) 请先阅读前言之说明。
    (2) 若适合现状者可以下载范例,评估研究程序。
    (3) 参考其标示之『参考资料』及『网络资源』。
    (4) 答案不是唯一,仅供参考用途。

此问题由tristram等回答。

 
把这个问题推荐给朋友
   
   
您的意见类别
您的名字
您的电子邮件
您的建议(请尽可能详细)
 
 

版权所有 1997-2008 热情软件屋
如果您有任何建议和意见, 请给我发个电子邮件 askpro@china-askpro.com
Web Designed by ZebraStudio