frmbankdetail.frm

金算盘软件代码

                & " WHERE lngAccountID=" & lngAcnID & " AND lngCurrencyID=" & lngCurID
        End If
        If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    End If
    AddBankDetail = 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
End Sub

Private Function AdaptBalance(ByVal lngAcnID As Long, ByVal lngCurID As Long, ByVal strDate As String, ByRef dblBalance As Double) As Boolean
    Dim recBankDetail As rdoResultset, strSql As String
    
    AdaptBalance = False
    strSql = "SELECT * FROM BankDetail WHERE lngAccountID=" & lngAcnID _
        & " AND lngCurrencyID=" & lngCurID & " AND intDirection<>9 " _
        & " AND strDate>='" & strDate & "' ORDER BY strDate,lngBankDetailID"
    Set recBankDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recBankDetail
        Do Until .EOF
            dblBalance = dblBalance - !intDirection * !dblAmount
            strSql = "UPDATE BankDetail Set dblBalance=" & dblBalance & " WHERE lngBankDetailID=" & !lngBankDetailID
            gclsBase.ExecSQL strSql
            .MoveNext
        Loop
        .Close
    End With
    AdaptBalance = True
End Function

Private Sub AdjustBalance(ByVal lngSRow As Long, Optional blnReStart As Boolean = False)
    Dim i As Long, j As Long ', blnBegin As Boolean
    
    If msgBill.Rows = 2 Then Exit Sub
'    GetColNO
    If blnReStart Then
        For j = 1 To msgBill.Rows - 1
            If msgBill.TextMatrix(j, 2) = "9" Then
                lngSRow = j
                Exit For
            End If
        Next
    Else
        j = lngSRow
    End If
    With msgBill
    For i = lngSRow + 1 To .Rows - 1
'        If .TextMatrix(i, 2) = "9" Then
'            blnBegin = True
'            j = i
'        End If
        If .RowHeight(i) <> 0 Then 'And blnBegin Then
            CalDebitAndCredit i
            .TextMatrix(i, mintBalCol) = FormatShow(TxtToDouble(.TextMatrix(j, _
                mintBalCol)) + mdblCredit - mdblDebit, mbytDec)
            .TextMatrix(i, 1) = "-1"
            j = i
'        Else
'            .TextMatrix(i, mintBalCol) = ""
        End If
    Next i
    End With
End Sub

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

Private Sub cboBill_Click(index As Integer)
    Dim i As Integer, lngAcnID As Long, lngCurID As Long
    
    lngAcnID = mlngAcnID
    lngCurID = mlngCurID
'    GetColNO
    dteInput.Move -50000
    If index = 0 Then
        lstInput.Move -50000
        If mlngAcnID = cboBill(0).ItemData(cboBill(0).ListIndex) Then Exit Sub
        mlngAcnID = cboBill(0).ItemData(cboBill(0).ListIndex)
        mlngCurID = 0
'        InitCurrencyList
    Else
        lstInput.Move -50000
        If mlngCurID = cboBill(1).ItemData(cboBill(1).ListIndex) Then Exit Sub
        mlngCurID = cboBill(1).ItemData(cboBill(1).ListIndex)
        With mrecBankAccount
        .Requery
        Do Until !lngCurrencyID = mlngCurID
            .MoveNext
        Loop
        mstrStartDate = !strStartDate
        End With
    End If
    If mblnIsChanged Then
        MsgForm.PleaseWait
        msgBill.TextMatrix(msgBill.Row, mintDateCol) = dteInput.Text
'        BillIsValid
'        If Not mblnValueOK Then
'            cboBill(0).Text = mstrAcnName
'            cboBill(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 = cboBill(0).Text
    mstrCurName = cboBill(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 msgBill
'    If (.Row = 1 And (.col = mintRemarkCol Or .col = mintBillNOCol Or .col = mintBalCol)) _
        Or (.Row > 1 And (.col <> 1 And .col <> mintBalCol And IIf(.col = mintDebitCol, _
        .TextMatrix(.Row, mintCreditCol) <= "1", IIf(.col = mintCreditCol, .TextMatrix(.Row, mintDebitCol) _
        <= "1", True)))) Then
    If (.TextMatrix(.Row, 2) = "9" And .col = mintBalCol) Or (.TextMatrix(.Row, 2) <> "9" _
        And (.col <> mintCheckCol And .col <> mintBalCol And .col <> mintDateCol)) Then
        CellAllowEdit = True
    Else
        CellAllowEdit = False
    End If
    End With
End Function

'Private Sub chkAll_Click()
'    Dim i As Integer
'
'    GetColNO
'    With msgBill
'    If chkAll.Value Then
'        For i = 1 To .Rows - 1
'            If .TextMatrix(i, 1) <> "-5" And .RowHeight(i) = 0 Then _
'                .RowHeight(i) = .RowHeight(0)

Private Sub cboBill_KeyUp(index As Integer, KeyCode As Integer, Shift As Integer)
    If index < 2 Then Exit Sub
    Select Case KeyCode
    Case vbKeyReturn ', vbKeyRight
        If msgBill.col < msgBill.Cols - 1 Then
            msgBill.col = msgBill.col + 1
            If msgBill.col <> mintDateCol Then msgBill.SetFocus
        End If
    Case vbKeyLeft
'        If msgbill.col > 2 Then msgbill.col = msgbill.col - 1
    End Select
End Sub

Private Sub cboBill_LostFocus(index As Integer)
    If index = 2 Then lstInput.Move -50000
End Sub

'        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
'    Form_Resize
'End Sub
'
Private Sub cmdBill_Click(index As Integer)
    dteInput.Move -50000
    lstInput.Move -50000
    If txtCal.Visible Then txtCal.Visible = False
    If index = 0 Then
        MakeListEditMenu
        SetMenu
        PopupMenu frmMain.mnuListEdit, , cmdBill(0).Left, cmdBill(0).top + cmdBill(0).Height
    Else
        MakeListReportMenu
        PopupMenu frmMain.mnuListReport, , cmdBill(1).Left, cmdBill(1).top + cmdBill(1).Height
    End If
End Sub

Private Sub EditGrid(ByVal KeyCode As Integer)
    On Error Resume Next
'    GetColNO
    With msgBill
    If .RowHeight(.Row) = 0 Or .col = 0 Then Exit Sub
    If .col = mintDebitCol Or .col = mintCreditCol Or .col = mintBalCol 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
        If .col = mintRemarkCol Then
            txtInput.MaxLength = 30
        Else
            txtInput.MaxLength = 20
            mstrBillNO = .Text
        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, 1) = ""
    End With
End Sub

Private Sub dteInput_Change()
    On Error GoTo ErrHandle
'    GetColNO
    If Not mblnIsInit Then mblnIsChanged = True
    If Not mblnIsInit Then mblnIsChanged = True
    If Trim(dteInput.Text) <> "" Then
        If Year(dteInput.Value) < 1000 Then dteInput.Text = mstrDate
        msgBill.TextMatrix(msgBill.Row, mintDateCol) = Format(CDate(dteInput.Text), "yyyy-mm-dd")
        msgBill.TextMatrix(mintRow, 4) = dteInput.Text & Mid(msgBill.TextMatrix(mintRow, 4), 11)
        If Not mblnIsInit Then msgBill.TextMatrix(mintRow, 1) = "-1"
    End If
    Exit Sub
ErrHandle:
'    dteInput.Text = mstrDate
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 < msgBill.Cols - 1 Then
            msgBill.col = mintDateCol + 1
            msgBill.SetFocus
        End If
    Case vbKeyUp
        For i = msgBill.Row - 1 To 1 Step -1
            If msgBill.RowHeight(i) > 0 Then Exit For
        Next i
        If msgBill.CellTop < msgBill.top + msgBill.RowHeight(0) Then msgBill.SetFocus
        If i > 0 Then msgBill.Row = i
        msgBill_Click
    Case vbKeyDown
        For i = msgBill.Row + 1 To msgBill.Rows - 1
            If msgBill.RowHeight(i) > 0 Then Exit For
        Next i
        If i < msgBill.Rows Then
'            msgBill.SetFocus
            msgBill.Row = i
            msgBill_Click
        End If
    Case vbKeySpace
        dteInput.DropDownPanel
    Case vbKeyLeft
        If dteInput.SelStart = 0 Then
            If Not blnIsLeft Then
                blnIsLeft = True
            Else
                msgBill.SetFocus
                BKKEY msgBill.hwnd, vbKeyLeft
                blnIsLeft = False
            End If
        End If
    Case vbKeyRight
        If dteInput.SelStart = Len(dteInput.Text) Then
            msgBill.SetFocus
            BKKEY msgBill.hwnd, vbKeyRight
        End If
    End Select
End Sub

Private Sub dteInput_LostFocus()
    Dim iLeft As Integer, i As Integer
    On Error Resume Next
'    GetColNO
    iLeft = 0
    For i = 1 To mintDateCol - 1
        iLeft = iLeft + msgBill.ColWidth(i)
    Next i
'    If mblnIsScroll Then