frmbankaccount.frm

金算盘软件代码

                If mlngAcnID = !lngAccountID Then mstrAcnName = Trim$(!strAccountCode) _
                    & String(4, " ") & Trim$(!strAccountName)
                cboBook(0).ItemData(cboBook(0).NewIndex) = !lngAccountID
                lngAcnID = !lngAccountID
            End If
            .MoveNext
        Loop
    End With
    cboBook(0).Text = mstrAcnName
End Sub

Private Sub InitCurrencyList()

    cboBook(1).Clear
    With mrecBankAccount
    .Requery
    Do Until !lngAccountID = mlngAcnID
        .MoveNext
    Loop
    Do Until .EOF
        If mlngCurID = 0 Then mlngCurID = !lngCurrencyID
        If !lngAccountID <> mlngAcnID Then Exit Do
        cboBook(1).AddItem Trim$(!strCurrencyCode) & String(2, " ") _
            & Trim$(!strCurrencyName)
        cboBook(1).ItemData(cboBook(1).NewIndex) = !lngCurrencyID
        If mlngCurID = !lngCurrencyID Then
            mstrCurName = Trim(!strCurrencyCode) & String(2, " ") _
                & Trim(!strCurrencyName)
            mstrStartDate = !strStartDate
            mstrEndDate = !strEndDate
            mbytDec = !bytCurrencydec
            If mstrEndDate < mstrStartDate Then mstrEndDate = mstrStartDate
        End If
        .MoveNext
    Loop
    End With
    cboBook(1).Text = mstrCurName
End Sub

Private Sub InitReceiptList(Optional blnIsRefresh As Boolean = False)

    If Not blnIsRefresh Then
        lstInput(0).ClearRefer
        lstInput(0).AddRefer "40" & Chr(9) & "收款单"
        lstInput(0).AddRefer "39" & Chr(9) & "付款单"
        lstInput(0).AddRefer "" & Chr(9) & ""
        lstInput(0).ColWidth(2) = 0
        lstInput(0).SeekCol = "1,3"
    End If
    setlistbox lstInput(2), 13
End Sub

Private Sub InitGrid(Optional ByVal strSql As String = "")
    Dim i As Integer, strSql0 As String
    
    mdblBankBalance = BankBalance(mlngAcnID, mlngCurID, Format(CDate(mstrStartDate) - 1, "yyyy-mm-dd"))
    msgBook.Cols = 0
    With mclsGrid.ListSet
        If gclsBase.ControlAccount Then
            strSql0 = "SELECT BankQuery0.ID,BankQuery0.blnIsMatch,BankQuery0.lngReceiptTypeID," _
                & "BankQuery0.lngPaymentMethodID,BankQuery0.OrderNO,"
        Else
            strSql0 = "SELECT BankQueryf0.ID,BankQueryf0.blnIsMatch,BankQueryf0.lngReceiptTypeID," _
                & "BankQueryf0.lngPaymentMethodID,BankQueryf0.lngVoucherTypeID," _
                & "BankQueryf0.OrderNO,"
        End If
        strSql0 = strSql0 & .GetSelect & .FromOfSql
        strSql0 = strSql0 & " WHERE lngAccountID=" & mlngAcnID & " AND lngCurrencyID=" _
            & mlngCurID & " AND ""日期""<='" & mstrEndDate & "'"
        If Trim(.WhereOfSql) <> "" Then
            strSql0 = strSql0 & " AND " & Trim(.WhereOfSql)
        End If
        If Trim$(strSql) <> "" Then strSql0 = strSql0 & " AND " & strSql
    End With
    strSql0 = Replace(strSql0, "BYTDEC", mbytDec)
    Set Data1.Resultset = gclsBase.BaseDB.OpenResultset(strSql0, rdOpenStatic)
    If Not Data1.Resultset.EOF Then
        mintRow = 1
        msgBook.Row = 1
        Data1.Resultset.MoveLast
        GetColNO
        If msgBook.Cols > mintTypeCol And mintTypeCol > 0 Then
            lstInput(0).Text = msgBook.TextMatrix(1, mintTypeCol)
        End If
        If msgBook.Cols > mintVoucherTypeCol And mintVoucherTypeCol > 0 Then
            lstInput(2).Text = msgBook.TextMatrix(1, mintVoucherTypeCol)
        End If
        msgBook.col = mintDebitCol
    Else
        mintRow = 0
