bos_applyinfo.cls

金蝶地磅称重插件

'Private Sub m_ListInterface_AfterMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckLevel As Long, ByVal lCheckStatus As Long, ByVal Success As Boolean)
''多级审核后指定下一级次的审核人
'    Dim strSql As String
'    Dim iNextLevel As Integer
'  '  If (lCheckLevel = 0) Then Exit Sub
'
'    '最大级次时,不要指定下一级的审核人
'    If (lCheckLevel = lCheckMaxLevel) Then
'        strSql = "exec Cg_SP_AddCheckerAssigned 't_EP_PB_PurchaseApply'," & m_ListInterface.GetCurrentSelRowInfo("FID") & ",0,0," & lCheckLevel & "," & m_ListInterface.K3Lib.User.UserID & " ,1," & lCheckMaxLevel
'        m_ListInterface.K3Lib.UpdateData strSql
'        Exit Sub
'    End If
'
'    '得到一级次的审核人，如果下一级次=0，说明是直接转移到结束，否则需要指定下一级次的审核人
'    iNextLevel = m_ListInterface.MultiCheckMgr.nextlevel
'    If iNextLevel = 0 Then
'        strSql = "exec Cg_SP_AddCheckerAssigned 't_EP_PB_PurchaseApply'," & m_ListInterface.GetCurrentSelRowInfo("FID") & ",0,0," & lCheckLevel & "," & m_ListInterface.K3Lib.User.UserID & " ,1," & lCheckMaxLevel
'        m_ListInterface.K3Lib.UpdateData strSql
'        Exit Sub
'    End If
'
'    strSql = "exec Cg_Sp_getChecker '110001287'," & m_ListInterface.K3Lib.User.UserID & "," & iNextLevel
'
'    Set frmChecker.rsChecker = m_ListInterface.K3Lib.GetData(strSql)
'    If frmChecker.rsChecker.EOF Then
'        MsgBox "请设置人员分组！", vbCritical + vbOKOnly, "金蝶提示"
'        Exit Sub
'    End If
'    '显示选择界面
'    frmChecker.IsMustAssigned = True
'    frmChecker.Show vbModal
'
'    '如果选择了审核人，则把审核人加入到审核人列表中，否则保留原来的审核人（不做任何的变化）
'    If lngFUserID > 0 Then
'        strSql = "exec Cg_SP_AddCheckerAssigned 't_EP_PB_PurchaseApply'," & m_ListInterface.GetCurrentSelRowInfo("FID") & "," & m_ListInterface.MultiCheckMgr.nextlevel & "," & lngFUserID & "," & lCheckLevel & "," & m_ListInterface.K3Lib.User.UserID & " ,1," & lCheckMaxLevel
'        m_ListInterface.K3Lib.UpdateData strSql
'    End If
'End Sub
'
'Private Sub m_ListInterface_AfterUnMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckLevel As Long, ByVal lCheckStatus As Long, ByVal Success As Boolean)
'    Dim strSql As String
' '   If lCheckLevel >= 0 Then
'        strSql = "exec Cg_SP_AddCheckerAssigned 't_EP_PB_PurchaseApply'," & m_ListInterface.GetCurrentSelRowInfo("FID") & "," & m_ListInterface.MultiCheckMgr.nextlevel & ",0," & lCheckLevel & "," & m_ListInterface.K3Lib.User.UserID & ",-1," & lCheckMaxLevel
'        m_ListInterface.K3Lib.UpdateData strSql
'  '  End If
'End Sub

'Private Sub m_ListInterface_BeforeMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, lCheckLevel As Long, ByVal lCheckStatus As Long, ByVal lLastCheckFrom As Long, ByVal lLastCheckTo As Long, Cancel As Boolean)
''判断是否是当前单据的审核人
'    Dim lngCurrCheckerID As Long
'    Dim rsRec As New Recordset
'    Set rsRec = m_ListInterface.K3Lib.GetData("select * from t_EP_PB_PurchaseApply where FID = " & m_ListInterface.GetCurrentSelRowInfo("FID"))
'     Select Case lCheckLevel
'        Case 1
'            lngCurrCheckerID = rsRec("FFirCheckerAssi")
'        Case 2
'            lngCurrCheckerID = rsRec("FSecCheckerAssi")
'        Case 3
'            lngCurrCheckerID = rsRec("FThiCheckerAssi")
'        Case 4
'            lngCurrCheckerID = rsRec("FFouCheckerAssi")
'        Case 5
'            lngCurrCheckerID = rsRec("FFivCheckerAssi")
'        Case 6
'            lngCurrCheckerID = rsRec("FSixCheckerAssi")
'    End Select
'
'     If lngCurrCheckerID <> m_ListInterface.K3Lib.User.UserID Then
'        MsgBox "您不是当前单据指定的本级次审核人！", vbCritical + vbOKOnly, "金蝶提示"
'        Cancel = True
'    End If
'
'End Sub

Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
    Dim dctCurrRow As Dictionary
    Dim vctCurrBill As Vector
    Dim sFIsClosed As String
    Dim lngFID As Long
    Dim lngFEntryID As Long
    Dim lngFCheckerID As Long
    Dim rsRec As New Recordset
    Dim iCurrRow As Integer
    
    Set vctCurrBill = m_ListInterface.GetSelectedBillInfo()
    
    lngFCheckerID = 0
    sFIsClosed = ""
             
' Select Case BOSTool.ToolName
'    Case "mnuZF"
'       For iCurrRow = vctCurrBill.LBound To vctCurrBill.UBound
'           Set dctCurrRow = vctCurrBill.Item(iCurrRow)
'           lngFID = dctCurrRow.GetValue("FID")
'           lngFEntryID = dctCurrRow.GetValue("FEntryID")
'
'           Set rsRec = m_ListInterface.K3Lib.GetData("select isnull(M.FChecker,0)  as FCheckerID, isnull(E.FIsClosed,'')  as FIsClosed from t_EP_PB_PurchaseApply M inner join t_EP_PB_PurchaseApplyEntry E on M.FID = E.FID where M.FID = " & lngFID & " and E.FEntryID = " & lngFEntryID)
'           If Not rsRec.EOF Then
'                sFIsClosed = Trim(rsRec("FIsClosed"))
'                lngFCheckerID = rsRec("FCheckerID")
'           End If
'
'           If lngFCheckerID > 0 And sFIsClosed <> "Y" Then
'              m_ListInterface.K3Lib.UpdateData "update  t_EP_PB_PurchaseApplyEntry set  FIsClosed = 'Y' where FID=" & lngFID & " and FEntryID = " & lngFEntryID
'           End If
'       Next
'       MsgBox "当前单据已成功关闭！", vbInformation + vbOKOnly, "金蝶提示"
'       Exit Sub
'    Case "mnuFZF"
'         For iCurrRow = vctCurrBill.LBound To vctCurrBill.UBound
'              Set dctCurrRow = vctCurrBill.Item(iCurrRow)
'              lngFID = dctCurrRow.GetValue("FID")
'              lngFEntryID = dctCurrRow.GetValue("FEntryID")
'
'             Set rsRec = m_ListInterface.K3Lib.GetData("select isnull(FIsClosed,'')  as FIsClosed from t_EP_PB_PurchaseApplyEntry  where FID = " & lngFID & " and FEntryID = " & lngFEntryID)
'             If Not rsRec.EOF Then
'                 sFIsClosed = Trim(rsRec("FIsClosed"))
'             End If
'
'             If sFIsClosed = "Y" Then
'                 m_ListInterface.K3Lib.UpdateData "update  t_EP_PB_PurchaseApplyEntry set  FIsClosed = '' where FID=" & lngFID & " and FEntryID = " & lngFEntryID
'              End If
'        Next
'        MsgBox "当前单据已成功进行了反关闭操作！", vbOKOnly + vbInformation, "金蝶提示"
'    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