bos_qmphybillsec.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_QmPhyBillSec"
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 "FDate_Rc", Format(Now, "YYYY-MM-DD HH:MM:SS")    '入厂日期为当前时间
    m_BillInterface.SetFieldValue "FDate_qy", Format(Now, "YYYY-MM-DD HH:MM:SS")    '取样日期为当前时间
    m_BillInterface.SetFieldValue "FCarno", "冀B"                                   '车号预置前辍冀B
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_AfterSave(bCancel As Boolean)
    '单据保存之后
    On Error GoTo Errhandle1
    ''向单据体第一个分录中添加FTempQu（用于统计报表）
    m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLDentry set ftempqu=" & m_BillInterface.GetFieldValue("FQuantity") & " where FInterid=" & m_BillInterface.CurBillID & " and FIndex=1"
    Exit Sub
Errhandle1:
    MsgBox err.Description, vbCritical, "金蝶提示"
    bCancel = True
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                            '当前行变量初值为0
       
       BillEntryRows = 0                                                          '单据体行数变量清为零
       If rs.RecordCount > 0 Then
          BillEntryRows = rs.RecordCount                                          '单据体行数变量赋值
       End If
       
       ''清空单据体全部数据，该勉句心须存在
       m_BillInterface.DeleteEntryData 2                                  '清空单据体全部数据
       
       ''开始向单据体填充数据
       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_Wl", "", 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 Errhandle
    
    ''取服务器日期时间
    Set rs = m_BillInterface.K3Lib.GetData("select getdate()")
    m_BillInterface.SetFieldValue "FBillDate", rs.Fields(0)             '单据日期为服务器时间
    
    ''如果对应检斤单已经结算则不允许进行梨复检
'    Set rs = m_BillInterface.K3Lib.GetData("select t2.FIsCompClosed,t2.FMergedFlag from t_ST_SC_BalanceBill t1 inner join t_ST_SC_BalanceBillentry t2 on t1.Fid=t2.fid where t2.FIsCompClosed>0 and t1.fstatus_wl=" & m_BillInterface.GetFieldValue("FBillNo_FjYd"))
'    If Not rs.EOF Then
'        MsgBox "对应检斤单已经结算不允许进行复检！", , "鑫蝶提示"
'        bCancel = True
'        Exit Sub
'    End If
    
    ''判断检验结果是否合格
    Dim Dict_SelectTemp As KFO.Dictionary
    Set Dict_SelectTemp = Vector_SelectBill(1)
    
    '取当前单据体行数
    If Dict_SelectTemp.GetValue("Finterid") <> "" Then
        Set rs = m_BillInterface.K3Lib.GetData("select Finterid  from t_ST_QM_WLDentry where Finterid=" & Dict_SelectTemp.GetValue("FInterid"))
        BillEntryRows = rs.RecordCount
    End If
    
    '如果当前单据体行数变量为0，重新取当前单据体行数
    If BillEntryRows = 0 Then
       Set rs = m_BillInterface.K3Lib.GetData("select count(*) from t_ST_QM_WLDentry where finterid=" & m_BillInterface.CurBillID)
       BillEntryRows = IIf(IsNull(rs.Fields(0)) = True, 0, rs.Fields(0))
    End If
    
    Dim Result_t As Boolean     '判断结果变量
    Dim H2oMod  As Boolean      '判断水分检验值是否变更
    Dim i As Long               '当前行变量
    
    '开始进行判断
    '------------------------------------------------
    H2oMod = False
    For i = 1 To BillEntryRows
        '取对应检验项目的名称
        Set Rs1 = m_BillInterface.K3Lib.GetData("select t2.fname from QMCheckItem t1 inner join QMAInfo t2 on t1.Fqcmethodid=t2.fid where t1.fid=" & m_BillInterface.GetFieldValue("Fid", i))
        
        If Rs1.RecordCount > 0 Then
        '如果为物理检验项目或化学检验时，则进行判断
        If Rs1.Fields(0) = "物理检验" Or Rs1.Fields(0) = "化学检验" Then
            '如果上限值+下限值>0，且在上下限范围之内，则为合格
            If (Val(m_BillInterface.GetFieldValue("FValue_Xx", i)) + Val(m_BillInterface.GetFieldValue("FValue_sx", i))) <> 0 And Val(m_BillInterface.GetFieldValue("FValue_Wl", i)) >= Val(m_BillInterface.GetFieldValue("FValue_Xx", i)) And Val(m_BillInterface.GetFieldValue("FValue_Wl", i)) <= Val(m_BillInterface.GetFieldValue("FValue_Sx", i)) Then
               m_BillInterface.SetFieldValue "FNote", "合格", i
               
            '如果上限值+下限值>0，且在上下限范围之外，则为不合格
            ElseIf (Val(m_BillInterface.GetFieldValue("FValue_Xx", i)) + Val(m_BillInterface.GetFieldValue("FValue_sx", i))) <> 0 And (Val(m_BillInterface.GetFieldValue("FValue_Wl", i)) < Val(m_BillInterface.GetFieldValue("FValue_Xx", i)) Or Val(m_BillInterface.GetFieldValue("FValue_Wl", i)) > Val(m_BillInterface.GetFieldValue("FValue_Sx", i))) Then
               m_BillInterface.SetFieldValue "FNote", "不合格", i
            
            '如果上限值+下限值=0，且化学检验没有回写时，则为合格
            ElseIf (Val(m_BillInterface.GetFieldValue("FValue_Xx", i)) + Val(m_BillInterface.GetFieldValue("FValue_sx", i))) = 0 Then
               m_BillInterface.SetFieldValue "FNote", "合格", i
            End If
        End If
        
        '如果备注为“不合格”，则判断结果为不合格
        If m_BillInterface.GetFieldValue("Fnote", i) = "不合格" Then
           Result_t = True
        End If
        End If
        '判断水分检验值是否变化
        If m_BillInterface.GetFieldValue("Fid", i, Enu_ValueType_FFND) = "001" And Val(m_BillInterface.GetFieldValue("Fvalue_wl_old", i)) <> Val(m_BillInterface.GetFieldValue("Fvalue_wl", i)) Then
            H2oMod = True
        End If
    Next
    
    '------------------------------------------------
    '根据判断结果回写检验结果字段
    If Result_t = True Then
       m_BillInterface.SetFieldValue "FResult", "不合格"
    Else
       m_BillInterface.SetFieldValue "FResult", "合格"
    End If
    
    '如果水分检验值有变动，则不允许保存。
'    If H2oMod = True Then
'        Set rs = m_BillInterface.K3Lib.GetData("select fstatus_wl from t_ST_SC_BalanceBill where fbillstatus=1 and fstatus_wl=" & m_BillInterface.GetFieldValue("FBillNo_FjYd"))
'        If rs.EOF Then
'            MsgBox "修改水分检验值后，将影响业务单据，请先将业务单据删除后处理！", , "鑫蝶提示"
'            bCancel = True
'            Exit Sub
'        End If
'    End If
    
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
    bCancel = True
End Sub

Private Sub m_BillInterface_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)
    ''多级审核发生后
    On Error GoTo Errhandle
    ''一级审核发生后
    If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckLevel = lCheckMaxLevel And lCheckStatus = GetCheckLevel(lCheckMaxLevel) Then
        
        ''如果存在原单编号，则执行下面代码,更新检斤单FStatus为物理检验单据内码(触发器)
        If m_BillInterface.GetFieldValue("FBillNo_Yd") <> "" Then
           m_BillInterface.K3Lib.UpdateData "update t_ST_SC_BalanceBill set FStatus_Wl=" & m_BillInterface.CurBillID & " where FStatus_Wl=" & m_BillInterface.CurBillID
        End If
    End If
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_AfterSelBill(ByVal lSelBillType As Long)
    ''选单之后触发
    On Error GoTo Errhandle
    ''物理检验单
    Dim i As Long
    Dim Temp_S As String
    Dim Dict_SelectTemp As KFO.Dictionary
    Temp_S = ""
    
    '如果选择了多张上游单据，则默认为第一个单据有效
    For i = Vector_SelectBill.LBound To Vector_SelectBill.UBound
     Set Dict_SelectTemp = Vector_SelectBill(i)
     If i = 1 And Dict_SelectTemp.GetValue("FInterid") <> "" Then
        Set rs = m_BillInterface.K3Lib.GetData("select FInterid,Fqmstyle from t_ST_QM_WLD where finterid=" & Dict_SelectTemp.GetValue("FInterid"))
        If Not rs.EOF Then
           m_BillInterface.SetFieldValue "FBillNo_FjYd", rs!FinterID & ""                 '回写原单号
           
            ''如果为“调拔质检”则更新调拔通知单的检验斤数量为 减去扣水后的数量
            If rs!Fqmstyle = "3" Then
              'Set Rs1 = m_BillInterface.K3Lib.GetData("select fnetweight,FInStockWeight from t_ST_SC_BalanceBillentry where fid in (select fid from  t_ST_SC_BalanceBill where fststus_wl=" & m_BillInterface.CurBillID & ")")
              'm_BillInterface.K3Lib.UpdateData "update ICStockBillOrderentry set FBalanceWeight=FBalanceWeight-(" & Rs1!fnetweight & "/1000)+" & Rs1!FInStockWeight & "  where fid in (select Fid_src from t_ST_SC_BalanceBillentry where fid in (select fid from  t_ST_SC_BalanceBill where fstatus_wl=" & m_BillInterface.CurBillID & "))"
            End If
        End If
     Else
        Exit For
     End If
    Next
    
    ''设置试样编号为：原单试样编号＋“复检”
    m_BillInterface.SetFieldValue "FSyNum", m_BillInterface.GetFieldValue("FSyNum", 2) & "复检"
    Exit Sub