bos_receivepaybill.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_ReceivePayBill"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'''''''''''''''''''''''''''''''''''''''''''''''
''应收应付单票据选单时保存所选票据号
''建立日期：2005-08-31
''建立人：闫建学
'''''''''''''''''''''''''''''''''''''''''''''''''
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_AfterNewBill()
    On Error GoTo Errhandle
    '设置有效日期默认为出票+6个月
    m_BillInterface.SetFieldValue "FValidDate", DateAdd("m", 6, CDate(m_BillInterface.GetFieldValue("FOutDate")))
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
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 UCase(dct.Value("Ffieldname")) = UCase("FOutDate") And m_BillInterface.GetFieldValue("FOutDate") <> "" Then
       '设置有效日期默认为出票+6个月
       m_BillInterface.SetFieldValue "FValidDate", DateAdd("m", 6, CDate(m_BillInterface.GetFieldValue("FOutDate")))
    End If
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_ListInterface_AfterSelList(ByVal RsId As ADODB.Recordset, VectList As KFO.IVector)
    ''选单时触发
    On Error GoTo Errhandle
    Dim i As Long
    Dim Dic_Select As KFO.Dictionary
    Dim Vec_Select As KFO.Vector
    Set Vec_Select = m_ListInterface.GetSelectedBillInfo()
    BillNumber = ""
    For i = Vec_Select.LBound To Vec_Select.UBound
        Set Dic_Select = Vec_Select(i)
        Set rs = m_ListInterface.K3Lib.GetData("select Fnumber from T_billmsg where fid=" & Dic_Select.GetValue("Fid"))
        BillNumber = BillNumber + rs!fnumber & ","
    Next
    If Trim(BillNumber) <> "" And Vec_Select.UBound >= 1 Then
       BillNumber = Left(BillNumber, Len(BillNumber) - 1)
    End If
    
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
    On Error GoTo Errhandle
    Select Case BOSTool.ToolName
    Case "mnuModPz"
        '此处添加处理 取皮重 菜单对象的 Click 事件
        Dim ModPzd_I As Long
        Dim ModFid As String
        Dim ModPzD As KFO.Dictionary
        Dim ModPzV As KFO.Vector
        
        Set ModPzV = m_ListInterface.GetSelectedBillInfo()
        ModFid = ""
        For ModPzd_I = ModPzV.LBound To ModPzV.UBound
            Set ModPzD = ModPzV(ModPzd_I)
            ModFid = ModFid & ModPzD.GetValue("FID") & ","
        Next
        
        If Trim(ModFid) <> "" And ModPzV.UBound >= 1 Then
            ModFid = Left(ModFid, Len(ModFid) - 1)
            m_ListInterface.K3Lib.UpdateData "delete from ICClassCheckRecords where fclasstypeid=200000170 and fbillid in(" & ModFid & ")"
            m_ListInterface.K3Lib.UpdateData "update t_billmsg set fcheckid=0 where fid in(" & ModFid & ")"
        End If
    Case Else
    End Select
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_ListInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
   On Error GoTo Errhandle
   
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand
 
    '*************** 开始新增 BOS 菜单 ***************

    '新增 改票 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("mnuModPz")
    With oTool
        .Caption = "改票"
        .ToolTipText = "改票"
        .Description = "改票"

        .ShortcutKey = 3
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path & "\get.ico"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuCaculate", oTool '将菜单对象插入指定工具栏
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub