card.bas

金算盘软件代码

Attribute VB_Name = "Card"
Option Explicit
Option Compare Text

Public gstrEndDate As String
Public gblnByDay As Boolean
Public gIsfrmExist As Boolean
Public gintMatchModel As Integer
Private Type dftKey
    strName As String
    lngID As Long
End Type
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const WM_KEYDOWN = &H100
Public Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long

Public Sub BankBillMissSum(ByVal lngAcnID As Long, ByVal lngCurID As Long, _
    ByVal strStartDate As String, ByVal strEndDate As String, ByRef dblBankDebitSum As Double, _
    ByRef dblBankCreditSum As Double, ByRef lngBankDebitCount As Long, ByRef lngBankCreditCount _
    As Long, ByRef dblBillDebitSum As Double, ByRef dblBillCreditSum As Double, ByRef lngBillDebitCount _
    As Long, ByRef lngBillCreditCount As Long)
    Dim recX As rdoResultset, strSql As String
    
    If gclsBase.ControlAccount Then
        strSql = "SELECT DECODE(DECODE(DECODE(Activity.lngActivityTypeID,40,1,-1)" _
            & "+DECODE(ActivityDetail.blnIsReceipt,1,1,-1),2,1,-1)" _
            & "+DECODE(DECODE(Activity.lngActivityTypeID,39,1,-1)" _
            & "+DECODE(ActivityDetail.blnIsReceipt,0,1,-1),2,1,-1),1,1,-1)" _
            & " intDirection,ActivityDetail.dblCurrAmount dblAmount " _
            & "FROM Activity, ActivityDetail Where " _
            & "Activity.lngActivityID = ActivityDetail.lngActivityID " _
            & "AND (Activity.lngActivityTypeID=39 OR Activity.lngActivityTypeID=40) " _
            & "AND Activity.blnIsVoid=0 AND ActivityDetail.blnIsClosed=0 " _
            & "AND ActivityDetail.lngAccountID=" & lngAcnID & " AND ActivityDetail.lngCurrencyID=" _
            & lngCurID & " AND Activity.strDate>='" & strStartDate & "' AND Activity.strDate<='" _
            & strEndDate & "' AND ActivityDetail.blnIsClosed=0"
    Else
        strSql = "SELECT DECODE(DECODE(DECODE(Activity.lngActivityTypeID,40,1,-1)" _
            & "+DECODE(ActivityDetail.blnIsReceipt,1,1,-1),2,1,-1)" _
            & "+DECODE(DECODE(Activity.lngActivityTypeID,39,1,-1)" _
            & "+DECODE(ActivityDetail.blnIsReceipt,0,1,-1),2,1,-1),1,1,-1)" _
            & " intDirection,ActivityDetail.dblCurrAmount dblAmount " _
            & "FROM Activity, ActivityDetail Where " _
            & "Activity.lngActivityID = ActivityDetail.lngActivityID " _
            & "AND (Activity.lngActivityTypeID=39 OR Activity.lngActivityTypeID=40) " _
            & "AND Activity.blnIsVoid=0 AND ActivityDetail.blnIsClosed=0 " _
            & "AND ActivityDetail.lngAccountID=" & lngAcnID & " AND ActivityDetail.lngCurrencyID=" _
            & lngCurID & " AND Activity.strDate>='" & strStartDate & "' AND Activity.strDate<='" _
            & strEndDate & "' UNION ALL SELECT VoucherDetail.intDirection," _
            & "VoucherDetail.dblCurrencyAmount dblAmount " _
            & " FROM Voucher, VoucherDetail Where Voucher.lngVoucherID = VoucherDetail.lngVoucherID " _
            & "AND Voucher.lngVoucherSourceID IN (1,2,3,4,14,16) " _
            & "AND Voucher.blnIsVoid=0 AND VoucherDetail.lngAccountID=" & lngAcnID _
            & " AND VoucherDetail.lngCurrencyID=" & lngCurID & " AND Voucher.strDate>='" _
            & strStartDate & "' AND Voucher.strDate<='" & strEndDate & "' AND VoucherDetail.blnIsClosed=0"
    End If
    strSql = strSql & " UNION ALL SELECT intDirection,dblAmount " _
        & "FROM BankInit Where lngAccountID =" & lngAcnID & " And lngCurrencyID =" & lngCurID _
        & " AND strDate<>' ' AND strDate<='" & strEndDate & "' AND blnIsMatch=0"
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    While Not recX.EOF
        If recX("intDirection") = 1 Then
            dblBankDebitSum = dblBankDebitSum + recX("dblAmount")
            lngBankDebitCount = lngBankDebitCount + 1
        Else
            dblBankCreditSum = dblBankCreditSum + recX("dblAmount")
            lngBankCreditCount = lngBankCreditCount + 1
        End If
        recX.MoveNext
    Wend
    recX.Close
    
    strSql = "SELECT intDirection,dblAmount FROM Bankdetail WHERE lngAccountID=" & lngAcnID _
        & " AND lngCurrencyID=" & lngCurID & " AND intDirection<>9 AND " _
        & "strDate<='" & strEndDate & "' AND blnIsMatch=0"
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    While Not recX.EOF
        If recX("intDirection") = 1 Then
            dblBillDebitSum = dblBillDebitSum + recX("dblAmount")
            lngBillDebitCount = lngBillDebitCount + 1
        Else
            dblBillCreditSum = dblBillCreditSum + recX("dblAmount")
            lngBillCreditCount = lngBillCreditCount + 1
        End If
        recX.MoveNext
    Wend
    recX.Close
