frmshuru.frm

财务管理信息系统

'读入主表数据
Private Sub LoadData()
    Dim strFilter As String
    If Len(Trim(txbOne.Text)) = 0 Then
        If Len(Trim(txbTwo.Text)) = 0 Then
            If Len(Trim(txbThree.Text)) = 0 Then
                strFilter = ""
            Else
                strFilter = "where 日期 like '"
                strFilter = strFilter + Trim(txbThree.Text) + "%'"
            End If
        Else
            strFilter = "where 会计期间 like '" + Trim(txbTwo.Text) + "%'"
            If Len(Trim(txbThree.Text)) <> 0 Then
                strFilter = strFilter + " and 日期 like '"
                strFilter = strFilter + Trim(txbThree.Text) + "%'"
            End If
        End If
    Else
        strFilter = "where 凭证编号 like '" + Trim(txbOne.Text) + "%'"
        If Len(Trim(txbTwo.Text)) <> 0 Then
            strFilter = strFilter + " and 会计期间 like '" + Trim(txbTwo.Text) + "%'"
            If Len(Trim(txbThree.Text)) <> 0 Then
                strFilter = strFilter + " and 日期 like '"
                strFilter = strFilter + Trim(txbThree.Text) + "%'"
            End If
        Else
            If Len(Trim(txbThree.Text)) <> 0 Then
                strFilter = strFilter + " and 日期 like '"
                strFilter = strFilter + Trim(txbThree.Text) + "%'"
            End If
        End If
    End If
    Dim db As New DataBases
    Dim rs As Recordset
    Set rs = db.RunSelectSQLUpdatable("select * from 凭证表  " + strFilter)
    Set Adodc1.Recordset = rs
    SetTextBoxState (False)
End Sub

'读入详细表数据
Private Sub LoadDataForDetail(strCode As String)
    Dim strSQL As String
    Dim rs As Recordset
    strSQL = "SELECT 摘要, a.科目代码, 科目名称, 借方, 贷方,凭证编号 FROM 分录表 as a,科目表 as b where a.科目代码=b.科目代码 "
    Set rs = Adodc1.Recordset
    If Not rs.EOF Then
        strSQL = strSQL + " and 凭证编号='" + strCode + "'"
    End If
    Dim db As New DataBases
    Set rs = db.RunSelectSQLUpdatable(strSQL)
    fgDetail.Rows = rs.RecordCount + 1
    For i = 1 To rs.RecordCount
        fgDetail.TextMatrix(i, 1) = Trim(rs("摘要"))
        fgDetail.TextMatrix(i, 2) = rs("科目代码")
        fgDetail.TextMatrix(i, 3) = rs("科目名称")
        fgDetail.TextMatrix(i, 4) = rs("借方")
        fgDetail.TextMatrix(i, 5) = rs("贷方")
        rs.MoveNext
    Next i
    iRSCount = rs.RecordCount
End Sub

Private Sub btnAdd_Click()
    Dim i As Integer
    i = fgDetail.Rows
    fgDetail.Rows = fgDetail.Rows + 1
    Dim db As New DataBases
    Dim strSQL As String
    Dim rs As Recordset
    strSQL = "select 科目名称 from 科目表 where 科目代码='"
    strSQL = strSQL + Trim(cbbSubjectCode.Text) + "'"
    Set rs = db.RunSelectSQL(strSQL)
    fgDetail.TextMatrix(i, 1) = Trim(txbSummary.Text)
    fgDetail.TextMatrix(i, 2) = Trim(cbbSubjectCode.Text)
    fgDetail.TextMatrix(i, 3) = Trim(rs("科目名称"))
    fgDetail.TextMatrix(i, 4) = Trim(txbDebit.Text)
    fgDetail.TextMatrix(i, 5) = Trim(txbLender.Text)
    txbSummary.Text = ""
    cbbSubjectCode.Text = ""
    txbDebit.Text = ""
    txbLender.Text = ""
    UpdateMoney
End Sub

