⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmbank.frm

📁 金算盘软件代码
💻 FRM
📖 第 1 页 / 共 5 页
字号:
        strSqlX = " AND BankQuery.lngAccountID=" & mlngAcnID & " AND BankQuery.lngCurrencyID=" _
            & mlngCurID & " AND BankQuery.strDate<='" & Format(gstrEndDate, "yyyy-mm-dd") & "'"
    Else
        msgBank.FormatString = "|对帐|   日期   |凭证字号 |单据类型 |  单据号 |    摘要    |    付款方式    | 票据号 |>  借方  |>  贷方  |"
        strSql = "SELECT ID,DECODE(blnIsMatch,1,'√',0,'') ""对帐"", strDate ""日期""," _
            & "VoucherType.strVoucherTypeCode || DECODE(strVoucherNO,'0','',strVoucherNO) ""凭证字号""," _
            & "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 BankQueryf,VoucherType,PaymentMethod,ReceiptType WHERE " _
            & "BankQueryf.lngVoucherTypeID=VoucherType.lngVoucherTypeID(+) AND " _
            & "BankQueryf.lngPaymentMethodId=PaymentMethod.lngPaymentMethodID(+) AND " _
            & "BankQueryf.lngReceiptTypeID=ReceiptType.lngReceiptTypeID(+)"
        strSql1 = "SELECT COUNT(*) AS BankDebit FROM BankQueryf WHERE intDirection=1"
        strsql2 = "SELECT COUNT(*) AS BankCredit FROM BankQueryf WHERE intDirection=-1"
        strSqlX = " AND BankQueryf.lngAccountID=" & mlngAcnID & " AND BankQueryf.lngCurrencyID=" _
            & mlngCurID & " AND BankQueryf.strDate<='" & Format(gstrEndDate, "yyyy-mm-dd") & "'"
    End If
    strSql = strSql & strSqlX
    strSql1 = strSql1 & strSqlX
    strsql2 = strsql2 & strSqlX
    If chkAll.Value = Unchecked Then
        strSql = strSql & " AND blnIsMatch=0"
        strSql1 = strSql1 & " AND blnIsMatch=0"
        strsql2 = strsql2 & " AND blnIsMatch=0"
    End If
    If strWhere <> "" Then
        strSql = strSql & " AND " & strWhere
        strSql1 = strSql1 & " AND " & strWhere1
        strsql2 = strsql2 & " AND " & strWhere1
    End If
    strSql = strSql & " ORDER BY intDirection,dblAmount,strDate"
    Set Data1(1).Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not Data1(1).Resultset.EOF Then
        Data1(1).Resultset.MoveLast
        Set recX = gclsBase.BaseDB.OpenResultset(strSql1, rdOpenForwardOnly)
        If Not recX.EOF Then
            mlngBankDebitCount = Format(recX!BankDebit, "@;0")
        Else
            mlngBankDebitCount = 0
        End If
        recX.Close
    
        Set recX = gclsBase.BaseDB.OpenResultset(strsql2, rdOpenForwardOnly)
        If Not recX.EOF Then
            mlngBankCreditCount = Format(recX!BankCredit, "@;0")
        Else
            mlngBankCreditCount = 0
        End If
        recX.Close
    Else
        mlngBankDebitCount = 0
        mlngBankCreditCount = 0
    End If
    For i = 1 To msgBank.Cols - 1
        msgBank.FixedAlignment(i) = flexAlignCenterCenter
'        If i > 1 Then mclsBankGrid.ColSort(i) = True
    Next i
    
'    For i = 1 To msgBank.Rows - 1
'        If TxtToDouble(msgBank.TextMatrix(i, 7)) = 0 Then
'            msgBank.TextMatrix(i, 7) = ""
'        Else
'            msgBank.TextMatrix(i, 7) = Format(msgBank.TextMatrix(i, 7), "0." & String(bytDec, "0"))
'        End If
'        If TxtToDouble(msgBank.TextMatrix(i, 8)) = 0 Then
'            msgBank.TextMatrix(i, 8) = ""
'        Else
'            msgBank.TextMatrix(i, 8) = Format(msgBank.TextMatrix(i, 8), "0." & String(bytDec, "0"))
'        End If
'    Next i
    msgBank.FixedCols = 0
    mclsBankGrid.SetupStyle
    msgBank.ColAlignment(9) = 7
    msgBank.ColAlignment(10) = 7
    msgBank.ColWidth(0) = 0
    msgBank.ColWidth(1) = 450
    msgBank.ColWidth(msgBank.Cols - 1) = 0
    Data1(1).Resultset.Close
End Sub

Private Sub InitBillGrid(Optional strWhere As String = "", Optional strWhere1 As String = "")
    Dim i As Integer, strSql As String, strSql1 As String, strsql2 As String
    Dim recX As rdoResultset
    
    msgBill.Cols = 0
    strSql = "SELECT lngBankDetailID,DECODE(blnIsMatch,1,'√',0,'') ""对帐"",strDate ""日期""," _
        & "strRemark ""摘要"",strPaymentMethodName ""付款方式"",strCheckNumber ""票据号""," _
        & "DECODE(intDirection,1,DECODE(dblAmount,0,'',LTRIM(TO_CHAR(dblAmount,'999999999999999." _
        & String(mbytCurDec, "9") & "'))),-1,'') ""借方"", DECODE(intDirection,-1," _
        & "DECODE(dblAmount,0,'',LTRIM(TO_CHAR(dblAmount,'999999999999999." _
        & String(mbytCurDec, "9") & "'))),-1,'') ""贷方"", blnIsMatch FROM BankDetail,PaymentMethod " _
        & "WHERE BankDetail.lngPaymentMethodID=PaymentMethod.lngPaymentMethodID(+) " _
        & "AND lngAccountID =" & mlngAcnID & " And lngCurrencyID =" & mlngCurID & " And " _
        & "intDirection <> 9 And strDate <='" & Format(gstrEndDate, "yyyy-mm-dd") & "'"
    strSql1 = "SELECT Count(*) AS BillDebit FROM BankDetail Where lngAccountID =" & mlngAcnID _
        & " And lngCurrencyID =" & mlngCurID & " And intDirection =1 And strDate <='" _
        & Format(gstrEndDate, "yyyy-mm-dd") & "'"
    strsql2 = "SELECT Count(*) AS BillCredit FROM BankDetail Where lngAccountID =" & mlngAcnID _
        & " And lngCurrencyID =" & mlngCurID & " And intDirection =-1 And strDate <='" _
        & Format(gstrEndDate, "yyyy-mm-dd") & "'"
    If chkAll.Value = Unchecked Then
        strSql = strSql & " And blnIsMatch=0 "
        strSql1 = strSql1 & " And blnIsMatch=0 "
        strsql2 = strsql2 & " And blnIsMatch=0 "
    End If
    If strWhere <> "" Then
        strSql = strSql & " AND " & strWhere
        strSql1 = strSql1 & " AND " & strWhere1
        strsql2 = strsql2 & " AND " & strWhere1
    End If
    strSql = strSql & " ORDER BY intDirection DESC,dblAmount,strDate"
    Set Data1(0).Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not Data1(0).Resultset.EOF Then
        Data1(0).Resultset.MoveLast
        
        Set recX = gclsBase.BaseDB.OpenResultset(strSql1, rdOpenStatic)
        If Not recX.EOF Then
            mlngBillDebitCount = Format(recX!billDebit, "@;0")
        Else
            mlngBillDebitCount = 0
        End If
        recX.Close
    
        Set recX = gclsBase.BaseDB.OpenResultset(strsql2, rdOpenStatic)
        If Not recX.EOF Then
            mlngBillCreditCount = Format(recX!billCredit, "@;0")
            mlngBillCreditCount = 0
        End If
        recX.Close
    Else
        mlngBillDebitCount = 0
        mlngBillCreditCount = 0
    End If
    Data1(0).Resultset.Close
    For i = 1 To msgBill.Cols - 1
        msgBill.FixedAlignment(i) = flexAlignCenterCenter
    Next i
    msgBill.FixedCols = 0
    mclsBillGrid.SetupStyle
    msgBill.ColAlignment(7) = 7
    msgBill.ColAlignment(6) = 7
    msgBill.ColWidth(0) = 0
    msgBill.ColWidth(1) = 450
    msgBill.ColWidth(msgBill.Cols - 1) = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    SaveColWidth
    Set mclsBillGrid = Nothing
    Set mclsBankGrid = Nothing
    Utility.RemoveFormResPicture 1001
    Utility.RemoveFormResPicture 1002
    Utility.RemoveFormResPicture 139
    Utility.RemoveFormResPicture 2001
    frmCollate.AccountID = mlngAcnID
    frmCollate.CurrencyID = mlngCurID
    frmCollate.ReActive = True
End Sub

Private Sub mclsBankGrid_AfterColResize(lngCol As Long)
    If lngCol = 1 Then msgBank.ColWidth(1) = 450
End Sub

Private Sub mclsBillGrid_AfterColResize(lngCol As Long)
    If lngCol = 1 Then msgBill.ColWidth(1) = 450
End Sub

Private Sub mclsSubClassForm_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)

        MinMax.ptMinTrackSize.x = 550
        MinMax.ptMinTrackSize.y = 420

        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
    End If
End Sub

Private Sub mnuAuto_Click()
    cmdCollate(0).Value = True
End Sub

Private Sub mnuCancel_Click()
    cmdCollate(2).Value = True
End Sub

Private Sub mnuMode_Click()
    cmdCollate(1).Value = True
End Sub

Private Sub mnuRefer_Click()
    cmdRefer.Value = Not cmdRefer.Value
    cmdRefer_Click
End Sub

Private Sub msgBank_Click()
    If msgBank.Rows = 1 Then Exit Sub
    If cmdRefer.Value Then
        If Not mblnIsBill Then
            mintRow = msgBank.Row
            cmdRefer_Click
        Else
