|
有沒有哪位兄弟在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圖形去刷新目錄樹背景就
可以了，
這種方法還可以用任意圖形作目錄樹背景，效果非常棒。如果你需要我要以帖上處理代碼。
|
|
|
|
#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 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 |
|
|
|
#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 |
|
#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中，然后運行看看效果吧！ |