'        mclsMainControl_ListEditMenu 0
        GetColNO
    End If
    mintPRow = mintRow
    For i = 0 To msgBook.Cols - 1
        msgBook.FixedAlignment(i) = flexAlignCenterCenter
    Next
    msgBook.Rows = msgBook.Rows + 1
    msgBook.TextMatrix(msgBook.Rows - 1, 0) = 0
    msgBook.TextMatrix(msgBook.Rows - 1, mintDateCol) = Format(CDate(mstrStartDate) - 1, "yyyy-mm-dd")
    If mintRemarkCol > 0 Then
        msgBook.TextMatrix(msgBook.Rows - 1, mintRemarkCol) = "期初余额"
    End If
    msgBook.TextMatrix(msgBook.Rows - 1, 2) = "-9"
    msgBook.TextMatrix(msgBook.Rows - 1, mintResortCol) = Format(CDate(mstrStartDate) - 1, "yyyy-mm-dd") & "A"
    msgBook.TextMatrix(msgBook.Rows - 1, mintBalCol) = FormatShow(mdblBankBalance, mbytDec)
    msgBook.ColAlignment(mintBalCol) = flexAlignRightCenter
    ReSort
    ShowBankBalance
'    msgBook.RowHeight(0) = 300
'    For i = 1 To msgBook.Rows - 1
'        msgBook.RowHeight(i) = 300
'        msgBook.RowData(i) = GetTypeID(msgBook.TextMatrix(i, mintTypeCol))
'        If TxtToDouble(msgBook.TextMatrix(i, mintDebitCol)) = 0 Then
'            msgBook.TextMatrix(i, mintDebitCol) = ""
'        Else
'            msgBook.TextMatrix(i, mintDebitCol) = FormatShow(msgBook.TextMatrix(i, mintDebitCol), mbytDec)
'        End If
'        If TxtToDouble(msgBook.TextMatrix(i, mintCreditCol)) = 0 Then
'            msgBook.TextMatrix(i, mintCreditCol) = ""
'        Else
'            msgBook.TextMatrix(i, mintCreditCol) = FormatShow(msgBook.TextMatrix(i, mintCreditCol), mbytDec)
'        End If
'    Next i
'    mintCol = 2
    If gclsBase.ControlAccount Then
        mclsGrid.ColOfs = 5
    Else
        mclsGrid.ColOfs = 6
    End If
    mclsGrid.ListSetToGrid
    mclsGrid.SetupStyle
    msgBook.ColWidth(1) = 0
    msgBook.ColWidth(2) = 0
    msgBook.ColWidth(3) = 0
    msgBook.ColWidth(4) = 0
    If Not gclsBase.ControlAccount Then
        msgBook.ColWidth(5) = 0
        msgBook.FixedCols = 7
    Else
        msgBook.FixedCols = 6
    End If
    Data1.Resultset.Close
End Sub

Private Sub ShowBankBalance()
    Dim l As Long, dblBankBalance As Double
    
    dblBankBalance = mdblBankBalance
    With msgBook
        For l = 1 To .Rows - 1
            If .TextMatrix(l, mintDateCol) >= mstrStartDate Then
                dblBankBalance = dblBankBalance + TxtToDouble(.TextMatrix(l, mintDebitCol)) - TxtToDouble(.TextMatrix(l, mintCreditCol))
                .TextMatrix(l, mintBalCol) = FormatShow(dblBankBalance, mbytDec)
            End If
        Next l
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    frmCollate.IsShowCard(1) = False
    Set mclsGrid = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    frmCollate.AccountID = mlngAcnID
    frmCollate.CurrencyID = mlngCurID
    frmCollate.ReActive = True
End Sub

Private Sub lstInput_AddNew(Index As Integer)
    Dim lngID As Long
    
    Select Case Index
    Case 1
        lngID = frmPaymentMethodCard.AddCard(, vbModal)
        If lngID <> 0 Then
            msgBook.TextMatrix(mintRow, Index + 2) = lngID
            msgBook.TextMatrix(msgBook.Row, mintCheckCol) = ""
        End If
        setlistbox lstInput(1), 33, lngID
    Case 2
        lngID = frmEntryTypeCard.AddCard(, vbModal)
        If lngID <> 0 Then msgBook.TextMatrix(mintRow, Index + 2) = lngID
        setlistbox lstInput(2), 13, lngID
    End Select
    lstInput(Index).SetFocus
    mblnIsChanged = True
