frmbank.frm

金算盘软件代码

        dteEnd.SetFocus
        Exit Sub
    End If
    gstrEndDate = dteEnd.Text
    strSql = "SELECT * FROM BankDetail WHERE lngAccountID=" & mlngAcnID _
        & " AND lngCurrencyID=" & mlngCurID & " AND strDate<='" _
        & gstrEndDate & "' ORDER BY strDate,lngBankDetailID"
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recX.EOF Then
        recX.MoveLast
        dblBalance = recX!dblBalance
    End If
    recX.Close
    
    strSql = "UPDATE BankInfo SET strEndDate='" & gstrEndDate _
        & "',dblEndBalance=" & dblBalance & " WHERE lngAccountID=" _
        & mlngAcnID & " AND  lngCurrencyID=" & mlngCurID
    gclsBase.ExecSQL strSql

    With frmCollate.msgCollate
        For i = 1 To .Rows - 1
            If .TextMatrix(i, 0) = mlngAcnID And .TextMatrix(i, 1) = mlngCurID Then
                .TextMatrix(i, 5) = gstrEndDate
            End If
        Next i
    End With
    If mblnIsChanged Then
        If Not SaveData Then
            ShowMsg hwnd, "保存数据失败,本次对帐无效!", vbExclamation, "银行对帐"
        End If
    End If
    Me.Caption = "银行对帐" & "   对帐截止日期: " & gstrEndDate
    InitCurrencyList
    cmdRefer.Value = False
    InitBillGrid
    InitBankGrid
'    RefreshGrid msgBill
'    RefreshGrid msgBank
    RefreshTitle
    CheckBalance
    chkAll_Click
End Sub

Private Sub Form_Activate()
    InitBillGrid
    InitBankGrid
'    RefreshGrid msgBill
'    RefreshGrid msgBank
'    Me.Caption = "银行对帐" & "   对帐截止日期: " & gstrEndDate
'    RefreshTitle
    CheckBalance
'    SetColWidth
'    'mintRow = 0
'    SendKeys "%{A}"
    SetHelpID Me.HelpContextID
End Sub

Private Sub InitAccountList()
    Dim lngAcnID As Long, strAcnName As String, strSql As String
    
    cboBank(0).Clear
    strSql = "SELECT * FROM BANKACCOUNTVIEW ORDER BY lngAccountID,lngCurrencyID"
    Set mrecBankAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    Set mrecBankAccount = gclsBase.BaseDB.QueryDefs("BankAccountQuery1"). _
        OpenResultset(rdOpenStatic)
    With mrecBankAccount
        If Not .EOF Then
            lngAcnID = !lngAccountID
            cboBank(0).AddItem Trim$(!strAccountCode) & String(4, " ") _
                & Trim$(!strAccountName)
            If mlngAcnID = !lngAccountID Then strAcnName = Trim$(!strAccountCode) _
                & String(4, " ") & Trim$(!strAccountName)
            cboBank(0).ItemData(cboBank(0).NewIndex) = !lngAccountID
            .MoveNext
        End If
        Do Until .EOF
            If lngAcnID <> !lngAccountID Then
                cboBank(0).AddItem Trim$(!strAccountCode) & String(4, " ") _
                    & Trim$(!strAccountName)
                If mlngAcnID = !lngAccountID Then strAcnName = Trim$(!strAccountCode) _
                    & String(4, " ") & Trim$(!strAccountName)
                cboBank(0).ItemData(cboBank(0).NewIndex) = !lngAccountID
                lngAcnID = !lngAccountID
            End If
            .MoveNext
        Loop
    End With
    cboBank(0).Text = strAcnName
End Sub

Private Sub InitCurrencyList()
    Dim strCurName As String
    
    cboBank(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
        cboBank(1).AddItem Trim$(!strCurrencyCode) & String(4, " ") _
            & Trim$(!strCurrencyName)
        cboBank(1).ItemData(cboBank(1).NewIndex) = !lngCurrencyID
        If mlngCurID = !lngCurrencyID Then
            strCurName = Trim(!strCurrencyCode) & String(4, " ") & Trim(!strCurrencyName)
            mbytCurDec = !bytCurrencydec
        End If
        .MoveNext
    Loop
    End With
    cboBank(1).Text = strCurName
End Sub

'检查对帐单和银行帐对应的数据是否匹配,0--匹配,1--继续,-1--下一个
Private Function Match(BillRow As Integer, BankRow As Integer, Optional IsCollate As Boolean = True) As Integer
    Dim BillDate As Date, BankDate As Date
    
    Match = -1
    If BillRow = 0 Or BankRow = 0 Then Exit Function
    If IsCollate Then
        If msgBill.TextMatrix(BillRow, 1) = "√" Then
            Exit Function
        ElseIf msgBank.TextMatrix(BankRow, 1) = "√" Then
            Match = 1
            Exit Function
        End If
    End If
    BillDate = CDate(msgBill.TextMatrix(BillRow, 2))
    BankDate = CDate(msgBank.TextMatrix(BankRow, 2))
    If TxtToDouble(msgBill.TextMatrix(BillRow, 6)) < TxtToDouble(msgBank.TextMatrix(BankRow, mintBankCreditCol)) Or _
        TxtToDouble(msgBill.TextMatrix(BillRow, 7)) < TxtToDouble(msgBank.TextMatrix(BankRow, mintBankDebitCol)) Then
        Exit Function
    ElseIf TxtToDouble(msgBill.TextMatrix(BillRow, 6)) > TxtToDouble(msgBank.TextMatrix(BankRow, mintBankCreditCol)) Or _
        TxtToDouble(msgBill.TextMatrix(BillRow, 7)) > TxtToDouble(msgBank.TextMatrix(BankRow, mintBankDebitCol)) Then
        Match = 1
        Exit Function
    End If
    If gblnByDay Then
        If Abs(BankDate - BillDate) > gintDiff Then
            Exit Function
        End If
    End If
    Select Case gintMatchModel
    Case 2
        If Trim(msgBill.TextMatrix(BillRow, 5)) <> Trim(msgBank.TextMatrix(BankRow, 8)) Then
            Match = 3
            Exit Function
        End If
    Case 3
        If Trim(msgBill.TextMatrix(BillRow, 4)) <> Trim(msgBank.TextMatrix(BankRow, 7)) Then
            Match = 3
            Exit Function
        End If
    Case 4
        If Trim(msgBill.TextMatrix(BillRow, 5)) <> Trim(msgBank.TextMatrix(BankRow, 8)) Or _
            Trim(msgBill.TextMatrix(BillRow, 4)) <> Trim(msgBank.TextMatrix(BankRow, 7)) Then
            Match = 3
            Exit Function
        End If
    End Select
    Match = 0
End Function

Private Sub SetColWidth()
    Dim i As Integer, strColWidth As String
    
    On Error Resume Next
    strColWidth = GetSetting(App.title, "Bill", "ColWidth")
    If strColWidth <> "" Then
        For i = 1 To msgBill.Cols - 1
            msgBill.ColWidth(i) = StringOut(strColWidth, ",")
        Next i
    Else
        msgBill.ColWidth(2) = 1035
        msgBill.ColWidth(3) = 1335
        msgBill.ColWidth(4) = 1035
        msgBill.ColWidth(5) = 1035
        msgBill.ColWidth(6) = 1035
        msgBill.ColWidth(7) = 1035
    End If
    msgBill.ColWidth(msgBill.Cols - 1) = 0
    If gclsBase.ControlAccount Then
        strColWidth = GetSetting(App.title, "Book", "ColWidth")
    Else
        strColWidth = GetSetting(App.title, "Bookf", "ColWidth")
    End If
    If strColWidth <> "" Then
        For i = 1 To msgBank.Cols - 1
            msgBank.ColWidth(i) = StringOut(strColWidth, ",")
        Next i
    Else
        msgBank.ColWidth(2) = 1035
        msgBank.ColWidth(3) = 1035
        msgBank.ColWidth(4) = 1035
        msgBank.ColWidth(5) = 1035
        msgBank.ColWidth(6) = 1035
        msgBank.ColWidth(7) = 1035
        msgBank.ColWidth(8) = 1035
        msgBank.ColWidth(9) = 1035
        msgBank.ColWidth(10) = 1035
    End If
    msgBank.ColWidth(msgBank.Cols - 1) = 0
End Sub

Private Sub SaveColWidth()
    Dim i As Integer, strColWidth As String
    
    strColWidth = msgBill.ColWidth(1)
    For i = 2 To msgBill.Cols - 1
        strColWidth = strColWidth & "," & msgBill.ColWidth(i)
    Next i
    SaveSetting App.title, "Bill", "ColWidth", strColWidth
    
    strColWidth = msgBank.ColWidth(1)
    For i = 2 To msgBank.Cols - 1
        strColWidth = strColWidth & "," & msgBank.ColWidth(i)
    Next i
    If gclsBase.ControlAccount Then
        SaveSetting App.title, "Book", "ColWidth", strColWidth
    Else
        SaveSetting App.title, "Bookf", "ColWidth", strColWidth
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyEscape Then Unload Me
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
    MsgForm.PleaseWait
'    SetHelpID Me.hwnd, 60119
    Utility.LoadFormResPicture Me
    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    Set mclsBillGrid = New Grid
    Set mclsBankGrid = New Grid
    Set mclsBillGrid.Grid = msgBill
    Set mclsBankGrid.Grid = msgBank
    Set cmdOk(0).Picture = GetFormResPicture(1001, vbResBitmap)
    Set cmdOk(1).Picture = GetFormResPicture(1002, vbResBitmap)
    Set msgBank.MouseIcon = GetFormResPicture(2001, vbResCursor)
    Set msgBill.MouseIcon = GetFormResPicture(2001, vbResCursor)
    If gclsBase.ControlAccount Then
        mintBankDebitCol = 8
        mintBankCreditCol = 9
    Else
        mintBankDebitCol = 9
        mintBankCreditCol = 10
    End If
    mlngAcnID = frmCollate.AccountID
    mlngCurID = frmCollate.CurrencyID
    InitAccountList
    InitCurrencyList
    mblnIsBill = True
    mblnIsChanged = False
    mblnBankChan = False
    mblnBillChan = False
    Me.Icon = GetFormResPicture(139, vbResIcon)
'    InitBillGrid
'    InitBankGrid
'    cmdRefer.Enabled = (msgBill.Rows > 1)
    mnuRefer.Enabled = cmdRefer.Enabled
    dteEnd.Text = Trim$(gstrEndDate)
'    RefreshGrid msgBill
'    RefreshGrid msgBank
    Me.Caption = "银行对帐" & "   对帐截止日期: " & gstrEndDate
    RefreshTitle
    CheckBalance
    SetColWidth
    'mintRow = 0
    SendKeys "%{A}"
    Unload MsgForm
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
        On Error Resume Next
        Unload MsgForm
        Unload Me
    End If
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then PopupMenu mnuBank, , x, y
End Sub

Private Sub Form_Paint()
'    FrameBox hwnd, 6300, 2070, 9000, 2070
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode <> vbFormControlMenu Then Exit Sub
    If mblnIsChanged Then
        If ShowMsg(hwnd, "要保存本次对帐的结果吗?", vbQuestion + vbYesNo, "银行对帐") = vbYes Then
            If Not SaveData Then
                ShowMsg hwnd, "保存数据失败,本次对帐无效!", vbExclamation, "银行对帐"
                Exit Sub
            End If
        End If
    End If
End Sub

Private Sub Form_Resize()
'    Frame1.Left = Me.ScaleWidth - 50 - Frame1.Width
'    msgBill.Left = Me.ScaleLeft + 50
'    msgBill.Width = Me.ScaleWidth - 50 - Frame1.Left
'    msgBill.ColWidth(1) = IIf(chkAll.Value, 450, 0)
'    msgBill.ColWidth(2) = (msgBill.Width - msgBill.ColWidth(1)) / 5
'    msgBill.ColWidth(3) = (msgBill.Width - msgBill.ColWidth(1)) / 5
'    msgBill.ColWidth(4) = (msgBill.Width - msgBill.ColWidth(1)) / 5
'    msgBill.ColWidth(5) = (msgBill.Width - msgBill.ColWidth(1)) / 5
'    msgBill.ColWidth(6) = (msgBill.Width - msgBill.ColWidth(1)) / 5
'    msgBill.Height = (Me.ScaleHeight - msgBill.Top - 750) / 2
'    Frame1.Height = msgBill.Height + lblBank(2).Height
'    Frame1.Top = lblBank(2).Top
'    lblBank(3).Top = msgBill.Top + msgBill.Height + 75
'    msgBank.Top = lblBank(3).Top + lblBank(3).Height + 75
'    msgBank.Left = msgBill.Left
'    msgBank.Width = Me.ScaleWidth - 50
'    msgBank.ColWidth(1) = IIf(chkAll.Value, 450, 0)
'    msgBank.ColWidth(2) = (msgBill.Width - msgBill.ColWidth(1)) / 7
'    msgBank.ColWidth(3) = (msgBill.Width - msgBill.ColWidth(1)) / 7
'    msgBank.ColWidth(4) = (msgBill.Width - msgBill.ColWidth(1)) / 7
'    msgBank.ColWidth(5) = (msgBill.Width - msgBill.ColWidth(1)) / 7
'    msgBank.ColWidth(6) = (msgBill.Width - msgBill.ColWidth(1)) / 7
'    msgBank.ColWidth(7) = (msgBill.Width - msgBill.ColWidth(1)) / 7
'    msgBank.ColWidth(8) = (msgBill.Width - msgBill.ColWidth(1)) / 7
'    msgBank.Height = msgBill.Height
'    cboBank(1).Left = msgBank.Left + msgBank.Width - cboBank(1).Width
'    lblBank(1).Left = cboBank(1).Left - lblBank(1).Width - 60
'    chkAll.Left = msgBank.Left + msgBank.Width - chkAll.Width + 40
''    msgBill.Height = Me.ScaleHeight - msgBill.Top - 450
''    msgBank.Height = msgBill.Height
'    cmdCollate(0).Top = msgBank.Top + msgBank.Height + 75
'    cmdCollate(1).Top = cmdCollate(0).Top
'    cmdCollate(2).Top = cmdCollate(0).Top
'    cmdRefer.Top = cmdCollate(0).Top
'    chkAll.Top = cmdCollate(0).Top
End Sub

Private Sub InitBankGrid(Optional ByVal strWhere As String = "", Optional strWhere1 As String = "")
    Dim recX As rdoResultset, i As Integer, strSql As String
    Dim strSql1 As String, strsql2 As String, strSqlX As String
    
    msgBank.Cols = 0
    
    If gclsBase.ControlAccount Then
        strSql = "SELECT ID,DECODE(blnIsMatch,1,'√',0,'') ""对帐"", strDate ""日期"", " _
            & "ReceiptType.strReceiptTypeName ""单据类型"", strReceiptNO ""单据号"", " _
            & "strRemark ""摘要"",strPaymentMethodName ""付款方式"",strCheckNumber ""票据号""," _
            & "DECODE(intDirection,1,LTRIM(TO_CHAR(dblAmount,'999999999999999." _
            & String(mbytCurDec, "9") & "')),'') ""借方"",DECODE(intDirection,-1," _
            & "LTRIM(TO_CHAR(dblAmount,'999999999999999." & String(mbytCurDec, "9") & "')),'') ""贷方""," _
            & "blnIsMatch FROM BankQuery,ReceiptType,PaymentMethod WHERE " _
            & "BankQuery.lngReceiptTypeID=ReceiptType.lngReceiptTypeID(+) AND " _
            & "BankQuery.lngPaymentMethodID=PaymentMethod.lngPaymentMethodID(+)"
        strSql1 = "SELECT COUNT(*) AS BankDebit FROM BankQuery WHERE intDirection=1"
        strsql2 = "SELECT COUNT(*) AS BankCredit FROM BankQuery WHERE intDirection=-1"