bos_transcontractlist.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_TransContractList"
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
 
Dim UserID As Long


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_MultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckLevel As Long, ByVal lCheckStatus As Long, bSendCheckMessage As Boolean, bSendAcceptMessage As Boolean, sMessageTitle As String, sMessage As String, Cancel As Boolean)
    If lCheckLevel = lBusinessLevel Then
        CloseOrderBill 1
    End If
End Sub


Private Sub m_BillInterface_UnMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckStatus As Long, ByVal lLastCheckFrom As Long, ByVal lLastCheckTo As Long, bSendMessage As Boolean, Cancel As Boolean)
     If lLastCheckFrom = lBusinessLevel Then
        CloseOrderBill 2
    End If
End Sub

Private Sub m_ListInterface_AfterSelList(ByVal RsId As ADODB.Recordset, VectList As KFO.IVector)
    Dim Dic_Select As KFO.Dictionary
    Dim rs As ADODB.Recordset
    Set Dic_Select = VectList.Item(1)
    g_lngFID = Dic_Select.GetValue("FID")
    g_lngFEntryID = Dic_Select.GetValue("FEntryID")
    
    Set rs = m_ListInterface.K3Lib.GetData("Select FBillNO from t_EP_PB_TransContract where FID=" & g_lngFID)
    g_strBillNo_SRC = rs.Fields(0)
    Set Dic_Select = Nothing
    Set rs = Nothing
End Sub


Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)

    Dim lngFClosed As Long
    Dim rsRec As New Recordset
    lngFClosed = 0
    Dim sFChecker As String
    
    
    Select Case BOSTool.ToolName
       Case "mnuZF"
          Set rsRec = m_ListInterface.K3Lib.GetData("select FBalanceClose from t_EP_PB_TransContractEntry where FID =" & m_ListInterface.GetCurrentSelRowInfo("FID") & " and FEntryID =" & m_ListInterface.GetCurrentSelRowInfo("FEntryID"))
           If Not rsRec.EOF Then
              lngFClosed = rsRec("FBalanceClose")
           End If
           
          If lngFClosed = 1 Then
               MsgBox "这张单据已经关闭,不需再执行此操作！", vbOKOnly + vbInformation, "金蝶提示"
               Exit Sub
           Else
           
               Set rsRec = m_ListInterface.K3Lib.GetData("select FChecker from t_EP_PB_TransContract where FID = " & m_ListInterface.GetCurrentSelRowInfo("FID"))
               If rsRec.EOF Then
                   Exit Sub
               End If
               
               sFChecker = rsRec("FChecker")
    
                UserID = IIf(sFChecker = "", 0, sFChecker)
                If UserID > 0 And lngFClosed <> 1 Then
                     m_ListInterface.K3Lib.UpdateData "update  t_EP_PB_TransContractEntry set  FBalanceClose = 1 where FID=" & m_ListInterface.GetCurrentSelRowInfo("FID") & " and FEntryID =" & m_ListInterface.GetCurrentSelRowInfo("FEntryID")
                     MsgBox "当前单据已成功关闭！", vbInformation + vbOKOnly, "金蝶提示"
                     Exit Sub
                Else
                    MsgBox "当前单据还没有审核或已经关闭，不能进行关闭操作！", vbOKOnly + vbInformation, "金蝶提示"
                    Exit Sub
               End If
           End If
       Case "mnuFZF"
           Set rsRec = m_ListInterface.K3Lib.GetData("select FBalanceClose from t_EP_PB_TransContractEntry where FID =" & m_ListInterface.GetCurrentSelRowInfo("FID") & " and FEntryID =" & m_ListInterface.GetCurrentSelRowInfo("FEntryID"))
           If Not rsRec.EOF Then
              lngFClosed = rsRec("FBalanceClose")
           End If
           
           If lngFClosed <> 1 Then
               MsgBox "当前单据没有关闭，不能执行恢复操作！", vbOKOnly + vbInformation, "金蝶提示"
               Exit Sub
           Else
               m_ListInterface.K3Lib.UpdateData "update  t_EP_PB_TransContractEntry set  FBalanceClose = 0 where FID=" & m_ListInterface.GetCurrentSelRowInfo("FID") & " and FEntryID =" & m_ListInterface.GetCurrentSelRowInfo("FEntryID")
               MsgBox "当前单据已成功进行了恢复操作！", vbOKOnly + vbInformation, "金蝶提示"
            End If
       Case Else
       End Select
       
End Sub

Private Sub m_ListInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
 
    If m_ListInterface.List.ShowMode = 2 Then Exit Sub '如果是选单，则不创建新的菜单对象
    
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand
 
'*************** 开始新增 BOS 菜单 ***************
 
    '新增 mnuZF 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("mnuZF")
    With oTool
        .Caption = "关闭"
        .ToolTipText = "关闭"
        .Description = "关闭"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path & "\未命名.bmp"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertBefore "mnuCaculate", oTool    '将菜单对象插入指定工具栏
 
    '新增 mnuFZF 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("mnuFZF")
    With oTool
        .Caption = "恢复"
        .ToolTipText = "恢复"
        .Description = "恢复"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path & "\未命名.bmp"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuCaculate", oTool '将菜单对象插入指定工具栏
 
 
'*************** 结束新增 BOS 菜单 ***************
 
End Sub

Private Sub CloseOrderBill(ByVal lOperType As Long)
'lOperType：1，表示从单据界面审核，2：表示从单据界面反审核，11：从序时簿界面审核，12：从序时簿界面反审核
    Dim dctCurrRow As Dictionary

    Select Case lOperType
        Case 1, 2
            m_BillInterface.K3Lib.UpdateData " exec IC_Sp_CloseOrderBill " & m_BillInterface.CurBillID & ", " & lOperType
        Case 11, 12
            Set dctCurrRow = m_ListInterface.GetCurrentSelRowInfo()
            m_ListInterface.K3Lib.UpdateData " exec IC_Sp_CloseOrderBill " & dctCurrRow.GetValue("FID") & ", " & lOperType
    End Select

End Sub



Private Sub m_ListInterface_MultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckLevel As Long, ByVal lCheckStatus As Long, bSendCheckMessage As Boolean, bSendAcceptMessage As Boolean, sMessageTitle As String, sMessage As String, Cancel As Boolean)
     If lCheckLevel = lBusinessLevel Then
        CloseOrderBill 11
    End If
End Sub

Private Sub m_ListInterface_UnMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckStatus As Long, ByVal lLastCheckFrom As Long, ByVal lLastCheckTo As Long, bSendMessage As Boolean, Cancel As Boolean)
     If lLastCheckFrom = lBusinessLevel Then
        CloseOrderBill 12
    End If
End Sub