zoukankan      html  css  js  c++  java

  • 设置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.
    这么做的问题就有上述问题,请教高手解答.



     分享到： 
     
    #1 得分：0回复于： 2005-07-22 10:00:43
    这个问题用简单的API是处理不了的，至少你的图标下无法添充上背景色，看看微软制作帮助文档的HTML Help Workshop，
    左侧目录树当设置背景色时图标也
    是无法上色的。
    我建议你用背景图进行目录区重画，如果你必须使用这种背景色，只需要将选定的背景色去为一个IMAGE图片上图背景，
    再用这个IMAGE图形去刷新目录树背景就
    可以了，
    这种方法还可以用任意图形作目录树背景，效果非常棒。如果你需要我要以帖上处理代码。
    你眼中的程序猿，百万资源等你来
    对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理
    #2 得分：0回复于： 2005-07-23 21:28:39
    谢谢你 wangxuejun,图标区是可以上色的,就是将imagelist 的backcolor也设置成sColor,我不能处理的就是那个每一个节点如果
    处于该级的最后一个并且
    也有childnode 的时候就又出现了白色的背景块的问题,能贴上你的处理方法吗?愿以100分相谢!
    【赠票活动】2013（秋季）CocoaChina开发者大会
    对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理
    #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] 引用 | 举报 | 管理
    #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] 引用 | 举报 | 管理

     

    #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中，然后运行看看效果吧！
  • 相关阅读:
    python报以下错误：TypeError: 'int' object is not subscriptable
    C# Func与Action
    C#调用C++的DLL 尝试写入受保护的内存
    C#调用C++的dll EntryPointNotFoundException
    C# 拖拽事件
    C#操作Access数据库中遇到的问题（待续）
    Winform 中写代码布局中遇到的控件遮盖问题
    thinkphp6执行流程(一)
    xdebug调试过程中apache500超时
    禁用phpcookie以后如何使用Session
  • 原文地址：https://www.cnblogs.com/rosesmall/p/3326223.html
Copyright © 2011-2022 走看看