bos_bidhitrec.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_BidHitRec"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'''''''''''''''''''''''''''''''''''''''''''''''
''中标记录
''建立日期：2005-08-15
''建立人：裴立巍
'''''''''''''''''''''''''''''''''''''''''''''''''
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_AfterSave(bCancel As Boolean)
 ''将中标情况回写到报价单
    Dim strSql As String
    strSql = "exec Bid_Sp_BackWrite  @InBidBillNo ='" & m_BillInterface.GetFieldValue("FBidBillNo") & "'"
    m_BillInterface.K3Lib.GetData strSql
End Sub

Private Sub m_BillInterface_AfterSelBill(ByVal lSelBillType As Long)
''选单之后触发
    Dim strSql As String
    Dim rsRec As New ADODB.Recordset
    Dim lngCurrRow As Integer
    
  On Error GoTo Errhandle
  
    ''系统自动选择出价最低的供应商中标
    strSql = "exec Bid_Sp_PriceReport  @InBidBillNo ='" & m_BillInterface.GetFieldValue("FBidBillNo") & "'"
    m_BillInterface.K3Lib.GetData strSql
    Set rsRec = m_BillInterface.K3Lib.GetData("select FMItem,FNumber,FQty,FSuppNo,FPrice,FIsHited From Result order by RID")
    lngCurrRow = 1
    
    m_BillInterface.DeleteEntryData 4
    m_BillInterface.DeleteEntryData 2
    ''将中标供应商填写入中标记录
    If Not rsRec.EOF Then
       While Not rsRec.EOF
              If lngCurrRow <= rsRec.RecordCount Then
                 m_BillInterface.InsertNewRowAndFill 4, lngCurrRow, "FMItem", rsRec("FNumber"), "FQty", rsRec("FQty"), "FSupplier", rsRec("FSuppNo"), "FPrice", rsRec("FPrice"), "FIsHited", rsRec("FIsHited"), "FAmount", rsRec("FPrice") * rsRec("FQty")
              End If
                
              lngCurrRow = lngCurrRow + 1
              rsRec.MoveNext
           
        Wend
        
        '添加中标记录
        rsRec.MoveFirst
        lngCurrRow = 1
        While Not rsRec.EOF
             
             If rsRec("FIsHited") = 1 Then
                    m_BillInterface.InsertNewRowAndFill 2, lngCurrRow, "FPMItem", rsRec("FNumber"), "FPQty", rsRec("FQty"), "FPSupplier", rsRec("FSuppNo"), "FPPrice", rsRec("FPrice"), "FPAmount", rsRec("FPrice") * rsRec("FQty")
                    lngCurrRow = lngCurrRow + 1
              End If
            
              rsRec.MoveNext
    
        Wend
    End If

Errhandle:

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)
''改变中标情况后触发,将选择的新中标供应商填写入中标记录
    Dim strFMItem As String
    Dim lngCurrRow As Integer
    
   On Error GoTo Errhandle
   
    If dct.Value("Ffieldname") <> "FIsHited" Then
       Exit Sub
    End If
    strFMItem = m_BillInterface.GetFieldValue("FMItem")
    
    lngCurrRow = 1
    While 1 = 1
          If m_BillInterface.GetFieldValue("FMItem", lngCurrRow) = strFMItem Then
            If lngCurrRow <> Row Then
                    m_BillInterface.SetFieldValue "FIsHited", 0, lngCurrRow
            End If
          End If
          lngCurrRow = lngCurrRow + 1
    Wend
    
Errhandle:

    lngCurrRow = 1
    Do While 1
        If m_BillInterface.Data("page2").UBound >= lngCurrRow Then
                
            If m_BillInterface.GetFieldValue("FPMItem", lngCurrRow) = strFMItem Then
                    m_BillInterface.SetFieldValue "FPSupplier", m_BillInterface.GetFieldValue("FSupplier", , Enu_ValueType_FDSP), lngCurrRow
                     m_BillInterface.SetFieldValue "FBidPrice", m_BillInterface.GetFieldValue("FPrice"), lngCurrRow
                    m_BillInterface.SetFieldValue "FPPrice", m_BillInterface.GetFieldValue("FPrice"), lngCurrRow
                    m_BillInterface.SetFieldValue "FPAmount", m_BillInterface.GetFieldValue("FAmount"), lngCurrRow
                    m_BillInterface.SetFieldValue "FCause", "", lngCurrRow
                    Exit Do
            Else
                    lngCurrRow = lngCurrRow + 1
            End If
        Else
            Exit Do
        End If
    Loop
End Sub