bos_qmchybill.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_QmChyBill"
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

''临时结果集对象
Dim Rs_Chy As New ADODB.Recordset

Public Sub Show(ByVal oBosInterface As Object)
    'BillEvent 接口实现
    '注意: 此方法必须存在, 请勿修改
    Select Case VBA.TypeName(oBosInterface)
    Case "BillEvent"
        Set m_BillInterface = oBosInterface
        ''设定化学检验单据头的质检方案默认过滤条件为“化学检验”
        m_BillInterface.BillHeads.Item(1).BOSFields("FSCBillInterId").Filter = "vwICQCScheme.fid in(select distinct t1.fInterId from icqcscheme t1 inner join icqcschemeentry t2 on t1.finterid=t2.finterid and t1.fcheckerid>0 inner join QMAInfo t3 on t2.Fqcmethodid=t3.fid where t3.FName='化学检验')"
    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_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
    
     '新增 作废 菜单对象，并设置属性
     '-----------------------------------------------------
     Set oTool = oMenuBar.BOSTools.Add("mnuDrop")
       With oTool
           .Caption = "作废"
           .ToolTipText = "作废"
           .Description = "作废"
    
           .ShortcutKey = 3
           .Visible = True
           .Enabled = True
           .BeginGroup = False
           .ToolPicture = App.Path & "\Drop.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

Private Sub m_BillInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
    ''工具栏按钮单击时触发
    On Error GoTo Errhandle
    Select Case BOSTool.ToolName
    Case "mnuDrop"                  '作废按钮单击时
         '对应检验单二级审核完成时，能符合作废条件
         If m_BillInterface.GetFieldValue("Fstatus") = 2 Then
            
            ''如果为收料质检等检验类型时
            If m_BillInterface.GetFieldValue("FQmStyle") = 2 Or m_BillInterface.GetFieldValue("FQmStyle") = 3 Or m_BillInterface.GetFieldValue("FQmStyle") = 4 Or m_BillInterface.GetFieldValue("FQmStyle") = 5 Or m_BillInterface.GetFieldValue("FQmStyle") = 6 Or m_BillInterface.GetFieldValue("FQmStyle") = 8 Then
               ''物理检验单的原单信息,也就是检斤单信息
               Set Rs1 = m_BillInterface.K3Lib.GetData("select fbillno_yd from t_ST_QM_WLD  where fbillno_hx=" & m_BillInterface.CurBillID)
               
               ''取对应检斤单的单据状态
               Set rs = m_BillInterface.K3Lib.GetData("select fbillstatus from t_ST_SC_BalanceBill  where fid in(" & Rs1!Fbillno_yd & ")")
               While Not rs.EOF
                   If rs!fbillstatus <> 1 Then
                      MsgBox "对应检斤单已经进行了业务处理,删除对应的业务单据才能进行作废处理!", , "金蝶提示"
                      Cancel = True
                      Exit Sub
                   End If
                   rs.MoveNext
               Wend
            End If
            
            '调用单据作废处理过程
            If MsgBox("是否进行单据作废？", vbOKCancel + vbDefaultButton2, "金蝶提示") = vbOK Then
               DropBills m_BillInterface.CurBillID         '作废单据
               MsgBox "单据作废成功！", , "金蝶提示"
            End If
         ElseIf m_BillInterface.GetFieldValue("Fstatus") = 1 Then
            MsgBox "该单据已经作废!", , "金蝶提示"
            Cancel = True
         Else
            MsgBox "该单据不能作废!", , "金蝶提示"
            Cancel = True
         End If
    Case Else
    End Select
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_AfterLoadBill()
    ''单据新增后触发
    On Error GoTo Errhandle
    ''根据“原单编号”是否为空来锁定字段
    ''------------------------------------------------------------------------------------------------------
    If m_BillInterface.GetFieldValue("FBillNo_Yd") <> "" Then
       m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = True         '质检方案
       m_BillInterface.BillHeads(1).BOSFields.Item("FBmNum").FieldLock = True           '保密编号
       m_BillInterface.BillHeads(1).BOSFields.Item("FItemId_Ic").FieldLock = True       '物料
    Else
       m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = False        '质检方案
       m_BillInterface.BillHeads(1).BOSFields.Item("FBmNum").FieldLock = False          '保密编号
       m_BillInterface.BillHeads(1).BOSFields.Item("FItemId_Ic").FieldLock = False      '物料
    End If
    ''------------------------------------------------------------------------------------------------------
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
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 "FBillDate_bc", 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_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.Value("Ffieldname") = "FSCBillInterId" And m_BillInterface.GetFieldValue("FSCBillInterId") <> "" Then
       Dim SQl_temp As String           '查询字符串变量
       Dim i As Long                    '当前行变量
       Dim F_D As Dictionary            'KFO.Dictionary对象变量
       '取质检方案详细内容
       SQl_temp = "select t3.fnumber,t2.fqcunit,t2.flowerlimitqty,t2.fupperlimitqty,t3.fqtydecimal from icqcscheme t1 left join icqcschemeentry t2 on t1.finterid=t2.finterid left join QMCheckItem t3 on t2.fqcitemid=t3.fid inner join QMAInfo t4 on t3.Fqcmethodid=t4.fid and t4.FName='化学检验' where t1.fInterid=" & m_BillInterface.GetFieldValue("FSCBillInterId")
       Set rs = m_BillInterface.K3Lib.GetData(SQl_temp)
       i = 1                            '当前行变量初值为1
       
       '清空单据体数据，该句必须存在
       m_BillInterface.DeleteEntryData 2                                  '清空单据体全部数据
       
       ''根据“原单编号”是否为空来锁定字段
       ''------------------------------------------------------------------------------------------------------
       If m_BillInterface.GetFieldValue("FBillNo_Yd") <> "" Then
          m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = True          '质检方案
          m_BillInterface.BillHeads(1).BOSFields.Item("FBmNum").FieldLock = True            '保密编号
          m_BillInterface.BillHeads(1).BOSFields.Item("FItemId_Ic").FieldLock = True        '物料
       Else
          m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = False         '质检方案
          m_BillInterface.BillHeads(1).BOSFields.Item("FBmNum").FieldLock = False           '保密编号
          m_BillInterface.BillHeads(1).BOSFields.Item("FItemId_Ic").FieldLock = False       '物料
       End If
       ''------------------------------------------------------------------------------------------------------
       
       BillEntryRows = 0                                                            '单据体行数变量清为0
       If rs.RecordCount > 0 Then
          BillEntryRows = rs.RecordCount                                            '给单据体行数赋值
       End If
       
       '开始向单据体填充数据
       While Not rs.EOF
            m_BillInterface.SetFieldValue "FId", rs!fnumber, i                          '设置“检验项目编号”字段的值