Private Sub btnDelete_Click()
    If MsgBox("你确认要删除此条记录吗？", vbYesNo) = vbYes Then
        For i = fgDetail.row To fgDetail.Rows - 2
            fgDetail.TextMatrix(i, 1) = fgDetail.TextMatrix(i + 1, 1)
            fgDetail.TextMatrix(i, 2) = fgDetail.TextMatrix(i + 1, 2)
            fgDetail.TextMatrix(i, 3) = fgDetail.TextMatrix(i + 1, 3)
            fgDetail.TextMatrix(i, 4) = fgDetail.TextMatrix(i + 1, 4)
        Next i
        fgDetail.Rows = fgDetail.Rows - 1
    End If
    UpdateMoney
End Sub

Private Sub btnModify_Click()
    Dim i As Integer
    i = fgDetail.row
    Dim db As New DataBases
    Dim strSQL As String
    Dim rs As Recordset
    strSQL = "select 科目名称 from 科目表 where 科目代码='"
    strSQL = strSQL + Trim(cbbSubjectCode.Text) + "'"
    Set rs = db.RunSelectSQL(strSQL)
    fgDetail.TextMatrix(i, 1) = Trim(txbSummary.Text)
    fgDetail.TextMatrix(i, 2) = Trim(cbbSubjectCode.Text)
    fgDetail.TextMatrix(i, 3) = Trim(rs("科目名称"))
    fgDetail.TextMatrix(i, 4) = Trim(txbDebit.Text)
    fgDetail.TextMatrix(i, 5) = Trim(txbLender.Text)
    UpdateMoney
End Sub

Private Sub Command1_Click()
    LoadData
End Sub

Private Sub fgDetail_Click()
    Dim row As Integer
    row = fgDetail.row
    Me.txbSummary.Text = fgDetail.TextMatrix(row, 1)
    Me.cbbSubjectCode.Text = fgDetail.TextMatrix(row, 3)
    Me.txbDebit.Text = fgDetail.TextMatrix(row, 4)
    Me.txbLender.Text = fgDetail.TextMatrix(row, 5)
End Sub

Private Sub form_load()
    Dim db As New DataBases
    Adodc1.ConnectionString = db.sConn
    Adodc2.ConnectionString = db.sConn
    fgDetail.Cols = 6
    fgDetail.Rows = 1
    fgDetail.TextMatrix(0, 1) = "摘要"
    fgDetail.TextMatrix(0, 2) = "科目代码"
    fgDetail.TextMatrix(0, 3) = "科目名称"
    fgDetail.TextMatrix(0, 4) = "借方"
    fgDetail.TextMatrix(0, 5) = "贷方"
    LoadData
    If Adodc1.Recordset.EOF Then
        LoadDataForDetail ""
    Else
        LoadDataForDetail Adodc1.Recordset("凭证编号")
    End If
    Me.cbbZiHao.AddItem ("收")
    Me.cbbZiHao.AddItem ("付")
    Me.cbbZiHao.AddItem ("转")
End Sub

'判断输入是否正确
Private Function ValidateData() As Boolean
    If Trim(cbbSubjectCode.Text) = "" Or _
        (Trim(txbDebit.Text) = "0" And Trim(txbLender.Text) = "0") Then
        ValidateData = False
    End If
    ValidateData = True
End Function

'清除输入框的值
Private Sub ClearTextBox()
    txbSummary.Text = ""
    cbbSubjectCode.Text = ""

    txbDebit.Text = "0"
    txbLender.Text = "0"
End Sub

'计算总钱数
Private Function CalMoney() As Single()
    Dim Result(2) As Single
    Result(0) = 0
    Result(1) = 0
    For i = 1 To fgDetail.Rows - 1
        Result(0) = Result(0) + CSng(fgDetail.TextMatrix(i, 4))
        Result(1) = Result(1) + CSng(fgDetail.TextMatrix(i, 5))
    Next i
    CalMoney = Result
End Function

'更新钱数
Private Sub UpdateMoney()
    Dim Result() As Single
    Result = CalMoney()
    Me.txbDebitTotal.Text = Result(0)
    Me.txbLenderTotal.Text = Result(1)
End Sub

