bos_rpcontract.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_RPContract"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'''''''''''''''''''''''''''''''''''''''''''''''
''应付合同修改
''建立日期：2005-09-28
''建立人：倪树祥
'''''''''''''''''''''''''''''''''''''''''''''''''
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_AfterLoadBill()
    AdjustPosition
End Sub

Private Sub m_BillInterface_AfterNewBill()
    AdjustPosition
End Sub

Private Sub AdjustPosition()
'调整自定义字段的位置,抵消第一个插件的影响
    '部门
    m_BillInterface.BillHeads(1).BOSFields("FDepartment").FieldTop = 5325
    m_BillInterface.BillHeads(1).BOSFields("FDepartment").FieldLeft = 235
    
     '业务员
    m_BillInterface.BillHeads(1).BOSFields("FEmployee").FieldTop = 5325
    m_BillInterface.BillHeads(1).BOSFields("FEmployee").FieldLeft = 2318
    
     '科长
    m_BillInterface.BillHeads(1).BOSFields("FDeptChecker").FieldTop = 5325
    m_BillInterface.BillHeads(1).BOSFields("FDeptChecker").FieldLeft = 4328
    
    '部长
    m_BillInterface.BillHeads(1).BOSFields("FMainChecker").FieldTop = 5325
    m_BillInterface.BillHeads(1).BOSFields("FMainChecker").FieldLeft = 6165
    
    '主管经理
    m_BillInterface.BillHeads(1).BOSFields("FSubChair").FieldTop = 5325
    m_BillInterface.BillHeads(1).BOSFields("FSubChair").FieldLeft = 7875
    
    '制单人
    m_BillInterface.BillHeads(1).BOSFields("FBillerID").FieldTop = 5325
    m_BillInterface.BillHeads(1).BOSFields("FBillerID").FieldLeft = 10163
    
    '第二条：质量标准
    m_BillInterface.BillHeads(1).BOSFields("FCompDetails").FieldTop = 5625
       
    '第三条：包装
    m_BillInterface.BillHeads(1).BOSFields("FPackage").FieldTop = 6345 '120 + m_BillInterface.BillHeads(1).BOSFields("FCompDetails").FieldTop + m_BillInterface.BillHeads(1).BOSFields("FCompDetails").FieldHeight
    
     '第四条：检验
    m_BillInterface.BillHeads(1).BOSFields("FTest").FieldTop = 6795 '120 + m_BillInterface.BillHeads(1).BOSFields("FPackage").FieldTop + m_BillInterface.BillHeads(1).BOSFields("FPackage").FieldHeight
   
    
    '第五条：运输
    m_BillInterface.BillHeads(1).BOSFields("FTrans").FieldTop = 7290 ' 120 + m_BillInterface.BillHeads(1).BOSFields("FTest").FieldTop + m_BillInterface.BillHeads(1).BOSFields("FTest").FieldHeight
   
    
    '第六条：结算
    m_BillInterface.BillHeads(1).BOSFields("FPayment").FieldTop = 7815 '120 + m_BillInterface.BillHeads(1).BOSFields("FTrans").FieldTop + m_BillInterface.BillHeads(1).BOSFields("FTrans").FieldHeight
    
    '第七条：交货
    m_BillInterface.BillHeads(1).BOSFields("FArrPlace").FieldTop = 8295 '120 + m_BillInterface.BillHeads(1).BOSFields("FPayment").FieldTop + m_BillInterface.BillHeads(1).BOSFields("FPayment").FieldHeight
    
     '第八条：其它约定
    m_BillInterface.BillHeads(1).BOSFields("FOtherMsg").FieldTop = 8820 '120 + m_BillInterface.BillHeads(1).BOSFields("FArrPlace").FieldTop + m_BillInterface.BillHeads(1).BOSFields("FArrPlace").FieldHeight
    
End Sub

Private Sub m_BillInterface_AfterSave(bCancel As Boolean)
    AdjustPosition
End Sub

Private Sub m_BillInterface_AfterSelBill(ByVal lSelBillType As Long)
'如果选择的是中标记录，则需要进行单位，单价的转化
Dim dblFSPrice As Double
Dim iCurrRow As Integer
Dim dblFQuantity As Double
Dim dblFTaxRate As Double
Dim dblFTaxPrice As Double
On Error GoTo DealEnd
    If lSelBillType = 200000139 Then
        For iCurrRow = 1 To m_BillInterface.BillCtl.Data("page3").Size
            dblFSPrice = m_BillInterface.GetFieldValue("FSourcePrice", iCurrRow)
            dblFTaxPrice = m_BillInterface.GetFieldValue("FTaxPriceFor", iCurrRow)
            dblFQuantity = m_BillInterface.GetFieldValue("FQuantity", iCurrRow)
            dblFTaxRate = m_BillInterface.GetFieldValue("FTaxRate", iCurrRow)
            If dblFSPrice > dblFTaxPrice Then
                m_BillInterface.SetFieldValue "FTaxPriceFor", dblFSPrice, iCurrRow
                m_BillInterface.SetFieldValue "FPriceFor", dblFSPrice / (100 + dblFTaxRate) * 100, iCurrRow
                m_BillInterface.SetFieldValue "FPrice", dblFSPrice / (100 + dblFTaxRate) * 100, iCurrRow
                m_BillInterface.SetFieldValue "FAmountIncludeTaxFor", dblFSPrice * dblFQuantity, iCurrRow
                m_BillInterface.SetFieldValue "FAmountIncludeTax", dblFSPrice * dblFQuantity, iCurrRow
                m_BillInterface.SetFieldValue "FTaxFor", dblFSPrice * (1 - 1 / (100 + dblFTaxRate) * 100) * dblFQuantity, iCurrRow
                m_BillInterface.SetFieldValue "FTax", dblFSPrice * (1 - 1 / (100 + dblFTaxRate) * 100) * dblFQuantity, iCurrRow
                m_BillInterface.SetFieldValue "FAmount", dblFQuantity * dblFSPrice / (100 + dblFTaxRate) * 100, iCurrRow
                m_BillInterface.SetFieldValue "FAmountFor3", dblFQuantity * dblFSPrice / (100 + dblFTaxRate) * 100, iCurrRow
                iCurrRow = iCurrRow + 1
            End If
        Next
    End If
DealEnd:
    
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)
    If UCase(dct.Value("FFieldName")) = UCase("FDetail") Then
        AdjustPosition
        Exit Sub
    End If
        
End Sub
'控制没有经过科长审核的合同,不允许打印
Private Sub m_BillInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
    Dim sFDeptChecker As String
    
    Select Case BOSTool.ToolName
        Case "mnuFilePreview", "mnuFilePrint" '预览'打印
           sFDeptChecker = m_BillInterface.GetFieldValue("FDeptChecker")
           If sFDeptChecker = "" Then
               MsgBox "当前合同没有审核！", vbCritical + vbOKOnly, "金蝶提示"
               Cancel = True
           End If
        Case Else
    End Select
End Sub

Private Sub m_BillInterface_MultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckLevel As Long, ByVal lCheckStatus As Long, bSendCheckMessage As Boolean, bSendAcceptMessage As Boolean, sMessageTitle As String, sMessage As String, Cancel As Boolean)
    UpdateChecker 1, lCheckLevel
    m_BillInterface.RefreshBill
End Sub

Private Sub m_BillInterface_UnMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckStatus As Long, ByVal lLastCheckFrom As Long, ByVal lLastCheckTo As Long, bSendMessage As Boolean, Cancel As Boolean)
    
    UpdateChecker 2, lLastCheckTo
    m_BillInterface.RefreshBill
End Sub

Private Sub m_ListInterface_MultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckLevel As Long, ByVal lCheckStatus As Long, bSendCheckMessage As Boolean, bSendAcceptMessage As Boolean, sMessageTitle As String, sMessage As String, Cancel As Boolean)