frmdlinvoice.frm

金算盘软件代码

        msgGrid.ColWidth(intCount) = 0
    Next intCount
    msgGrid.ColWidth(mintCheckCol) = 480
    mclsGrid.ColOfs = lngOffsetCol
    mclsGrid.ShowTotal = True
    Set mclsGrid.Form = Me
    mclsGrid.ListSetToGrid
    mclsGrid.SetupStyle
    ShowTotalRow
    datAR.Resultset.Close
    cboCustomer.Text = mstrCustomerName
    cboCurrency.Text = mstrCurrencyName
    Set mclsGrid.EditText = txtEdit
    mclsGrid.SetEditText ("本次核销")
    If mlngVoucherID = 0 Then
        mclsGrid.SetEditText ("本次折扣")
    End If
    mclsGrid.SetEditText ("核销数量")
End Sub

Private Sub Form_Load()
    Height = 420 * 15
    Me.HelpContextID = IIf(mblnIsAR, 60120, 60121)
    mdblLastChkAmt = 0
    mblnFormNoRezise = False
    Set mclsGrid = New Grid
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    
    If GetSet(1, "应收应付核销", "相同科目", "1") = "1" Then
        chkSameAccount.Value = 1
    Else
        chkSameAccount.Value = 0
    End If
    If GetSet(1, "应收应付核销", "相同对帐号", "1") = "1" Then
        chkCheckNo.Value = 1
    Else
        chkCheckNo.Value = 0
    End If
End Sub

'功能 ： 响应退出窗体事件
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next

    If mblnModify Then
        If ShowMsg(Me.hwnd, "数据未保存，是否退出应收款核销?", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "应收款核销") = IDNO Then
            Cancel = True
            Exit Sub
        End If
    End If
    Set mclsGrid = Nothing
    gclsSys.MainControls.Remove Me
    Utility.UnLoadFormResPicture Me
    Set mclsMainControl = Nothing
    Set frmdlInvoice = Nothing
End Sub


Private Sub hLb_Change(Index As Integer)
    On Error Resume Next
    Select Case Index
    Case mintEditAmtCol
        If C2Dbl(hLb(mintEditAmtCol).Caption) <> 0 Then