'从Detail表中删除
Private Sub DeleteDetail()
    Dim db As New DataBases
    Dim strSQL As String
    strSQL = "delete from 分录表 where 凭证编号='"
    strSQL = strSQL + Trim(txbCode.Text) + "'"
    db.RunSelectSQL (strSQL)
    db.CloseConn
End Sub

'清空各TextBox并计算凭证编号
Private Sub Clear()
    ' 计算凭证编号(Primary key)
    Dim strID As String
    Dim strSQL As String
    strID = strID1 = ""
    strSQL = "select max(凭证编号) as 编号 from 凭证表"
    Dim db As New DataBases
    Dim rs As Recordset
    Set rs = db.RunSelectSQL(strSQL)
    If IsNull(rs("编号")) Then
        strSQL = "select max(凭证编号) as 编号 from 凭证表历史"
        Set rs = db.RunSelectSQL(strSQL)
        If IsNull(rs("编号")) Then
            strID = "000001"
        Else
            strID = CInt(rs("编号")) + 1
            strID = "00000" + strID
        End If
    Else
        strID = CInt(rs("编号")) + 1
        strID = "00000" + strID
    End If
    txbCode.Text = strID
    LoadDataForDetail txbCode.Text
    Set rs = db.RunSelectSQL("select 取值 from 系统参数表 where 参数名称 = '当前会计期间'")
    txbPeriod.Text = rs(0)
    txbState.Text = "未过"
    txbDate.Text = Date
    txbDebitTotal.Text = "0"
    txbLenderTotal.Text = "0"
    ClearTextBox
    cbbZiHao.Text = ""
End Sub

Private Sub grdDataGrid_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    If IsNull(Adodc1.Recordset("凭证编号")) Then
        LoadDataForDetail ""
    Else
        LoadDataForDetail Adodc1.Recordset("凭证编号")
    End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    If StrComp(Button.Key, "btnFirst") = 0 Then
        Adodc1.Recordset.MoveFirst
    ElseIf StrComp(Button.Key, "btnBefore") = 0 Then
        Adodc1.Recordset.MovePrevious
    ElseIf StrComp(Button.Key, "btnNext") = 0 Then
        Adodc1.Recordset.MoveNext
    ElseIf StrComp(Button.Key, "btnLast") = 0 Then
        Adodc1.Recordset.MoveLast
    ElseIf StrComp(Button.Key, "btnNew") = 0 Then
        bAdd = True
        Adodc1.Recordset.AddNew
        SetTextBoxState (True)
        SetToolBarState (False)
        Clear
    ElseIf StrComp(Button.Key, "btnModify") = 0 Then
        bAdd = False
        SetTextBoxState (True)
        SetToolBarState (False)
    ElseIf StrComp(Button.Key, "btnDelete") = 0 Then
        If MsgBox("确定要删除吗？", vbYesNo) = vbYes Then
            DeleteData
        End If
    ElseIf StrComp(Button.Key, "btnSave") = 0 Then
        SetTextBoxState (False)
        SetToolBarState (True)
        If bAdd = True Then
            '为新增数据保存
            If Trim(Me.txbDebitTotal.Text) = Trim(Me.txbLenderTotal.Text) Then
                SaveForAdd
                Adodc1.Recordset.Requery
            Else
                MsgBox "借贷双方不平衡,请检查"
            End If
        Else
            '为更新数据保存
            If Trim(Me.txbDebitTotal.Text) = Trim(Me.txbLenderTotal.Text) Then
                SaveForUpdate
            Else
                MsgBox "借贷双方不平衡,请检查"
            End If
        End If
    ElseIf StrComp(Button.Key, "btnCancel") = 0 Then
        Adodc1.Recordset.Requery
        SetTextBoxState (False)
        SetToolBarState (True)
    ElseIf StrComp(Button.Key, "btnExit") = 0 Then
        Hide
    End If
End Sub

Private Sub SetToolBarState(ByVal bState As Boolean)
    '设置Button是否能够单击
    Toolbar1.Buttons("btnFirst").Enabled = bState
    Toolbar1.Buttons("btnBefore").Enabled = bState
    Toolbar1.Buttons("btnNext").Enabled = bState
    Toolbar1.Buttons("btnLast").Enabled = bState
    Toolbar1.Buttons("btnNew").Enabled = bState
    Toolbar1.Buttons("btnModify").Enabled = bState
    Toolbar1.Buttons("btnDelete").Enabled = bState
    Toolbar1.Buttons("btnSave").Enabled = Not bState
    Toolbar1.Buttons("btnCancel").Enabled = Not bState
    grdDataGrid.Enabled = bState
End Sub


Private Sub SetTextBoxState(ByVal bState As Boolean)
    '设置TextBox是否能够输入
    Me.cbbZiHao.Enabled = bState
    Me.txbDate.Enabled = bState
    Me.txbPeople.Enabled = bState
    Me.txbSummary.Enabled = bState
    Me.cbbSubjectCode.Enabled = bState
    Me.txbDebit.Enabled = bState
    Me.txbLender.Enabled = bState
    Me.btnAdd.Enabled = bState
    Me.btnModify.Enabled = bState
    Me.btnDelete.Enabled = bState
End Sub

'实现更新操作
Private Sub SaveForUpdate()
    Dim db As New DataBases
    Dim strSQL As String
    strSQL = "delete from 分录表 where 凭证编号='" + txbCode.Text + "'"
    db.RunSelectSQL (strSQL)
    For i = 1 To fgDetail.Rows - 1
        strSQL = "insert into 分录表(摘要, 科目代码, 借方, 贷方,凭证编号) values ('"
        strSQL = strSQL + fgDetail.TextMatrix(i, 1) + "','"
        strSQL = strSQL + fgDetail.TextMatrix(i, 2) + "',"
        strSQL = strSQL + fgDetail.TextMatrix(i, 3) + ","
        strSQL = strSQL + fgDetail.TextMatrix(i, 4) + ",'"
        strSQL = strSQL + Trim(txbCode.Text) + "')"
        db.RunSelectSQL (strSQL)
    Next i
    Adodc1.Recordset.UpdateBatch
End Sub

'实现删除操作
Private Sub DeleteData()
    Dim db As New DataBases
    Dim strSQL As String
    strSQL = "delete from 分录表 where 凭证编号='" + txbCode.Text + "'"
    db.RunSelectSQL (strSQL)
    Adodc1.Recordset.Delete
    Adodc1.Recordset.UpdateBatch
End Sub

'实现新增操作
Private Sub SaveForAdd()
    Dim db As New DataBases
    Dim strSQL As String
    strSQL = "insert into 凭证表(凭证编号, 会计期间, 日期, 制单, 凭证字号, 过账状态, 借方合计, 贷方合计) values ('"
    strSQL = strSQL + Trim(txbCode.Text) + "','"
    strSQL = strSQL + Trim(txbPeriod.Text) + "','"
    strSQL = strSQL + Trim(txbDate.Text) + "','"
    strSQL = strSQL + Trim(txbPeople.Text) + "','"
    strSQL = strSQL + Trim(cbbZiHao.Text) + "','"
    strSQL = strSQL + Trim(txbState.Text) + "',"
    strSQL = strSQL + Trim(txbDebitTotal.Text) + ","
    strSQL = strSQL + Trim(txbLenderTotal.Text) + ")"
    db.RunSelectSQL (strSQL)
    strSQL = "delete from 分录表 where 凭证编号='" + txbCode.Text + "'"
    db.RunSelectSQL (strSQL)
    For i = 1 To fgDetail.Rows - 1
        strSQL = "insert into 分录表(摘要, 科目代码, 借方, 贷方,凭证编号) values ('"
        strSQL = strSQL + fgDetail.TextMatrix(i, 1) + "','"
        strSQL = strSQL + fgDetail.TextMatrix(i, 2) + "',"
        strSQL = strSQL + fgDetail.TextMatrix(i, 4) + ","
        strSQL = strSQL + fgDetail.TextMatrix(i, 5) + ",'"
        strSQL = strSQL + Trim(txbCode.Text) + "')"
        db.RunSelectSQL (strSQL)
    Next i
End Sub