End Sub

Public Function BankBalance(ByVal lngAcnID As Long, ByVal lngCurID As Long, ByVal strEndDate As String) As Double
    Dim qryBankBalance As rdoQuery, recX As rdoResultset
    Dim dblDaily As Double
    Dim strSql As String
    
    strSql = "SELECT SUM(dblCurrencyUnVoucherDebit-dblCurrencyUnVoucherCredit) as dblDaily" _
        & " FROM AccountDaily Where lngAccountID =" & lngAcnID & " And lngCurrencyID =" _
        & lngCurID & " AND strDate <='" & strEndDate & "'"
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If Not recX.EOF Then
        dblDaily = Format(recX!dblDaily, "@;0")
    End If
    recX.Close
    
    BankBalance = dblDaily
End Function

Public Sub BankMiss(ByVal lngAcnID As Long, ByVal lngCurID As Long, ByVal strStartDate As String, ByVal strEndDate As String, ByRef dblDebit As Double, ByRef dblCredit As Double)
'    Dim qryBankMIss As rdoQuery, strSql As String
'
'    strSql = "{CALL BankMiss(?,?,?,?,?,?)}"
'    Set qryBankMIss = gclsBase.BaseDB.CreateQuery("", strSql)
'    qryBankMIss.rdoParameters("lngAcnID") = lngAcnID
'    qryBankMIss.rdoParameters("lngCurID") = lngCurID
'    qryBankMIss.rdoParameters("strStartDate") = strStartDate
'    qryBankMIss.rdoParameters("strEndDate") = strEndDate
'    qryBankMIss.Execute
'    dblDebit = Format(qryBankMIss.rdoParameters("Debit").Value, "@;0;")
'    dblCredit = Format(qryBankMIss.rdoParameters("Credit").Value, "@;0;")
'    qryBankMIss.Close
    Dim recX As rdoResultset, strSql As String
    
    strSql = "SELECT DECODE(DECODE(DECODE(Activity.lngActivityTypeID,40,1,-1)" _
        & "+DECODE(ActivityDetail.blnIsReceipt,1,1,-1),2,1,-1)" _
        & "+DECODE(DECODE(Activity.lngActivityTypeID,39,1,-1)" _
        & "+DECODE(ActivityDetail.blnIsReceipt,0,1,-1),2,1,-1),1,1,-1)" _
        & " intDirection,ACTIVITY.STRDATE,ActivityDetail.dblCurrAmount dblAmount " _
        & "FROM Activity, ActivityDetail " _
        & "Where ActivityDetail.blnIsClosed = 0 AND (Activity.lngActivityTypeID=39 " _
        & "OR Activity.lngActivityTypeID=40) AND Activity.blnIsVoid=0 " _
        & " AND ACTIVITYDETAIL.LNGACCOUNTID=" & lngAcnID & " AND ACTIVITYDETAIL.LNGCURRENCYID=" _
        & lngCurID & " AND ACTIVITY.STRDATE>='" & strStartDate & "' AND ACTIVITY.STRDATE<='" _
        & strEndDate & "'"
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    While Not recX.EOF
        If recX("intDirection") = 1 Then
            dblDebit = dblDebit + recX("dblAmount")
        Else
            dblCredit = dblCredit + recX("dblAmount")
        End If
        recX.MoveNext
    Wend
    recX.Close
    
    strSql = "SELECT SUM(DECODE(intDirection,1,dblAmount,0)) DEBIT2, " _
        & "Sum (DECODE(intDirection, -1, dblAmount, 0)) CREDIT2 " _
        & "FROM BankInit Where lngAccountID =" & lngAcnID _
        & " AND lngCurrencyID=" & lngCurID & "AND blnIsMatch =0"
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    dblDebit = dblDebit + Format(recX("DEBIT2"), "@;0;")
    dblCredit = dblCredit + Format(recX("CREDIT2"), "@;0;")
    recX.Close
