frmlistclass.frm

金算盘软件代码

        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2)
        .mnuListEditMenu(2).Caption = "删除(&D)"
        Load .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)
        
        Load .mnuListEditMenu(4)
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(4)
        .mnuListEditMenu(4).Caption = "停用(&H)"
        .mnuListEditMenu(4).Visible = True
        
        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Caption = "全部显示(&W)"
        .mnuListEditMenu(5).Visible = True
        
        Load .mnuListEditMenu(6)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6)
        .mnuListEditMenu(6).Visible = True
        
        Load .mnuListEditMenu(7)
        Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(7)
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(8)
        .mnuListEditMenu(8).Visible = False
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditNotepad, .mnuListEditMenu(9)
        
        Load .mnuListEditMenu(10)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(10)
        .mnuListEditMenu(10).Visible = False
        
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(11)
        Load .mnuListEditMenu(12)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(12)
        
        Load .mnuListEditMenu(13)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(13)
        
        Load .mnuListEditMenu(14)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(14)
        Load .mnuListEditMenu(15)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(15)
    End With
End Sub

'
' 报表菜单
'
Private Sub MakeListReportMenu(Optional ByVal EditObject As String = "")
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
            Unload .mnuListReportMenu(intCnt)
        Next
        
'        Utility.CloneMenu .mnuReportQuick, .mnuListReportMenu(0)
'        .mnuListReportMenu(0).Caption = .mnuListReportMenu(0).Caption & EditObject
'
'
'         Load .mnuListReportMenu(1)
'       '  .mnuListReportMenu(1).Caption = "-"
'        ' .mnuListReportMenu(1).Enabled = True
'         '.mnuListReportMenu(1).Visible = True
'          Utility.CloneMenu .mnuEditBar2, .mnuListReportMenu(1)
'
'         Load .mnuListReportMenu(2)
        .mnuListReportMenu(0).Caption = "统计核算一览表(&E)"
        .mnuListReportMenu(0).Enabled = True
        .mnuListReportMenu(0).Visible = True
        
         Load .mnuListReportMenu(1)
        .mnuListReportMenu(1).Caption = "项目核算一览表(&D)"
        .mnuListReportMenu(1).Visible = True
        .mnuListReportMenu(1).Enabled = True
        If sstTypAct.Tab = 0 Then
            .mnuListReportMenu(0).Enabled = True
            .mnuListReportMenu(1).Enabled = False
        Else
            .mnuListReportMenu(0).Enabled = False
            .mnuListReportMenu(1).Enabled = True
        End If
        
    End With
End Sub





Private Sub ToolRefresh(intTab As Integer)
    Dim i As Integer
    Dim strOldText As String
    Dim strOldSort As String
    
    
        '保存当前排序列
        strOldSort = cboFindKind.Text
        strOldText = mclsList(intTab).FlexGrid.TextMatrix(mclsList(intTab).FlexGrid.Row, mclsList(intTab).SortCol)
        mclsList(intTab).SaveListColWidth
        mclsList(intTab).FlexGrid.Redraw = False
        '刷新列表记录
        mclsList(intTab).FlexGrid.Cols = 0
        Set datItem(intTab).Resultset = GetList(intTab)
        If Not datItem(intTab).Resultset.EOF Then datItem(intTab).Resultset.MoveLast
        datItem(intTab).Resultset.Close
       ' Set datItem(intTab).Recordset = Nothing
        '设置FlexGrid列表
        mclsList(intTab).SetFlexGrid
        
        '恢复以前排序列
        cboFindKind.Text = strOldSort
        cboFindKind.Text = strOldSort
        mclsList(intTab).FlexGrid.Redraw = False
        If mclsList(intTab).FlexGrid.Rows > 1 Then
            txtfind.Text = strOldText
        End If
        If chkShowAll.Value = 0 Then mclsList(intTab).DoShowAll False
        '更新菜单状态
        UpdateMenuStatus
        mclsList(intTab).FlexGrid.Redraw = True
End Sub

Private Sub txtFind_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim intSelLen As Integer
    If KeyCode = 8 Then
        intSelLen = txtfind.SelLength
        If txtfind.SelStart > 0 Then txtfind.SelStart = txtfind.SelStart - 1
        txtfind.SelLength = intSelLen + 1
    End If
