VB财务软件系统下载源代码提供自由下载使用学习

        rs.Close
        Call setNoDataState
    Else
        SuperGrid1.ReadOnly = True
        Call loadData(rs)
        rs.Close
    End If
    ocxCtbtool.RefreshEnable
End Sub
'加载数据到数组和supergrid中
Private Sub loadData(rs As ADODB.Recordset)
    Dim i As Long
    If rs.RecordCount > 0 Then
        ReDim creClass(rs.RecordCount - 1, 3)
        For i = 0 To rs.RecordCount - 1
            creClass(i, 0) = IIf(IsNull(rs("creClass")), "", rs("creClass"))
            creClass(i, 1) = IIf(IsNull(rs("lowMark")), 0, rs("lowMark"))
            creClass(i, 2) = IIf(IsNull(rs("highMark")), 0, rs("highMark"))
            creClass(i, 3) = IIf(IsNull(rs("borLim")), 0, rs("borLim"))
            rs.MoveNext
        Next
        SuperGrid1.Rows = rs.RecordCount + 1
    Else
        Call setNoDataState
        Exit Sub
    End If
    For i = 1 To rs.RecordCount
        SuperGrid1.TextMatrix(i, 0) = creClass(i - 1, 0)
        SuperGrid1.TextMatrix(i, 1) = creClass(i - 1, 1)
        If i < rs.RecordCount Then
            SuperGrid1.TextMatrix(i, 2) = creClass(i - 1, 2)
        Else
            'SuperGrid1.TextMatrix(i, 2) = ">" & creClass(i - 1, 1)
            SuperGrid1.TextMatrix(i, 2) = ""
        End If
        SuperGrid1.TextMatrix(i, 3) = creClass(i - 1, 3)
    Next
    credstat.selRow = SuperGrid1.Rows - 1
End Sub
'无数据时设置界面状态
Private Sub setNoDataState()
        credstat.ModifyState = 3
        credstat.modified = True
        
        SuperGrid1.Rows = 2
        SuperGrid1.ReadOnly = False
        SuperGrid1.TextMatrix(1, 0) = ""
        SuperGrid1.TextMatrix(1, 1) = 0
        SuperGrid1.TextMatrix(1, 2) = ""
        SuperGrid1.TextMatrix(1, 3) = ""
        
        With tlbTool
            .ButtonWidth = 8.53
            .Buttons("print").Enabled = False
            .Buttons("preview").Enabled = False
            .Buttons("Output").Enabled = False
            .Buttons("Modi").Enabled = False
            .Buttons("addColumn").Enabled = True
            .Buttons("delColumn").Enabled = False
            .Buttons("Cancel").Enabled = False
            .Buttons("Save").Enabled = True
            .Buttons("estModal").Enabled = True
            .Buttons("Help").Enabled = True
            .Buttons("Exit").Enabled = True
        End With
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim result As VbMsgBoxResult
    If credstat.modified Then
        result = MsgBox("您还有数据未保存，是否决定在退出信用评价程序前保存数据？", vbYesNoCancel, "退出程序")
        Select Case result
         Case vbYes
             If SaveData Then
                Cancel = 0
             Else
                Cancel = 1
                Exit Sub
             End If
        Case vbNo
            Cancel = 0
        Case vbCancel
            Cancel = 1
            Exit Sub
        End Select
    Else
'        If MsgBox("确定要退出信用评价程序吗？", vbYesNo, "退出程序") = vbYes Then
'            Cancel = 0
'        Else
'            Cancel = 1
'            Exit Sub
'        End If
    End If
    
    Erase creClass
    
    If con.State = adStateOpen Then
        con.Close
    End If
    Set con = Nothing
    
    Call clear
End Sub

Private Sub Form_Resize()
    If Me.WindowState <> 1 Then
        Picture1.top = tlbTool.Height
        Picture1.left = tlbTool.left
        Picture1.width = Me.width
        SuperGrid1.top = tlbTool.Height + Picture1.Height
        SuperGrid1.left = tlbTool.left + 100
        If Me.width > 200 Then
            SuperGrid1.width = Me.width - 200
        End If
        If Me.Height - tlbTool.Height - Picture1.Height > 0 Then
            SuperGrid1.Height = Me.Height - tlbTool.Height - Picture1.Height - 500
        End If
    End If
    ResizeTlb Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
'    Dim result As VbMsgBoxResult
'    If credstat.modified Then
'        result = MsgBox("您还有数据未保存，是否决定在退出信用评价程序前保存数据？", vbYesNoCancel, "退出程序")
'        Select Case result
'         Case vbYes
'             If SaveData Then
'                Cancel = 0
'             Else
'                Cancel = 1
'                Exit Sub
'             End If
'        Case vbNo
'            Cancel = 0
'        Case vbCancel
'            Cancel = 1
'            Exit Sub
'        End Select
'    Else
''        If MsgBox("确定要退出信用评价程序吗？", vbYesNo, "退出程序") = vbYes Then
''            Cancel = 0
''        Else
''            Cancel = 1
''            Exit Sub
''        End If
'    End If
'    Con.Close
'    Set Con = Nothing
'    If Not duplicate Then
'        Call clear
'    End If
End Sub

Private Sub ocxCtbTool_OnCommand(ByVal enumType As prjTBCtrl.ENUM_MENU_OR_BUTTON, ByVal cButtonId As String, ByVal cMenuId As String)
    tlbTool_ButtonClick tlbTool.Buttons(cButtonId)
End Sub

Private Sub SuperGrid1_Click()
    credstat.selRow = SuperGrid1.row
    credstat.selcol = SuperGrid1.col
    If SuperGrid1.row = SuperGrid1.Rows - 1 And SuperGrid1.col = 3 Then
        precol = 1
    ElseIf SuperGrid1.row = SuperGrid1.Rows - 1 And SuperGrid1.col = 2 Then
        precol = 0
    Else
        precol = 2
    End If
    If credstat.ModifyState = 0 Then
        tlbTool.Buttons("addColumn").Enabled = False
        tlbTool.Buttons("delColumn").Enabled = False
    Else
        credstat.selRow = SuperGrid1.row
        tlbTool.Buttons("addColumn").Enabled = True
        tlbTool.Buttons("delColumn").Enabled = True
    End If

End Sub

Private Sub SuperGrid1_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim discolor() As Long
    If credstat.ModifyState = 0 Then
        tlbTool.Buttons("addColumn").Enabled = False
        tlbTool.Buttons("delColumn").Enabled = False
    Else
        credstat.selRow = SuperGrid1.row
        tlbTool.Buttons("addColumn").Enabled = True
        tlbTool.Buttons("delColumn").Enabled = True
    End If
    If credstat.ModifyState <> 0 Then
        If KeyCode = vbKeyReturn Then
            If credstat.selcol = 3 And credstat.selRow = SuperGrid1.Rows - 1 Then
                If precol = 0 Or precol = 3 Then
                    precol = 1
                ElseIf precol = 1 Then
                    addColumnProc
                End If
            End If
        End If
    End If
End Sub

Private Sub SuperGrid1_LostFocus()
    If SuperGrid1.row < SuperGrid1.Rows - 1 Then
        SuperGrid1.row = SuperGrid1.Rows - 1
    Else
        SuperGrid1.row = 1
    End If
End Sub

Private Sub SuperGrid1_OnEdit(Editing As Boolean)
If credstat.ModifyState <> 0 Then
    modified = True
    credstat.modified = True
Else
    credstat.modified = False
    modified = False
End If
End Sub

Private Sub SuperGrid1_RowColChange()
    Dim b As Boolean
    
    b = False
    With SuperGrid1
        If .row = .Rows - 1 Then
            If credstat.selcol = 3 Then
                precol = 3
            ElseIf credstat.selcol = 2 Then
                precol = 0
            End If
        Else
            precol = credstat.selcol
        End If
    End With
    If credstat.modified Then
        If modified Then
            '执行数据填充
            If errornum = 0 Then
                If credstat.selcol = 1 Then
                    b = lowBoundProc
                End If
                If credstat.selcol = 2 Then
                        b = highBoundProc
                End If
                If Not b Then
                    errornum = 1
                End If
            Else
                errornum = 0
            End If
            If b Then
                'modified = False
                credstat.selRow = SuperGrid1.row
                credstat.selcol = SuperGrid1.col
            Else
                If credstat.selcol <> 1 And credstat.selcol <> 2 Then
                    'modified = False
                    credstat.selRow = SuperGrid1.row
                    credstat.selcol = SuperGrid1.col
                Else
                    SuperGrid1.col = credstat.selcol
                    SuperGrid1.row = credstat.selRow
                    SuperGrid1.SetFocus
                End If
            End If
'        Else
'            If SuperGrid1.Row <> credstat.selRow Then
'                MsgBox "您正在编辑第" & credstat.selRow + 1 & "行数据,请先保存数据或继续编辑该行！", vbInformation, "系统提示"
'                SuperGrid1.Row = credstat.selRow
'                SuperGrid1.SetFocus
'            Else
'                credstat.selcol = SuperGrid1.Col
'                'SuperGrid1.ReadOnly = True
'            End If
        End If
    Else
        If credstat.ModifyState <> 3 Then
            credstat.selRow = SuperGrid1.row
            credstat.selcol = SuperGrid1.col
        End If
    End If
    If credstat.ModifyState = 0 Then
        tlbTool.Buttons("addColumn").Enabled = False
        tlbTool.Buttons("delColumn").Enabled = False
    Else
        credstat.selRow = SuperGrid1.row
        tlbTool.Buttons("addColumn").Enabled = True
        tlbTool.Buttons("delColumn").Enabled = True
    End If
    credstat.selcol = SuperGrid1.col
    credstat.selRow = SuperGrid1.row
End Sub

Private Sub tlbTool_ButtonClick(ByVal Button As MSComctlLib.Button)
    With tlbTool
        Select Case Button.key
            Case "print"
                Call printProc
            Case "preview"
                Call previewProc
            Case "Output"
                Call outputProc
            Case "Modi"
                Call ModiProc
            Case "addColumn"
                Call addColumnProc
            Case "delColumn"
                Call delColumnProc
            Case "Cancel"
                Call CancelProc
            Case "Save"
                Call saveProc
            Case "estModal"
                If show_estModal Then
                    If frmEstModal.check_open_Form Then
                        Unload Me
                        frmEstModal.Show