End Sub

Private Sub lstInput_Choose(Index As Integer)
    
    If mintRow = 0 Then Exit Sub
    Select Case Index
    Case 0
        msgBook.TextMatrix(mintRow, mintTypeCol) = lstInput(0).Text
        msgBook.TextMatrix(mintRow, 2) = TxtToDouble(lstInput(0).TextMatrix(lstInput(0).ReferRow, 2))
    Case 1
        If msgBook.TextMatrix(mintRow, mintPayMethodCol) <> lstInput(1).Text Then
            msgBook.TextMatrix(mintRow, mintPayMethodCol) = lstInput(1).Text
            msgBook.TextMatrix(msgBook.Row, mintCheckCol) = ""
            msgBook.TextMatrix(mintRow, Index + 2) = TxtToDouble(lstInput(Index).TextMatrix(lstInput(Index).ReferRow, 1))
        End If
    Case 2
        msgBook.TextMatrix(mintRow, mintVoucherTypeCol) = lstInput(2).Text
        msgBook.TextMatrix(mintRow, Index + 2) = TxtToDouble(lstInput(Index).TextMatrix(lstInput(Index).ReferRow, 1))
    End Select
    msgBook.TextMatrix(mintRow, 1) = "-1"
    mblnIsChanged = True
End Sub

Private Sub lstInput_Delete(Index As Integer)

    Select Case Index
    Case 1
        If frmPaymentMethodCard.DelCard(msgBook.TextMatrix(mintRow, Index + 2), Me.hwnd) Then
            msgBook.TextMatrix(mintRow, Index + 2) = 0
            msgBook.TextMatrix(mintRow, mintPayMethodCol) = ""
            msgBook.TextMatrix(msgBook.Row, mintCheckCol) = ""
        End If
        setlistbox lstInput(Index), 33, msgBook.TextMatrix(mintRow, Index + 2)
    Case 2
        If frmEntryTypeCard.DelCard(TxtToDouble(msgBook.TextMatrix(mintRow, Index + 2)), Me.hwnd) Then
            msgBook.TextMatrix(mintRow, Index + 2) = 0
            msgBook.TextMatrix(mintRow, mintVoucherTypeCol) = ""
        End If
        setlistbox lstInput(Index), 13, TxtToDouble(msgBook.TextMatrix(mintRow, Index + 2))
    End Select
    msgBook.TextMatrix(mintRow, 1) = "-1"
    mblnIsChanged = True
End Sub

Private Sub lstInput_Edit(Index As Integer)
    
    Select Case Index
    Case 1
        If TxtToDouble(msgBook.TextMatrix(mintRow, Index + 2)) = 0 Then
            ShowMsg hwnd, "请先选择付款方式再进行修改！", vbExclamation, Caption
            Exit Sub
        End If
        frmPaymentMethodCard.EditCard msgBook.TextMatrix(mintRow, Index + 2), vbModal
        setlistbox lstInput(1), 33, msgBook.TextMatrix(mintRow, Index + 2)
    Case 2
        If TxtToDouble(msgBook.TextMatrix(mintRow, Index + 2)) = 0 Then
            ShowMsg hwnd, "请先选择凭证类别再进行修改！", vbExclamation, Caption
            Exit Sub
        End If
        frmEntryTypeCard.EditCard msgBook.TextMatrix(mintRow, Index + 2), vbModal
        setlistbox lstInput(2), 13, msgBook.TextMatrix(mintRow, Index + 2)
    End Select
    lstInput(Index).SetFocus
    msgBook.TextMatrix(mintRow, 1) = "-1"
    mblnIsChanged = True
End Sub

Private Sub lstInput_ItemNotExist(Index As Integer)
    Dim lngID As Long
    
    If Trim(lstInput(Index).Text) = "" Then Exit Sub
    Select Case Index
    Case 0
    Case 1
        If frmMsgAdd.MsgAddShow(Caption, "付款方式中没有" & lstInput(Index).Text) = vbOK Then
            lngID = frmPaymentMethodCard.AddCard(lstInput(Index).Text, vbModal)
            If lngID <> 0 Then
                msgBook.TextMatrix(mintRow, Index + 2) = lngID
                msgBook.TextMatrix(msgBook.Row, mintCheckCol) = ""
            End If
            setlistbox lstInput(1), 33, lngID
        Else
            msgBook.TextMatrix(mintRow, Index + 2) = 0
            msgBook.TextMatrix(mintRow, mintPayMethodCol) = ""
        End If
    Case 2
        If frmMsgAdd.MsgAddShow(Caption, "凭证类别中没有" & lstInput(Index).Text) = vbOK Then
            lngID = frmEntryTypeCard.AddCard(lstInput(Index).Text, vbModal)
            If lngID <> 0 Then msgBook.TextMatrix(mintRow, Index + 2) = lngID
            setlistbox lstInput(2), 13, lngID
        Else
            msgBook.TextMatrix(mintRow, Index + 2) = 0
            msgBook.TextMatrix(mintRow, mintVoucherTypeCol) = ""
        End If
    End Select
    msgBook.TextMatrix(mintRow, 1) = "-1"
    mblnIsChanged = True
End Sub

Private Sub lstInput_LostFocus(Index As Integer)
    If Me.ActiveControl.Name <> "lstInput" Then
        lstInput(Index).Move -50000
    End If
End Sub

Private Sub lstInput_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    Dim i As Integer, iCol As Integer
    Static blnIsLeft As Boolean
    
    Select Case Index
    Case 0: iCol = mintTypeCol
    Case 1: iCol = mintPayMethodCol
    Case 2: iCol = mintVoucherTypeCol
    End Select
'    GetColNO
    Select Case KeyCode
    Case vbKeyReturn
        If iCol < msgBook.Cols - 1 Then
            msgBook.col = iCol + 1
            If msgBook.col <> mintTypeCol And msgBook.col <> mintVoucherTypeCol _
                And msgBook.col <> mintPayMethodCol And msgBook.col <> mintDateCol Then
                msgBook.SetFocus
            Else
                lstInput_LostFocus Index
                Paste
            End If
        Else
            msgBook.col = 2
            AddBook
        End If
    Case vbKeyUp
'        For i = msgBook.Row - 1 To 1 Step -1
'            If msgBook.RowHeight(i) > 0 Then Exit For
'        Next i
''        msgBook.SetFocus
'        If i > 0 Then msgBook.Row = i
    Case vbKeyDown
'        For i = msgBook.Row + 1 To msgBook.Rows - 1
'            If msgBook.RowHeight(i) > 0 Then Exit For
'        Next i
'        If i < msgBook.Rows Then
''            msgBook.SetFocus
'            msgBook.Row = i
'        End If
    Case vbKeyLeft
        If lstInput(Index).SelStart = 0 Then
            If Not blnIsLeft Then
                blnIsLeft = True
            Else
                msgBook.SetFocus
                BKKEY msgBook.hwnd, vbKeyLeft
                blnIsLeft = False
            End If
        End If
    Case vbKeyRight
        If lstInput(Index).SelStart = Len(lstInput(Index).Text) Then
            msgBook.SetFocus
            BKKEY msgBook.hwnd, vbKeyRight
        End If
    End Select
End Sub

Private Sub mclsGrid_AfterColChange(lngSourCol As Long, lngDestCol As Long)
'    Dim i As Integer, iDateLeft As Integer, iTypeLeft As Integer
'
'    GetColNO
'    For i = 1 To msgBook.Cols - 1
'        If i < mintDateCol Then iDateLeft = iDateLeft + msgBook.ColWidth(i)
'        If i < mintTypeCol Then iTypeLeft = iTypeLeft + msgBook.ColWidth(i)
'    Next i
'    If msgBook.col = mintDateCol Then
'        dteInput.Left = msgBook.Left + iDateLeft
'    ElseIf msgBook.col = mintTypeCol Then
'        cboBook(2).Left = msgBook.Left + iTypeLeft
'    Else
    dteInput.Left = -50000
    dteInput_LostFocus
    lstInput(0).Left = -50000
    lstInput(1).Left = -50000
    lstInput(2).Left = -50000
    txtInput.Visible = False