bos_qmpassbill.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_QmPassBill"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'''''''''''''''''''''''''''''''''''''''''''''''
''保密单
''建立日期：2005-07-18
''建立人：闫建学
'''''''''''''''''''''''''''''''''''''''''''''''''
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
    m_BillInterface.SetFieldValue "FBillDate", Format(Now, "YYYY-MM-DD HH:MM:SS")   '单据日期为当前时间
    m_BillInterface.SetFieldValue "FSyDate", Format(Now, "YYYY-MM-DD HH:MM:SS")     '收样日期为当前时间
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_beforesave(ByRef bCancel As Boolean)
    ''单据保存之前
    On Error GoTo Errhandle1
    ''判断所选检斤单是否已被其他用户选取
    If Trim(m_BillInterface.GetFieldValue("FBillNo_Yd")) <> "" And m_BillInterface.BillStatus = Enu_BillStatusExt_New Then
       Set rs = m_BillInterface.K3Lib.GetData("select count(*) as Rowc from t_ST_QM_WLD where fstatus=2 and  finterid in (" & m_BillInterface.GetFieldValue("FBillNo_Yd") & ")")
       If rs!rowc > 0 Then
          MsgBox "所选的物理检验单已被其它单据引用，请重新进行选择！", , "金蝶提示"
          bCancel = True
          Exit Sub
       End If
    End If
    
    ''取服务器日期时间
    Set rs = m_BillInterface.K3Lib.GetData("select getdate()")
    m_BillInterface.SetFieldValue "FBillDate", rs.Fields(0)     '单据日期为服务器时间
    Exit Sub
Errhandle1:
    MsgBox err.Description, vbCritical, "金蝶提示"
    bCancel = True
End Sub

Private Sub m_BillInterface_AfterSave(ByRef bCancel As Boolean)
    ''单据保存之后触发
    On Error GoTo Errhandle2
    ''选单保存之后，回写原单的FStatus字段和Fjystyle
    m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set fstatus=2,FBmBillerid=" & m_BillInterface.GetFieldValue("FBillerId") & " where finterid=" & m_BillInterface.GetFieldValue("FBillNo_Yd")
    
    ''保存之后自动审核（多级审核的一级审核）
    '----------------------------------------------------------------------
'    m_BillInterface.K3Lib.UpdateData "Insert Into ICClassCheckRecords(FClassTypeID,FPage,FBillID,FBillEntryID,FBillNo," & _
'                                     " FBillEntryIndex,FCheckLevel,FCheckLevelTo,FMode,FCheckMan, FCheckIdea,FCheckDate," & _
'                                     "FDescriptions) " & _
'                                     " Values (" & m_BillInterface.FID & "," & 1 & "," & m_BillInterface.CurBillID & ",0," & _
'                                     "'" & m_BillInterface.GetFieldValue("FBillNo") & "',0,-1,-1,0," & _
'                                     m_BillInterface.GetFieldValue("FBillerID") & ",'','" & _
'                                     Format(Now, "yyyy-mm-dd hh:mm:ss") & "','审核')"
'    m_BillInterface.K3Lib.UpdateData "Insert Into ICClassCheckStatus(FClassTypeID,FPage,FBillID,FBillEntryID,FBillNo," & _
'                                     "FBillEntryIndex,FCurrentLevel,FCheckMan1,FCheckDate1,FCheckIdea1)" & _
'                                     " Values (" & m_BillInterface.FID & ",1," & m_BillInterface.CurBillID & ",0,'" & _
'                                     m_BillInterface.GetFieldValue("FBillNo") & "',0,1," & _
'                                     m_BillInterface.GetFieldValue("FBillerID") & ",'" & _
'                                     Format(Now, "yyyy-mm-dd hh:mm:ss") & "','通过审核')"
    m_BillInterface.K3Lib.UpdateData "Update t_ST_QM_Bmd Set FCheckId=" & m_BillInterface.GetFieldValue("FBillerID") & _
                                     " Where FClassTypeID=" & m_BillInterface.FID & " And FInterID=" & _
                                     m_BillInterface.CurBillID
    m_BillInterface.K3Lib.UpdateData "Update t_ST_QM_Bmd Set FCheckTime='" & Format(Now, "yyyy-mm-dd hh:mm:ss") & _
                                     "' Where FClassTypeID=" & m_BillInterface.FID & " And FInterID=" & _
                                     m_BillInterface.CurBillID
   
    ''刷新单据
    m_BillInterface.RefreshBill
    '----------------------------------------------------------------------
    Exit Sub
Errhandle2:
    MsgBox err.Description, vbCritical, "金蝶提示"
    bCancel = True
End Sub

Private Sub m_BillInterface_AfterSelBill(ByVal lSelBillType As Long)
    ''选单之后触发
    On Error GoTo Errhandle
    ''回写保密单原单编号
    Dim Dic_SelectTemp As KFO.Dictionary
    Set Dic_SelectTemp = Vector_SelectBill(1)
    
    If Dic_SelectTemp.GetValue("FInterid") <> "" Then
       m_BillInterface.SetFieldValue "FBillNo_Yd", Dic_SelectTemp.GetValue("FInterid")
    End If
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
    On Error GoTo Errhandle
    
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand
    ''隐藏“保存后新增”选项
    '-------------------------------------------------
    Set oBand = oMenuBar.BOSBands("mnuOption")
    Set oTool = oBand.BOSTools("mnuOptionAfterSaveNew")
    With oTool
        .Visible = False
        .Enabled = False
    End With
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
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)
    ''驳回审核时触发
    On Error GoTo Errhandle
    ''一级审核驳回时发生
    If lCheckMode = 0 And lBusinessLevel = 1 And lCheckStatus = GetCheckLevel(lCheckMaxLevel) Then
       Set rs = m_BillInterface.K3Lib.GetData("select Fstatus from t_ST_QM_Bmd where fInterId=" & m_BillInterface.CurBillID)
       If rs.RecordCount > 0 Then
          If rs!Fstatus = 1 Then
             MsgBox "该单据已经引用，不允许驳回审核！", , "金蝶提示"
             Cancel = True
             Exit Sub
          End If
       End If
    End If
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub


'序时簿事件
'**********************************************************************************************
Private Sub m_ListInterface_AfterSelList(ByVal RsId As ADODB.Recordset, VectList As KFO.Vector)
    ''序时簿选择之后触发
    On Error GoTo Errhandle
    ''向选向量赋值
    Set Vector_SelectBill = VectList
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
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)
    ''驳回审核时触发
    On Error GoTo Errhandle
    ''一级审核驳回发生
    If lCheckMode = 0 And lBusinessLevel = 1 And lCheckStatus = GetCheckLevel(lCheckMaxLevel) Then
       Dim D As Dictionary
       Set D = m_ListInterface.GetCurrentSelRowInfo()
       Set rs = m_ListInterface.K3Lib.GetData("select Fstatus from t_ST_QM_Bmd where fInterId=" & D.GetValue("FInterID"))
       If rs.RecordCount > 0 Then
          If rs!Fstatus = 1 Then
             MsgBox "该单据已经引用，不允许驳回审核！", , "金蝶提示"
             Cancel = True
             Exit Sub
          End If
       End If
    End If
    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 oBand = oMenuBar.BOSBands("menu")
    Set oTool = oBand.BOSTools("mnuPushBill")
    With oTool
        .Visible = False
        .Enabled = True
    End With
    
    '隐藏“上查”工具档按钮
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    Set oTool = oBand.BOSTools("mnuDataViewPrvBill")
    With oTool
        .Visible = False
        .Enabled = True
    End With
 
    '隐藏“下查”工具档按钮
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    Set oTool = oBand.BOSTools("mnuDataViewNextBill")
    With oTool
        .Visible = False
        .Enabled = True
    End With
    '*************** 结束设置 BOS 原有菜单 ***************

    ''根据当前操作员来判断是否显示“过滤”按钮
    '----------------------------------------------------------
    If m_ListInterface.List.ShowMode = 0 Then
       ''如果为审核人时,按原过滤条件显示
       Set rs = m_ListInterface.K3Lib.GetData("select fcheckman from ICClassMCMan where fid=110000311 and fchecklevel=1 and fcheckman=" & m_ListInterface.K3Lib.User.UserID)
       If Not rs.EOF Then
            ''显示过滤菜单和工具栏按钮
            'm_ListInterface.List.ListFilterString = "1=1"
            Set oBand = oMenuBar.BOSBands("BandToolBar")
            Set oTool = oBand.BOSTools("mnuDataFilter")
            With oTool
                .Visible = True
                .Enabled = True
            End With
            Exit Sub
          Exit Sub
       End If
       
       ''如果为制单人时，按原过滤条件显示，否则不能看到任何单据
       Set rs = m_ListInterface.K3Lib.GetData("select fbillerid from t_ST_QM_Bmd where fbillerid=" & m_ListInterface.K3Lib.User.UserID)
       If rs.EOF Then
            ''锁定过滤菜单和工具栏按钮
            m_ListInterface.List.ListFilterString = "1=2"
            Set oBand = oMenuBar.BOSBands("BandToolBar")
            Set oTool = oBand.BOSTools("mnuDataFilter")
            With oTool
                .Visible = False
                .Enabled = False
            End With
            Exit Sub
        Else
            ''显示过滤菜单和工具栏按钮
            'm_ListInterface.List.ListFilterString = "1=1"
            Set oBand = oMenuBar.BOSBands("BandToolBar")
            Set oTool = oBand.BOSTools("mnuDataFilter")
            With oTool
                .Visible = True
                .Enabled = True
            End With
            Exit Sub
       End If
    End If
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub