Option Explicit
Private Sub Form_Load()
Dim nodX As Node
'addera några testrader
Set nodX = TV1.Nodes.Add(, , "R", "Root")
Set nodX = TV1.Nodes.Add("R", tvwChild, "C1", "Child 1")
Set nodX = TV1.Nodes.Add("R", tvwChild, "C2", "Child 2")
Set nodX = TV1.Nodes.Add("R", tvwChild, "C3", "Child 3")
Set nodX = TV1.Nodes.Add("R", tvwChild, "C4", "Child 4")
nodX.EnsureVisible
Set nodX = TV1.Nodes.Add("C3", tvwChild, "C31", "Child 3 SubC 1")
Set nodX = TV1.Nodes.Add("C3", tvwChild, "C32", "Child 3 SubC 2")
nodX.EnsureVisible
Set nodX = TV1.Nodes.Add("C31", tvwChild, "C321", "Child 3 SubC 1 SubC 1")
Set nodX = TV1.Nodes.Add("C4", tvwChild, "C41", "Child 4 Subchild 1")
nodX.EnsureVisible
End Sub
Private Sub cmdEnd_Click()
Unload Me
End Sub
Private Function GetTVBackColour() As Long
Dim clrref As Long
Dim hwndTV As Long
hwndTV = TV1.hwnd
'försök hämta treeview bakgrundsfärg
clrref = SendMessageLong(hwndTV, TVM_GETBKCOLOR, 0, 0)
'if clrref = -1, then the color is a system color.
'In theory, system colors need to be Or'd with &HFFFFFF
'to retrieve the actual RGB value, but not Or'ing
'seems to work for me. The default system colour for
'a treeview background is COLOR_WINDOW.
If clrref = -1 Then
clrref = GetSysColor(COLOR_WINDOW) ' Or &HFFFFFF
End If
'Skicka tillbaks resultatet
GetTVBackColour = clrref
End Function
Private Function GetTVForeColour() As Long
Dim clrref As Long
Dim hwndTV As Long
hwndTV = TV1.hwnd
'try for the treeview text colour
clrref = SendMessageLong(hwndTV, TVM_GETTEXTCOLOR, 0, 0)
'if clrref = -1, then the color is a system color.
'In theory, system colors need to be Or'd with &HFFFFFF
'to retrieve the actual RGB value, but not Or'ing
'seems to work for me. The default system colour for
'treeview text is COLOR_WINDOWTEXT.
If clrref = -1 Then
clrref = GetSysColor(COLOR_WINDOWTEXT) ' Or &HFFFFFF
End If
'one way or another, pass it back
GetTVForeColour = clrref
End Function
Private Sub SetTVBackColour(clrref As Long)
Dim hwndTV As Long
Dim style As Long
hwndTV = TV1.hwnd
'Change the background
Call SendMessageLong(hwndTV, TVM_SETBKCOLOR, 0, clrref)
'reset the treeview style so the
'tree lines appear properly
style = GetWindowLong(TV1.hwnd, GWL_STYLE)
'if the treeview has lines, temporarily
'remove them so the back repaints to the
'selected colour, then restore
If style And TVS_HASLINES Then
Call SetWindowLong(hwndTV, GWL_STYLE, style Xor TVS_HASLINES)
Call SetWindowLong(hwndTV, GWL_STYLE, style)
End If
End Sub
Private Sub SetTVForeColour(clrref)
Dim hwndTV As Long
Dim style As Long
hwndTV = TV1.hwnd
'Change the background
Call SendMessageLong(hwndTV, TVM_SETTEXTCOLOR, 0, clrref)
'reset the treeview style so the
'tree lines appear properly
style = GetWindowLong(TV1.hwnd, GWL_STYLE)
'if the treeview has lines, temporarily
'remove them so the back repaints to the
'selected colour, then restore
If style And TVS_HASLINES Then
Call SetWindowLong(hwndTV, GWL_STYLE, style Xor TVS_HASLINES)
Call SetWindowLong(hwndTV, GWL_STYLE, style)
End If
End Sub
Private Sub cmdSetBackground_Click()
Dim newclr As Long
With cDlg
.Flags = cdlCCRGBInit 'using rgb colours
.Color = GetTVBackColour() 'pre-select the current colour
.ShowColor 'get the user's choice
newclr = .Color 'and assign to a var
End With
SetTVBackColour newclr 'set the backcolour
End Sub
Private Sub cmdBold_Click()
Dim TVI As TVITEM
Dim r As Long
Dim hitemTV As Long
Dim hwndTV As Long
'get the handle to the treeview item.
'If the item is selected, use TVGN_CARET.
'To highlight the first item in the root, use TVGN_ROOT
'To hilight the first visible, use TVGN_FIRSTVISIBLE
'To hilight the selected item, use TVGN_CARET
hwndTV = TV1.hwnd
hitemTV = SendMessageLong(hwndTV, TVM_GETNEXTITEM, TVGN_CARET, 0&)
'if a valid handle get and set the
'item's state attributes
If hitemTV > 0 Then
With TVI
.hItem = hitemTV
.mask = TVIF_STATE
.stateMask = TVIS_BOLD
r = SendMessageAny(hwndTV, TVM_GETITEM, 0&, TVI)
'flip the bold mask state
.state = TVIS_BOLD
End With
r = SendMessageAny(hwndTV, TVM_SETITEM, 0&, TVI)
End If
End Sub
Private Sub cmdFullRow_Click()
Dim hwndTV As Long
Dim style As Long
'get the window style
style = GetWindowLong(TV1.hwnd, GWL_STYLE)
'toggle the fullrow select
If style And TVS_FULLROWSELECT Then
style = style Xor TVS_FULLROWSELECT
Else: style = style Or TVS_FULLROWSELECT
End If
'and set it
Call SetWindowLong(TV1.hwnd, GWL_STYLE, style)
End Sub
Private Sub cmdSetText_Click()
Dim newclr As Long
With cDlg
.Flags = cdlCCRGBInit 'använd rgb colours
.Color = GetTVForeColour() 'förselektera aktuell colour
.ShowColor 'Användaren får bestämma färg
newclr = .Color 'addera till parameter
End With
SetTVForeColour newclr 'sätt text färgen
End Sub