bos_qmphybill.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_QmPhyBill"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "This is BillEvent Interface Class, made by K3BOSPLUGINSWIZAED"
'''''''''''''''''''''''''''''''''''''''''''''''''
''物理检验单
''建立日期：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
        
    ''保存变量，（保存之后）
    Private CurBillId1 As Long      '单据内码
    Private CurBillQty1 As Double   '单据数量
    Private CurBillYd1 As String    '原单内码

Public Sub Show(ByVal oBosInterface As Object)
    'BillEvent 接口实现
    '注意: 此方法必须存在, 请勿修改
    Select Case VBA.TypeName(oBosInterface)
        Case "BillEvent"                                '单据
            QM_Select = True
            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
    QM_Select = False                                   '是否物理检验单选择了检斤单标志变量清空
End Sub

Private Sub m_BillInterface_AfterLoadBill()
    ''单据加载时发生
    On Error GoTo Errhandle
        
    ''给变量赋值
    CurBillId1 = 0
    CurBillQty1 = 0
    CurBillYd1 = ""
    
    CurBillId1 = m_BillInterface.CurBillID
    CurBillQty1 = m_BillInterface.GetFieldValue("FQuantity")
    CurBillYd1 = m_BillInterface.GetFieldValue("FBillNo_Yd")
    
    ''如果物理检验单添加化学检验结果后，则将单据标题改为“原料理化检验单”
    '得到物理检验单的化学检验单据内码
    Set rs = m_BillInterface.K3Lib.GetData("select FBillNo_Hx from t_ST_QM_WLD where FInterid=" & m_BillInterface.CurBillID)
    If Not rs.EOF Then
       If rs.Fields(0) > 0 Then                             ''如果化学检验结果已经更新,将单据显示为“原料理化单”
          m_BillInterface.BillName = "原料理化单"
          m_BillInterface.SetBillFormCaption "原料理化单"
       Else                                                 ''如果化学检验结果没有更新,将单据显示为“物理检验单”
          m_BillInterface.BillName = "物理检验单"
          m_BillInterface.SetBillFormCaption "物理检验单"
       End If
    End If
    
    ''------------------------------------------------------------------------------------------------------------
    ''根据原单编号是否为空来锁定相关字段
    If m_BillInterface.GetFieldValue("FBillNo_Yd") <> "" Then
       m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = True         ''检验类型
       m_BillInterface.BillHeads(1).BOSFields.Item("FSupplyId").FieldLock = True        ''供应商
       m_BillInterface.BillHeads(1).BOSFields.Item("FItemId_Ic").FieldLock = True       ''物料
       m_BillInterface.BillHeads(1).BOSFields.Item("FCarNo").FieldLock = True           ''车号
    Else
       m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = False        ''检验类型
       m_BillInterface.BillHeads(1).BOSFields.Item("FSupplyId").FieldLock = False       ''供应商
       m_BillInterface.BillHeads(1).BOSFields.Item("FItemId_Ic").FieldLock = False      ''物料
       m_BillInterface.BillHeads(1).BOSFields.Item("FCarNo").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 "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_AfterDoAction(ByVal dct As KFO.Dictionary, ByVal dctFld As KFO.Dictionary, ByVal ItemObj As Object, ByVal ActionTypeName As String, ByVal ActionName As String, ByVal Paremeters As String)
    ''值更新事件处理后发生
    On Error GoTo Errhandle
    ''选完单（检斤单）后根据物料自自动带出质检方案
    ''如当前更改的字段为物料
    If UCase(dct.Value("Ffieldname")) = UCase("FItemId_Ic") And m_BillInterface.GetFieldValue("FItemId_Ic") <> "" Then
        ''如果为值更新
        If ActionTypeName = "FAction" And ActionName = "TakeBaseData" Then
        
           ''取历史数据中为当前检验类型和当前物料的质检方案的编码
           Set rs = m_BillInterface.K3Lib.GetData("select t2.Fbillno from t_ST_QM_WLD t1 left join icqcscheme t2 on t2.finterid=t1.FSCBillInterId  where t1.fqmstyle=" & m_BillInterface.GetFieldValue("Fqmstyle") & "  and t1.Fitemid_ic=" & m_BillInterface.GetFieldValue("FItemId_Ic", 1) & " and t1.fbilldate=(select max(fbilldate) from t_ST_QM_WLD where fitemid_ic=" & m_BillInterface.GetFieldValue("FItemId_Ic", 1) & ")")
           If rs.RecordCount > 0 Then
              ''给质检方案字段赋值为对应的质检方案的编码
              m_BillInterface.SetFieldValue "FSCBillInterId", rs!FBillNO
              
              ''取对应质检方案的详细内容
              '---------------------------------------------------
              Dim SQl_temp As String        '临时查询字符串变量
              Dim i As Long                 '当前行变量
              Dim F_D As Dictionary         ' kfo.dictionare对象变量
              ''取质检验方案内容
              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
              
              ''根据“原单编号”是否为空来锁定相关字段
              ''------------------------------------------------------------------------------------------------------------
              If m_BillInterface.GetFieldValue("FBillNo_Yd") <> "" Then
                 m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = True           ''检验类型
                 m_BillInterface.BillHeads(1).BOSFields.Item("FSupplyId").FieldLock = True          ''供应商
                 m_BillInterface.BillHeads(1).BOSFields.Item("FItemId_Ic").FieldLock = True         ''物料
                 m_BillInterface.BillHeads(1).BOSFields.Item("FCarNo").FieldLock = True             ''车号
              Else
                 m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = False          ''检验类型
                 m_BillInterface.BillHeads(1).BOSFields.Item("FSupplyId").FieldLock = False         ''供应商
                 m_BillInterface.BillHeads(1).BOSFields.Item("FItemId_Ic").FieldLock = False        ''物料
                 m_BillInterface.BillHeads(1).BOSFields.Item("FCarNo").FieldLock = False            ''车号
              End If
              ''------------------------------------------------------------------------------------------------------------
              
              ''向单据体填充质检方案中的检验项目数据
              ''------------------------------------------------------------------------------------------------------------
              BillEntryRows = 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_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
        End If
    End If
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_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)
    ''驳回审核时触发
    On Error GoTo Errhandle
    
    ''二级审核驳回时
    If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckStatus = 1 Then
        ''更新检斤单单据体扣杂数量Fdeductweight(解发器算干基数量)
        m_BillInterface.K3Lib.UpdateData "update t_ST_SC_BalanceBillentry set FDeductWeight=FDeductWeight where FID in(" & m_BillInterface.GetFieldValue("FBillNo_YD") & ")"
        
        ''如果是外购生铁，则调整质检单的数量
        If m_BillInterface.GetFieldValue("Fitemid_ic", , Enu_ValueType_FDSP) = "102.00001" Then
           m_BillInterface.K3Lib.UpdateData "exec BjSp_UpdateQmFeQty 'WLD0'," & m_BillInterface.CurBillID & "," & m_BillInterface.GetFieldValue("FBillNo_Yd") & ",0"
        End If
    End If
    
    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 UCase(dct.Value("Ffieldname")) = UCase("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                                   '清空单据体全部数据
       
       ''根据“原单编号”是否为空来锁定相关字段
       ''------------------------------------------------------------------------------------------------------------
        If m_BillInterface.GetFieldValue("FBillNo_Yd") <> "" Then
           m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = True         '质检方案
           m_BillInterface.BillHeads(1).BOSFields.Item("FSupplyId").FieldLock = True        '供应商
           m_BillInterface.BillHeads(1).BOSFields.Item("FItemId_Ic").FieldLock = True       '物料
           m_BillInterface.BillHeads(1).BOSFields.Item("FCarNo").FieldLock = True           '车号
        Else
           m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = False        '质检方案
           m_BillInterface.BillHeads(1).BOSFields.Item("FSupplyId").FieldLock = False       '供应商