Recent Posts

Wednesday, March 26, 2008

Tree view structure from VS Flexgrid in VB 6.0

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



Related Posts by Categories




No comments:

Post a Comment