End Sub

Public Function BankQuery(ByVal lngAcnID As Long, lngCurID As Long, _
    ByVal strEndDate As String, Optional ByVal blnIsAll As Boolean = False) As rdoResultset
    Dim strSql As String
    
    strSql = "SELECT lngActivityDetailID ID," _
        & "DECODE(DECODE(DECODE(Activity.lngActivityTypeID,40,1,-1)" _
        & "+DECODE(ActivityDetail.blnIsReceipt,1,1,-1),2,1,-1)" _
        & "+DECODE(DECODE(Activity.lngActivityTypeID,39,1,-1)" _
        & "+DECODE(ActivityDetail.blnIsReceipt,0,1,-1),2,1,-1),1,1,-1) " _
        & "intDirection,ActivityDetail.blnIsClosed blnIsMatch," _
        & "Activity.strDate,Activity.lngReceiptTypeID," _
        & "Activity.strReceiptNo || TO_CHAR(Activity.lngReceiptNO,'9999') strReceiptNO," _
        & "ActivityDetail.strRemark,Activity.strCheckNumber," _
        & "ActivityDetail.dblCurrAmount dblAmount FROM Activity, ActivityDetail " _
        & "Where Activity.lngActivityID = ActivityDetail.lngActivityID " _
        & "AND (Activity.lngActivityTypeID=39 OR Activity.lngActivityTypeID=40) " _
        & "AND ActivityDetail.lngAccountID=" & lngAcnID _
        & " AND ActivityDetail.lngCurrencyID=" & lngCurID _
        & " AND Activity.strDate>=(SELECT strStartDate FROM BankInfo " _
        & "WHERE lngAccountID=" & lngAcnID & " AND lngCurrencyID=" & lngCurID _
        & ") AND Activity.strDate<='" & strEndDate & "'" _
        & " AND Activity.blnIsVoid=0"
    If Not blnIsAll Then strSql = strSql & " AND ActivityDetail.blnIsClosed=0"
    strSql = strSql & " UNION ALL SELECT lngBankInitID ID,intDirection," _
        & "blnIsMatch,strDate,lngReceiptTypeID," _
        & "BankInit.strReceiptNo || DECODE(lngReceiptNO,0,'',lngReceiptNO) strReceiptNO," _
        & "strRemark , strCheckNumber, dblAmount FROM BankInit " _
        & "Where lngAccountID =" & lngAcnID & " And lngCurrencyID =" & lngCurID _
        & " AND strDate<>' ' AND strDate<='" & strEndDate & "'"
    If Not blnIsAll Then strSql = strSql & " AND blnIsMatch=0"
    If Not gclsBase.ControlAccount Then
        strSql = strSql & " UNION ALL SELECT lngVoucherDetailID ID," _
            & "VoucherDetail.intDirection intDirection," _
            & "VoucherDetail.blnIsClosed blnIsMatch," _
            & "Voucher.strDate,0,''," _
            & "VoucherDetail.strRemark,VoucherDetail.strCheckNumber," _
            & "VoucherDetail.dblCurrencyAmount dblAmount FROM Voucher, VoucherDetail " _
            & "Where Voucher.lngVoucherID = VoucherDetail.lngVoucherID " _
            & "AND Voucher.lngVoucherSourceID IN (1,2,3,4,14,16) " _
            & "AND VoucherDetail.lngAccountID=" & lngAcnID _
            & " AND VoucherDetail.lngCurrencyID=" & lngCurID _
            & " AND Voucher.strDate>=(SELECT strStartDate FROM BankInfo " _
            & "WHERE lngAccountID=" & lngAcnID & " AND lngCurrencyID=" & lngCurID _
            & ") AND Voucher.strDate<='" & strEndDate & "'" _
            & " AND Voucher.blnIsVoid=0"
        If Not blnIsAll Then strSql = strSql & " AND VoucherDetail.blnIsClosed=0"
    End If
    strSql = strSql & " ORDER BY strDate,ID"
    Set BankQuery = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
End Function

Public Sub BillMiss(ByVal lngAcnID As Long, ByVal lngCurID As Long, ByRef dblDebit As Double, ByRef dblCredit As Double)
    'Dim qryBillMiss As rdoQuery, strSql As String
    Dim recX As rdoResultset, strSql As String
    
    strSql = "SELECT SUM(DECODE(intDirection,1,dblAmount,0)) Debit," _
        & "SUM(DECODE(intDirection, -1, dblAmount, 0)) Credit " _
        & "FROM BankDetail Where lngAccountID =" & lngAcnID _
        & " And lngCurrencyID =" & lngCurID & " AND blnIsMatch=0"
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    dblDebit = recX("Debit")
    dblCredit = recX("Credit")
    recX.Close
'    strSql = "{CALL BillMiss(?,?,?,?)}"
'    Set qryBillMiss = gclsBase.BaseDB.CreateQuery("", strSql)
'    qryBillMiss.rdoParameters(0) = lngAcnID
'    qryBillMiss.rdoParameters(1) = lngCurID
'    qryBillMiss.Execute
'    dblDebit = qryBillMiss.rdoParameters(2).Value
'    dblCredit = qryBillMiss.rdoParameters(3).Value
'    qryBillMiss.Close
End Sub

Public Function ItemIsExist(ByVal strTable As String, ByVal strField As String, ByVal lngID As Long) As Boolean
    Dim recX As rdoResultset, strSql As String
    
    strSql = "SELECT * FROM " & strTable & " WHERE " & strField & "=" & lngID
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    ItemIsExist = Not recX.EOF
    recX.Close
End Function

Public Function UsedInAccountDaily(ByVal strField As String, ByVal lngID As Long) As Boolean
    Dim strBDate As String, strSDate As String
    Dim recX As rdoResultset, strSql As String, fieX As rdoColumn
    
    UsedInAccountDaily = False
    
'    strSql = "SELECT * FROM AccountYear WHERE strStartDate<='" _
'        & Format(gclsBase.BaseDate, "yyyy-mm-dd") & "' AND strEndDate>='" _
'        & Format(gclsBase.BaseDate, "yyyy-mm-dd") & "'"
'    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    strSDate = recX("strStartDate")
'
'    strBDate = Format(gclsBase.BeginDate, "yyyy-mm-dd")
'    If strSDate = strBDate Then Exit Function
    
'    strSql = "SELECT * FROM AccountDaily WHERE ABS(dblUnVoucherDebit)" _
'        & "+ABS(dblUnPostedDebit)+ABS(dblPostedDebit)+ABS(dblUnVoucherCredit)" _
'        & "+ABS(dblUnPostedCredit)+ABS(dblPostedCredit)+ABS(dblCurrencyUnVoucherDebit)" _
'        & "+ABS(dblCurrencyUnPostedDebit)+ABS(dblCurrencyPostedDebit)" _
'        & "+ABS(dblCurrencyUnVoucherCredit)+ABS(dblCurrencyUnPostedCredit)" _
'        & "+ABS(dblCurrencyPostedCredit)+ABS(dblQuantityUnVoucherDebit)" _
'        & "+ABS(dblQuantityUnPostedDebit)+ABS(dblQuantityPostedDebit)" _
'        & "+ABS(dblQuantityUnVoucherCredit)+ABS(dblQuantityUnPostedCredit)" _
'        & "+ABS(dblQuantityPostedCredit)>0 AND " & strField & "=" & lngID _
'        & " AND strDate='" & Format(CDate(strSDate), "yyyy-mm-dd") & "'"
    strSql = "SELECT * FROM AccountDaily WHERE " & strField & "=" & lngID
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recX.EOF Then
        For Each fieX In recX.rdoColumns
            If Left(fieX.Name, 3) = "dbl" Then
                If fieX.Value <> 0 Then
                    recX.Close
                    UsedInAccountDaily = True
                    Exit Function
                End If
            End If
        Next fieX
'        recX.Close
'        Exit Function
    End If
    recX.Close
    
'    UsedInAccountDaily = True
End Function