bos_bidprice.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_BidPrice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'''''''''''''''''''''''''''''''''''''''''''''''
''招投标报价单
''建立日期：2005-08-17
''建立人：倪树祥
'''''''''''''''''''''''''''''''''''''''''''''''''
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_AfterSelBill(ByVal lSelBillType As Long)
    Dim lngCurrRow As Integer
    Dim rsRec As New Recordset
    Dim strSql As String

    strSql = "select tic.FNumber as FINumber,tme.FNumber as FUNumber,tbe.FAmount,tbe.FDeliveryDate,tbe.FEntryNote from t_EP_PB_BidBill tb inner join t_EP_PB_BidBillentry tbe on tb.FID=tbe.FID  inner join t_icitem tic on tbe.FMItem = tic.Fitemid inner join t_measureunit tme on tbe.FunitID=tme.FMeasureUnitID where tb.FBillNo ='" & m_BillInterface.GetFieldValue("FBidBillNO") & "'" & "order by tbe.findex"
    
    Set rsRec = m_BillInterface.K3Lib.GetData(strSql)
    
    rsRec.MoveFirst
    
    lngCurrRow = 1
        
        While Not rsRec.EOF
        
            m_BillInterface.InsertNewRowAndFill 2, lngCurrRow, "FMItem", rsRec("FINumber"), "FBase", rsRec("FUNumber"), "FQty", rsRec("FAmount"), "FDeliveryDate", rsRec("FDeliveryDate"), "FNote1", rsRec("FEntryNote")
            
            lngCurrRow = lngCurrRow + 1
            
            rsRec.MoveNext
    
        Wend
        
        
End Sub

Private Sub m_BillInterface_beforesave(bCancel As Boolean)
    Dim rsRec As New Recordset
    Dim strSql As String
    Dim flag As New Recordset
    Dim strchecker As String
    Dim strfind As String
    Dim flag1 As New Recordset
    
    'and BB.Checker > 0   modify by christin 20060805
    strSql = "select 1 from t_EP_PB_BidBack BB inner join t_EP_PB_BidBackEntry BE on  BB.FID = BE.FID where BB.FID = (select FID from t_EP_PB_BidBack where FBIllNo_SRC = '" & m_BillInterface.GetFieldValue("FBidBillNO") & "') and BB.Checker > 0 and BE.FSupplier = " & m_BillInterface.GetFieldValue("FSupplier")
    Set rsRec = m_BillInterface.K3Lib.GetData(strSql)
    If rsRec.EOF Then
        MsgBox "当前供应商没有出现在标书回收记录中！", vbOKOnly + vbInformation, "金蝶提示"
        bCancel = True
    End If
    
    strchecker = "select checker from t_EP_PB_BidBack where fbidbillno='" & m_BillInterface.GetFieldValue("FBidBillNO") & "'"
    Set flag = m_BillInterface.K3Lib.GetData(strchecker)
    If Not flag.BOF Then
        If flag("checker") = 0 Then
            MsgBox "请先审核标书回收记录！", vbOKOnly + vbInformation, "金蝶提示"
            bCancel = True
        End If
    End If
    
    strfind = "select 1 from t_EP_PB_BidPrice where fbidbillno='" & m_BillInterface.GetFieldValue("FBidBillNO") & "'and Fsupplier='" & m_BillInterface.GetFieldValue("FSupplier") & "'" & "and fid <>'" & m_BillInterface.CurBillID & "'"
    Set flag1 = m_BillInterface.K3Lib.GetData(strfind)
    If Not flag1.EOF Then
        MsgBox "该供应商的报价单已经存在！", vbOKOnly + vbInformation, "金蝶提示"
        bCancel = True
    End If
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.GetValue("FFieldName") = "FAmount" Then
        m_BillInterface.SetFieldValue "FSumAmount", m_BillInterface.Sum(dct, 1)
        Exit Sub
    End If
    


    Dim dblFSumAmount As Double
    Dim lngCurrRow As Long
    dblFSumAmount = 0
    For lngCurrRow = 1 To m_BillInterface.BillEntrys(1).MaxRows
        dblFSumAmount = dblFSumAmount + m_BillInterface.GetFieldValue("FAmount", lngCurrRow)
    Next
  
Errhandle:
     m_BillInterface.SetFieldValue "FSumAmount", dblFSumAmount
    
End Sub