frmdlinvoice.frm

金算盘软件代码

                & "DECODE(Activity.lngActivityTypeID,35,1,36,1,38,1,-1)," _
                & "DECODE(Activity.lngActivityTypeID,35,-1,36,-1,38,-1,40,-1,1)) AS intDirection " _
                & "FROM ActivityDetail,Activity " _
                & "WHERE ActivityDetail.lngActivityID=Activity.lngActivityID " _
                & "AND ActivityDetail.lngActivityDetailID=" & lngARAPDetailID
            strSql = "UPDATE ActivityDetail SET dblCurrPaymentAmount=(" & strARAPDirection _
                & ") WHERE lngActivityDetailID=" & lngARAPDetailID
            blnSucceed = gclsBase.ExecSQL(strSql)
            If Not blnSucceed Then GoTo Err
        Case "2" '商品
            strARAPDirection = "SELECT dblCurrPaymentAmount+(" & intFX * (recCashToARAP!dblCurrPaymentAmount + recCashToARAP!dblCurrDiscount) & ") " _
                & "*DECODE(ItemActivity.lngActivityTypeID,11,1,12,1,14,1,17,1,-1),dblPaymentQuantity+(" & intFX * IIf(intFX = 1, recCashToARAP!dblPaymentQuantity, recCashToARAP!dblCashQuantity) & ") " _
                & "*DECODE(ItemActivity.lngActivityTypeID,11,1,12,1,14,1,17,1,-1) " _
                & "FROM ItemActivityDetail,ItemActivity " _
                & "WHERE ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID " _
                & "AND ItemActivityDetail.lngActivityDetailID=" & lngARAPDetailID
            strSql = "UPDATE ItemActivityDetail SET (dblCurrPaymentAmount,dblPaymentQuantity)=(" & strARAPDirection _
                & ") WHERE lngActivityDetailID=" & lngARAPDetailID
            blnSucceed = gclsBase.ExecSQL(strSql)
            If Not blnSucceed Then GoTo Err
        Case "3" '凭证
            strSql = "UPDATE VoucherDetail SET dblCurrPaymentAmount=dblCurrPaymentAmount+(" & intFX * (recCashToARAP!dblCurrPaymentAmount + recCashToARAP!dblCurrDiscount) _
                & ")*intDirection WHERE lngVoucherDetailID=" & lngARAPDetailID
            blnSucceed = gclsBase.ExecSQL(strSql)
            If Not blnSucceed Then GoTo Err
        End Select
        
        recCashToARAP.MoveNext
    Loop
    recCashToARAP.Close
    If mstrActivityFrom = "现金银行" Then
        dblChkDiscount = 0
    End If
    dblChkAmount = dblChkAmount + dblChkDiscount
    Select Case mstrActivityFrom
    Case "记帐凭证"
        If -mintDirection = adCredit Then
            strSql = "UPDATE VoucherDetail SET dblCurrPaymentAmount=(" & dblChkAmount & ") " _
                & "WHERE lngVoucherDetailID=" & mlngCashDetailID
        Else
            strSql = "UPDATE VoucherDetail SET dblCurrPaymentAmount=(" & -dblChkAmount & ") " _
                & "WHERE lngVoucherDetailID=" & mlngCashDetailID
        End If
        blnSucceed = gclsBase.ExecSQL(strSql)
        If Not blnSucceed Then GoTo Err
    Case "商品业务"
        If -mintDirection = adCredit Then
            strSql = "UPDATE ItemActivityDetail SET dblCurrPaymentAmount=(" & dblChkAmount & ")," _
                & "dblPaymentQuantity=(" & dblCashQuantity & ") " _
                & "WHERE lngActivityDetailID=" & mlngCashDetailID
        Else
            strSql = "UPDATE ItemActivityDetail SET dblCurrPaymentAmount=(" & -dblChkAmount & ")," _
                & "dblPaymentQuantity=(" & -dblCashQuantity & ") " _
                & "WHERE lngActivityDetailID=" & mlngCashDetailID
        End If
        blnSucceed = gclsBase.ExecSQL(strSql)
        If Not blnSucceed Then GoTo Err
    Case Else
        If -mintDirection = adCredit Then
            strSql = "UPDATE ActivityDetail SET dblCurrPaymentAmount=(" & dblChkAmount & "), " _
                & "lngDiscountActivityID=" & mlngDiscActivityID _
                & " WHERE lngActivityDetailID=" & mlngCashDetailID
        Else
            strSql = "UPDATE ActivityDetail SET dblCurrPaymentAmount=(" & -dblChkAmount & "), " _
                & "lngDiscountActivityID=" & mlngDiscActivityID _
                & " WHERE lngActivityDetailID=" & mlngCashDetailID
        End If
        blnSucceed = gclsBase.ExecSQL(strSql)
        If Not blnSucceed Then GoTo Err
    End Select
    strSql = "DELETE FROM CashToARAP WHERE (strCashSource='" & strCashSource & "' AND lngCashActivityDetailID=" & mlngCashDetailID _
        & " OR strARAPSource='" & strCashSource & "' AND lngARAPActivityDetailID=" & mlngCashDetailID _
        & ") AND dblCurrPaymentAmount=0 AND dblCurrDiscount=0"
    blnSucceed = gclsBase.ExecSQL(strSql)
    If Not blnSucceed Then GoTo Err
    
    
    gclsBase.BaseWorkSpace.CommitTrans
    On Error Resume Next
    MousePointer = vbDefault
    mblnModify = False
    gclsSys.SendMessage Me.hwnd, msgReceipt37
    If blnQuit Then
       Unload Me
    End If
    Exit Sub

Err:
    If Err.Description <> "" Then
        ShowMsg Me.hwnd, Err.Description, MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
    End If
Err1:
    gclsBase.BaseWorkSpace.RollBacktrans
    MousePointer = vbDefault
End Sub

'响应窗体按钮动作
Private Sub Cmdall_Click(Index As Integer)
    Select Case Index
    Case 6                                    '确定存盘
        If mblnModify Then
            SaveData True
        Else
           Unload Me
        End If
    Case 1                                    '取消
         Unload Me
    Case 3                                    '筛选
         MousePointer = vbHourglass
         FilterData
         MousePointer = vbDefault
    Case 2                                   '全部选择
         If msgGrid.Rows > 1 Then
            mnuCheckAll_Click
         End If
    Case 4                                    '栏目设置
         MousePointer = vbHourglass
         setColumn
         MousePointer = vbDefault
    Case 5
        mnuUndoCheck_Click
'         BillPublic.ShowBill GetValue(msgGrid.Row, 2), mlngCashDetailID         '关联到单据
    End Select
End Sub

'重定窗体中各控件的位置、大小
Private Sub Form_Resize()
    On Error Resume Next
    
    If Me.WindowState <> 1 Then
        With msgGrid
            .Left = ListFormLeft
            .width = ScaleWidth - ListFormLeft - 5 * ListFormRight - DlFormButtonWidth
            If mstrActivityFrom = "现金银行" Then
                .Height = ScaleHeight - .top - 15 * ListFormBottom - hLb(0).Height
                fraDiscount.top = ScaleHeight - fraDiscount.Height - ListFormBottom
                fraDiscount.Left = ListFormLeft
                fraDiscount.width = msgGrid.width
                fraDiscount.Visible = True
            Else
                .Height = ScaleHeight - .top - 2 * ListFormBottom - hLb(0).Height
                fraDiscount.Visible = False
            End If
        End With
        mclsGrid.TotalRowAdjust
        mclsGrid.DrawTotalBox
    End If
End Sub

'栏目设置
Private Sub setColumn()
    Dim intCount As Integer
    Dim lngRow As Long

    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
    mclsGrid.GridToListSet
    mclsGrid.ListSet.SaveList
    If mclsGrid.ListSet.ShowListSet(mclsGrid.ListSet.ViewId, False) Then
        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.ListSetToGrid
        mclsGrid.SetupStyle
        ShowTotalRow
        datAR.Resultset.Close
        mclsGrid.SetEditText ("核销数量")
    End If
End Sub

Private Function GetValue(lngRow As Long, intCol As Integer, Optional strType As String = "Double") As Variant
    If intCol >= 0 Then
        GetValue = GetGridValue(lngRow, intCol, strType, msgGrid)
    Else
        GetValue = 0
    End If
End Function


Private Sub mclsGrid_DataValid(blnCancel As Boolean)
    Dim lngRow As Long
    Dim dblChkQty As Double
    Dim dblChkAmt As Double
    
    If txtEdit.Value = 0 Then Exit Sub
    
    lngRow = msgGrid.Row
    Select Case msgGrid.col
    Case mintEditAmtCol
        If Abs(txtEdit.Value) > Abs(GetValue(lngRow, mintBalAmtCol)) Then
            If txtEdit.Visible Then
                If GetValue(lngRow, mintBalAmtCol) >= 0 And txtEdit.Value > 0 Then
                    If ShowMsg(Me.hwnd, "核销金额大于未核销金额,是否继续核销?", vbQuestion + vbYesNo + vbDefaultButton2, Caption) = vbNo Then
                        blnCancel = True
                    End If
                Else
                    If ShowMsg(Me.hwnd, "核销金额(绝对值)大于未核销金额(绝对值),是否继续核销?", vbQuestion + vbYesNo + vbDefaultButton2, Caption) = vbNo Then
                        blnCancel = True
                    End If
                End If
            Else
                blnCancel = True
            End If
        ElseIf Abs(txtEdit.Value) > Abs(mdblRestAmount + GetValue(lngRow, mintEditAmtCol)) And txtEdit.Value * mdblRestAmount > 0 Then
            If txtEdit.Visible Then
                ShowMsg Me.hwnd, "核销金额不能大于可核销金额！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
            End If
            blnCancel = True
        ElseIf Abs((txtEdit.Value) + GetValue(lngRow, mintEditDiscCol)) > Abs(GetValue(lngRow, mintBalAmtCol)) Then
            If txtEdit.Visible Then
                ShowMsg Me.hwnd, "本次核销金额与折扣金额之和不能大于未核销金额！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
            End If
            blnCancel = True
        End If
    Case mintEditDiscCol
        If (txtEdit.Value) < 0 Then
            If txtEdit.Visible Then
                ShowMsg Me.hwnd, "折扣金额不能小于0.00！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
            End If
            blnCancel = True
        ElseIf (txtEdit.Value) > (GetValue(lngRow, mintBalAmtCol)) Then
            If txtEdit.Visible Then
                ShowMsg Me.hwnd, "折扣金额不能大于未核销金额！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
            End If
            blnCancel = True
        ElseIf (txtEdit.Value) + GetValue(lngRow, mintEditAmtCol) > (GetValue(lngRow, mintBalAmtCol)) Then
            If txtEdit.Visible Then
                ShowMsg Me.hwnd, "折扣金额与本次核销金额之和不能大于未核销金额！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
            End If
            blnCancel = True
        End If
    Case mintEditQtyCol
        If GetValue(lngRow, mintTotalQtyCol) <> 0 Then
            If InStr(txtEdit.Text, ".") > 0 Then
                If C2Dbl(Trim(Right(txtEdit.Text, StrLen(txtEdit.Text) - InStr(txtEdit.Text, ".")))) >= (GetValue(lngRow, mintFactorCol, "String")) Then
                   ShowMsg Me.hwnd, "数量小数位数有错！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
                   blnCancel = True
                End If
            End If
            If Not blnCancel Then
                dblChkQty = NormalToMinQty(txtEdit.Value, GetValue(lngRow, mintFactorCol))
                If Abs(dblChkQty) > Abs(NormalToMinQty(GetValue(lngRow, mintBalQtyCol), GetValue(lngRow, mintFactorCol))) Then
                    If txtEdit.Visible Then
                        If GetValue(lngRow, mintBalQtyCol) >= 0 Then
                            ShowMsg Me.hwnd, "核销数量不能大于未核销数量！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
                        Else
                            ShowMsg Me.hwnd, "核销数量不能小于未核销数量！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
                        End If
                    End If
                    blnCancel = True
                End If
            End If
        End If
    End Select
End Sub

Private Sub mclsMainControl_ChildActive()
    Dim vntMessage As Variant
    
    On Error Resume Next
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        Select Case vntMessage
        Case Message.msgTemplate
            RefreshTemplate
        End Select
    Next
    
    gclsSys.CurrFormName = hwnd
End Sub

Private Sub msgGrid_Click()
    If msgGrid.Rows > msgGrid.FixedRows And msgGrid.MouseCol = mintCheckCol Then
        CheckOne msgGrid.Row
    End If
End Sub

Private Sub CheckOne(ByVal lngRow As Long)
    Dim dblAmount As Double
    Dim dblDiscount As Double
    Dim dblChkAmount As Double
    Dim dblChkQuantity As Double
    Dim dblChkDisc As Double
    
    On Error Resume Next
    
    If Not CanNotModify(lngRow) Then
        If msgGrid.TextMatrix(lngRow, mintCheckCol) <> "√" Then
            If True And m