bos_transfeecomp.cls

金蝶地磅称重插件

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "BOS_TransFeeComp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'''''''''''''''''''''''''''''''''''''''''''''''
''运费结算
''建立日期：2005-07-28
''建立人：倪树祥
'''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'定义 BillEvent 接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_BillInterface  As BillEvent
Attribute m_BillInterface.VB_VarHelpID = -1
'定义 ListEvents 接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_ListInterface  As ListEvents
Attribute m_ListInterface.VB_VarHelpID = -1

Public Sub Show(ByVal oBosInterface As Object)
    'BillEvent 接口实现
    '注意: 此方法必须存在, 请勿修改
    Select Case VBA.TypeName(oBosInterface)
        Case "BillEvent"
            Set m_BillInterface = oBosInterface
        Case "ListEvents"
            Set m_ListInterface = oBosInterface
    End Select
End Sub

Private Sub Class_Terminate()
    '释放接口对象
    '注意: 此方法必须存在, 请勿修改
    Set m_BillInterface = Nothing
    Set m_ListInterface = Nothing
   
End Sub


Private Sub m_BillInterface_AfterSelBill(ByVal lSelBillType As Long)
''选单之后触发
    Dim iCurrSel As Long
    Dim sTemp As String
    Dim lngCurrFID As Long
    Dim sBID As String
    
    Dim rsRec As New Recordset
  
  On Error GoTo Errhandle
  
   '填写捡斤单信息
   Dim strSql As String
   strSql = " SELECT BB.FBillNo,BB.FCarNo, BB.FID as FBInterID,BE.FTareBalanceNo, BE.FTareWeight, " & _
                                                      " BE.FTareBalanceTime, BE.FGrossBalanceNo,BE.FGrossWeight, BE.FGrossBalanceTime, " & _
                                                      " BE.FNetWeight/1000 as FNetWeight , BB.FNetWeight_For,BE.FNetWeight /1000 - BB.FNetWeight_For as FDeltaQty " & _
                                             " FROM t_ST_SC_BalanceBill BB INNER JOIN t_ST_SC_BalanceBillEntry BE ON BB.FID = BE.FID" & _
                                             " WHERE BE.FClassID_SRC = '200000160' and BE.FEntryID_SRC =" & g_lngFEntryID & " and BE.FID_SRC = " & g_lngFID & " and FBillStatus > 0 "
                                             
    Set rsRec = m_BillInterface.K3Lib.GetData(strSql)
                                             
    iCurrSel = 1
   
    Dim dblFNetWeight As Double
    Dim dblFNetWeight_For As Double
        
    dblFNetWeight = 0
    dblFNetWeight_For = 0
    
    m_BillInterface.DeleteEntryData 2
    
    If Not rsRec.EOF Then
        While Not rsRec.EOF
             m_BillInterface.SetFieldValue "FBBillNo", rsRec("FBillNo"), iCurrSel       '捡斤单号
             m_BillInterface.SetFieldValue "FCarNo", rsRec("FCarNo"), iCurrSel       '捡斤单号
             m_BillInterface.SetFieldValue "FBInterID", rsRec("FBInterID"), iCurrSel                    '捡斤单ID
             m_BillInterface.SetFieldValue "FTareWeight", rsRec("FTareWeight"), iCurrSel   '皮重
             m_BillInterface.SetFieldValue "FGrossWeight", rsRec("FGrossWeight"), iCurrSel   '毛重
             m_BillInterface.SetFieldValue "FGrossBalanceTime", rsRec("FGrossBalanceTime"), iCurrSel   '毛重
             m_BillInterface.SetFieldValue "FNetWeight", rsRec("FNetWeight"), iCurrSel   '净重
             m_BillInterface.SetFieldValue "FNetWeight_For", rsRec("FNetWeight_For"), iCurrSel   '对方净重
             m_BillInterface.SetFieldValue "FDeltaQty", rsRec("FDeltaQty"), iCurrSel   '差额
                                       
             If iCurrSel < rsRec.RecordCount Then
                m_BillInterface.InsertNewRowAndFill 2, iCurrSel + 1                 '插入一个新行.

             End If
             rsRec.MoveNext
             iCurrSel = iCurrSel + 1
        Wend
    End If

   '填写第二个分录的内容：每一天的合计数据
   strSql = " select TheDay,sum(FNetWeight) as FNetWeight,sum(FNetWeight_For) as FNetWeight_For,sum(FDeltaQty) as FDeltaQty " & _
            " from ( SELECT CONVERT ( char(10),BE.FTareBalanceTime ,21) as TheDay, BE.FNetWeight /1000 as FNetWeight, BB.FNetWeight_For, BE.FNetWeight/1000 -BB.FNetWeight_For as FDeltaQty " & _
                 "  FROM t_ST_SC_BalanceBill BB INNER JOIN t_ST_SC_BalanceBillEntry BE ON BB.FID = BE.FID " & _
                 "  WHERE BE.FClassID_SRC = '200000160' and BE.FEntryID_SRC =" & g_lngFEntryID & " and BE.FID_SRC = " & g_lngFID & " and FBillStatus > 0 ) " & _
                 " A " & _
            " group by A.TheDay"
                                             
    Set rsRec = m_BillInterface.K3Lib.GetData(strSql)
    
    iCurrSel = 1
     
    dblFNetWeight = 0
    dblFNetWeight_For = 0
     m_BillInterface.DeleteEntryData 3
    If Not rsRec.EOF Then
        While Not rsRec.EOF
                                       
             If iCurrSel <= rsRec.RecordCount Then
                m_BillInterface.InsertNewRowAndFill 3, iCurrSel, "FBDateDay", rsRec("TheDay"), "FQtyForSum", rsRec("FNetWeight_For"), "FSelfSumQtyDay", rsRec("FNetWeight"), "FDDeltaSum", rsRec("FDeltaQty")      '插入一个新行.
                dblFNetWeight = dblFNetWeight + rsRec("FNetWeight")
                dblFNetWeight_For = dblFNetWeight_For + rsRec("FNetWeight_For")
             End If
             rsRec.MoveNext
             iCurrSel = iCurrSel + 1
        Wend
    End If
    
    '填写运输协议编号
   strSql = " select top 1 isnull(FBillNo,'') as FBillNo from t_EP_PB_TransContract where FID =" & g_lngFID
                                             
    Set rsRec = m_BillInterface.K3Lib.GetData(strSql)
     
    If Not rsRec.EOF Then
         m_BillInterface.SetFieldValue "FBillNo_SRC", rsRec("FBillNo")
    End If
    
   '保留运输协议的内码
   m_BillInterface.SetFieldValue "FTransID", g_lngFID
   m_BillInterface.SetFieldValue "FTransEntryID", g_lngFEntryID
   
   
   '净重合计
   m_BillInterface.SetFieldValue "FNetWeightSum", dblFNetWeight
   m_BillInterface.SetFieldValue "FNetWeight_ForSum", dblFNetWeight_For
   m_BillInterface.SetFieldValue "FDDeltaIn", dblFNetWeight - dblFNetWeight_For
   
   CompFee  '计算费用

Errhandle:

End Sub

Private Sub CompFee()
'计算费用
    Dim dblDeltaQty As Double
    Dim dblFNetWeight As Double
    Dim dblFNetWeight_For As Double
    Dim dblFDisWayAmount As Double
    Dim dblFFeeAmount As Double
    Dim dblFFeeAugAmount As Double
    Dim dblFLostPrice As Double
    Dim dblFtransPrice As Double
    Dim dblFWayLost As Double
    Dim dblFNotPayQty As Double
    Dim bFTransFeeByCust As Boolean
    Dim dblFDeltaSumQty As Double
  
    dblFNetWeight = 0
    dblFNetWeight_For = 0
    dblFDeltaSumQty = 0
    dblFDisWayAmount = 0
    dblFFeeAmount = 0
    dblFFeeAugAmount = 0
    dblFLostPrice = 0
    dblFtransPrice = 0
    dblFWayLost = 0
    Dim lngCurrRow As Long
    lngCurrRow = 1
    
On Error GoTo Errhandle
    '计算净重
    dblFNetWeight = Format(m_BillInterface.GetFieldValue("FNetWeightSum"), "###,##0.0000")
    dblFNetWeight_For = Format(m_BillInterface.GetFieldValue("FNetWeight_ForSum"), "###,##0.0000")
    
    dblFNetWeight = dblFNetWeight
    dblFNetWeight_For = dblFNetWeight_For
    dblFDeltaSumQty = Format(dblFNetWeight - dblFNetWeight_For, "###,##0.0000")
        
  
    '计算运费和丢失扣减
    dblFLostPrice = CDbl(m_BillInterface.GetFieldValue("FLostPrice"))
    dblFtransPrice = CDbl(m_BillInterface.GetFieldValue("FtransPrice"))
    dblFWayLost = CDbl(m_BillInterface.GetFieldValue("FWayLost"))
    dblFNotPayQty = CDbl(m_BillInterface.GetFieldValue("FNotPayQty"))
    dblFDisWayAmount = CDbl(m_BillInterface.GetFieldValue("FDisWayAmount"))
    
    bFTransFeeByCust = CBool(m_BillInterface.GetFieldValue("FTransFeeByCust"))
    dblFDisWayAmount = 0
    dblFFeeAmount = 0
    dblFFeeAugAmount = 0
    If dblFNetWeight_For > 0 And dblFDeltaSumQty < 0 Then '计算路途损失扣款
        If Abs(dblFDeltaSumQty / dblFNetWeight_For) > dblFWayLost Then
            dblFDeltaSumQty = dblFNetWeight_For * (Abs(dblFDeltaSumQty / dblFNetWeight_For) - dblFWayLost)
        Else
            dblFDeltaSumQty = 0
        End If
    Else
        dblFDeltaSumQty = 0
    End If
    
    If dblFDeltaSumQty > 0 And (dblFDeltaSumQty - dblFNotPayQty > 0) Then
        dblFDeltaSumQty = dblFDeltaSumQty - dblFNotPayQty
    Else
        dblFDeltaSumQty = 0
    End If
    
    If bFTransFeeByCust Then '计算运费
        dblFFeeAmount = dblFtransPrice * dblFNetWeight_For
    Else
        dblFFeeAmount = dblFtransPrice * dblFNetWeight
    End If
    
    '计算损失扣款
    dblFDisWayAmount = dblFDeltaSumQty * dblFLostPrice - dblFDisWayAmount
    If dblFDisWayAmount < 0 Then dblFDisWayAmount = 0
    
    '计算应结运费
    dblFFeeAugAmount = dblFFeeAmount - dblFDisWayAmount
    m_BillInterface.SetFieldValue "FDeltaSumQty", dblFDeltaSumQty
    m_BillInterface.SetFieldValue "FDisWayAmount", dblFDisWayAmount
    m_BillInterface.SetFieldValue "FFeeAmount", dblFFeeAmount
    m_BillInterface.SetFieldValue "FFeeAugAmount", dblFFeeAugAmount
Errhandle:

End Sub

Private Sub m_BillInterface_beforesave(bCancel As Boolean)
    CompFee '计算费用
End Sub

Private Sub m_BillInterface_Change(ByVal dct As KFO.IDictionary, ByVal dctFld As KFO.IDictionary, ByVal Col As Long, ByVal Row As Long, Cancel As Boolean)
        CompFee '计算费用
End Sub