bos_rprepayinfo.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_RPRepayInfo"
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)
    '选单之后触发
    On Error GoTo Errhandle
    Dim lngCurrRow As Long
    Dim dblCurrAmount As Double
    Dim dblSumAmount As Double
    dblCurrAmount = 0
    dblSumAmount = 0
    lngCurrRow = 1
   Do
        dblCurrAmount = m_BillInterface.GetFieldValue("FApplyAmountFor", lngCurrRow)
        If dblCurrAmount > 0 Then
            dblSumAmount = dblSumAmount + dblCurrAmount
        Else
            Exit Do
        End If
        
        lngCurrRow = lngCurrRow + 1
    Loop While 1
    Exit Sub
Errhandle:
    m_BillInterface.SetFieldValue "FAmountFor", dblSumAmount
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)
    On Error GoTo Errhandle
    ''字段改变之后触发
    If dct.GetValue("FFieldName") = "FApplyAmountFor" Then
        m_BillInterface.SetFieldValue "FAmountFor", m_BillInterface.Sum(dct, 1)
    End If
    
    If m_BillInterface.FID = 200000125 Then
        If dct.GetValue("FFieldName") = "FCustomer" Then
            m_BillInterface.SetFieldValue "FCustomerNo", m_BillInterface.GetFieldValue("FCustomer", , Enu_ValueType_FFND)
        End If
    End If
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示："
End Sub

Private Sub m_BillInterface_AfterSave(bCancel As Boolean)
    On Error GoTo Errhandle
    ''单据保存之后
    ''更新未收款金额
    m_BillInterface.K3Lib.UpdateData "update t_RecApplyEntry set FNOReceiveAmount=FApplyAmountFor-FReceiveAmount where FBillID=" & m_BillInterface.CurBillID
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub