frmdlinvoice.frm

金算盘软件代码

        & "DECODE(SIGN(" & strPayDays & "), -1, 0, Term.dblDiscountRate1)))))))))/100"
    
    strSelect = "QARAPDetail.intDirection," _
        & "QARAPDetail.lngActivityDetailID," _
        & "QARAPDetail.strARAPSource," _
        & "DECODE(NVL(QCashToARAP.dblCurrPaymentAmount,0),0,'','√') As 核销," _
        & "QCashToARAP.dblCurrPaymentAmount*" & mintDirection & " AS 原核销金额," _
        & "QCashToARAP.dblCurrDiscount*" & mintDirection & " AS 原折扣金额," _
        & "DECODE(NVL(QCashToARAP.dblPaymentQuantity,0),0,0,QCashToARAP.dblPaymentQuantity)*" & mintDirection & " As 原核销数量, " _
        & "QARAPDetail.dblQuantity*" & mintDirection & " As 原总数量," _
        & "QARAPDetail.dblCurrAmount*" & mintDirection & " As 原总金额," _
        & "QARAPDetail.dblFactor As 换算因子," _
        & "QCashToARAP.blnIsCash As 自动生成," _
        & strPayDays & " As lngPaydays," _
        & strDiscountRate & " As dblDiscountRate," _
        & strSelect
        
    If strFilter = "" Then
        strFilter = "1=1 "
    End If
    If chkSameAccount.Value = 1 Then
        strFilter = strFilter & " AND Account.lngAccountID=" & mlngAccountID
    End If
    If chkCheckNo.Value = 1 And gclsBase.ControlAccount = False And mstrActivityFrom = "记帐凭证" Then
        strFilter = strFilter & " AND strCheckNumber='" & mstrCheckNumber & "'"
    End If
    If mstrActivityFrom = "商品业务" Then
        strWhere = " Not (QARAPDetail.strARAPSource='2' AND QARAPDetail.lngActivityDetailID=" & mlngCashDetailID & ") AND ("
    ElseIf mstrActivityFrom = "记帐凭证" Then
        strWhere = " Not (QARAPDetail.strARAPSource='3' AND QARAPDetail.lngActivityDetailID=" & mlngCashDetailID & ") AND ("
    Else
        strWhere = " Not (QARAPDetail.strARAPSource='1' AND QARAPDetail.lngActivityDetailID=" & mlngCashDetailID & ") AND ("
    End If
    strWhere = strFilter & " AND " & strWhere
    strWhere = strWhere & " QARAPDetail.lngCustomerID=" & mlngCustomerID & " " _
        & "AND QARAPDetail.lngCurrencyID=" & mlngCurrencyID & " " _
        & "AND Not (QARAPDetail.dblCurrAmount=QARAPDetail.dblCurrPaymentAmount " _
        & "AND DECODE(NVL(QCashToARAP.dblCurrPaymentAmount,0),0,0,QCashToARAP.dblCurrPaymentAmount)=0) " _
        & "OR DECODE(NVL(QCashToARAP.dblCurrPaymentAmount,0),0,0,QCashToARAP.dblCurrPaymentAmount)<>0)"
    strSql = "SELECT " & strSelect & " " & strFrom & " WHERE " & strWhere

    strSql = Replace(strSql, "[DIRECTION]", mintDirection)
    strSql = Replace(strSql, "[DBLDISCOUNTRATE]", strDiscountRate)
    strSql = Replace(strSql, "[QCASHTOARAP]", strCashARAP)
    Set GetList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
End Function

