frmsubcell.frm

一款Grid表格控件源代码,非常棒.不下你一定会后悔

        .RowHeight = 50
        '/* enable cell tooltips
        .CellTips = True
        '/* custom cursors
        .CustomCursors = True
        '/* double buffer grid
        .DoubleBuffer = True
        '/* enable user sizable header height
        .HeaderHeightSizable = True
        '/* lock the first column
        '.LockFirstColumn = True
        '/* set alphbar transparency
        .AlphaBarTransparency = 120
        '/* enable sorting
        .CellsSorted = True
        '/* set the column focus color
        .ColumnFocusColor = &H9C541F
        
        '/* set grid back color
        .BackColor = &H887466
        '/* set header height
        .HeaderHeight = 60
        '/* lock the third column
        .ColumnLock(3) = True
        '/* enable checkboxes
        .Checkboxes = True
        '/* use gridlines
        .GridLines = EGLBoth
        '/* set the drag effect style
        .DragEffectStyle = edsClientArrow
        '/* enable header vertical text
        .ColumnVerticalText = True
        '/* apply skin
        .ThemeManager etmGloss, True, &HC4B0A2, estThemeSoft, &HDCDCDC, &HFFEBEB, &HC4B0A2, _
            &H8A8181, &HC4B0A2, &H808080, 210, True, True, &HC4B0A2, _
            True, False, False, False
        '/* apply cell decoration
        .CellDecoration erdCellChecker, &HF1DDCF, &HC4B0A2, True, 2
    End With

    '/* load data
    CreateMusicData

End Sub

Private Sub cmdPopulate_Click()