'            SetGridRowBackColor msgBank, msgBank.Row
            mintRow = msgBill.Row
            cmdRefer_Click
        End If
    Else
'        If mblnIsBill Then SetGridRowBackColor msgBill
        mblnIsBill = False
        mintRow = msgBank.Row
    End If
End Sub

Private Sub msgBank_EnterCell()
'    If msgBank.Rows = 1 Then Exit Sub
'    If cmdRefer.Value Then
'        If Not mblnIsBill Then
'            mintRow = msgBank.Row
'            cmdRefer_Click
'        Else
''            SetGridRowBackColor msgBank, msgBank.Row
'            mintRow = msgBill.Row
'            cmdRefer_Click
'        End If
'    Else
''        If mblnIsBill Then SetGridRowBackColor msgBill
'        mblnIsBill = False
'        mintRow = msgBank.Row
'    End If
End Sub

Private Sub msgBank_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer, lHeigh As Long
    With msgBank
    For i = 0 To .Rows - 1
        lHeigh = lHeigh + .RowHeight(i)
    Next i
    If .MouseCol = 1 And y > .RowHeight(0) And y < lHeigh Then
        .MousePointer = flexCustom
    Else
        .MousePointer = flexDefault
    End If
    End With
End Sub

Private Sub msgBank_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer, lHeigh As Long, strcollate As String
    
    If Button = vbRightButton Then
        PopupMenu mnuBank  ', , x, y
    Else
        For i = 0 To msgBank.Rows - 1
            lHeigh = lHeigh + msgBank.RowHeight(i)
        Next i
        If y > lHeigh Or y <= msgBank.RowHeight(0) Then
            If cmdRefer.Value Then cmdRefer.Value = False
            'mintRow = 0
            cmdRefer.Enabled = False
            mnuRefer.Enabled = False
            Exit Sub
        End If
        cmdRefer.Enabled = True
        mnuRefer.Enabled = True
        If msgBank.MousePointer <> vbDefault Then
            strcollate = Trim$(msgBank.TextMatrix(msgBank.Row, 1))
            If strcollate = "√" Then
                msgBank.TextMatrix(msgBank.Row, 1) = ""
            Else
                msgBank.TextMatrix(msgBank.Row, 1) = "√"
'                If chkAll.Value = Unchecked Then msgBank.RowHeight(msgBank.Row) = 0
            End If
            mblnIsChanged = True
            mblnBankChan = True
'            cmdCollate(2).Enabled = True
            CheckBalance
        End If
    '    RefreshTitle
    '    msgBank.SetFocus
    End If
End Sub

Private Sub msgBill_Click()
    If msgBill.Rows = 1 Then Exit Sub
    If cmdRefer.Value Then
        If mblnIsBill Then
            mintRow = msgBill.Row
            cmdRefer_Click
        Else
'            SetGridRowBackColor msgBill, msgBill.Row
        End If
    Else
'        If Not mblnIsBill Then SetGridRowBackColor msgBank
        mblnIsBill = True
        mintRow = msgBill.Row
    End If
End Sub

Private Sub msgBill_EnterCell()
'    If msgBill.Rows = 1 Then Exit Sub
'    If cmdRefer.Value Then
'        If mblnIsBill Then
'            mintRow = msgBill.Row
'            cmdRefer_Click
'        Else
''            SetGridRowBackColor msgBill, msgBill.Row
'        End If
'    Else
''        If Not mblnIsBill Then SetGridRowBackColor msgBank
'        mblnIsBill = True
'        mintRow = msgBill.Row
'    End If
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, strcollate As String
    
'    msgBank_MouseUp 1, 0, 50, 50
    If Button = vbRightButton Then
        PopupMenu mnuBank  ', , x, y
    Else
        For i = 0 To msgBill.Rows - 1
            lHeigh = lHeigh + msgBill.RowHeight(i)
        Next i
        If y <= msgBill.RowHeight(0) Or y > lHeigh Then
            If cmdRefer.Value Then cmdRefer.Value = False
            'mintRow = 0
            cmdRefer.Enabled = False
            mnuRefer.Enabled = False
            Exit Sub
        End If
        cmdRefer.Enabled = True
        mnuRefer.Enabled = True
        If msgBill.MousePointer <> vbDefault Then
            strcollate = Trim$(msgBill.TextMatrix(msgBill.Row, 1))
            If strcollate = "√" Then
                msgBill.TextMatrix(msgBill.Row, 1) = ""
            Else
                msgBill.TextMatrix(msgBill.Row, 1) = "√"
'                If chkAll.Value = Unchecked Then msgBill.RowHeight(msgBill.Row) = 0
            End If
            mblnIsChanged = True
            mblnBillChan = True
'            cmdCollate(2).Enabled = True
            CheckBalance
        End If
    '    RefreshTitle
    '    msgBill.SetFocus
    End If
End Sub

Private Sub msgBill_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer, lHeigh As Long
    With msgBill
    For i = 0 To .Rows - 1
        lHeigh = lHeigh + .RowHeight(i)
    Next i
    

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -