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

                        Exit Sub
                    End If
                End If
            Case "Help"
                SendKeys "{f1 3}"
                'SendKeys "{f1}"
            Case "Exit"
                Unload Me
                Exit Sub
        End Select
    End With
    If Button.key <> "Exit" Then
        ocxCtbtool.RefreshEnable
    End If
End Sub

Private Function lowBoundProc() As Boolean
    With SuperGrid1
    'Empty Or Not
    If .TextMatrix(credstat.selRow, credstat.selcol) <> "" Then
        'Bigger than 0 or not
        If IsNumeric(.TextMatrix(credstat.selRow, credstat.selcol)) Then
            If (connumber(.TextMatrix(credstat.selRow, credstat.selcol), credstat.selRow, credstat.selcol)) >= 0 Then
                Select Case credstat.selRow
                    Case "1"  'first row
                        .TextMatrix(credstat.selRow, credstat.selcol) = 0
                        lowBoundProc = True
                        Exit Function
                    Case .Rows - 1 'last row
                        If .Rows - 1 = 1 Then
                            .TextMatrix(credstat.selRow, credstat.selcol) = 0
                            '.TextMatrix(credstat.selRow, credstat.selcol + 1) = ">0"
                            .TextMatrix(credstat.selRow, credstat.selcol + 1) = ""
                            lowBoundProc = True
                            Exit Function
                        Else
                            If CDbl(.TextMatrix(credstat.selRow, credstat.selcol)) >= .TextMatrix(credstat.selRow - 1, credstat.selcol) Then
                                .TextMatrix(credstat.selRow - 1, credstat.selcol + 1) = .TextMatrix(credstat.selRow, credstat.selcol)
                                '.TextMatrix(credstat.selRow, credstat.selcol + 1) = ">" & .TextMatrix(credstat.selRow, credstat.selcol)
                                .TextMatrix(credstat.selRow, credstat.selcol + 1) = ""
                                lowBoundProc = True
                                Exit Function
                            Else
                                MsgBox "第" & credstat.selRow & "行输入错误！" & "下限不能小于上一条的下限!"
                                lowBoundProc = False
                                Exit Function
                            End If
                        End If
                    Case Else
                        'bigger pre line's lowbound
                        If CDbl(connumber(.TextMatrix(credstat.selRow, credstat.selcol), credstat.selRow, credstat.selcol)) >= connumber(.TextMatrix(credstat.selRow - 1, credstat.selcol), credstat.selRow - 1, credstat.selcol) Then
                            'smaller than next line's lowbound
                            If credstat.selRow <> .Rows - 1 Then
                                If CDbl(.TextMatrix(credstat.selRow, credstat.selcol)) <= CDbl(.TextMatrix(credstat.selRow + 1, credstat.selcol)) Then
                                    .TextMatrix(credstat.selRow - 1, credstat.selcol + 1) = .TextMatrix(credstat.selRow, credstat.selcol)
                                    lowBoundProc = True
                                    Exit Function
                                Else
                                    MsgBox "第" & credstat.selRow & "行输入错误！" & "下限不能大于上限"
                                    lowBoundProc = False
                                    Exit Function
                                End If
                            End If
                        Else
                            MsgBox "第" & credstat.selRow & "行输入错误！" & "下限不能小于上一条的下限"
                            lowBoundProc = False
                            Exit Function
                        End If
               End Select
            Else
                MsgBox "第" & credstat.selRow & "行输入错误！" & "下限不能为负！"
                lowBoundProc = False
                Exit Function
            End If
        Else
            MsgBox "第" & credstat.selRow & "行输入错误！" & "下限必须为数字"
            lowBoundProc = False
            Exit Function
        End If
    Else
        MsgBox "第" & credstat.selRow & "行输入错误！" & "下限不能为空！"
        lowBoundProc = False
        Exit Function
    End If
End With
End Function

Private Function highBoundProc() As Boolean
    With SuperGrid1
    'Empty Or Not
    If .TextMatrix(credstat.selRow, credstat.selcol) <> "" Then
        'Bigger than 0 or not
        If IsNumeric(connumber(.TextMatrix(credstat.selRow, credstat.selcol), credstat.selRow, credstat.selcol)) Then
            If (CDbl(connumber(.TextMatrix(credstat.selRow, credstat.selcol), credstat.selRow, credstat.selcol))) >= 0 Then
                Select Case credstat.selRow
                    Case "1"  'first row
                        If .Rows > 2 Then
                            If CDbl(.TextMatrix(credstat.selRow, credstat.selcol)) <= CDbl(connumber(.TextMatrix(credstat.selRow + 1, credstat.selcol), credstat.selRow + 1, credstat.selcol)) Then
                                .TextMatrix(credstat.selRow + 1, credstat.selcol - 1) = .TextMatrix(credstat.selRow, credstat.selcol)
                                highBoundProc = True
                                Exit Function
                            Else
                                If credstat.selRow = .Rows - 2 Then
                                    .TextMatrix(credstat.selRow + 1, credstat.selcol - 1) = .TextMatrix(credstat.selRow, credstat.selcol)
                                    highBoundProc = True
                                    Exit Function
                                End If
                                MsgBox "第" & credstat.selRow & "行输入错误！" & "上限不能大于下一条的上限！"
                                highBoundProc = False
                                Exit Function
                            End If
                        Else
                            GoTo proc1
                        End If
                    Case .Rows - 1 'last row
