frmdlpayment.frm

金算盘软件代码

Private mstrActivityFrom As String

Private WithEvents mclsGrid As Grid                                          '声明类模块
Attribute mclsGrid.VB_VarHelpID = -1

Private mlngCustomerID As Long                                               '单位ID
Private mlngCurrencyID As Long                                               '币种ID
Private mlngCashDetailID As Long                                             '单据业务ID
Private mstrCustomerName As String                                           '单位名称
Private mstrCurrencyName As String                                           '币种名称
Private mdtmEndDate As Date

Private mintCurrencyDec As Integer                                           '币种保留小数点位数
Private mblnFormNoRezise As Boolean                                          '窗体是否允许Resize
Private mdblPayAmount As Double                                              '可核销金额
Private mdblLastChkAmt As Double                                             '本次原核销金额之和
Private mblnModify As Boolean                                                '按钮退出吗
Private mintDirection As Integer

Public Sub SetParameters(lngDetailID As Long)
    
    mlngCashDetailID = lngDetailID
    If GetActivity(lngDetailID) Then
        mstrCustomerName = CustomerName(mlngCustomerID)
        mstrCurrencyName = CurrencyName(mlngCurrencyID)
        mintCurrencyDec = CurrencyDec(mlngCurrencyID)
        Me.Show vbModal
    End If
End Sub


Private Sub Form_Load()
    Dim intCount As Integer
    
    SetHelpID Me.hwnd, 17005
    mdblLastChkAmt = 0
    mblnFormNoRezise = False
    
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = msgGrid
    msgGrid.FixedCols = 0
    mclsGrid.ListSet.ViewId = mintViewID2
    'Set datAP.Recordset = GetList()                         '取SQL语句并绑定数据到FLEXGRID
    Set datAP.Resultset = GetList()                          '取SQL语句并绑定数据到FLEXGRID
    FindColPosition
    For intCount = 0 To mlngOffsetCol - 1
        msgGrid.ColWidth(intCount) = 0
    Next intCount
    msgGrid.ColWidth(mintCheckCol) = 480
    mclsGrid.ColOfs = mlngOffsetCol
    mclsGrid.ShowTotal = True
    Set mclsGrid.Form = Me
    mclsGrid.ListSetToGrid
    mclsGrid.SetupStyle
    ShowTotalRow
    lblCustomer.Caption = mstrCustomerName
    lblCurrency.Caption = mstrCurrencyName
    mdblPayAmount = mdblPayAmount - mdblLastChkAmt
    lblPayAmount.Caption = strFormat(mdblPayAmount, mintCurrencyDec)
    Set mclsGrid.EditText = txtEdit
    mclsGrid.SetEditText ("本次核销")
    mclsGrid.SetEditText ("核销数量")
    
    Utility.LoadFormResPicture Me
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
End Sub

'功能 ： 响应退出窗体事件
Private Sub Form_Unload(Cancel As Integer)
    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
    
    mclsGrid.GridToListSet
    mclsGrid.ListSet.SaveList
    Set mclsGrid = Nothing
    Utility.UnLoadFormResPicture Me
    Set frmdlPayment = Nothing
End Sub

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

'响应完全取消核销菜单
Private Sub mnuUndoCheck_Click()
    Dim intAmtCol As Integer
    Dim intQtyCol As Integer
    Dim dblChkAmount As Double
    Dim lngRow As Long
    
    On Error GoTo Err
    
    intAmtCol = mintEditAmtCol
    intQtyCol = mintEditQtyCol
    For lngRow = 1 To msgGrid.Rows - 1
        If msgGrid.TextMatrix(lngRow, mintCheckCol) = "√" Then
            msgGrid.TextMatrix(lngRow, mintCheckCol) = ""
            dblChkAmount = GetValue(lngRow, intAmtCol)
            mdblPayAmount = mdblPayAmount + dblChkAmount
            msgGrid.TextMatrix(lngRow, intAmtCol) = 0
            mclsGrid.FormatCell lngRow, intAmtCol
            If (GetValue(lngRow, mintTableIDCol) <> 1) Then         '=2表示是商品表
                If intQtyCol > 0 Then msgGrid.TextMatrix(lngRow, intQtyCol) = "0"
            End If
            ShowHlb C2Dbl(hLb(intAmtCol).Caption) - dblChkAmount
            lblPayAmount.Caption = strFormat(mdblPayAmount, mintCurrencyDec)
        End If
    Next lngRow
    Exit Sub

Err:
    ShowMsg Me.hwnd, "完全取消操作失败！  ", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "应付款核销"
End Sub

'响应完全核销(自动分配)按钮
Private Sub mnuCheckAll_Click()
    Dim intAmtCol As Integer
    Dim intQtyCol As Integer
    Dim dblChkAmount As Double
    Dim lngRow As Long

    On Error GoTo Err

    intAmtCol = mintEditAmtCol
    intQtyCol = mintEditQtyCol

    For lngRow = 1 To msgGrid.Rows - 1
        If mdblPayAmount > 0 Then
            dblChkAmount = GetValue(lngRow, mintLastBalAmtCol) - GetValue(lngRow, intAmtCol)
            If dblChkAmount * mdblPayAmount > 0 Then
                If mdblPayAmount > 0 Then
                    If dblChkAmount >= mdblPayAmount Then
                        dblChkAmount = mdblPayAmount
                    End If
                Else
                    If Abs(dblChkAmount) >= Abs(mdblPayAmount) Then
                        dblChkAmount = mdblPayAmount
                    End If
                End If
                If dblChkAmount <> 0 Then
                    mblnModify = True
                    mdblPayAmount = mdblPayAmount - dblChkAmount
                    msgGrid.TextMatrix(lngRow, intAmtCol) = GetValue(lngRow, intAmtCol) + dblChkAmount
                    mclsGrid.FormatCell lngRow, intAmtCol
                    msgGrid.TextMatrix(lngRow, mintCheckCol) = "√"
                    If intQtyCol > 0 And (GetValue(lngRow, mintTableIDCol) <> 1) Then        '=2表示是商品表
                        If (GetValue(lngRow, mintLastBalQtyCol) <> 0) Then
                            msgGrid.TextMatrix(lngRow, intQtyCol) = GetValue(lngRow, mintLastBalQtyCol) * dblChkAmount / GetValue(lngRow, mintLastBalAmtCol)
                        End If
                    End If               '总付款的更新
                    ShowHlb C2Dbl(hLb(intAmtCol).Caption) + dblChkAmount
                    lblPayAmount.Caption = strFormat(mdblPayAmount, mintCurrencyDec)
                End If
            End If
        End If
    Next lngRow
    Exit Sub

Err:
    ShowMsg Me.hwnd, "自动核销操作失败 ", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "应付款核销"
End Sub

'功能 ： 生成应付明细
'用到查询：dActivityCash,dGoodsCash,dInitCash
 Private Function GetList() As rdoResultset
'Private Function GetList() As Recordset
    Dim strSelect1 As String
    Dim strSelect2 As String
    Dim strSelect3 As String
    Dim strWhere1 As String
    Dim strWhere2 As String
    Dim strWhere3 As String
    Dim strFrom1 As String
    Dim strFrom2 As String
    Dim strFrom3 As String
    Dim strSql1 As String
    Dim strsql2 As String
    Dim strSql3 As String
    Dim strSql As String
    'Dim qrfAP As QueryDef
    'Dim recViewID1 As Recordset
    'Dim recViewID2 As Recordset
    'Dim recViewID3 As Recordset
    
    Dim qrfAP As rdoQuery
    Dim recViewID1 As rdoResultset
    Dim recViewID2 As rdoResultset
    Dim recViewID3 As rdoResultset
    
    
    mclsGrid.ListSet.ViewId = mintViewID2
    mstrCommWhere = mclsGrid.ListSet.WhereOfSql
    If mstrCommWhere = "" Then
        mstrCommWhere = "True"
    End If
'    On Error GoTo Err
    
    '商品业务
    '商品销售,直运销售,委托结算,分期结算(11,12,14,17)(13,14,16,19)
    '商品采购,直运采购,加工费用,受托结算(1,2,4,6)(2,3,5,7)
    strSelect2 = "IIF((ItemActivity.lngActivityTypeID IN (1,2,4,6)),1,-1)*" & mintDirection & " AS intDirection," _
        & "ItemActivityDetail.lngActivityDetailID As lngActivityDetailID," _
        & "2 As lngTableID," _
        & "IIf((([CashToARAP].[dblCurrPaymentAmount]<>0)<>0),'√','') As 核销," _
        & "[CashToARAP].[dblCurrPaymentAmount]*intDirection AS 原核销金额," _
        & "Format([CashToARAP].[dblPaymentQuantity],'@;0')*intDirection As 原核销数量, " _
        & "([ItemActivityDetail ].[dblCurrAmount]+[ItemActivityDetail ].[dblCurrTaxAmount]" _
        & "-[ItemActivityDetail ].[dblCurrPaymentAmount]+Format([CashToARAP]." _
        & "[dblCurrPaymentAmount],'@;0'))*intDirection AS 原付款余额, " _
        & "([ItemActivityDetail].[dblQuantity]-[ItemActivityDetail].[dblPaymentQuantity]" _
        & "+Format([CashToARAP].[dblPaymentQuantity],'@;0'))*intDirection AS 原数量余额," _
        & "ItemActivityDetail.dblQuantity As 原总数量," _
        & "(ItemActivityDetail.dblCurrAmount+ItemActivityDetail.dblCurrTaxAmount) As 原总金额," _
        & "ItemUnit.dblFactor As 换算因子," _
        & "'现金银行' As ID来源 "
    strFrom2 = "(((ItemActivityDetail INNER JOIN ((ItemActivity LEFT JOIN Term ON ItemActivity.lngTermID=Term.lngTermID) INNER JOIN ReceiptType " _
        & "ON ItemActivity.lngReceiptTypeID=ReceiptType.lngReceiptTypeID) " _
        & "ON ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID) INNER JOIN ItemUnit " _
        & "ON ItemActivityDetail.lngUnitID=ItemUnit.lngUnitID) INNER JOIN Item " _
        & "ON ItemActivityDetail.lngItemID=Item.lngItemID) LEFT JOIN dGoodsCash As CashToARAP " _
        & "ON ItemActivityDetail.lngActivityDetailID=CashToARAP.lngARAPActivityDetailID"
    strSelect2 = strSelect2 & GetSelectFromView(mintViewID2, mintViewID2, strFrom2)
    strWhere2 = "(ItemActivity.lngActivityTypeID IN (11,12,14,17,1,2,4,6)) " _
        & "AND (ItemActivity.lngCustomerID=[CustomerID]) " _
        & "AND (NOT ItemActivity.blnIsVoid) " _
        & "AND (ItemActivity.lngCurrencyID=[CurrencyID]) " _
        & "AND ([ItemActivityDetail].[dblCurrAmount]+[ItemActivityDetail].[dblCurrTaxAmount]" _
        & "-[ItemActivityDetail].[dblCurrPaymentAmount]+Format([CashToARAP].[dblCurrPaymentAmount],'@;0')<>0) "
    strWhere2 = strWhere2 & " AND " & mstrCommWhere
    strsql2 = "SELECT " & strSelect2 & " FROM " & strFrom2 & " WHERE " & strWhere2
    
    '业务表
    '应付借项,应收借项,财务费用,收款单(35,36,38,40)
    strSelect1 = "IIF(ActivityDetail.blnIsReceipt,IIF(Activity.lngActivityTypeID IN (35,36,38),-1,1)," _
        & "IIF(Activity.lngActivityTypeID IN (35,36,38,40),1,-1))*" & mintDirection & " AS intDirection," _
        & "ActivityDetail.lngActivityDetailID As lngActivityDetailID," _
        & "1 As lngTableID," _
        & "IIf([CashToARAP].[dblCurrPaymentAmount]<>0,'√','') As 核销," _
        & "[CashToARAP].[dblCurrPaymentAmount]*intDirection AS 原核销金额," _
        & "0 As 原核销数量, " _
        & "([ActivityDetail].[dblCurrAmount]-[ActivityDetail].[dblCurrPaymentAmount]" _
        & "+Format([CashToARAP].[dblCurrPaymentAmount],'@;0'))*intDirection AS 原付款余额, " _
        & "0 AS 原数量余额," _
        & "0 As 原总数量," _
        & "ActivityDetail.dblCurrAmount As 原总金额," _
        & "1 As 换算因子," _
        & "Format([CashToARAP].[strARAPSource],'@;') As ID来源 "
    strFrom1 = "((ActivityDetail INNER JOIN ((Activity LEFT JOIN Term ON Activity.lngTermID=Term.lngTermID) INNER JOIN ReceiptType " _
        & "ON Activity.lngReceiptTypeID=ReceiptType.lngReceiptTypeID) " _
        & "ON ActivityDetail.lngActivityID=Activity.lngActivityID) INNER JOIN Account " _
        & "ON ActivityDetail.lngAccountID=Account.lngAccountID) " _
        & "LEFT JOIN dActivityCash As CashToARAP " _
        & "ON ActivityDetail.lngActivityDetailID=CashToARAP.lngARAPActivityDetailID"
    strSelect1 = strSelect1 & GetSelectFromView(mintViewID1, mintViewID2, strFrom1)
    strWhere1 = "ActivityDetail.lngActivityDetailID<>" & mlngCashDetailID & " " _
        & "AND (ActivityDetail.lngCustomerID=[CustomerID]) " _
        & "AND (Activity.blnIsVoid=False) " _
        & "AND (Account.lngAccountNatureID IN (3,4)) " _
        & "AND (ActivityDetail.lngCurrencyID=[CurrencyID]) " _
        & "AND (ActivityDetail.dblCurrAmount-ActivityDetail.dblCurrPaymentAmount" _
        & "+Format(CashToARAP.dblCurrPaymentAmount,'@;0')<>0)"
    strWhere1 = strWhere1 & " AND " & mstrCommWhere
    strSql1 = "SELECT " & strSelect1 & " FROM " & strFrom1 & " WHERE " & strWhere1
    
    '期初表
    '商品采购,直运采购,加工费用,受托结算(1,2,4,6)(2,3,5,7)
    '应付贷项,应收贷项,收款单(34,37,40)
    strSelect3 = "IIF((ARAPInit.lngReceiptTypeID IN (2,3,5,7,34,37,40)),1,-1)*" & mintDirection & " AS intDirection," _
        & "ARAPInit.lngARAPInitID As lngActivityDetailID,0 as lngTableID," _
        & "IIf(([CashToARAP].[dblCurrPaymentAmount]<>0),'√','') As 核销," _
        & "[CashToARAP].[dblCurrPaymentAmount]*intDirection AS 原核销金额," _
        & "Format([CashToARAP].[dblPaymentQuantity],'@;0')*intDirection As 原核销数量," _
        & "([ARAPInit].[dblCurrAmount]+[ARAPInit].[dblCurrTaxAmount]-[ARAPInit].[dblCurrPaymentAmount]" _
        & "+Format([CashToARAP].[dblCurrPaymentAmount],'@;0'))*intDirection AS 原付款余额, " _
        & "([ARAPInit].[dblQuantity]-[ARAPInit].[dblPaymentQuantity]+Format([CashToARAP]." _
        & "[dblPaymentQuantity],'@;0'))*intDirection AS 原数量余额," _
        & " ARAPInit.dblQuantity As 原总数量," _
        & "(ARAPInit.dblCurrAmount+ARAPInit.dblCurrTaxAmount) As 原总金额," _
        & "ItemUnit.dblFactor As 换算因子," _
        & "'现金银行' As ID来源 "
    strFrom3 = "(((((ARAPInit INNER JOIN Account " _
        & "ON ARAPInit.lngAccountID=Account.lngAccountID) LEFT JOIN ReceiptType " _
        & "ON ARAPInit.lngReceiptTypeID=ReceiptType.lngReceiptTypeID) LEFT JOIN ItemUnit " _
        & "ON ARAPInit.lngUnitID=ItemUnit.lngUnitID) LEFT JOIN dInitCash As CashToARAP " _
        & "ON ARAPInit.lngARAPInitID=CashToARAP.lngARAPActivityDetailID) LEFT JOIN Item " _
        & "ON ARAPInit.lngItemID=Item.lngItemID) LEFT JOIN Term ON ARAPInit.lngTermID=Term.lngTermID"
    strSelect3 = strSelect3 & GetSelectFromView(mintViewID3, mintViewID2, strFrom3)
    strWhere3 = "(ARAPInit.lngCustomerID=[CustomerID]) " _
        & "AND (ARAPInit.lngCurrencyID=[CurrencyID]) " _
        & "AND (ARAPInit.[dblCurrAmount]-ARAPInit.[dblCurrPaymentAmount]" _
        & "+Format(CashToARAP.[dblCurrPaymentAmount],'@;0')<>0)"
    strWhere3 = strWhere3 & " AND " & mstrCommWhere
    strSql3 = "SELECT " & strSelect3 & " FROM " & strFrom3 & " WHERE " & strWhere3
    
    strSql = strSql1 & " Union all " & strsql2 & " Union all " & strSql3
    'Set qrfAP = gclsBase.BaseDB.CreateQueryDef("", Strsql)
    'qrfAP.Parameters("DetailID") = mlngCashDetailID
    'qrfAP.Parameters("CustomerID") = mlngCustomerID
    'qrfAP.Parameters("CurrencyID") = mlngCurrencyID
    
    'Set GetList = qrfAP.OpenRecordset(dbOpenSnapshot)
    'Set GetList = qrfAP.OpenResultset(rdOpenStatic)
End Function

Private Function GetSelectFromView(lngViewID1 As Long, lngViewID2 As Long, Optional strFrom As String) As String
    'Dim recView1 As Recordset
    'Dim recView2 As Recordset
    
    Dim recView1 As rdoResultset
    Dim recView2 As rdoResultset