VB5 Hierarchy Tree Selector Control (40K)
VB5 Hierarchy Tree Selector Demonstration (16K)
VB5 Hierarchy Tree Selector Full Source (75K)
VB6 Hierarchy Tree Selector Control (39K)
VB6 Hierarchy Tree Selector Demonstration (15K)
VB6 Hierarchy Tree Selector Full Source (74K)
Bugs: 0 / 1
Issues: 0 / 0
Questions: 0 / 0
25 Aug 1999
Version 2 of the control adds the following:
Tile a picture into the TreeView background. This code is based on Ben Baird's TreeView background image sample. Visit his great website, VB Thunder.
Get/set item states using the new Value property.
New Clear method to reset the content.
Subclassing Without The Crashes
vbAccelerator - Contents of code file: frmTest.frm
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{C961F4E8-6F58-11D1-83BC-0080C7771982}#5.3#0"; "cTreeOpt.ocx"
Begin VB.Form frmTest
Caption = "Hierarchy Tree Selector Control"
ClientHeight = 6630
ClientLeft = 4800
ClientTop = 1755
ClientWidth = 6795
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmTest.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6630
ScaleWidth = 6795
Begin VB.CheckBox chkBackground
Appearance = 0 'Flat
Caption = "&Background"
ForeColor = &H80000008&
Height = 195
Left = 3480
TabIndex = 10
Top = 4020
Width = 1275
End
Begin VB.CheckBox chk3DIcons
Appearance = 0 'Flat
Caption = "Flat &Icons"
ForeColor = &H80000008&
Height = 195
Left = 2220
TabIndex = 9
Top = 4020
Value = 1 'Checked
Width = 1275
End
Begin VB.CommandButton cmdSetSelected
Caption = "&Set Selected"
Height = 375
Left = 5400
TabIndex = 8
Top = 1320
Width = 1215
End
Begin VB.CommandButton cmdCheckSelected
Caption = "&Get Selected"
Height = 375
Left = 5400
TabIndex = 7
Top = 900
Width = 1215
End
Begin VB.CommandButton cmdEval
Caption = "&Evaluate"
Height = 375
Left = 5400
TabIndex = 6
Top = 300
Width = 1215
End
Begin VB.CheckBox chkLocked
Appearance = 0 'Flat
Caption = "&Locked"
ForeColor = &H80000008&
Height = 195
Left = 1200
TabIndex = 5
Top = 4020
Width = 1275
End
Begin VB.CheckBox chkEnabled
Appearance = 0 'Flat
Caption = "E&nabled"
ForeColor = &H80000008&
Height = 195
Left = 60
TabIndex = 4
Top = 4020
Value = 1 'Checked
Width = 1095
End
Begin cTreeOpt.XTreeOpt XTreeOpt2
Height = 2055
Left = 60
TabIndex = 1
Top = 4500
Width = 5235
_ExtentX = 9234
_ExtentY = 3625
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Indentation = 256.251983642578
End
Begin cTreeOpt.XTreeOpt XTreeOpt1
Height = 3675
Left = 60
TabIndex = 0
Top = 300
Width = 5235
_ExtentX = 9234
_ExtentY = 6482
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Indentation = 256.251983642578
Style = 5
TrackSelect = 0 'False
FullRowSelect = -1 'True
End
Begin VB.Image imgBack
Height = 1920
Left = 5460
Picture = "frmTest.frx":014A
Top = 2040
Visible = 0 'False
Width = 1920
End
Begin VB.Label lblHierarchy
Caption = "Hierarchy Tree:"
Height = 255
Left = 60
TabIndex = 3
Top = 4260
Width = 5235
End
Begin VB.Label lblOption
Caption = "Option Tree:"
Height = 195
Left = 60
TabIndex = 2
Top = 60
Width = 5175
End
Begin ComctlLib.ImageList ilsIcons
Left = 4620
Top = 6000
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 4
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTest.frx":09A6
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTest.frx":0CC0
Key = "TTF"
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTest.frx":0FDA
Key = "TTN"
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTest.frx":12F4
Key = "TTP"
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'
' ====================================================================
' Filename: frmTest.ctl
' Author: SP McMahon
' Date: 15 June 1999
'
' Tester for the vbAccelerator Hierarchy Tree Option Control:
' A Control which modifies a VB5 TreeView control to turn it into
' a Explorer Folder Options/IE Advanced Options style picker.
'
'
' --------------------------------------------------------------------
' vbAccelerator - Advanced, Free Source Code:
' http://vbaccelerator.com/
' ====================================================================
'
Private Sub chk3DIcons_Click()
If chk3DIcons.Value = Checked Then
XTreeOpt1.IconSet = OptionTreeIconsWin98
Else
XTreeOpt1.IconSet = OptionTreeIcons3d
End If
End Sub
Private Sub chkBackground_Click()
If (chkBackground.Value = Checked) Then
XTreeOpt1.BackgroundPicture = imgBack.Picture
Else
XTreeOpt1.BackgroundPicture = Nothing
End If
End Sub
Private Sub chkEnabled_Click()
XTreeOpt1.Enabled = -1 * chkEnabled.Value
If (chkEnabled.Value = Checked) Then
XTreeOpt1.BackColor = vbWindowBackground
Else
XTreeOpt1.BackColor = vbButtonFace
End If
End Sub
Private Sub chkLocked_Click()
XTreeOpt1.Locked = (chkLocked.Value = Checked)
End Sub
Private Sub RecurseShowNodes( _
ByRef nodX As Node, _
ByRef sMsg As String, _
ByVal iLevel As Long _
)
Dim i As Long
Dim nodY As Node
Dim nodZ As Node
Dim iCHildren As Long
Dim bEnd As Boolean
iCHildren = nodX.Children
If (iCHildren > 0) Then
If XTreeOpt1.FolderType(nodX.Index) = OptionTreeCheck Then
sMsg = sMsg & Space$(iLevel) & "Folder Node: '" & nodX.Text & "',
Selected: " & (XTreeOpt1.Value(nodX.Index) = OptionTreeCheckFull) &
vbCrLf
Else
sMsg = sMsg & Space$(iLevel) & "Folder Node: '" & nodX.Text & "'" &
vbCrLf
End If
Set nodY = nodX.Child
iLevel = iLevel + 4
Do
bEnd = False
Set nodZ = nodY
RecurseShowNodes nodZ, sMsg, iLevel
If Not (nodY.Next Is Nothing) Then
Set nodY = nodY.Next
Else
bEnd = True
End If
Loop While Not (bEnd)
Else
If (InStr(nodX.Image, "OPTION") <> 0) Then
sMsg = sMsg & Space$(iLevel) & "Bottom Option Node: '" & nodX.Text &
"', Selected: " & (XTreeOpt1.Value(nodX.Index) = OptionTreeCheckFull)
& vbCrLf
Else
sMsg = sMsg & Space$(iLevel) & "Bottom Check Node: '" & nodX.Text &
"', Selected: " & (XTreeOpt1.Value(nodX.Index) = OptionTreeCheckFull)
& vbCrLf
End If
End If
End Sub
Private Sub cmdCheckSelected_Click()
Dim nod As Node
With XTreeOpt1
Select Case .Value(.SelectedNode.Index)
Case OptionTreeCheckFull
MsgBox "Selected", vbInformation
Case OptionTreeCheckNone
MsgBox "Not Selected", vbInformation
Case OptionTreeCheckPartial
MsgBox "Folder: some selected items", vbInformation
End Select
End With
End Sub
Private Sub cmdEval_Click()
Dim sMsg As String
Dim iLevel As Long
RecurseShowNodes XTreeOpt1.Nodes(1), sMsg, iLevel
MsgBox sMsg, vbInformation
End Sub
Private Sub cmdSetSelected_Click()
With XTreeOpt1
If .Value(.SelectedNode.Index) = OptionTreeCheckFull Then
.Value(.SelectedNode.Index) = OptionTreeCheckNone
Else
.Value(.SelectedNode.Index) = OptionTreeCheckFull
End If
End With
End Sub
Private Sub Form_Load()
Dim nodX As Object, nodTOp As Object, nodY As ComctlLib.Node
With XTreeOpt1
.AddFolderType ilsIcons.ListImages(1).Picture, , "STEVE"
Set nodTOp = .AddFolder(, , "Options", , , True)
.AddCheck "TRYOUT", nodTOp, "Custom Icons", OptionTreeCheckNone
.AddCheck , nodTOp, "Fast Start Mode"
.AddCheck , nodTOp, "Start at your home page"
Set nodX = .AddFolder(, nodTOp, "Image Size", optiontreeFolderCustom,
"STEVE", True)
.AddOption , nodX, "Small (16x16)"
.AddOption , nodX, "Medium (32x32)"
.AddOption , nodX, "Large (48x48)"
Set nodX = .AddFolder(, nodTOp, "Security", OptionTreeCheck, , True)
.AddCheck , nodX, "Encrypt Files with Password"
.AddCheck , nodX, "Ask for Password at Startup"
Set nodY = .AddCheck(, nodX, "SSI Options")
.AddCheck , nodY, "SSI1.0"
.AddCheck , nodY, "SSI2.0"
.AddCheck , nodY, "SSI3.0"
.AddCheck , nodX, "Warn when Changing zones"
Set nodX = .AddFolder(, nodTOp, "Toolbars", OptionTreeCheck, , True)
.AddCheck , nodX, "Main Toolbar"
.AddCheck , nodX, "Fonts"
.AddCheck , nodX, "Address"
Set nodX = .AddFolder(, nodTOp, "Save Settings on Exit",
optiontreeFolderCustom, "STEVE", True)
.AddOption , nodX, "Yes"
.AddOption , nodX, "No"
.ExpandAll
.Nodes(1).EnsureVisible
End With
With XTreeOpt2
.AddCheck "SEC", , "All Sectors", , True
.AddCheck "AAP", .Nodes("SEC"), "Autos and Auto Parts"
.AddCheck "AUT", .Nodes("AAP"), "Auto Manufacturers"
.AddCheck "AUP", .Nodes("AAP"), "Auto Parts"
.AddCheck "TYR", .Nodes("AAP"), "Tires"
.AddCheck "BNK", .Nodes("SEC"), "Banking"
.AddCheck "CMB", .Nodes("BNK"), "Commercial Banks"
.AddCheck "MMB", .Nodes("BNK"), "Merchant Banks"
.AddCheck "DVB", .Nodes("BNK"), "Derivatives"
.ExpandAll
End With
End Sub
Private Sub XTreeOpt1_CheckClick(ItemNode As ComctlLib.Node, Value As
cTreeOpt.OptionTreeCheckTypes)
Debug.Print ItemNode.Text, Value
If (ItemNode.Key = "TRYOUT") Then
If (Value = OptionTreeCheckFull) Then
With XTreeOpt1
ilsIcons.ListImages.Add , "T1",
.CheckPicture(OptionTreeCheckFull)
ilsIcons.ListImages.Add , "T2",
.CheckPicture(OptionTreeCheckNone)
ilsIcons.ListImages.Add , "T3",
.CheckPicture(OptionTreeCheckPartial)
Set .CheckPicture(OptionTreeCheckFull) =
ilsIcons.ListImages(2).Picture
Set .CheckPicture(OptionTreeCheckNone) =
ilsIcons.ListImages(3).Picture
Set .CheckPicture(OptionTreeCheckPartial) =
ilsIcons.ListImages(4).Picture
End With
Else
With XTreeOpt1
Set .CheckPicture(OptionTreeCheckFull) =
ilsIcons.ListImages("T1").Picture
Set .CheckPicture(OptionTreeCheckNone) =
ilsIcons.ListImages("T2").Picture
Set .CheckPicture(OptionTreeCheckPartial) =
ilsIcons.ListImages("T3").Picture
ilsIcons.ListImages.Remove "T1"
ilsIcons.ListImages.Remove "T2"
ilsIcons.ListImages.Remove "T3"
End With
End If
End If
End Sub
Private Sub XTreeOpt1_OptionClick(ItemNode As ComctlLib.Node)
MsgBox "Chose Option: " & ItemNode.Text
End Sub