End Sub
Private Sub CeaseLower(ByVal intTab As Integer)
    Dim Flage As String
    Dim Code As String
    Dim strOldSortCol As String
    Dim strOldSortText As String
    Dim strSql As String
    Dim intSortCol As Integer
    Dim blnreStore As Boolean
    Dim intResponse As String
    Dim blnRemark As Boolean
    Dim intOldRow As Integer
    blnreStore = False
    
    With mclsList(intTab).FlexGrid
        strOldSortCol = cboFindKind.Text
        strOldSortText = .TextMatrix(.Row, mclsList(intTab).SortCol)
        intOldRow = .Row
        blnRemark = ListIsInActive(intTab)
        Select Case intTab
            Case 0
                For intSortCol = 2 To .FixedCols - 1
                    If .TextMatrix(0, intSortCol) = "统计编码" Or .TextMatrix(0, intSortCol) = "统计编码↑" Or .TextMatrix(0, intSortCol) = "统计编码↓" Then
                        Code = .TextMatrix(.Row, intSortCol)
                        Exit For
                    End If
                Next intSortCol
                If mclsList(intTab).ListSet.ColumnOrderType(intSortCol - 1) <> 1 Then
                    cboFindKind.Text = "统计编码" '排序
                    txtfind.Text = Code
                    blnreStore = True
                End If
            Case 1
                For intSortCol = 2 To .FixedCols - 1
                    If .TextMatrix(0, intSortCol) = "项目编码" Or .TextMatrix(0, intSortCol) = "项目编码↑" Or .TextMatrix(0, intSortCol) = "项目编码↓" Then
                        Code = .TextMatrix(.Row, intSortCol)
                        Exit For
                    End If
                Next intSortCol
                If mclsList(intTab).ListSet.ColumnOrderType(intSortCol - 1) <> 1 Then
                    cboFindKind.Text = "项目编码" '排序
                    txtfind.Text = Code
                    blnreStore = True
                End If
        End Select
        
        Dim intNewRow As Integer
        If UpdateIsActive(Code, Not blnRemark, intTab) Then
            If chkShowAll.Value Then
                If .TextMatrix(.Row, 1) = "" Then
                    .TextMatrix(.Row, 1) = "√"
                Else
                    .TextMatrix(.Row, 1) = ""
                End If
            Else
                .TextMatrix(.Row, 1) = "√"
                .RowHeight(.Row) = 0
              '  mclsList.SetFlexRow
            End If
            Flage = .TextMatrix(.Row, 1)
            If Flage <> "" Then
                intNewRow = .Row + 1
                Code = Code & "-"
                Do
                    If intNewRow > .Rows - 1 Then Exit Do
                    If InStr(1, .TextMatrix(intNewRow, intSortCol), Code, 1) = 0 Then
                         Exit Do
                     Else
                        .TextMatrix(intNewRow, 1) = Flage
                        If chkShowAll.Value <> 1 Then .RowHeight(intNewRow) = 0
                         intNewRow = intNewRow + 1
                     End If
                Loop
    
            Else
                Dim i As Integer
                .TextMatrix(.Row, 1) = Flage
                i = 1
                If .Row < .Rows - 1 Then
                    If UCase(.TextMatrix(.Row + 1, intSortCol)) Like UCase(.TextMatrix(.Row, intSortCol)) & "-*" Then
                        intResponse = ShowMsg(Me.hwnd, "是否取消所有下级的停用标记", vbYesNo, Me.Caption)
                        If intResponse = vbYes Then
                            Select Case intTab
                                Case 0
                                    strSql = "UPDATE Class1 SET blnIsInActive =  0 WHERE  strClassCode like '" & .TextMatrix(.Row, intSortCol) & "-*'"
                                Case 1
                                    strSql = "UPDATE Class2 SET blnIsInActive =  0 WHERE  strClassCode like '" & .TextMatrix(.Row, intSortCol) & "-*'"
                            End Select
                            If gclsBase.ExecSQL(strSql) Then
                                Do Until Not UCase(.TextMatrix(.Row + i, intSortCol)) Like UCase(.TextMatrix(.Row, intSortCol)) & "-*"
                                    .TextMatrix(.Row + i, 1) = Flage
                                    If .Row + i = .Rows - 1 Then
                                        Exit Do
                                    Else
                                        i = i + 1
                                    End If
                                Loop
                            End If
                        End If
                    End If
                End If
                Dim strOldText As String
                If CodePrefix(.TextMatrix(.Row, intSortCol)) <> "" Then
                    Do Until CodePrefix(.TextMatrix(.Row, intSortCol)) = ""
                           ' If .RowHeight(.Row) > 0 Then
                            strOldText = txtfind.Text
                            txtfind.Text = CodePrefix(.TextMatrix(.Row, intSortCol))
                            If txtfind.Text <> CodePrefix(strOldText) Then Exit Do
                            .TextMatrix(.Row, 1) = Flage
                            
                    Loop
                    
                End If
            End If
            If chkShowAll.Value <> 1 Then mclsList(intTab).SetFlexRow
            If intTab = 0 Then gclsSys.SendMessage CStr(Me.hwnd), Message.msgClass
            If intTab = 1 Then gclsSys.SendMessage CStr(Me.hwnd), Message.msgClass2
        End If
        '恢复旧的排序
        If blnreStore Then
            cboFindKind.Text = strOldSortCol
            txtfind.Text = strOldSortText
        End If
     End With
End Sub

Private Function UpdateIsActive(ByVal strCode As String, ByVal blnIsInActive As Boolean, ByVal intTab As Integer) As Boolean
    Dim strSql As String
    Select Case intTab
        Case 0
            If blnIsInActive Then
                strSql = "UPDATE Class1 SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strClasscode='" & strCode & "' Or strClasscode like '" & strCode & "-*'"
            Else
                strSql = "UPDATE Class1 SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strClasscode  in  ('" & strCode
                Do Until CodePrefix(strCode) = ""
                    strCode = CodePrefix(strCode)
                    strSql = strSql & "','" & strCode
                Loop
                strSql = strSql & "')"
            End If
        Case 1
            If blnIsInActive Then
                strSql = "UPDATE Class2 SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strClasscode='" & strCode & "' Or strClasscode like '" & strCode & "-*'"
            Else
                strSql = "UPDATE Class2 SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strClasscode  in  ('" & strCode
                Do Until CodePrefix(strCode) = ""
                    strCode = CodePrefix(strCode)
                    strSql = strSql & "','" & strCode
                Loop
                strSql = strSql & "')"
            End If
    End Select
    UpdateIsActive = gclsBase.ExecSQL(strSql)
End Function

Private Function CurrCodeName(ByVal intTab As Integer) As String
    Dim strCode As String
    Dim strName As String
    Dim i As Integer
    With mclsList(intTab).FlexGrid
        If .Row > 0 Then
            Select Case intTab
                Case 0
                For i = 0 To mclsList(intTab).ListSet.FixColumns - 1
                    If .TextMatrix(0, 2 + i) = "统计编码" Or .TextMatrix(0, 2 + i) = "统计编码↑" Or .TextMatrix(0, 2 + i) = "统计编码↓" Then
                        strCode = .TextMatrix(.Row, 2 + i)
                    ElseIf .TextMatrix(0, i + 2) = "统计名称" Or .TextMatrix(0, i + 2) = "统计名称↑" Or .TextMatrix(0, i + 2) = "统计名称↓" Then
                        strName = .TextMatrix(.Row, 2 + i)
                    End If
                Next
                Case 1
                For i = 0 To mclsList(intTab).ListSet.FixColumns - 1
                    If .TextMatrix(0, 2 + i) = "项目编码" Or .TextMatrix(0, 2 + i) = "项目编码↑" Or .TextMatrix(0, 2 + i) = "项目编码↓" Then
                        strCode = .TextMatrix(.Row, 2 + i)
                    ElseIf .TextMatrix(0, i + 2) = "项目名称" Or .TextMatrix(0, i + 2) = "项目名称↑" Or .TextMatrix(0, i + 2) = "项目名称↓" Then
                        strName = .TextMatrix(.Row, 2 + i)
                    End If
                Next
            End Select
        End If
    End With
    CurrCodeName = Trim(strCode) & " " & Trim(strName)
End Function
Private Function GetCol(ByVal strColName As String, ByVal intTab As Integer) As Integer
    Dim i As Integer
    With mclsList(intTab).FlexGrid
         For i = 1 To .Cols - 1
             If .TextMatrix(0, i) = strColName Or .TextMatrix(0, i) = strColName & "↑" Or .TextMatrix(0, i) = strColName & "↓" Then
                GetCol = i
                Exit For
             End If
         Next
    End With
End Function
Private Function UpDatePreFlage(ByVal intTab As Integer) As Boolean
    Dim i As Integer
    Dim intCol
    Dim strOldSort As String
    Dim strOldCol As String
    Dim strSql As String
    Dim recTemplete As rdoResultset
    Dim strOldCode As String
    With mclsList(intTab).FlexGrid
        '.Redraw = False
        Select Case intTab
            Case 0
                strOldCol = cboFindKind.Text
                strOldSort = txtfind.Text
                strOldCode = CodePrefix(.TextMatrix(.Row, GetCol("统计编码", 0)))
                intCol = GetCol("末级标志", 0)
                If intCol > 0 Then
                    strSql = "select blnIsDetail from Class1 where strClasscode='" & strOldCode & "'"
                    Set recTemplete = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If Not recTemplete.EOF Then
                        If recTemplete!blnIsDetail = 1 Then
                            If mclsList(intTab).ListSet.ColumnOrderType(GetCol("统计编码", 0) - 1) <> 1 Then cboFindKind.Text = "统计编码"
                            txtfind.Text = strOldCode 'CodePrefix(.TextMatrix(.Row, GetCol("科目编码",0)))
                            .TextMatrix(.Row, intCol) = "是"
                        End If
                    End If
                    recTemplete.Close
                End If
                cboFindKind.Text = strOldCol
                cboFindKind.Text = strOldCol
                txtfind.Text = strOldSort
            Case 1
                strOldCol = cboFi