'初始化各金额Label框中数据
Private Sub ShowTotalRow()
    Dim intCount As Integer
    Dim dblBalance As Double
    Dim dblAmount As Double
    Dim dblBalDiscount As Double
    Dim dblDiscount As Double
    Dim lngRow As Long
    
    On Error Resume Next
    RefreshCbo
    
    dblBalance = 0
    dblAmount = 0
    dblBalDiscount = 0
    dblDiscount = 0
    mdblLastChkAmt = 0
    With msgGrid
        For lngRow = 1 To .Rows - 1
            If mintBalAmtCol > 0 And IsNumeric(.TextMatrix(lngRow, mintBalAmtCol)) Then
                dblBalance = dblBalance + CDbl(.TextMatrix(lngRow, mintBalAmtCol))
            End If
            If mintEditAmtCol > 0 And IsNumeric(.TextMatrix(lngRow, mintEditAmtCol)) Then
                mdblLastChkAmt = mdblLastChkAmt + CDbl(.TextMatrix(lngRow, mintEditAmtCol))
                dblAmount = dblAmount + CDbl(.TextMatrix(lngRow, mintEditAmtCol))
            End If
            If mintBalDiscCol > 0 And mstrActivityFrom = "现金银行" And IsNumeric(.TextMatrix(lngRow, mintBalDiscCol)) Then
                dblBalDiscount = dblBalDiscount + CDbl(.TextMatrix(lngRow, mintBalDiscCol))
            End If
            If mintEditDiscCol > 0 And IsNumeric(.TextMatrix(lngRow, mintEditDiscCol)) Then
                dblDiscount = dblDiscount + CDbl(.TextMatrix(lngRow, mintEditDiscCol))
            End If
        Next lngRow
    End With
    
    hLb(mintBalAmtCol).Caption = strFormat(dblBalance, mintCurrencyDec)
    hLb(mintEditAmtCol).Caption = strFormat(dblAmount, mintCurrencyDec)
    If mintBalDiscCol Then
        hLb(mintBalDiscCol).Caption = strFormat(dblBalDiscount, mintCurrencyDec)
    End If
    If mintEditDiscCol > 0 Then
        hLb(mintEditDiscCol).Caption = strFormat(dblDiscount, mintCurrencyDec)
    End If
    If mstrActivityFrom <> "现金银行" Then
        mdblLastChkAmt = mdblLastChkAmt + dblDiscount
    End If
    If Not gclsBase.ControlAccount And gVersionType = vtAccount Then
        If mintEditDiscCol > 0 Then msgGrid.ColWidth(mintEditDiscCol) = 0
        If mintBalDiscCol > 0 Then msgGrid.ColWidth(mintBalDiscCol) = 0
    End If
    mdblDiffAmount = mdblPaymentAmount - mdblLastChkAmt
    mdblRestAmount = mdblReceiveAmount - mdblLastChkAmt - mdblDiffAmount
    lblReceiveAmount.Caption = strFormat(mdblRestAmount, mintCurrencyDec, True)
End Sub