'''            cmdall(5).Enabled = True
        Else
'            cmdall(5).Enabled = False
            If mintEditDiscCol > 0 Then
                If C2Dbl(hLb(mintEditDiscCol).Caption) <> 0 Then
''                    cmdall(5).Enabled = True
                End If
            End If
        End If
    Case mintEditDiscCol
        If C2Dbl(hLb(mintEditDiscCol).Caption) <> 0 Then
            ltxtAccount.Enabled = True
            ltxtTemplate.Enabled = True
        Else
            ltxtAccount.Enabled = False
            ltxtTemplate.Enabled = False
        End If
        If C2Dbl(hLb(mintEditDiscCol).Caption) <> 0 Or C2Dbl(hLb(mintEditAmtCol).Caption) <> 0 Then
''            cmdall(5).Enabled = True
        Else
'            cmdall(5).Enabled = False
        End If
    End Select
End Sub

Private Sub mclsGrid_AfterColChange(lngSourCol As Long, lngDestCol As Long)
    FindColPosition
End Sub

Private Sub mclsGrid_AfterRefresh(lngRow As Long)
    With msgGrid
        If mintBalQtyCol > 0 Then
            .TextMatrix(lngRow, mintBalQtyCol) = MinToNormalQty(GetValue(lngRow, mintBalQtyCol), GetValue(lngRow, mintFactorCol))
        End If
        If mintEditQtyCol > 0 Then
            .TextMatrix(lngRow, mintEditQtyCol) = MinToNormalQty(GetValue(lngRow, mintEditQtyCol), GetValue(lngRow, mintFactorCol))
        End If
        If mintBalAmtCol > 0 Then
            .TextMatrix(lngRow, mintBalAmtCol) = strFormat(GetValue(lngRow, mintBalAmtCol), mintCurrencyDec)
        End If
        If mintEditAmtCol > 0 Then
           .TextMatrix(lngRow, mintEditAmtCol) = strFormat(GetValue(lngRow, mintEditAmtCol), mintCurrencyDec)
        End If
        If mintBalDiscCol > 0 Then
            If mstrActivityFrom = "现金银行" And GetValue(lngRow, mintBalAmtCol) >= 0 Then
                .TextMatrix(lngRow, mintBalDiscCol) = strFormat(GetValue(lngRow, mintBalDiscCol), mintCurrencyDec)
            Else
                .TextMatrix(lngRow, mintBalDiscCol) = strFormat(0, mintCurrencyDec)
            End If
        End If
        If mintEditDiscCol > 0 Then
           .TextMatrix(lngRow, mintEditDiscCol) = strFormat(GetValue(lngRow, mintEditDiscCol), mintCurrencyDec)
        End If
    End With
End Sub

Private Function CanNotModify(lngRow As Long) As Boolean
    Dim strMsg As String
    If GetValue(lngRow, mintAutoDiscCol) = 1 Then
        CanNotModify = True
        strMsg = "本笔数据是现借自动生成的，不能修改！"
    Else
        If mstrActivityFrom <> "现金银行" Then
            If GetValue(lngRow, mintEditDiscCol) <> 0 Then
                CanNotModify = True
                strMsg = "本笔数据有现金折扣，必须通过" & IIf(mblnIsAR, "收款单", "付款单") & "修改！"
            End If
        Else
            If GetValue(lngRow, mintEditDiscCol) <> 0 And mlngVoucherID > 0 Then
                CanNotModify = True
                strMsg = "本笔数据对应现金折扣单据已生成凭证，不能修改！"
            End If
        End If
    End If
    If CanNotModify Then
        ShowMsg hwnd, strMsg, vbExclamation + vbOKOnly, Caption
    End If
End Function

Private Sub mclsGrid_AfterSave()
    With msgGrid
        If mintEditAmtCol > 0 Then
           .TextMatrix(.Row, mintEditAmtCol) = strFormat(GetValue(.Row, mintEditAmtCol), mintCurrencyDec)
        End If
        If mintEditDiscCol > 0 Then
           .TextMatrix(.Row, mintEditDiscCol) = strFormat(GetValue(.Row, mintEditDiscCol), mintCurrencyDec)
        End If
    End With
End Sub

Private Sub mclsGrid_BeforeSave(blnCancel As Boolean)
    Dim lngRow As Long
    Dim dblChkQty As Double
    Dim dblChkAmt As Double
    Dim dblChkDisc As Double
    Dim dblLastChkAmt As Double
    Dim dblLastChkDisc As Double
    
    mblnModify = True
    lngRow = msgGrid.Row
    dblChkAmt = GetValue(lngRow, mintEditAmtCol)
    dblChkDisc = GetValue(lngRow, mintEditDiscCol)
    dblLastChkAmt = dblChkAmt
    dblLastChkDisc = dblChkDisc
    Select Case msgGrid.col
    Case mintEditAmtCol
        dblChkAmt = txtEdit.Value
        If mintEditQtyCol > 0 Then
            If GetValue(lngRow, mintTotalQtyCol) <> 0 Then
                If mintBalQtyCol > 0 And (txtEdit.Value + dblChkDisc) = GetValue(lngRow, mintBalAmtCol) Then
                    dblChkQty = NormalToMinQty(GetValue(lngRow, mintBalQtyCol), GetValue(lngRow, mintFactorCol))
                Else
                    dblChkQty = GetValue(lngRow, mintTotalQtyCol) * (txtEdit.Value + dblChkDisc) / GetValue(lngRow, mintTotalAmtCol)
                End If
                msgGrid.TextMatrix(lngRow, mintEditQtyCol) = MinToNormalQty(dblChkQty, GetValue(lngRow, mintFactorCol))
            End If
        End If
    Case mintEditDiscCol
        dblChkDisc = txtEdit.Value
        If mintEditQtyCol > 0 Then
            If GetValue(lngRow, mintTotalQtyCol) <> 0 Then
                If mintBalQtyCol > 0 And (txtEdit.Value + dblChkAmt) = GetValue(lngRow, mintBalAmtCol) Then
                    dblChkQty = NormalToMinQty(GetValue(lngRow, mintBalQtyCol), GetValue(lngRow, mintFactorCol))
                Else
                    dblChkQty = GetValue(lngRow, mintTotalQtyCol) * (txtEdit.Value + dblChkAmt) / GetValue(lngRow, mintTotalAmtCol)
                End If
                msgGrid.TextMatrix(lngRow, mintEditQtyCol) = MinToNormalQty(dblChkQty, GetValue(lngRow, mintFactorCol))
            End If
        End If
    Case mintEditQtyCol
        If GetValue(lngRow, mintTotalQtyCol) <> 0 Then
            dblChkQty = NormalToMinQty(txtEdit.Value, GetValue(lngRow, mintFactorCol))
            dblChkAmt = GetValue(lngRow, mintTotalAmtCol) * dblChkQty / GetValue(lngRow, mintTotalQtyCol) - dblChkDisc
            msgGrid.TextMatrix(lngRow, mintEditAmtCol) = dblChkAmt
            If dblChkQty = 0 Then txtEdit.Text = ""
        End If
    End Select
    mdblRestAmount = mdblRestAmount - (dblChkAmt - dblLastChkAmt)
    lblReceiveAmount.Caption = strFormat(mdblRestAmount, mintCurrencyDec, True)
    ShowHlb mintEditAmtCol, C2Dbl(hLb(mintEditAmtCol).Caption) + (dblChkAmt - dblLastChkAmt)
    If mintEditDiscCol > 0 Then
        ShowHlb mintEditDiscCol, C2Dbl(hLb(mintEditDiscCol).Caption) + (dblChkDisc - dblLastChkDisc)
    End If
    If dblChkAmt <> 0 Or dblChkDisc <> 0 Then
        msgGrid.TextMatrix(lngRow, mintCheckCol) = "√"
    Else
        msgGrid.TextMatrix(lngRow, mintCheckCol) = ""
        txtEdit.Text = ""
    End If
End Sub

'响应完全取消核销菜单
Private Sub mnuUndoCheck_Click(Optional blnAsk As Boolean = True)
    Dim dblChkAmount As Double
    Dim dblChkDisc As Double
    Dim lngRow As Long
    
    On Error Resume Next
    
    If C2Dbl(hLb(mintEditAmtCol).Caption) <> 0 And blnAsk Then
        If ShowMsg(hwnd, "你是否确认要取消已核销数据?", vbQuestion + vbYesNo + vbDefaultButton2, Caption) = vbNo Then
            Exit Sub
        End If
    End If
    
    For lngRow = 1 To msgGrid.Rows - 1
        If msgGrid.TextMatrix(lngRow, mintCheckCol) = "√" Then
            CheckOne lngRow
        End If
    Next lngRow
End Sub

'响应完全核销(自动分配)按钮
Private Sub mnuCheckAll_Click()
    Dim dblChkAmount As Double
    Dim dblChkQuantity As Double
    Dim dblChkDisc As Double
    Dim blnZero As Boolean
    Dim lngRow As Long

    On Error Resume Next
    blnZero = (mdblRestAmount >= 0)
    For lngRow = 1 To msgGrid.Rows - 1
        If mdblRestAmount <> 0 And msgGrid.TextMatrix(lngRow, mintCheckCol) <> "√" Then
            CheckOne lngRow
            #If conQuanDisc <> -1 Then
                If blnZero And mdblRestAmount <= 0 Or Not blnZero And mdblRestAmount >= 0 Then
                    Exit For
                End If
            #End If
        End If
    Next lngRow
End Sub

Private Function GetList() As rdoResultset
    Dim strSql As String
    Dim strSelect As String
    Dim strFrom As String
    Dim strWhere As String
    Dim strFilter As String
    Dim strPayDays As String
    Dim strDiscountRate As String
    Dim strCashFrom As String
    Dim strCashARAP As String
    
'    mclsGrid.ListSet.ViewId = mlngViewID2
    strSelect = mclsGrid.ListSet.SelectOfSql
    strFrom = mclsGrid.ListSet.FromOfSql
    strFilter = mclsGrid.ListSet.WhereOfSql
    
    If mstrActivityFrom = "商品业务" Then
        strCashFrom = "2"
    ElseIf mstrActivityFrom = "记帐凭证" Then
        strCashFrom = "3"
    Else
        strCashFrom = "1"
    End If
    
    strCashARAP = "(SELECT 1 As intCashDirection," _
        & "CashToARAP.lngCashActivityDetailID AS lngCashActivityDetailID," _
        & "CashToARAP.lngARAPActivityDetailID AS lngARAPActivityDetailID," _
        & "CashToARAP.strCashSource As strCashSource," _
        & "CashToARAP.strARAPSource As strARAPSource," _
        & "CashToARAP.dblPaymentQuantity As dblPaymentQuantity," _
        & "CashToARAP.dblCurrPaymentAmount As dblCurrPaymentAmount," _
        & "CashToARAP.dblCurrDiscount As dblCurrDiscount," _
        & "CashToARAP.blnIsCash As blnIsCash " _
        & "FROM CashToARAP " _
        & "WHERE CashToARAP.lngCashActivityDetailID=" & mlngCashDetailID & " AND strCashSource='" & strCashFrom & "' " _
        & "UNION ALL SELECT " _
        & "-1 As intCashDirection," _
        & "CashToARAP.lngARAPActivityDetailID AS lngCashActivityDetailID," _
        & "CashToARAP.lngCashActivityDetailID AS lngARAPActivityDetailID," _
        & "CashToARAP.strARAPSource As strCashSource," _
        & "CashToARAP.strCashSource As strARAPSource," _
        & "CashToARAP.dblCashQuantity*(-1) As dblPaymentQuantity," _
        & "CashToARAP.dblCurrPaymentAmount*(-1) As dblCurrPaymentAmount," _
        & "CashToARAP.dblCurrDiscount*(-1) As dblCurrDiscount," _
        & "CashToARAP.blnIsCash As blnIsCash " _
        & "FROM CashToARAP " _
        & "WHERE CashToARAP.lngARAPActivityDetailID=" & mlngCashDetailID & " AND strARAPSource='" & strCashFrom & "') QCashToARAP"
    
    strPayDays = "DECODE(isDate(strReceiptDate), 1, TO_DATE('" & Format(mdtmEndDate, "yyyy-mm-dd") & "', 'YYYY-MM-DD')-TO_DATE(strReceiptDate, 'YYYY-MM-DD'), -1)"
    strDiscountRate = "DECODE(SIGN(" & strPayDays & "- Term.intDiscountDay8)+DECODE(Term.intDiscountDay8,0,0,1), 2, Term.dblDiscountRate8, " _
        & "DECODE(SIGN(" & strPayDays & " - Term.intDiscountDay7)+DECODE(Term.intDiscountDay7,0,0,1), 2, Term.dblDiscountRate7, " _
        & "DECODE(SIGN(" & strPayDays & " - Term.intDiscountDay6)+DECODE(Term.intDiscountDay6,0,0,1), 2, Term.dblDiscountRate6, " _
        & "DECODE(SIGN(" & strPayDays & " - Term.intDiscountDay5)+DECODE(Term.intDiscountDay5,0,0,1), 2, Term.dblDiscountRate5, " _
        & "DECODE(SIGN(" & strPayDays & " - Term.intDiscountDay4)+DECODE(Term.intDiscountDay4,0,0,1), 2, Term.dblDiscountRate4, " _
        & "DECODE(SIGN(" & strPayDays & " - Term.intDiscountDay3)+DECODE(Term.intDiscountDay3,0,0,1), 2, Term.dblDiscountRate3, " _
        & "DECODE(SIGN(" & strPayDays & " - Term.intDiscountDay2)+DECODE(Term.intDiscountDay2,0,0,1), 2, Term.dblDiscountRate2, " _
        & "DECODE(SIGN(" & strPayDays & "- Term.intDiscountDay1)+DECODE(Term.intDiscountDay1,0,0,1), 2, Term.dblDiscountRate1, " _