frmbankdetail.frm

金算盘软件代码

        strsql2 = ") VALUES(" & GetNewID("BankDetail") & "," & AcnID & "," & CurID & "," & .TextMatrix(iRow, 3) & ",'" _
            & .TextMatrix(iRow, mintDateCol) & "'," & mintDire & "," _
            & mdblDebit + mdblCredit & "," & TxtToDouble(.TextMatrix(iRow, mintBalCol)) & "," _
            & gclsBase.OperatorID
        If mintRemarkCol <> -1 Then
            strSql1 = strSql1 & ",strRemark"
            strsql2 = strsql2 & ",'" & IIf(.TextMatrix(iRow, mintRemarkCol) = "", " ", .TextMatrix(iRow, mintRemarkCol)) & "'"
        End If
        If mintBillNOCol <> -1 Then
            strSql1 = strSql1 & ",strCheckNumber"
            strsql2 = strsql2 & ",'" & IIf(.TextMatrix(iRow, mintBillNOCol) = "", " ", .TextMatrix(iRow, mintBillNOCol)) & "'"
        End If
        strsql2 = strsql2 & ")"
    Else
        strSql1 = "UPDATE BankDetail SET lngPaymentMethodID=" & .TextMatrix(iRow, 3) _
            & ",strDate='" & .TextMatrix(iRow, mintDateCol) & "',intDirection=" & mintDire _
            & ",dblAmount=" & mdblDebit + mdblCredit & ",dblBalance=" _
            & TxtToDouble(.TextMatrix(iRow, mintBalCol)) & ",lngOperatorID=" _
            & gclsBase.OperatorID & ",blnIsMatch=" & IIf(.TextMatrix(iRow, mintCheckCol) = "√", 1, 0)
        strsql2 = " WHERE lngBankDetailID=" & .TextMatrix(iRow, 0)
        If mintRemarkCol <> -1 Then
            strSql1 = strSql1 & ",strRemark='" & IIf(.TextMatrix(iRow, mintRemarkCol) = "", " ", .TextMatrix(iRow, mintRemarkCol)) & "'"
        End If
        If mintBillNOCol <> -1 Then
            strSql1 = strSql1 & ",strCheckNumber='" & IIf(.TextMatrix(iRow, mintBillNOCol) = "", " ", .TextMatrix(iRow, mintBillNOCol)) & "'"
        End If
    End If
    MakeSQL = strSql1 & strsql2
    End With
End Function

'保存对帐单期初数据
Private Function SaveData(Optional AcnID As Long, Optional CurID As Long) As Boolean
    Dim i As Integer, j As Integer, strSql As String
    
'    GetColNO
    On Error GoTo ErrHandle
    SaveData = False
    gclsBase.BaseWorkSpace.BeginTrans
    
    AcnID = IIf(AcnID = 0, mlngAcnID, AcnID)
    CurID = IIf(CurID = 0, mlngCurID, CurID)
    
    For i = 1 To msgBill.Rows - 1
        If msgBill.TextMatrix(i, 1) <> "-5" Then
            CalDebitAndCredit i
            If mdblDebit + mdblCredit <> 0 Then
                If msgBill.TextMatrix(i, 0) = "0" Then
                    strSql = MakeSQL(i, True, AcnID, CurID)
                Else
                    strSql = MakeSQL(i, False, AcnID, CurID)
                End If
                j = i       '取最大可见行
            ElseIf msgBill.TextMatrix(i, 0) <> "0" Then
                If msgBill.TextMatrix(i, 2) = "9" Then
                    strSql = "UPDATE BankDetail SET dblBalance=" _
                        & TxtToDouble(msgBill.TextMatrix(i, mintBalCol)) _
                        & " WHERE lngBankDetailID=" & msgBill.TextMatrix(i, 0)
                    If j < i Then j = i
                Else
                    strSql = "DELETE FROM BankDetail WHERE lngBankDetailID=" _
                        & msgBill.TextMatrix(i, 0)
                End If
            Else
                strSql = ""
            End If
        ElseIf msgBill.TextMatrix(i, 0) <> "0" Then
            strSql = "DELETE FROM BankDetail WHERE lngBankDetailID=" _
                & msgBill.TextMatrix(i, 0)
        Else
            strSql = ""
        End If
        If strSql <> "" Then
            If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
        End If
    Next i
    strSql = "UPDATE BankInfo SET strEndDate='" & msgBill.TextMatrix(j, mintDateCol) _
        & "',dblEndBalance=" & TxtToDouble(msgBill.TextMatrix(j, mintBalCol)) & " WHERE lngAccountID=" _
        & AcnID & " AND lngCurrencyID=" & CurID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    
    gclsBase.BaseWorkSpace.CommitTrans
    SaveData = True
    mblnIsChanged = False
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
End Function

Private Sub SetMenu()
'    If txtInput.Visible Or dteInput.Left > 0 Then
'        frmMain.mnuListEditMenu(0).Enabled = False
'        frmMain.mnuListEditMenu(1).Enabled = False
'        frmMain.mnuListEditMenu(3).Enabled = False
'        frmMain.mnuListEditMenu(4).Enabled = False
'    Else
        frmMain.mnuListEditMenu(0).Enabled = True
        frmMain.mnuListEditMenu(1).Enabled = True
        frmMain.mnuListEditMenu(3).Enabled = True
        frmMain.mnuListEditMenu(4).Enabled = True
'    End If
    frmMain.mnuListEditMenu(1).Enabled = (msgBill.TextMatrix(msgBill.Row, 2) <> "9")
End Sub

Private Sub msgBill_KeyPress(KeyAscii As Integer)
'
'    GetColNO
    If KeyAscii = vbKeyEscape Then Exit Sub
    With msgBill
        If CellAllowEdit Then
            If (.col = mintDebitCol Or .col = mintCreditCol Or .col = mintBalCol) And .Text = "0" Then .Text = ""
            If KeyAscii <> vbKeyReturn Then EditGrid KeyAscii
        End If
    End With
End Sub

Private Sub msgBill_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim i As Integer, iMax As Integer, iNext As Integer

'    GetColNO
    With msgBill
    iNext = 0
    For i = .Row + 1 To .Rows - 1
        If .RowHeight(i) > 0 Then
            If iNext = 0 Then iNext = i
            iMax = i
        End If
    Next i
    If iMax = 0 Then iMax = .Row
'    If iNext = 0 Then iNext = iMax
    If KeyCode = vbKeyReturn Then
        If .col < .Cols - 1 Then
            BKKEY msgBill.hwnd, vbKeyRight
'            .col = .col + 1
        ElseIf .Row = iMax Then
            mclsMainControl_ListEditMenu 0
        Else
            .Row = iNext
            .col = mintDateCol
        End If
    End If
    End With
End Sub

Private Sub msgBill_MouseUP(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer, lHeigh As Long
    
    If txtCal.Visible Then txtCal.Visible = False
    With msgBill
        For i = 0 To .Rows - 1
            lHeigh = .RowHeight(i) + lHeigh
        Next i
        If y < lHeigh And y > .RowHeight(0) Then
            mblnRowValid = .RowHeight(.Row) > 0
        Else
            mblnRowValid = False
        End If
    End With
    If Button = vbLeftButton Then Exit Sub
    MakeListEditMenu
    SetMenu
    PopupMenu frmMain.mnuListEdit
End Sub

Private Sub msgBill_Scroll()
'    mblnIsScroll = True
    dteInput.Move -50000
    lstInput.Move -50000
    If txtInput.Visible Then txtInput.Visible = False
    If txtCal.Visible Then txtCal.Visible = False
End Sub

Private Sub txtCal_KeyUp(ByVal KeyCode As Integer, ByVal Shift As Integer)
    Static blnIsLeft As Boolean
    
'    GetColNO
    Select Case KeyCode
    Case vbKeyUp
        msgBill.Text = FormatShow(txtCal.Text, mbytDec)
        If msgBill.Row > 1 Then
            txtCal_LostFocus
            msgBill.Row = msgBill.Row - 1
        End If
        msgBill.SetFocus
    Case vbKeyDown
        msgBill.Text = FormatShow(txtCal.Text, mbytDec)
        If msgBill.Row < msgBill.Rows - 1 Then
            txtCal_LostFocus
            msgBill.Row = msgBill.Row + 1
            msgBill.SetFocus
        End If
    Case vbKeyReturn
        msgBill.Text = FormatShow(txtCal.Text, mbytDec)
        msgBill.SetFocus
        BKKEY msgBill.hwnd, vbKeyRight
    Case vbKeyLeft
        If txtCal.SelStart = 0 Then
            If Not blnIsLeft Then
                blnIsLeft = True
            Else
                msgBill.Text = FormatShow(txtCal.Text, mbytDec)
                msgBill.SetFocus
                BKKEY msgBill.hwnd, vbKeyLeft
                blnIsLeft = False
            End If
        End If
    Case vbKeyRight
        If txtCal.SelLength = Len(txtCal.Text) Then
            msgBill.Text = FormatShow(txtCal.Text, mbytDec)
            msgBill.SetFocus
            BKKEY msgBill.hwnd, vbKeyRight
        End If
    End Select
End Sub

Private Sub txtCal_LostFocus()

    txtCal.Visible = False
'    GetColNO
    msgBill.TextMatrix(mintPRow, mintPCol) = FormatShow(txtCal.Text, mbytDec)
'    If mintPCol = mintDebitCol Or mintPCol = mintCreditCol Or mintPCol = mintBalCol Then
        If mdblAmount <> TxtToDouble(txtCal.Text) Then msgBill.TextMatrix(msgBill.Row, mintCheckCol) = ""  '金额改变取消对帐标志
        If mintPCol = mintDebitCol And TxtToDouble(msgBill.TextMatrix(msgBill.Row, mintDebitCol)) <> 0 Then
            msgBill.TextMatrix(msgBill.Row, mintCreditCol) = ""
        ElseIf TxtToDouble(msgBill.TextMatrix(msgBill.Row, mintCreditCol)) <> 0 Then
            msgBill.TextMatrix(msgBill.Row, mintDebitCol) = ""
        End If
        If mintRow <> msgBill.Row Then
            If TxtToDouble(txtCal.Text) <> 0 Then
                If mblnIsAdd Then
                    msgBill.TextMatrix(msgBill.Row, 4) = msgBill.TextMatrix(msgBill.Row, mintDateCol) & "B" & mlngNO
                    mlngNO = mlngNO + 1
                End If
'                ReSort
            End If
        Else
            If TxtToDouble(msgBill.TextMatrix(mintRow, mintDebitCol)) + _
                TxtToDouble(msgBill.TextMatrix(mintRow, mintCreditCol)) <> 0 _
                Or msgBill.TextMatrix(mintRow, 2) = "9" Then
                If mblnIsAdd Then
                    msgBill.TextMatrix(msgBill.Row, 4) = msgBill.TextMatrix(msgBill.Row, mintDateCol) & "B" & mlngNO
                    mlngNO = mlngNO + 1
                End If
'                ReSort
            End If
        End If
        ReSort
'    End If
End Sub

Private Sub txtInput_Change()
    On Error Resume Next
'    GetColNO
    Select Case msgBill.col
    Case mintRemarkCol, mintBillNOCol
        If ContainErrorChar(txtInput.Text, "'?/\|""*%$#@!~`") Then
            BKKEY txtInput.hwnd '控制非法字符录入
        Else
            msgBill.Text = txtInput.Text
        End If
'    Case mintDebitCol, mintCreditCol, mintBalCol
'        If Not IsNum(txtInput.Text, mbytDec) And txtInput.Text <> "" Then
'            BKKEY txtInput.hwnd
'        Else
'            msgBill.Text = FormatShow(txtInput.Text, mbytDec)
'        End If
    End Select
End Sub

Private Sub txtInput_KeyUp(KeyCode As Integer, Shift As Integer)
    Static blnIsLeft As Boolean
    
'    GetColNO
    Select Case KeyCode
    Case vbKeyUp
        If msgBill.col = mintDebitCol Or msgBill.col = mintCreditCol Or msgBill.col = mintBalCol Then
            msgBill.Text = FormatShow(txtInput.Text, mbytDec)
        Else
            msgBill.Text = txtInput.Text
        End If
        If msgBill.Row > 1 Then
            txtInput_LostFocus
            msgBill.Row = msgBill.Row - 1
        End If
        msgBill.SetFocus
    Case vbKeyDown
        If msgBill.col = mintDebitCol Or msgBill.col = mintCreditCol Or msgBill.col = mintBalCol Then
            msgBill.Text = FormatShow(txtInput.Text, mbytDec)
        Else
            msgBill.Text = txtInput.Text
        End If
        If msgBill.Row < msgBill.Rows - 1 Then
            txtInput_LostFocus
            msgBill.Row = msgBill.Row + 1
            msgBill.SetFocus
        End If
    Case vbKeyReturn
        If msgBill.col = mintDebitCol Or msgBill.col = mintCreditCol Or msgBill.col = mintBalCol Then
            msgBill.Text = FormatShow(txtInput.Text, mbytDec)
        Else
            msgBill.Text = txtInput.Text
        End If
        msgBill.SetFocus
        BKKEY msgBill.hwnd, vbKeyRight
    Case vbKeyLeft
        If txtInput.SelStart = 0 Then
            If Not blnIsLeft Then
                blnIsLeft = True
            Else
                msgBill.Text = txtInput.Text
                msgBill.SetFocus
                BKKEY msgBill.hwnd, vbKeyLeft
                blnIsLeft = False
            End If
        End If
    Case vbKeyRight
        If txtInput.SelLength = Len(txtInput.Text) Then
            msgBill.Text = txtInput.Text
            msgBill.SetFocus
            BKKEY msgBill.hwnd, vbKeyRight
        End If
    End Select
End Sub

Private Sub txtInput_LostFocus()
    Dim i As Integer
    
    txtInput.Visible = False
'    GetColNO
    With msgBill
    If mintPCol > 4 And mintPCol < msgBill.Cols - 1 And .TextMatrix(mintRow, mintPCol) = "" Then
'            .TextMatrix(mintRow, mintPCol) = "0"
    End If
    If mintPCol = mintBillNOCol And txtInput.Text <> mstrBillNO Then msgBill.TextMatrix(msgBill.Row, mintCheckCol) = ""
'    If mintPCol = mintDebitCol Or mintPCol = mintCreditCol Or mintPCol = mintBalCol Then
'        If mdblAmount <> TxtToDouble(txtInput.Text) Then msgBill.TextMatrix(msgBill.Row, 3) = ""  '金额改变取消对帐标志
'        If mintPCol = mintDebitCol And TxtToDouble(msgBill.TextMatrix(msgBill.Row, mintDebitCol)) <> 0 Then
'            msgBill.TextMatrix(msgBill.Row, mintCreditCol) = ""
'        ElseIf TxtToDouble(msgBill.TextMatrix(msgBill.Row, mintCreditCol)) <> 0 Then
'            msgBill.TextMatrix(msgBill.Row, mintDebitCol) = ""
'        End If
'        If mblnIsAdd And mintRow <> msgBill.Row Then
'            If TxtToDouble(txtInput.Text) <> 0 Then ReSort
'        Else
'            If TxtToDouble(msgBill.TextMatrix(mintRow, mintDebitCol)) + _
'                TxtToDouble(msgBill.TextMatrix(mintRow, mintCreditCol)) <> 0 _
'                Or msgBill.TextMatrix(mintRow, 2) = "9" Then ReSort
'        End If
'    End If
'    If ((.col = mintDebitCol Or .col = mintCreditCol) And (mintPCol = _
        mintDebitCol Or mintPCol = mintCreditCol)) Or mintPRow <> mintRow Then
''        If mblnIsAdd Then
'            For i = .Row - 1 To 1 Step -1
'                If .RowHeight(i) <> 0 Then Exit For
'            Next i
'            If i > 0 Then dteInput.Text = .TextMatrix(i, mintDateCol)
'            dteInput.Move -50000
'            .col = mintDateCol
'            .Sort = 5
'            .col = mintPCol
'            mblnIsAdd = False
''        End If
'        AdjustBalance
'    End If
    End With
End Sub

Private Sub ReSort()
    Dim i As Long, blnRSta