Dim lCt         As Long
Dim lRnd        As Long
Dim sTitle      As String
Dim sHeader     As String
Dim sDetails    As String
Dim oFnt        As StdFont
Dim lCust()     As Long

    m_lRowCount = 20

    sTitle = "Media Search Results:" & vbNewLine & "Time Elapsed: 1:22 Seconds.." & vbNewLine & "Found: 20 matching entries." & vbNewLine & "Media Types: Mixed"
    sHeader = "-Current Settings-" & vbNewLine & "File Edit Options: Enabled" & vbNewLine & "Media Play Types: Full" & vbNewLine & "User: Administrator" & vbNewLine & "Change Tracking: Loaded"
    sDetails = vbNewLine & "Master: Yes" & vbNewLine & "Public: Yes" & vbNewLine & "Last Access: " & CStr(Date)
    
    '/* cell font
    Set oFnt = New StdFont
    With oFnt
        .Name = "Tahoma"
        .Bold = True
        .Size = 8
    End With
    
    ReDim lCust(2)
    lCust(0) = RGB(217, 55, 0)
    lCust(1) = &H969682
    lCust(2) = &H414B25

    With ucVHGrid1
        '/* manually initialize list: rowcount, columncount
        .GridInit m_lRowCount, 5
        '/* add special cells
        '/* row 0 -spanned 2 rows
        .AddCell 0, 0, sTitle, DT_VCENTER Or DT_CENTER Or DT_WORDBREAK, , , , oFnt, 6, 2
        .RowHideCheckBox 0, True
        .RowNoFocus 0, True
        '/* cell is spanned from 1st to last column
        .CellSpanHorizontal 0, 0, 4
        
        '/* row 1 -spanned 3 rows
        .AddCell 1, 0, sHeader, DT_VCENTER Or DT_LEFT Or DT_WORDBREAK, , lCust(0), , oFnt, 6, 3
        .RowHideCheckBox 1, True
        .RowNoFocus 1, True
        '/* cell spanned from 1st to last column
        .CellSpanHorizontal 1, 0, 4
        
        '/* row 2 -spanned 3 rows
        .AddCell 2, 0, , , , lCust(0), , , , 2
        .AddCell 2, 1, m_sMedia(0), DT_LEFT Or DT_VCENTER Or DT_END_ELLIPSIS, 5, , , , 6
        .AddCell 2, 2, m_sTitles(0), DT_WORDBREAK Or DT_VCENTER
        .AddCell 2, 3, m_sLyrics(0), DT_WORDBREAK Or DT_VCENTER
        .AddCell 2, 4, m_sDesc(0) & sDetails, DT_WORDBREAK Or DT_VCENTER
        
        '/* row 3 -spanned 3 rows
        .AddCell 3, 0, , , , lCust(0), , , , 2
        .AddCell 3, 1, m_sMedia(1), DT_LEFT Or DT_VCENTER Or DT_END_ELLIPSIS, 0, , , , 6
        .AddCell 3, 2, m_sTitles(1), DT_WORDBREAK Or DT_VCENTER, , , , , 5
        .AddCell 3, 3, m_sLyrics(1), DT_WORDBREAK Or DT_VCENTER
        .AddCell 3, 4, m_sDesc(1) & sDetails, DT_WORDBREAK Or DT_VCENTER
        
        '/* row 4 -spanned 3 rows
        .AddCell 4, 0, , , , lCust(0), , , , 2
        .AddCell 4, 1, m_sMedia(2), DT_LEFT Or DT_VCENTER Or DT_END_ELLIPSIS, 2, , , , 6
        .AddCell 4, 2, m_sTitles(2), DT_LEFT Or DT_END_ELLIPSIS Or DT_VCENTER, , , , , 5
        .AddCell 4, 3, m_sLyrics(2), DT_WORDBREAK Or DT_VCENTER
        .AddCell 4, 4, m_sDesc(2) & sDetails, DT_WORDBREAK Or DT_VCENTER

        '/* row 5 -spanned 3 rows
        .AddCell 5, 0, , , , lCust(0), , , , 2
        .AddCell 5, 1, m_sMedia(3), DT_LEFT Or DT_VCENTER Or DT_END_ELLIPSIS, 1, , , , 6
        .AddCell 5, 2, m_sTitles(3), DT_WORDBREAK Or DT_VCENTER, , , , , 5
        .AddCell 5, 3, m_sLyrics(3), DT_WORDBREAK Or DT_VCENTER
        .AddCell 5, 4, m_sDesc(3) & sDetails, DT_WORDBREAK Or DT_VCENTER

        '/* row 6 -spanned 3 rows
        .AddCell 6, 0, , , , , , , , 2
        .AddCell 6, 1, m_sMedia(4), DT_LEFT Or DT_VCENTER Or DT_END_ELLIPSIS, 2, , , , 6
        .AddCell 6, 2, m_sTitles(4), DT_WORDBREAK Or DT_VCENTER, , , , , 5
        .AddCell 6, 3, m_sLyrics(4), DT_WORDBREAK Or DT_VCENTER
        .AddCell 6, 4, m_sDesc(4) & sDetails, DT_LEFT Or DT_WORDBREAK Or DT_VCENTER
        
        '/* add the rest of the rows
        For lCt = 7 To m_lRowCount
            lRnd = RandomNum(0, 9)
            .AddCell lCt, 0, , , , lCust(0)
            .AddCell lCt, 1, m_sMedia(lRnd), DT_LEFT Or DT_END_ELLIPSIS, lRnd, , , , 6
            .AddCell lCt, 2, m_sTitles(lRnd), DT_WORDBREAK Or DT_VCENTER, , , , , 5
            .AddCell lCt, 3, m_sLyrics(lRnd), DT_WORDBREAK Or DT_VCENTER, , , , , 5
            .AddCell lCt, 4, m_sDesc(lRnd), DT_WORDBREAK Or DT_VCENTER
        Next lCt
        '/* refresh the grid
        .GridRefresh True
    End With

    '/* add subcells
    AddSubCells
    
End Sub

Private Sub AddSubCells()

    With ucVHGrid1
        Set m_clblDesc = New clsODControl
        With m_clblDesc
            .Name = "lblDesc"
            .BorderStyle ecbsNone
            .LabelTransparent = True
            .Create ucVHGrid1.hWnd, 9, 129, 44, 13, ecsLabel
            .Text = "Local Edit Options"
            .AutoSize = True
            .AutoBackColor = True
            .Visible = False
        End With
        .SubCellAddControl 1, 3, 100, 20, m_clblDesc.hWnd, evsUserDefine, , 2, 20, True, False
        
        Set m_coptEdit0 = New clsODControl
        With m_coptEdit0
            .Name = "edit0"
            .HiliteColor = &HCCCCCC
            .ThemeStyle = m_lSkinStyle
            .ThemeColor = &HC4B0A2
            .BorderStyle ecbsNone
            .AutoBackColor = True
            .Create ucVHGrid1.hWnd, 0, 0, 100, 20, ecsOptionButton
            .Visible = False
            .Text = "Standard Edit"
        End With
        .SubCellAddControl 1, 3, 100, 20, m_coptEdit0.hWnd, evsUserDefine, , 2, 38, True, False
        
        Set m_coptEdit1 = New clsODControl
        With m_coptEdit1
            .Name = "edit0"
            .HiliteColor = &HCCCCCC
            .ThemeStyle = m_lSkinStyle
            .ThemeColor = &HC4B0A2
            .BorderStyle ecbsNone
            .AutoBackColor = True
            .Create ucVHGrid1.hWnd, 0, 0, 100, 20, ecsOptionButton
            .Visible = False
            .Text = "Advanced Editor"
        End With
        .SubCellAddControl 1, 3, 100, 20, m_coptEdit1.hWnd, evsUserDefine, , 2, 58, True, False
        
        Set m_coptEdit2 = New clsODControl
        With m_coptEdit2
            .Name = "edit0"
            .HiliteColor = &HCCCCCC
            .ThemeStyle = m_lSkinStyle
            .ThemeColor = &HC4B0A2
            .BorderStyle ecbsNone
            .AutoBackColor = True
            .Create ucVHGrid1.hWnd, 0, 0, 100, 20, ecsOptionButton
            .Visible = False
            .Text = "Editor Locked"
        End With
        .SubCellAddControl 1, 3, 100, 20, m_coptEdit2.hWnd, evsUserDefine, , 2, 78, True, False
        
        Set m_clblBck = New clsODControl
        With m_clblBck
            .Name = "lblBck"
            .BorderStyle ecbsNone
            .LabelTransparent = True
            .Create ucVHGrid1.hWnd, 9, 129, 44, 13, ecsLabel
            .Text = "File Backup Options"
            .AutoSize = True
            .AutoBackColor = True
            .Visible = False
        End With
        .SubCellAddControl 1, 4, 100, 20, m_clblBck.hWnd, evsUserDefine, , 2, 10, True, False
        
        Set m_cmbSave = New clsODControl
        With m_cmbSave
            .Name = "cbSave"
            .HiliteColor = &HCCCCCC
            .ThemeStyle = m_lSkinStyle
            .ThemeColor = &HC4B0A2
            .BorderStyle ecbsThin
            .AutoBackColor = True
            .Create ucVHGrid1.hWnd, 2, 10, 140, 80, ecsComboDropDown
            .Visible = False
            .AddItem "No Backup"
            .AddItem "Local Backup"
            .AddItem "Remote Backup"
            .AddItem "Converging Backup"
        End With
        .SubCellAddControl 1, 4, 140, 20, m_cmbSave.hWnd, evsUserDefine, , 2, 29, True, False
        
        Set m_chkOptn0 = New clsODControl
        With m_chkOptn0
            .Name = "chkbox0"
            .HiliteColor = &HCCCCCC
            .ThemeStyle = m_lSkinStyle
            .ThemeColor = &HC4B0A2
            .BorderStyle ecbsNone
            .AutoBackColor = True
            .Create ucVHGrid1.hWnd, 0, 0, 100, 20, ecsCheckBox
            .Visible = False
            .Text = "Use Flash Editing"
        End With
        .SubCellAddControl 1, 4, 100, 20, m_chkOptn0.hWnd, evsUserDefine, , 2, 60, True, False
        
        Set m_chkOptn1 = New clsODControl
        With m_chkOptn1
            .Name = "chkbox1"
            .HiliteColor = &HCCCCCC
            .ThemeStyle = m_lSkinStyle
            .ThemeColor = &HC4B0A2
            .BorderStyle ecbsNone
            .AutoBackColor = True
            .Create ucVHGrid1.hWnd, 0, 0, 160, 20, ecsCheckBox
            .Visible = False
            .Text = "Enable Watch-File Manager"
        End With
        .SubCellAddControl 1, 4, 160, 20, m_chkOptn1.hWnd, evsUserDefine, , 2, 80, True, False
    End With
    
End Sub

Private Sub RemoveSubcells()

    If Not m_clblDesc Is Nothing Then Set m_clblDesc = Nothing
    If Not m_coptEdit0 Is Nothing Then Set m_coptEdit0 = Nothing
    If Not m_coptEdit1 Is Nothing Then Set m_coptEdit1 = Nothing
    If Not m_coptEdit2 Is Nothing Then Set m_coptEdit2 = Nothing
    If Not m_cmbSave Is Nothing Then Set m_cmbSave = Nothing
    If Not m_clblBck Is Nothing Then Set m_clblBck = Nothing
    If Not m_chkOptn0 Is Nothing Then Set m_chkOptn0 = Nothing
    If Not m_chkOptn1 Is Nothing Then Set m_chkOptn1 = Nothing
    
End Sub

Private Function RandomNum(ByVal lBase As Long, _
                           ByVal lSpan As Long) As Long
    
    RandomNum = Int(Rnd() * lSpan) + lBase

End Function

Private Sub Form_Unload(Cancel As Integer)
    RemoveSubcells
End Sub