'响应核销内容筛选操作
Private Sub FilterData()
    Dim lngRow As Long
    Dim strCustomer As String
    Dim blnOK As Boolean
    Dim intCount As Integer
    
    On Error Resume Next
    
    If mblnModify Then
        If ShowMsg(Me.hwnd, "数据已被修改，是否先保存？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "应收款核销") = IDYES Then
            If mstrActivityFrom = "现金银行" Then
                 If ltxtAccount.ID <= 0 And mintEditDiscCol > 0 Then
                    If C2Dbl(hLb(mintEditDiscCol)) <> 0 Then
                        ShowMsg hwnd, "请指定折扣科目！", vbExclamation + vbOKOnly, Caption
                        ltxtAccount.SetFocus
                        Exit Sub
                    End If
                 End If
            End If
            SaveData False
        Else
            mnuUndoCheck_Click False
        End If
    End If
    strCustomer = "单位/" & mstrCustomerName & "/" & mlngCustomerID
    If mclsGrid.ListSet.ListID < 1 Then
       mclsGrid.ListSet.SaveList
    End If
    Filter.ShowFilter mclsGrid.ListSet.ListID, 1, , , , , blnOK, strCustomer
    If blnOK Then
        mclsGrid.ListSet.SaveList
        mclsGrid.ListSet.ViewId = mlngViewID2
        msgGrid.FixedCols = 0
        msgGrid.Rows = 1
        For intCount = 1 To mclsGrid.ListSet.Columns
            If mclsGrid.ListSet.ColumnFormat(intCount) = 3 Then
                mclsGrid.ListSet.ColumnFieldDec(intCount) = mintCurrencyDec
            End If
        Next intCount
        Set datAR.Resultset = GetList()
        FindColPosition
        mclsGrid.ColOfs = lngOffsetCol
        mclsGrid.SetupStyle
        ShowTotalRow
        datAR.Resultset.Close
    End If
End Sub

'入参 ： blnQuit=False是存盘不关闭窗体，blnQuit=true是存盘关闭窗体
'功能 ： 响应存盘操作
Private Sub SaveData(blnQuit As Boolean)         '存盘
    Dim dblChkAmount As Double
    Dim dblChkDiscount As Double
    Dim dblChkQuantity As Double
    Dim dblLastQuantity As Double
    Dim dblLastAmount As Double
    Dim dblLastDiscount As Double
    Dim intFX As Integer
    Dim strSql As String
    Dim lngRow As Long
    Dim strCashSource As String
    Dim blnSucceed As Boolean
    Dim dblCashQuantity As Double
    Dim dblCashAmount As Double
    Dim dblCashDetailQuantity As Double
    Dim strARAPSource As String
    Dim lngARAPDetailID As Long
    Dim recCashToARAP As rdoResultset
    Dim strARAPDirection As String
    
    On Error GoTo Err
    If Not ExclusiveIn(Caption, mclsMainControl.LogID) Then
        Exit Sub
    End If
    
    MousePointer = vbHourglass
    
    gclsBase.BaseWorkSpace.BeginTrans
    
    dblChkAmount = C2Dbl(hLb(mintEditAmtCol).Caption) + mdblDiffAmount
    If mstrActivityFrom = "现金银行" Then
        If Not SaveDiscount() Then
            GoTo Err1
        End If
    Else
        If mintEditDiscCol > 0 Then
            dblChkAmount = dblChkAmount + C2Dbl(hLb(mintEditDiscCol).Caption)
        End If
    End If
    mdblPaymentAmount = dblChkAmount
    Select Case mstrActivityFrom
    Case "记帐凭证"
        strCashSource = "3"
    Case "商品业务"
        strCashSource = "2"
        dblCashQuantity = AdjustDec(mdblCashQuantity * dblChkAmount / mdblCashAmount, 0)
        dblCashAmount = dblChkAmount
    Case Else
        strCashSource = "1"
    End Select
    
    blnSucceed = DeleteCashToARAP(mlngCashDetailID, strCashSource, False, False)
    If Not blnSucceed Then GoTo Err
    
    For lngRow = 1 To msgGrid.Rows - 1
        '前后有否变化
        If GetValue(lngRow, mintLastChkAmtCol) <> GetValue(lngRow, mintEditAmtCol) Or GetValue(lngRow, mintLastChkDiscCol) <> GetValue(lngRow, mintEditDiscCol) Then
            dblLastQuantity = GetValue(lngRow, mintLastChkQtyCol) * GetValue(lngRow, mintARAPFlagCol) * mintDirection
            dblLastAmount = GetValue(lngRow, mintLastChkAmtCol) * GetValue(lngRow, mintARAPFlagCol) * mintDirection
            dblLastDiscount = GetValue(lngRow, mintLastChkDiscCol) * GetValue(lngRow, mintARAPFlagCol) * mintDirection
            dblChkAmount = GetValue(lngRow, mintEditAmtCol) * GetValue(lngRow, mintARAPFlagCol) * mintDirection
            dblChkDiscount = GetValue(lngRow, mintEditDiscCol) * GetValue(lngRow, mintARAPFlagCol) * mintDirection
            If mintEditQtyCol > 0 Then
                dblChkQuantity = (NormalToMinQty(GetValue(lngRow, mintEditQtyCol), GetValue(lngRow, mintFactorCol))) * GetValue(lngRow, mintARAPFlagCol) * mintDirection
            Else
                If mintBalQtyCol > 0 And dblChkAmount + dblChkDiscount = GetValue(lngRow, mintBalAmtCol) Then
                    dblChkQuantity = NormalToMinQty(GetValue(lngRow, mintBalQtyCol), GetValue(lngRow, mintFactorCol)) _
                        * GetValue(lngRow, mintARAPFlagCol) * mintDirection
                Else
                    dblChkQuantity = (CLng(GetValue(lngRow, mintTotalQtyCol) * (dblChkAmount + dblChkDiscount) / GetValue(lngRow, mintTotalAmtCol)))
                End If
            End If
            If mstrActivityFrom = "商品业务" Then
                dblCashDetailQuantity = AdjustDec(mdblCashQuantity * GetValue(lngRow, mintEditAmtCol) / mdblCashAmount, 0)
                dblCashQuantity = dblCashQuantity - dblCashDetailQuantity
                dblCashAmount = dblCashAmount - GetValue(lngRow, mintEditAmtCol)
                If dblCashAmount = 0 Then
                    dblCashDetailQuantity = dblCashDetailQuantity + dblCashQuantity
                End If
                dblCashDetailQuantity = dblCashDetailQuantity * GetValue(lngRow, mintARAPFlagCol) * mintDirection
            Else
                dblCashDetailQuantity = 0
            End If
            '新增情况
            If (dblLastQuantity = 0 And dblLastAmount = 0 And (dblChkQuantity <> 0 Or dblChkAmount <> 0 Or dblChkDiscount <> 0)) Then
                intFX = GetValue(lngRow, mintARAPFlagCol)
                strSql = "INSERT INTO CashToARAP (strCashSource,lngCashActivityDetailID,strARAPSource,lngARAPActivityDetailID,dblPaymentQuantity,dblCurrPaymentAmount,dblCurrDiscount,dblCashQuantity) " _
                    & "VALUES('" & strCashSource & "'," & mlngCashDetailID & ",'" & msgGrid.TextMatrix(lngRow, mintTableIDCol) & "'," & GetValue(lngRow, mintDetailIDCol) & "," _
                    & dblChkQuantity * intFX & "," & dblChkAmount * intFX & "," & dblChkDiscount * intFX & "," & dblCashDetailQuantity * intFX & ")"
                blnSucceed = gclsBase.ExecSQL(strSql)
                If Not blnSucceed Then GoTo Err
            Else        '更新情况
                dblChkAmount = dblChkAmount - dblLastAmount
                dblChkQuantity = dblChkQuantity - dblLastQuantity
                dblChkDiscount = dblChkDiscount - dblLastDiscount
                intFX = GetValue(lngRow, mintARAPFlagCol)
                strSql = "UPDATE CashToARAP SET dblPaymentQuantity=dblPaymentQuantity+(" & dblChkQuantity * intFX & ")," _
                    & "dblCurrPaymentAmount=dblCurrPaymentAmount+(" & dblChkAmount * intFX & "), " _
                    & "dblCurrDiscount=dblCurrDiscount+(" & dblChkDiscount * intFX & ")," _
                    & "dblCashQuantity=" & dblCashDetailQuantity * intFX & " " _
                    & "WHERE lngARAPActivityDetailID=" & GetValue(lngRow, mintDetailIDCol, "String") _
                    & " AND strARAPSource='" & msgGrid.TextMatrix(lngRow, mintTableIDCol) & "' " _
                    & " AND strCashSource='" & strCashSource & "' " _
                    & " AND lngCashActivityDetailID=" & mlngCashDetailID
                blnSucceed = gclsBase.ExecSQL(strSql)
                If Not blnSucceed Then GoTo Err
                strSql = "UPDATE CashToARAP SET dblPaymentQuantity=(" & -dblCashDetailQuantity * intFX & ")," _
                    & "dblCurrPaymentAmount=dblCurrPaymentAmount-(" & dblChkAmount * intFX & ")," _
                    & "dblCurrDiscount=dblCurrDiscount-(" & dblChkDiscount * intFX & ")," _
                    & "dblCashQuantity=dblCashQuantity-(" & dblChkQuantity * intFX & ") " _
                    & "WHERE lngCashActivityDetailID=" & GetValue(lngRow, mintDetailIDCol) _
                    & " AND strCashSource='" & msgGrid.TextMatrix(lngRow, mintTableIDCol) & "'" _
                    & " AND strARAPSource='" & strCashSource & "' " _
                    & " AND lngARAPActivityDetailID=" & mlngCashDetailID
                blnSucceed = gclsBase.ExecSQL(strSql)
                If Not blnSucceed Then GoTo Err
            End If
        End If
    Next lngRow
    
    '保存单据核销金额
    dblChkAmount = 0
    dblChkDiscount = 0
    dblCashQuantity = 0
    strSql = "SELECT * FROM CashtoARAP WHERE strCashSource='" & strCashSource & "' AND lngCashActivityDetailID=" & mlngCashDetailID _
        & " OR strARAPSource='" & strCashSource & "' AND lngARAPActivityDetailID=" & mlngCashDetailID
    Set recCashToARAP = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    Do While Not recCashToARAP.EOF
        If recCashToARAP!strCashSource = strCashSource And recCashToARAP!lngCashActivityDetailID = mlngCashDetailID Then
            dblChkAmount = dblChkAmount + recCashToARAP!dblCurrPaymentAmount
            dblChkDiscount = dblChkDiscount + recCashToARAP!dblCurrDiscount
            dblCashQuantity = dblCashQuantity + recCashToARAP!dblCashQuantity
            strARAPSource = recCashToARAP!strARAPSource
            lngARAPDetailID = recCashToARAP!lngARAPActivityDetailID
            intFX = 1
        Else
            dblChkAmount = dblChkAmount - recCashToARAP!dblCurrPaymentAmount
            dblChkDiscount = dblChkDiscount - recCashToARAP!dblCurrDiscount
            dblCashQuantity = dblCashQuantity - recCashToARAP!dblPaymentQuantity
            strARAPSource = recCashToARAP!strCashSource
            lngARAPDetailID = recCashToARAP!lngCashActivityDetailID
            intFX = -1
        End If
        
        Select Case strARAPSource
        Case "0" '期初
            If gclsBase.ControlAccount Then
                strARAPDirection = "DECODE(ARAPInit.lngReceiptTypeID,13,1,14,1,16,1,19,1,35,1,36,1,38,1,39,1,-1)"
                strSql = "UPDATE ARAPInit SET dblCurrPaymentAmount=dblCurrPaymentAmount+(" & intFX * (recCashToARAP!dblCurrPaymentAmount + recCashToARAP!dblCurrDiscount) _
                    & ")*(" & strARAPDirection & "),dblPaymentQuantity=dblPaymentQuantity+(" & intFX * IIf(intFX = 1, recCashToARAP!dblPaymentQuantity, recCashToARAP!dblCashQuantity) _
                    & ") WHERE lngARAPInitID=" & lngARAPDetailID
            Else
                strSql = "UPDATE ARAPInit1 SET dblCurrPaymentAmount=dblCurrPaymentAmount+(" & intFX * (recCashToARAP!dblCurrPaymentAmount + recCashToARAP!dblCurrDiscount) _
                    & ")*intDirection WHERE lngARAPInitID=" & lngARAPDetailID
            End If
            blnSucceed = gclsBase.ExecSQL(strSql)
            If Not blnSucceed Then GoTo Err
        Case "1" '业务
            strARAPDirection = "SELECT dblCurrPaymentAmount+(" & intFX * (recCashToARAP!dblCurrPaymentAmount + recCashToARAP!dblCurrDiscount) & ") " _
                & "*DECODE(ActivityDetail.blnIsReceipt,1," _