This article provides full source code on how to get Tree View structure from VS Flex grid in visual basic 6.0. This is a perfect tutorial and visual basic source code for the beginners who want to show the tree view by using VS Flex Grid.
Get the full source code from below and paste in your application and it works for you.
Private Sub Load_Access()
Dim clsMD As clsMDUserAccess
Dim clsD As clsDUserAccess
clsMD = New clsMDUserAccess
clsD = New clsDUserAccess
Dim strUserID As String
Dim intFirst As Integer
Dim strFirst As String
Dim intSecond As Integer
Dim strSecond As String
Dim intThird As Integer
Dim strThird As String
Dim intFourth As Integer
Dim strFourth As String
Dim intlen As Integer
Dim strLen As String
Dim i As Integer
Dim intCurF As Integer
Dim intCurS As Integer
Dim intCurT As Integer
Dim intCurFo As Integer
intCurF = 0
intCurS = 0
intCurT = 0
intCurFo = 0
On Error GoTo ErrLoadBeds
Me.grdAssign.Rows = 1
Me.grdAssign.Row = 0
'initialize tree control
With grdAssign
' structure
.Cols = 14
.Rows = 0
.FixedCols = 0
.FixedRows = 0
'.Left = 50
' appearance
.GridLines = flexGridNone
.BackColorBkg = .BackColor
.SheetBorder = .BackColor
.ExtendLastCol = True
.Redraw = flexRDBuffered ' << new setting .OutlineCol = 0 .OutlineBar = flexOutlineBarCompleteLeaf .Ellipsis = flexEllipsisEnd ' behavior
.AllowSelection = False
.Highlight = flexHighlightWithFocus
.ScrollTrack = True
.AutoSearch = flexSearchFromCursor
'.CellChecked = flexUnchecked
'fetch data from view
strUserID = Trim(grdSearch.Cell(flexcpText, grdSearch.Row, 0))
.Redraw = flexRDNone
.ToolTipText = "Click To Select the Desired Access Level for the user"
.AddItem ("Election Module- User Access")
.Cell(flexcpForeColor, .Rows - 1) = &HC00000 'vbBlue
.Cell(flexcpFontSize, .Rows - 1) = 10
.IsSubtotal(.Rows - 1) = True
.RowHeight(0) = 500
'initial assignment on variables for checking
strFirst = "Module A"
obj = objM.Item(grdSearch.Row)
clsMD = obj.DUserAccess
For i = 1 To clsMD.Count
clsD = clsMD.Item(i)
strLen = CStr(clsD.MenuID)
intlen = Len(strLen)
If intlen = 1 Then
intFirst = CInt(Mid(strLen, 1, 1))
intSecond = 0
intThird = 0
intFourth = 0
ElseIf intlen = 2 Then
intFirst = CInt(Mid(strLen, 1, 1))
intSecond = CInt(Mid(strLen, 2, 1))
intThird = 0
intFourth = 0
ElseIf intlen = 3 Then
intFirst = CInt(Mid(strLen, 1, 1))
intSecond = CInt(Mid(strLen, 2, 1))
intThird = CInt(Mid(strLen, 3, 1))
intFourth = 0
ElseIf intlen = 4 Then
intFirst = CInt(Mid(strLen, 1, 1))
intSecond = CInt(Mid(strLen, 2, 1))
intThird = CInt(Mid(strLen, 3, 1))
intFourth = CInt(Mid(strLen, 4, 1))
End If
If intCurF <> intFirst Then
intCurS = 0
intCurT = 0
intCurFo = 0
.AddItem (Trim(strFirst) & vbTab & "")
.Cell(flexcpForeColor, .Rows - 1) = &HC00000 'vbBlue
.IsSubtotal(.Rows - 1) = True
.RowOutlineLevel(.Rows - 1) = 1
If IsNull(clsD.UserID) Or Trim(clsD.UserID) = "" Then
.Cell(flexcpChecked, .Rows - 1, 1) = False
Else
.Cell(flexcpChecked, .Rows - 1, 1) = True
End If
intCurF = intFirst
End If
If intCurS <> intSecond Then
intCurT = 0
intCurFo = 0
.AddItem (Trim(clsD.MenuCaption) & vbTab & "") & vbTab & clsD.MenuID & vbTab & Trim(clsD.MenuName)
.Cell(flexcpForeColor, .Rows - 1) = &HC00000 'vbBlue
.IsSubtotal(.Rows - 1) = True
.RowOutlineLevel(.Rows - 1) = 2
If IsNull(clsD.UserID) Or Trim(clsD.UserID) = "" Then
.Cell(flexcpChecked, .Rows - 1, 1) = False
Else
.Cell(flexcpChecked, .Rows - 1, 1) = True
End If
intCurS = intSecond
End If
If intCurT <> intThird Then
intCurFo = 0
.AddItem (CStr(clsD.MenuCaption) & vbTab & "") & vbTab & clsD.MenuID & vbTab & Trim(clsD.MenuName)
.Cell(flexcpForeColor, .Rows - 1) = &H5172D2
.IsSubtotal(.Rows - 1) = True
.RowOutlineLevel(.Rows - 1) = 3
If IsNull(clsD.UserID) Or Trim(clsD.UserID) = "" Then
.Cell(flexcpChecked, .Rows - 1, 1) = False
Else
.Cell(flexcpChecked, .Rows - 1, 1) = True
End If
intCurT = intThird
End If
If intCurFo <> intFourth Then
.AddItem CStr(clsD.MenuCaption) & vbTab & "" & _
vbTab & clsD.MenuID & vbTab & Trim(clsD.MenuName)
.Cell(flexcpForeColor, .Rows - 1) = &HC000&
.IsSubtotal(.Rows - 1) = True
.RowOutlineLevel(.Rows - 1) = 4
If IsNull(clsD.UserID) Or Trim(clsD.UserID) = "" Then
.Cell(flexcpChecked, .Rows - 1, 1) = False
Else
.Cell(flexcpChecked, .Rows - 1, 1) = True
End If
intCurFo = intFourth
End If
Next
.OutlineCol = 0
.OutlineBar = flexOutlineBarCompleteLeaf
.Row = 0
.Redraw = flexRDBuffered
.MergeCol(0) = True
.ColWidth(0) = 3750
.ColWidth(1) = 20
.ColWidth(2) = 0
.ColWidth(3) = 0
.ColWidth(4) = 0
.ColWidth(5) = 0
.ColWidth(6) = 0
.ColWidth(7) = 0
.ColWidth(8) = 0
.ColWidth(9) = 0
.ColWidth(10) = 0
.ColWidth(11) = 0
.ColWidth(12) = 0
.ColWidth(13) = 0
End With
Exit Sub
ErrLoadBeds:
MsgBox ("Err while loading ")
End Sub
Posts
No comments:
Post a Comment