frmbankaccount.frm

金算盘软件代码

    On Error GoTo ErrHandle
    AddBankAccount = 0
    If Not GetString(strBankAccount, strTemp, 1) Then GoTo ErrHandle
    lngAcnID = CDbl(strTemp)
    If Not GetString(strBankAccount, strTemp, 2) Then GoTo ErrHandle
    lngCurID = CDbl(strTemp)
    strSql = "SELECT * FROM BankInfo WHERE lngAccountID=" & lngAcnID _
        & " AND lngCurrencyID=" & lngCurID
    Set recBankInfo = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recBankInfo.EOF Then
        recBankInfo.Close
        AddBankAccount = 2
        GoTo ErrHandle
    Else
        strStartDate = recBankInfo("strStartDate")
    End If
    recBankInfo.Close
    If gclsBase.ControlAccount Then
        If Not GetString(strBankAccount, strTemp, 5) Then GoTo ErrHandle
        lngReceiptTypeID = CLng(strTemp)
        If lngReceiptTypeID < 39 Or lngReceiptTypeID > 40 Then lngReceiptTypeID = 0
        If Not GetString(strBankAccount, strReceiptNo, 6) Then GoTo ErrHandle
        If Not GetString(strBankAccount, strTemp, 7) Then GoTo ErrHandle
        lngReceiptNo = CDbl(strTemp)
        lngVoucherTypeID = 0
        intVoucherNO = 0
    Else
        If Not GetString(strBankAccount, strTemp, 3) Then GoTo ErrHandle
        lngVoucherTypeID = CDbl(strTemp)
        If lngVoucherTypeID <> 1 And lngVoucherTypeID <> 2 And lngVoucherTypeID <> 3 _
            And lngVoucherTypeID <> 4 And lngVoucherTypeID <> 14 And lngVoucherTypeID <> 16 Then
            lngVoucherTypeID = 0
        End If
        If Not GetString(strBankAccount, strTemp, 4) Then GoTo ErrHandle
        intVoucherNO = CInt(strTemp)
        lngReceiptTypeID = 0
        strReceiptNo = ""
        lngReceiptNo = 0
    End If
    If Not GetString(strBankAccount, strDate, 8) Then GoTo ErrHandle
    If Trim(strDate) = "" Or strDate >= strStartDate Then GoTo ErrHandle
    If Not GetString(strBankAccount, strRemark, 9) Then GoTo ErrHandle
    If Not GetString(strBankAccount, strTemp, 10) Then GoTo ErrHandle
    intDirection = CInt(strTemp)
    If Abs(intDirection) <> 1 Then GoTo ErrHandle
    If Not GetString(strBankAccount, strTemp, 11) Then GoTo ErrHandle
    dblAmount = CDbl(strTemp)
    If Not GetString(strBankAccount, strTemp, 12) Then GoTo ErrHandle
    lngPaymentMethodID = CLng(strTemp)
    If Not ItemIsExist("PaymentMethod", "lngPaymentMethodID", lngPaymentMethodID) Then
        lngPaymentMethodID = 0
    End If
    If Not GetString(strBankAccount, strCheckNumber, 13) Then GoTo ErrHandle
    If Not GetString(strBankAccount, strTemp, 14) Then GoTo ErrHandle
    lngOperatorID = CLng(strTemp)
    If Not ItemIsExist("Operator", "lngOperatorID", lngOperatorID) Then GoTo ErrHandle
    If Not GetString(strBankAccount, strTemp, 15) Then GoTo ErrHandle
    intIsMatch = strTemp
    strSql = "INSERT INTO BankInit(lngBankInitID,lngAccountID,lngCurrencyID,lngVoucherTypeID," _
        & "intVoucherNO,lngReceiptTypeID,strReceiptNO,lngReceiptNO,strDate,strRemark," _
        & "intDirection,dblAmount,lngPaymentMethodID,strCheckNumber,lngOperatorID," _
        & "blnIsMatch) VALUES(" & GetNewID("BankInit") & "," & lngAcnID & "," & lngCurID & "," & lngVoucherTypeID _
        & "," & intVoucherNO & "," & lngReceiptTypeID & ",'" & IIf(strReceiptNo = "", " ", strReceiptNo) & "'," _
        & lngReceiptNo & ",'" & strDate & "','" & strRemark & "'," & intDirection _
        & "," & dblAmount & "," & lngPaymentMethodID & ",'" & strCheckNumber & "'," _
        & lngOperatorID & "," & intIsMatch & ")"
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    AddBankAccount = 1
    gclsBase.BaseWorkSpace.CommitTrans
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
End Function

Public Sub ShowCard()
    If Me.WindowState = 1 Then Me.WindowState = 0
    InitGrid
    Show
    Refresh
    ZOrder 0
    mblnIsInit = False
End Sub

'检查编辑的银行帐是否合法
'Private Sub BankIsValid(Optional intMode As Integer = -1)
'    Dim blnShow As Boolean, strMess As String
'
'    If Not mblnIsInit Then mblnValueOK = False
'    If mintPRow = msgBook.Row And intMode <> vbFormControlMenu Then
'        mblnValueOK = True
'        Exit Sub
'    End If
'    blnShow = (mintPCol = msgBook.col)
'    CalDebitAndCredit mintRow
'    If msgBook.RowHeight(mintRow) > 0 Then
'        If mdblDebit <> 0 And mdblCredit <> 0 Then
'            strMess = "不能同时有借方和贷方!"
'        ElseIf mdblDebit + mdblCredit = 0 Then
'            strMess = "必须要有借方或贷方!"
'        End If
'    End If
'    If strMess <> "" Then
'        If blnShow Then ShowMsg hwnd, strMess, vbExclamation, Caption
'        msgBook.Row = mintPRow
'        msgBook.col = mintDebitCol
'        EditGrid vbKeyEnd
'        Exit Sub
'    End If
'    mblnValueOK = True
'End Sub
'
Private Sub CalDebitAndCredit(iRow As Integer)
'    GetColNO
    mdblDebit = 0
    mdblCredit = 0
    With msgBook
    mdblDebit = TxtToDouble(.TextMatrix(iRow, mintDebitCol))
    mdblCredit = TxtToDouble(.TextMatrix(iRow, mintCreditCol))
    mintDire = IIf(mdblDebit = 0, -1, 1)
    End With
End Sub

Private Sub InitHeadName()
    Dim i As Integer
    
    With mclsGrid.ListSet
    For i = 1 To mclsGrid.ListSet.Columns
        If InStr(.ColumnFieldName(i), "对帐") > 0 Then
            mstrCheckCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "日期") > 0 Then
            mstrDateCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "摘要") > 0 Then
            mstrRemarkCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "票据号") > 0 Then
            mstrBillNOCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "借方") > 0 Then
            mstrDebitCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "贷方") > 0 Then
            mstrCreditCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "单据类型") > 0 Then
            mstrTypeCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "单据号") > 0 Then
            mstrReceiptNOCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "凭证类型") > 0 Then
            mstrVoucherTypeCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "凭证号") > 0 Then
            mstrVoucherNOCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "付款方式") > 0 Then
            mstrPayMethodCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "''") > 0 Then
            mstrBalCol = .ColumnDesc(i)
        End If
    Next i
    End With
    
End Sub

Private Sub cboBook_Click(Index As Integer)
    Dim i As Integer, lngAcnID As Long, lngCurID As Long
    
'    GetColNO
    dteInput.Move -50000
    lstInput(0).Move -50000
    lstInput(1).Move -50000
    lstInput(2).Move -50000
    lngAcnID = mlngAcnID
    lngCurID = mlngCurID
    If Index = 0 Then
        If mlngAcnID = cboBook(0).ItemData(cboBook(0).ListIndex) Then Exit Sub
        mlngAcnID = cboBook(0).ItemData(cboBook(0).ListIndex)
        mlngCurID = 0
'        InitCurrencyList
    Else
        If mlngCurID = cboBook(1).ItemData(cboBook(1).ListIndex) Then Exit Sub
        mlngCurID = cboBook(1).ItemData(cboBook(1).ListIndex)
        With mrecBankAccount
        .Requery
        Do Until !lngCurrencyID = mlngCurID
            .MoveNext
        Loop
        mstrStartDate = !strStartDate
        mstrEndDate = !strEndDate
        If mstrEndDate < mstrStartDate Then mstrEndDate = mstrStartDate
        End With
    End If
    MsgForm.PleaseWait
    If mblnIsChanged Then
'        msgBook.TextMatrix(msgBook.Row, mintDateCol) = dteInput.Text
'        BankIsValid
'        If Not mblnValueOK Then
'            cboBook(0).Text = mstrAcnName
'            cboBook(1).Text = mstrCurName
'            Exit Sub
'        End If
        If Not SaveData(lngAcnID, lngCurID) Then
            ShowMsg hwnd, "保存数据失败,本次银行帐期初编辑无效!", vbExclamation, Caption
            Unload MsgForm
            Exit Sub
        End If
    End If
    mstrAcnName = cboBook(0).Text
    mstrCurName = cboBook(1).Text
    InitCurrencyList
    With frmCollate.msgCollate
    For i = 1 To .Rows - 1
        If .TextMatrix(i, 0) = mlngAcnID And .TextMatrix(i, 1) = mlngCurID Then
            gstrEndDate = .TextMatrix(i, 5)
        End If
    Next i
    End With
    InitGrid
    Form_Resize
    Unload MsgForm
End Sub

Private Function CellAllowEdit() As Boolean

'    GetColNO
    With msgBook
'    If (.col <> mintCheckCol And .col <> mintDateCol And .col <= .Cols - 1 And _
        IIf(.col = mintCreditCol, .TextMatrix(.Row, mintDebitCol) <= "1", _
        IIf(.col = mintDebitCol, .TextMatrix(.Row, mintCreditCol) <= "1", True))) And _
        .TextMatrix(.Row, mintDateCol) < mstrStartDate Then
    If .col <> mintCheckCol And .col <> mintDateCol And .col <= .Cols - 1 And _
        .TextMatrix(.Row, mintDateCol) < mstrStartDate And .col <> mintBalCol _
        And .TextMatrix(.Row, 2) <> "-9" And .col <> mintVoucherTypeCol Then
        CellAllowEdit = True
    Else
        CellAllowEdit = False
    End If
    End With
End Function

Private Sub cboBook_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If Index < 2 Then Exit Sub
    Select Case KeyCode
    Case vbKeyUp
'        If msgBook.Row > 1 Then
'            msgBook.Row = msgBook.Row - 1
'        End If
'        msgBook.SetFocus
    Case vbKeyDown
    Case vbKeyReturn ', vbKeyRight
        If msgBook.col < msgBook.Cols - 1 Then
            msgBook.col = msgBook.col + 1
            If msgBook.col <> mintTypeCol And msgBook.col <> mintVoucherTypeCol _
                And msgBook.col <> mintPayMethodCol And msgBook.col <> mintDateCol Then
                msgBook.SetFocus
            End If
        End If
    Case vbKeyLeft
'        If msgBook.col > 2 Then msgBook.col = msgBook.col - 1
    Case vbKeyRight
'        If cboBook(Index).SelLength = Len(cboBook(Index).Text) Then
'            msgBook.SetFocus
'            BKKEY msgBook.hwnd, vbKeyRight
'        End If
    End Select
End Sub

Private Sub cboBook_LostFocus(Index As Integer)
    If Index >= 2 Then cboBook(Index).Left = -50000
End Sub

'Private Sub chkAll_Click()
'    Dim i As Integer
'
'    GetColNO
'    With msgBook
'    If chkAll.Value Then
'        For i = 1 To .Rows - 1
'            If .TextMatrix(i, 1) <> "-5" And .RowHeight(i) = 0 Then _
'                .RowHeight(i) = .RowHeight(0)
'        Next i
'        .ColWidth(mintCheckCol) = 450
'    Else
'        For i = 1 To .Rows - 1
'            If .TextMatrix(i, mintCheckCol) = "√" Then .RowHeight(i) = 0
'        Next i
'        .ColWidth(mintCheckCol) = 0
'    End If
'    End With
'    dteInput.Move -50000
'    cboBook(2).Move -50000
'    Form_Resize
'End Sub
'
Private Sub cmdBook_Click(Index As Integer)
    dteInput.Move -50000
    lstInput(0).Move -50000
    lstInput(1).Move -50000
    lstInput(2).Move -50000
    If Index = 0 Then
        MakeListEditMenu
        SetMenu
        PopupMenu frmMain.mnuListEdit, , cmdBook(0).Left, cmdBook(0).top + cmdBook(0).Height
    Else
        MakeListReportMenu
        PopupMenu frmMain.mnuListReport, , cmdBook(1).Left, cmdBook(1).top + cmdBook(1).Height
    End If
End Sub

Private Sub EditGrid(ByVal KeyCode As Integer)
    On Error Resume Next
'    GetColNO
    With msgBook
    If .RowHeight(.Row) = 0 Or .col = 0 Then Exit Sub
    If .col = mintDebitCol Or .col = mintCreditCol Then
        txtCal.Move .Left + .CellLeft, .top + .CellTop, .CellWidth, .CellHeight
        mintDCBCol = .col
        mdblAmount = TxtToDouble(.TextMatrix(.Row, .col))
        If Chr(KeyCode) >= "0" And Chr(KeyCode) <= "9" Or Chr(KeyCode) = "-" Then
            txtCal.Text = Chr(KeyCode)
        Else
            txtCal.Text = .Text ' & Chr(KeyCode)
        End If
        txtCal.Visible = True
        txtCal.SetFocus
        txtCal.SelStart = Len(txtCal.Text)
    Else
        txtInput.Move .Left + .CellLeft, .top + .CellTop, .CellWidth, .CellHeight
        If KeyCode = 8 Then
            txtInput.Text = Mid(.Text, 1, Len(.Text) - 1)
        Else
            txtInput.Text = .Text & Chr(KeyCode)
        End If
        txtInput.Visible = True
        txtInput.SetFocus
        txtInput.SelStart = Len(txtInput.Text)
    End If
    mintPCol = .col
    mintPRow = .Row
    mblnIsChanged = True
'    .TextMatrix(.Row, 1) = -1  '修改
'    .TextMatrix(.Row, mintCheckCol) = ""
    End With
End Sub

Private Sub dteInput_Change()
'    GetColNO
    If mintPRow <> 0 Then msgBook.TextMatrix(mintPRow, mintDateCol) = dteInput.Text
    msgBook.TextMatrix(mintPRow, mintResortCol) = dteInput.Text & Mid(msgBook.TextMatrix(mintPRow, mintResortCol), 11)
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub dteInput_Error(bCancel As Integer)
    mblnDateOK = False
    dteInput.Text = mstrDate
End Sub

Private Sub dteInput_GotFocus()
    mstrDate = dteInput.Text
End Sub

Private Sub dteInput_KeyUp(KeyCode As Integer, Shift As Integer, bCancel As Long)
    Dim i As Integer
    Static blnIsLeft As Boolean
    
'    GetColNO
    Select Case KeyCode
    Case vbKeyReturn
        If mintDateCol < msgBook.Cols - 1 Then
            msgBook.col = mintDateCol + 1
            If msgBook.col <> mintTypeCol And msgBook.col <> mintVoucherTypeCol _
                And msgBook.col <> mintPayMethodCol Then
                msgBook.SetFocus
            Else
                dteInput_LostFocus
                Paste