Oops, I forgot to include pColor as a parameter (this happens when I type directly into the post):
Code:Option Explicit 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 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 'treeview styles Private Const TVS_HASLINES As Long = 2 Private Const TV_FIRST As Long = &H1100 Private Const TVM_SETBKCOLOR As Long = (TV_FIRST + 29) Private Const TVM_SETTEXTCOLOR As Long = (TV_FIRST + 30) Public Enum enumTreePartColor BACK_COLOR = 1 FORE_COLOR = 2 End Enum Public Sub SetTreeColor(pTreeView As TreeView, pTreePart As enumTreePartColor, pColor As OLE_COLOR) Dim lngStyle As Long Dim intTreePart As Integer If pTreePart = BACK_COLOR Then intTreePart = TVM_SETBKCOLOR Else intTreePart = TVM_SETTEXTCOLOR End If With pTreeView Call SendMessage(.hwnd, intTreePart, 0, ByVal pColor) lngStyle = GetWindowLong(.hwnd, GWL_STYLE) If lngStyle And TVS_HASLINES Then Call SetWindowLong(.hwnd, GWL_STYLE, lngStyle Xor TVS_HASLINES) Call SetWindowLong(.hwnd, GWL_STYLE, lngStyle) End If End With End Sub Private Sub cmdBackColor_Click() Dim lngColor As Long On Error Resume Next With CommonDialog1 .CancelError = True .ShowColor If Err.Number = cdlCancel Then Exit Sub lngColor = .Color End With SetTreeColor TreeView1, BACK_COLOR, lngColor End Sub Private Sub cmdForeColor_Click() Dim lngColor As Long Dim lngStyle As Long On Error Resume Next With CommonDialog1 .CancelError = True .ShowColor If Err.Number = cdlCancel Then Exit Sub lngColor = .Color End With SetTreeColor TreeView1, FORE_COLOR, lngColor End Sub Private Sub Form_Load() Dim nodParent As Node Dim intParent As Integer Dim intChild As Integer With TreeView1.Nodes For intParent = 1 To 3 Set nodParent = .Add(, , "Parent" & intParent, "Parent" & intParent) For intChild = 1 To 5 .Add nodParent, tvwChild, , "ChildNode " & intChild Next Next End With End Sub




Reply With Quote