proc1:
                        
                        If .Rows > 2 Then
                            '.TextMatrix(credstat.selRow, credstat.selcol) = ">" & .TextMatrix(credstat.selRow, credstat.selcol - 1)
                            '.TextMatrix(credstat.selRow, credstat.selcol) = ""
                        End If
                            '& ">" & .TextMatrix(credstat.selRow, credstat.selcol - 1)
                        highBoundProc = True
                        Exit Function
                    Case .Rows - 2
                        If CDbl(.TextMatrix(credstat.selRow, credstat.selcol)) < CDbl(.TextMatrix(credstat.selRow, credstat.selcol - 1)) Then
                                MsgBox "第" & credstat.selRow & "行输入错误！" & "上限不能大于下限"
                                highBoundProc = False
                                Exit Function
                        End If
                        '.TextMatrix(credstat.selRow + 1, credstat.selcol) = ">" & .TextMatrix(credstat.selRow, credstat.selcol)
                        '.TextMatrix(credstat.selRow + 1, credstat.selcol) = ""
                        '">" & .TextMatrix(credstat.selRow, credstat.selcol)
                        .TextMatrix(credstat.selRow + 1, credstat.selcol - 1) = .TextMatrix(credstat.selRow, credstat.selcol)
                        .TextMatrix(credstat.selRow, credstat.selcol) = connumber(.TextMatrix(credstat.selRow, credstat.selcol), credstat.selRow, credstat.selcol)
                        highBoundProc = True
                        Exit Function
                    Case Else
                        'bigger pre line's highbound
                        If CDbl(.TextMatrix(credstat.selRow, credstat.selcol)) >= CDbl(.TextMatrix(credstat.selRow - 1, credstat.selcol)) Then
                            'smaller than next line's lowbound
                            If CDbl(.TextMatrix(credstat.selRow, credstat.selcol)) <= CDbl(.TextMatrix(credstat.selRow + 1, credstat.selcol)) Then
                                .TextMatrix(credstat.selRow + 1, credstat.selcol - 1) = .TextMatrix(credstat.selRow, credstat.selcol)
                                highBoundProc = True
                                Exit Function
                            Else
                                MsgBox "第" & credstat.selRow & "行输入错误！" & "上限不能大于下一条的上限"
                                highBoundProc = False
                                Exit Function
                            End If
                        Else
                            MsgBox "第" & credstat.selRow & "行输入错误！" & "上限不能小于下限"
                            highBoundProc = False
                            Exit Function
                        End If
               End Select
            Else
                MsgBox "第" & credstat.selRow & "行输入错误！" & "上限不能为负！"
                highBoundProc = False
                Exit Function
            End If
        Else
            MsgBox "第" & credstat.selRow & "行输入错误！" & "上限只能是数字！"
            highBoundProc = False
            Exit Function
        End If
    Else
        If credstat.selRow <> .Rows - 1 Then
            If credstat.selRow = .Rows - 2 Then
                .TextMatrix(credstat.selRow, 2) = .TextMatrix(credstat.selRow, 1)
                .TextMatrix(.Rows - 1, 1) = .TextMatrix(credstat.selRow, 1)
                highBoundProc = True
                Exit Function
            End If
            MsgBox "第" & credstat.selRow & "行输入错误！" & "上限不能为空！"
            highBoundProc = False
        Else
            highBoundProc = True
        End If
        Exit Function
    End If
End With
End Function

Private Sub ModiProc()
    With tlbTool
        .Buttons("print").Enabled = False
        .Buttons("preview").Enabled = False
        .Buttons("Output").Enabled = False
        .Buttons("Modi").Enabled = False
        .Buttons("addColumn").Enabled = False
        .Buttons("delColumn").Enabled = False
        .Buttons("Cancel").Enabled = True
        .Buttons("Save").Enabled = True
    End With
    credstat.modified = True
    credstat.ModifyState = 2
    SuperGrid1.ReadOnly = False
   ' SuperGrid1.SetFocus
End Sub

Private Sub addColumnProc()
    Dim i As Integer
    Dim coldisc() As Long
    With SuperGrid1
        credstat.modified = True
        credstat.ModifyState = 3
        tlbTool.Buttons("addColumn").Enabled = False
        .AddRecord "", coldisc
        'For i = SuperGrid1.Rows - 1 To credstat.selRow + 1 Step -1
            i = SuperGrid1.Rows - 1
        If i <> 2 Then
            '.TextMatrix(i, 0) = .TextMatrix(i - 1, 0)
            .TextMatrix(i, 0) = ""
            .TextMatrix(i, 1) = .TextMatrix(i - 1, 1)
            .TextMatrix(i, 2) = .TextMatrix(i - 1, 2)
            .TextMatrix(i, 3) = .TextMatrix(i - 1, 3)
        End If 'Next
        '定义credstat.selRow为新增行行号
        credstat.selRow = .Rows - 1
        '.TextMatrix(credstat.selRow, 0) = ""
        If credstat.selRow = 1 Then
            .TextMatrix(credstat.selRow, 1) = 0
            '.TextMatrix(credstat.selRow, 2) = ">0"
            .TextMatrix(credstat.selRow, 2) = ""
        ElseIf credstat.selRow = .Rows - 1 Then
            If Trim(.TextMatrix(credstat.selRow - 1, 2)) <> "" Then
                .TextMatrix(credstat.selRow, 1) = connumber(.TextMatrix(credstat.selRow - 1, 2), credstat.selRow - 1, 2)
                '.TextMatrix(credstat.selRow, 2) = ">" & connumber(.TextMatrix(credstat.selRow - 1, 2), credstat.selRow - 1, 2)
                .TextMatrix(credstat.selRow, 2) = ""
            Else
                .TextMatrix(credstat.selRow, 1) = ""
                .TextMatrix(credstat.selRow, 2) = ""
            End If
            .TextMatrix(credstat.selRow - 1, 2) = .TextMatrix(credstat.selRow, 1)
        Else
            .TextMatrix(credstat.selRow, 1) = .TextMatrix(credstat.selRow - 1, 2)
            .TextMatrix(credstat.selRow, 2) = .TextMatrix(credstat.selRow + 1, 1)
        End If
        .TextMatrix(credstat.selRow, 3) = ""
    
        .row = credstat.selRow
        .SetFocus
    End With
    With tlbTool
        .Buttons("print").Enabled = False
        .Buttons("preview").Enabled = False
        .Buttons("Output").Enabled = False
        .Buttons("Modi").Enabled = False
        .Buttons("addColumn").Enabled = False
        .Buttons("delColumn").Enabled = False
        .Buttons("Cancel").Enabled = True
        .Buttons("Save").Enabled = True
    End With
    credstat.modified = True
    credstat.ModifyState = 3
    SuperGrid1.ReadOnly = False
    SuperGrid1.SetFocus

End Sub

Private Function connumber(ByVal str As String, ByVal R As Integer, ByVal c As Integer) As String
    If R <> SuperGrid1.Rows - 1 Then
        If R = SuperGrid1.Rows - 2 And c = 2 Then
            If str = "" Then
                connumber = SuperGrid1.TextMatrix(R, 1)
            Else
                connumber = str
            End If
        Else
            connumber = str
        End If
    Else
        If c = 2 Then
            If str = "" Then
                connumber = SuperGrid1.TextMatrix(R, 1)
            Else
                connumber = str
            End If
        Else
            connumber = str
        End If
    End If
End Function

Private Sub delColumnProc()
    Dim sqlstr As String
    Dim i As Integer
    'Dim con1 As New ADODB.Connection
    On Error GoTo error0
    'sqlstr = "delete from FD_creClass Where creClass='" & SuperGrid1.TextMatrix(credstat.selRow, 0) & "'"
    Dim ReturnValue As VbMsgBoxResult
    ReturnValue = MsgBox("该操作将删除当前行的数据，确定需要删除吗？", vbYesNo, "保存数据")
    With SuperGrid1
    Select Case ReturnValue
        Case vbNo
           Exit Sub
           'Call cancelproc
        Case vbYes
            'con1.ConnectionString = zjLogInfo.UfDbName
            'con1.Open
            If credstat.selRow = 1 Then
                MsgBox "第一条记录不能删除!", vbCritical, "错误操作"
                Exit Sub
            Else
'                con1.BeginTrans
'                con1.Execute sqlstr
'                con1.CommitTrans
                If credstat.selRow = .Rows - 1 Then
                    '.TextMatrix(credstat.selRow - 1, 2) = ">" & .TextMatrix(credstat.selRow - 1, 1)
                    .TextMatrix(credstat.selRow - 1, 2) = ""
                Else
                    .TextMatrix(credstat.selRow - 1, 2) = .TextMatrix(credstat.selRow, 2)
                    .TextMatrix(credstat.selRow + 1, 1) = .TextMatrix(credstat.selRow, 2)
                End If
            End If
            .RemoveItem credstat.selRow
            credstat.modified = True