bos_qmchybillsec.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_QmChyBillSec"
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 "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 where t1.fInterid=" & m_BillInterface.GetFieldValue("FSCBillInterId")
       Set rs = m_BillInterface.K3Lib.GetData(SQl_temp)
       
       i = 1                                                                '当前行变量初值为1
       
       '清空单据体全部数据，该句必须存在
       m_BillInterface.DeleteEntryData 2
       
       BillEntryRows = 0                                                    '单据体行数变量清为0
       If rs.RecordCount > 0 Then
          BillEntryRows = rs.RecordCount                                    '给单据体行数变量赋值
       End If
       
       '开始填充数据
       While Not rs.EOF
            m_BillInterface.SetFieldValue "FId", rs!fnumber, i                          '设置“检验项目编号”字段的值
            m_BillInterface.SetFieldValue "FValue_Xx", rs!flowerlimitqty, i             '设置“标准下限”字段的值
            m_BillInterface.SetFieldValue "FValue_Sx", rs!fupperlimitqty, i             '设置“标准上限”字段的值

            Set F_D = m_BillInterface.GetFieldInfoByKey("Fvalue_Xx", "", 0)             '取得当前“标准下限”字段的Dictionary对象
            m_BillInterface.SetDecimal F_D, i, CLng(rs!fqtydecimal)                     '设置“标准下限”当前行的数据精度值

            Set F_D = m_BillInterface.GetFieldInfoByKey("Fvalue_Sx", "", 0)             '取得当前“标准上限”字段的Dictionary对象
            m_BillInterface.SetDecimal F_D, i, CLng(rs!fqtydecimal)                     '设置“标准上限”当前行的数据精度值

            Set F_D = m_BillInterface.GetFieldInfoByKey("Fvalue_hx", "", 0)             '取得当前“检验值”字段的Dictionary对象
            m_BillInterface.SetDecimal F_D, i, CLng(rs!fqtydecimal)                     '设置“检验值”当前行的数据精度值

            If i < rs.RecordCount Then
               m_BillInterface.BillEntrys(1).BOSFields(4).Row = i + 1                   '当前行设置为下一行
               m_BillInterface.InsertNewRowAndFill 2, i + 1                '插入一个新行
            End If
            rs.MoveNext                                                                 '结果集向后移动
            i = i + 1                                                                   '当前行变量加1
       Wend
    End If
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_beforesave(ByRef bCancel As Boolean)
    ''单据保存之前
    On Error GoTo Errhandle1
    ''取服务器日期时间
    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_AfterSelBill(ByVal lSelBillType As Long)
    ''选单之后触发
    On Error GoTo Errhandle
    Dim Dict_SelectTemp As KFO.Dictionary
    Set Dict_SelectTemp = Vector_SelectBill(1)
    m_BillInterface.SetFieldValue "FBillNo_FjYd", Dict_SelectTemp.GetValue("FInterid") & ""                '原单号赋值
    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_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)
    ''多级审核发生时
    On Error GoTo Errhandle
    ''一级审核发生时
    If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckLevel = lCheckMaxLevel And lCheckStatus = GetCheckLevel(lCheckMaxLevel - 1) Then
       Dim Wl_Index As Long
       Set rs = m_BillInterface.K3Lib.GetData("select t1.FResult,t1.Fstatus,t1.FInterId,t1.FBillNo_FjYd,t2.FBillNo_yd from t_ST_QM_Hxd t1 left join t_ST_QM_Bmd t2 on t1.FBillNo_yd=t2.FInterId where t1.fInterId=" & m_BillInterface.CurBillID)
       If rs.RecordCount > 0 Then
          If rs!Fstatus = 0 Then
             ''更新原化学单为作废状态
             m_BillInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set fstatus=1,fjystyle='作废' where finterid=" & rs!fbillno_fjyd
             
             ''更新当前化学单原单编号为作废前的原单编号
             m_BillInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set Fstatus=2,Fbillno_yd=(select Fbillno_yd from t_ST_QM_Hxd where finterid=" & rs!fbillno_fjyd & ") where Finterid=" & m_BillInterface.CurBillID
             
             Set rs = m_BillInterface.K3Lib.GetData("select t1.FResult,t1.Fstatus,t1.FInterId,t1.FBillNo_FjYd,t2.FBillNo_yd from t_ST_QM_Hxd t1 left join t_ST_QM_Bmd t2 on t1.FBillNo_yd=t2.FInterId where t1.fInterId=" & m_BillInterface.CurBillID)
             ''将化学检验结果添加到物理检验单中
             Set Rs1 = m_BillInterface.K3Lib.GetData("select max(FIndex) as maxid from t_ST_QM_WLDEntry  where fInterId=" & CNulls(rs!Fbillno_yd, 0))
             Wl_Index = IIf(IsNull(Rs1!maxid), 0, Rs1!maxid)
             Set Rs1 = m_BillInterface.K3Lib.GetData("select * from t_ST_QM_HxdEntry  where fInterId=" & m_BillInterface.CurBillID)
             
             ''添加之前将物理检验单中的化学检验结果删除
             m_BillInterface.K3Lib.GetData ("delete from t_ST_QM_WLDEntry  where fInterId_hx=" & rs!fbillno_fjyd & " and FInterid=" & CNulls(rs!Fbillno_yd, 0))
             
             Dim Result_t As Boolean             '判断是否合格的最终变量
             Dim Result_temp  As String            '判断是否合格的中间变量
             '开始循环
             While Not Rs1.EOF
                ''判断检验结果是否合格
                '----------------------------------------------------------------------------------------------------------------------------
                ''开始判断是否合格
                    ''如果上限值+下限值<>0,且检验检验值在上下限范围之内，则为合格
                    If (Val(Rs1!FValue_Xx) + Val(Rs1!FValue_sx)) <> 0 And Val(Rs1!FValue_hx) >= Val(Rs1!FValue_Xx) And Val(Rs1!FValue_hx) <= Val(Rs1!FValue_sx) Then
                       Result_temp = "合格"
                    ''如果上限值+下限值<>0,且检验检验值在上下限范围之外，则为不合格
                    ElseIf (Val(Rs1!FValue_Xx) + Val(Rs1!FValue_sx)) <> 0 And (Val(Rs1!FValue_hx) < Val(Rs1!FValue_Xx) Or Val(Rs1!FValue_hx) > Val(Rs1!FValue_sx)) Then
                       Result_temp = "不合格"
                    ''如果上限值+下限值=0则不用判断，结果为合格
                    ElseIf (Val(Rs1!FValue_Xx) + Val(Rs1!FValue_sx)) = 0 Then
                       Result_temp = "合格"
                    End If


                ''根据判断结果给检验结果字段赋值
                If Result_temp = "不合格" Then
                   Result_t = True
                End If
                '----------------------------------------------------------------------------------------------------------------------------
                 m_BillInterface.K3Lib.UpdateData "INSERT INTO t_ST_QM_WLDEntry(FIndex,FInterId,FId,FValue_Xx,FValue_Sx," & _
                                                  "FValue_Wl,FNote,FInterId_Hx) Values(" & Wl_Index & "," & CNulls(rs!Fbillno_yd, 0) & _
                                                  "," & Rs1!FID & "," & Rs1!FValue_Xx & "," & Rs1!FValue_sx & "," & _
                                                  Rs1!FValue_hx & ",'" & Result_temp & "'," & m_BillInterface.CurBillID & ")"
                 Rs1.MoveNext
                 Wl_Index = Wl_Index + 1
             Wend
                
             ''如果化学检验单不合格则对应物理检验单也应为不合格，否则为合格
             If Result_t = True Then
               Set Rs1 = m_BillInterface.K3Lib.GetData("select FResult from t_ST_QM_WLD where finterid=" & CNulls(rs!Fbillno_yd, 0))
                If Rs1.RecordCount > 0 Then
                    If Rs1!FResult = "合格" Then
                        m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set fresult='不合格' where finterid=" & rs!Fbillno_yd
                    End If
                End If
             Else
                Set Rs1 = m_BillInterface.K3Lib.GetData("select Fnote from t_ST_QM_WLDentry where fnote='不合格' and finterid=" & CNulls(rs!Fbillno_yd, 0) & " and finterid_hx=0")
                If Rs1.EOF Then
                   m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set fresult='合格' where finterid=" & CNulls(rs!Fbillno_yd, 0)
                End If
             End If
          End If
       End If