bos_rolloutstock.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_rolloutstock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
 '**********************************************************************
 '2006-06-01 张健
 '热轧卷板销售库单的插件
 '功能：用于放在热轧卷板销售库单的插件中
 '**********************************************************************
Option Explicit
Private WithEvents m_BillInterface  As BillEvent
Attribute m_BillInterface.VB_VarHelpID = -1
Public tuityperow As String
Public sumbalance As Double
Dim aa() As String
Dim net1, net2 As Double

Public Sub Show(ByVal oBillInterface As Object)

    'BillEvent 接口实现
    '注意: 此方法必须存在, 请勿修改
    Set m_BillInterface = oBillInterface
   
End Sub
Private Sub Class_Terminate()
    '释放接口对象
    '注意: 此方法必须存在, 请勿修改
    Set m_BillInterface = Nothing
  
End Sub



Private Sub m_BillInterface_AfterLoadBill()
m_BillInterface.LockBill
End Sub

Private Sub m_BillInterface_AfterSave(bCancel As Boolean)
    Dim i As Integer
    Dim strSql, qq, bb As String
    Dim rs, rt As ADODB.Recordset
    
    On Error GoTo errAfterSave
    '用frewriteflag来控制不能重多次保存所带来的对检斤单和自动生成销售出库单的操作
    qq = "select frewriteflag from t_sheetoutstock where fid=" & m_BillInterface.CurBillID
    Set rt = m_BillInterface.K3Lib.GetData(qq)
    If rt.Fields(0) = True Then Exit Sub
   
    For i = 1 To UBound(aa)
        m_BillInterface.K3Lib.GetData ("update t_ST_SC_BalanceBill set fmodifyflag=1 where fbillno='" & aa(i) & "'")
    Next


'###########################################################
'自动生成销售出库单
'先取出发货通知单中购货单位的ID,以做下面存储过程的参数。
    Dim cust, strcust As String
    Dim rscust As ADODB.Recordset
    Dim g_StrUser As Integer
    cust = m_BillInterface.GetFieldValue("fcustomer")
    g_StrUser = m_BillInterface.K3Lib.User.UserID
    strSql = "exec BjSp_Autooutstock 1," & m_BillInterface.CurBillID & "," & cust & "," & g_StrUser
    m_BillInterface.K3Lib.GetData (strSql)
    bb = "update t_sheetoutstock set frewriteflag=1 where fid=" & m_BillInterface.CurBillID
    m_BillInterface.K3Lib.GetData (bb)
    
    Exit Sub
    m_BillInterface.LockBill
errAfterSave:
    MsgBox err.Description, vbCritical, "金蝶提示"
    Set rs = Nothing
End Sub

Private Sub m_BillInterface_AfterSelBill(ByVal lSelBillType As Long)
    Dim rrz As ADODB.Recordset
    Dim xy1 As String
    m_BillInterface.LockBill
    m_BillInterface.BillHeads(1).BOSFields.Item("fcarno").FieldLock = False
    m_BillInterface.BillHeads(1).BOSFields.Item("fnote").FieldLock = False
    m_BillInterface.SetFieldValue "fsum", 0
    xy1 = "select t2.fqty from seoutstock t1 inner join seoutstockentry t2 on t2.finterid=t1.finterid where t1.fbillno='" & m_BillInterface.GetFieldValue("fbillno_src") & "'"
    Set rrz = m_BillInterface.K3Lib.GetData(xy1)
    If Not rrz.EOF Then
        m_BillInterface.SetFieldValue "fqty", rrz.Fields(0)
    End If
    
End Sub

Private Sub m_BillInterface_beforesave(bCancel As Boolean)
    Dim status As String
    Dim a As Integer
    With m_BillInterface
        If Not CheckMar() Then MsgBox "发货通知的物料与检斤单物料不同，请查找原因": bCancel = True: Exit Sub
        If Not calcnetweight() Then   'm_BillInterface.BillCtl.Data("page2").Size
            If MsgBox("由于所装卷板量比发货通知单所开的量多" & Str((net1 - net2) / 1000) & "吨，是否保存？", vbYesNo, "国丰提示") = vbNo Then
                bCancel = True
                Exit Sub
            End If
        End If
        If Len(.GetFieldValue("fcarno")) = 0 Then
            MsgBox "车号不能为空，请录入", vbInformation, "国丰提示"
            bCancel = True
            Exit Sub
        End If
   a = m_BillInterface.BillCtl.Data("Page3").Size
   ReDim aa(a)
   For a = 1 To a
        aa(a) = .GetFieldValue("fjianjinno", a)
   Next
        .SetFieldValue "fseoutno", .GetFieldValue("fseoutbillno")
        .SetFieldValue "FBase", .GetFieldValue("Fcustomer", , 2)
        .SetFieldValue "fsendstock1", .GetFieldValue("fstock", , 2)
        .SetFieldValue "fqty1", .GetFieldValue("fqty")
    End With
   m_BillInterface.SetFieldValue "fsum", sumbalance / 1000
End Sub

Private Function CheckMar() As Boolean   'ByVal lrow As Long
    Dim lrowcont As Long
    Dim StrMar1, strmar3 As String
    Dim strMar2 As String
    With m_BillInterface
        StrMar1 = .GetFieldValue("Fmar", 1)
        strmar3 = .GetFieldValue("Fmaterial1")
        If StrMar1 <> strmar3 Then
                CheckMar = False
                Exit Function
        End If
    End With
    CheckMar = True
End Function

Private Function calcnetweight() As Boolean   'ByVal lrow As Long
Dim rr As ADODB.Recordset
Dim strr, strtype1, strtype2 As String
Dim S_Key As String
Dim L_Index As Long
Dim kk, lrowcont As Long
Dim rr1 As ADODB.Recordset
Dim xy As String
With m_BillInterface
net1 = 0
net2 = 0
'取所选 检斤单净重合计
net1 = m_BillInterface.Sum(m_BillInterface.GetFieldInfoByKey("Fnetweight", S_Key, L_Index))
sumbalance = net1
xy = "select t2.fqty,t2.fentryselfs0232 from seoutstock t1 inner join seoutstockentry t2 on t2.finterid=t1.finterid where t1.fbillno='" & .GetFieldValue("fbillno_src") & "'"
Set rr1 = .K3Lib.GetData(xy)
    'net2 = .GetFieldValue("fqty") * 1000
       'If net2 = 0 Then
       net2 = (rr1.Fields(0) - rr1.Fields(1)) * 1000
       If net1 > net2 Then
            
            calcnetweight = False
            Exit Function
            
        End If
End With
calcnetweight = True
End Function