bos_billevent_plugins.cls

ERP合同变更ERP合同变更ERP合同变更ERP合同变更

Private Sub m_BillInterface_BusinessCheck(Cancel As Boolean)
 
    'TODO: 请在此处添加代码响应事件 BusinessCheck
  
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)
 
    'TODO: 请在此处添加代码响应事件 Change
    With m_BillInterface
            Select Case dct("FKey")
            
                Case "FDetail"
                    '控制单据头中，“录入产品明细分录”选项控件
                    .BillEntrys(2).Visible = CBool(.BillHeads(1).BOSFields("FDetail").Value)
            End Select
    End With

End Sub

Private Sub m_BillInterface_FinishMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckStatus As Long, bSendMessage As Boolean)
 
    'TODO: 请在此处添加代码响应事件 FinishMultiCheck
    '完成多级审核后，更新采购申请单中的--建议采购单价，--建议采购含税单价
    'If UpdateMode = 0 Then UpdatePORequestEntryPrice lngFID_SRC, lngEntryFID_SRC, FSupplyID
     
    
End Sub

Private Sub m_BillInterface_HeadCtlClick(ByVal ctl As Object, ByVal dct As KFO.IDictionary)
 
    'TODO: 请在此处添加代码响应事件 HeadCtlClick
 

End Sub

Private Sub m_BillInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
 
    'TODO: 请在此处添加代码响应事件 MenuBarClick
    With m_BillInterface
        Select Case BOSTool.ToolName
            '----------------------------------------------------------------------------------------------------------------------
            '此处代码不能删除
            Case "mnuEditChange"
                Call UpdateContract
        End Select
    End With

End Sub

Private Sub m_BillInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
    
    'TODO: 请在此处添加代码响应事件 MenuBarInitialize
 
 
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand
 
'*************** 开始新增 BOS 菜单 ***************
 
    '新增 mnuEditChange 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("mnuEditChange")
    With oTool
        .Caption = "合同变更"
        .ToolTipText = "合同变更"
        .Description = "合同变更"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = True
         '清除剪贴板信息
         Clipboard.Clear
            '从资源文件从读取预先保存的图片　须注意此处客户内存不足时有可能执行失败
            Clipboard.SetData LoadResPicture(101, vbResBitmap), vbCFBitmap
            .PasteToolFace
    End With
 
    Set oBand = oMenuBar.BOSBands("mnuEdit")
    oBand.BOSTools.InsertBefore "mnuEditAddRow", oTool  '将菜单对象插入指定一级菜单
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertBefore "mnuFilePrint", oTool   '将菜单对象插入指定工具栏
 
 
'*************** 结束新增 BOS 菜单 ***************
 
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)
 
    'TODO: 请在此处添加代码响应事件 MultiCheck
 

End Sub

Private Sub m_BillInterface_SaveBillFailed(ByVal dctData As KFO.IDictionary, sErrorMessage As String, bCancelErrorMessage As Boolean)
 
    'TODO: 请在此处添加代码响应事件 SaveBillFailed
    mblnSave = False
    m_BillInterface.MenuBar.BOSTools("mnuEditChange").Enabled = False

End Sub

Private Sub m_BillInterface_StartMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, bSendMessage As Boolean, Cancel As Boolean)
 
    'TODO: 请在此处添加代码响应事件 StartMultiCheck
 

End Sub

Private Sub m_BillInterface_UnBusinessCheck(Cancel As Boolean)
 
    'TODO: 请在此处添加代码响应事件 UnBusinessCheck
 

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)
 
    'TODO: 请在此处添加代码响应事件 UnMultiCheck
    '撤消多级审核
   
End Sub

Private Sub m_BillInterface_Verify(dctErr As KFO.IDictionary, sErr As String, sErrRow As Long)
 
    'TODO: 请在此处添加代码响应事件 Verify
 

End Sub
'---------------------------------------------------------------------------------------------------------------------------
'描述：初始化系统界面，可以设置当前模块开发的公司名称，版权所有单位
'使用：在以下事件中引用该方法函数
'示例：
'   Public Sub Show(ByVal oBillInterface As Object)
'       Set m_BillInterface = oBillInterface
'       Call InitForm
'   End Sub
'---------------------------------------------------------------------------------------------------------------------------
Private Sub InitForm()
    With m_BillInterface
        .SetStatus 2, "登录用户:" & CStr(.K3Lib.User.UserName)
        .SetStatus 4, "版本号:" & gstrProduct & "/" & gstrVersion
    End With
End Sub
'-------------------------------------------------------------------------------------
'过程： RefreshData
'
'描述： 得到当前合同的收款执行情况
'
'涉及表： t_RPContractScheme
'
'参数：     @mFID --源单内码
'
'--------------------------------------------------------------------------------------
Private Sub RefreshData(ByVal mFID As Long)
    With m_BillInterface
    
        Dim strSQL As String
        Dim rs As ADODB.Recordset
        Dim intRow As Long
        strSQL = "SELECT * FROM t_RPContractScheme where FContractID=" & mFID
        
        Set rs = .K3Lib.GetData(strSQL)
        
        .DeleteEntryData (2)
        intRow = 1
        Do While Not rs.EOF
         .InsertNewRowAndFill 2, intRow, "FReceiveDate", rs("FReceiveDate"), "FAmountFor", rs("FAmountFor"), "FAmount2", rs("FAmount")
        
         rs.MoveNext
          intRow = intRow + 1
        Loop
        Set rs = Nothing
    End With
End Sub
Private Sub UpdateContract()
 'TODO: 请在此处添加代码响应事件 AfterSave

      

    If UpdateHead Then
            Call UpdateEntry                                '更新表体
            mblnSave = False
            m_BillInterface.MenuBar.BOSTools("mnuEditChange").Enabled = False
            Msg "合同更新完成!", vbExclamation
        
    End If
        

End Sub
'更新表头
Private Function UpdateHead() As Boolean
    With m_BillInterface
        
        Dim strUpdate As String
        Dim blnReturn As Boolean
        Dim mFDepartment As Long
        Dim mFEmployee As Long
        Dim mFCustomer As Long
        Dim mFArea As Long
        Dim mFBase As Long
        Dim mFItemClassID As Long
        
        blnReturn = False                                               '设置默认返回不成功
        
        If Not mblnSave Then UpdateHead = False: Exit Function
        
        '应收合同单据头为空时返回，不允许合同变更
        If .BillHeads(1).BOSFields("FContractNo").Text = vbNullString Then UpdateHead = False: Exit Function
        
        mFItemClassID = .BillHeads(1).BOSFields("FItemClassID").Value                                                                   '核算项目内码
        
        mFDepartment = IIf(.BillHeads(1).BOSFields("FDepartment").Text = vbNullString, 0, .BillHeads(1).BOSFields("FDepartment").Value) '表头部门内码
        
        mFEmployee = IIf(.BillHeads(1).BOSFields("FEmployee").Text = vbNullString, 0, .BillHeads(1).BOSFields("FEmployee").Value)       '表头职员信息内码
        
        mFArea = IIf(.BillHeads(1).BOSFields("FBase4").Text = vbNullString, 0, .BillHeads(1).BOSFields("FBase4").Value)                 '
        
        mFBase = IIf(.BillHeads(1).BOSFields("FBase").Text = vbNullString, 0, .BillHeads(1).BOSFields("FBase").Value)                   '
        
        '核算部门为空，则退出变更
        If mFDepartment = 0 Then UpdateHead = False: Exit Function
        
        '职员信息为空，则退出变更
        If mFEmployee = 0 Then UpdateHead = False: Exit Function
        
        '更新应收合同表头信息
        strUpdate = strUpdate & "Update t_RPContract Set FDepartment=" & mFDepartment                   '更新部门内码
        strUpdate = strUpdate & ",FEmployee=" & mFEmployee                                              '更新职员内码
        strUpdate = strUpdate & ",FItemClassID=" & mFItemClassID                                        '核算项目内码
        strUpdate = strUpdate & ",FCustomer=" & .BillHeads(1).BOSFields("FCustomer").Value              '更新核算项目
        
        If mFBase <> 0 Then strUpdate = strUpdate & ",FBase=" & .BillHeads(1).BOSFields("FBase").Value
        strUpdate = strUpdate & ",FBase1=" & .BillHeads(1).BOSFields("FBase1").Value
        
        If mFArea <> 0 Then strUpdate = strUpdate & ",FBase4=" & .BillHeads(1).BOSFields("FBase4").Value
        strUpdate = strUpdate & " WHERE FContractNo=" & SplitChar(CStr(.BillHeads(1).BOSFields("FContractNo").Value))
        
        'Debug.Print strUpdate
        On Error GoTo ErrHandle
        .K3Lib.UpdateData (strUpdate)
        blnReturn = True
        UpdateHead = blnReturn
        Exit Function
        
ErrHandle:
        Msg Err.Description, vbCritical
        UpdateHead = blnReturn
    End With
End Function

Private Function UpdateEntry()
    With m_BillInterface
    
        Dim intRow As Long
        Dim strUpdate As String
        
        Dim lngMinRow As Long
        Dim lngMaxRow As Long
        Dim mFBase3 As Long
        
        lngMinRow = CLng(.Data("Page3").LBound)         '得到产品分录的最小行号
        lngMaxRow = CLng(.Data("Page3").UBound)         '得到产品分录的最大行号
        
        For intRow = lngMaxRow To lngMinRow Step -1
            If .GetFieldValue("FBase3", intRow) = "" Then
                mFBase3 = 0
            Else
                mFBase3 = CLng(.GetFieldValue("FBase3", intRow))
            End If
                

                strUpdate = strUpdate & "Update t_RPContractEntry Set Fgcm=" & SplitChar(.GetFieldValue("Fgcm", intRow))    '更新工程名称
                strUpdate = strUpdate & ",Fkph=" & SplitChar(.GetFieldValue("Fkph", intRow))                                '更新卡片号
                If mFBase3 <> 0 Then
                    strUpdate = strUpdate & ",FBase3=" & mFBase3
                Else
                    strUpdate = strUpdate & ",FBase3=''"
                End If
                
                strUpdate = strUpdate & " WHERE FContractID=" & .GetFieldValue("FID_SRC", intRow)
                strUpdate = strUpdate & " AND FEntryID=" & .GetFieldValue("FEntryID_SRC", intRow)

                'Debug.Print strUpdate
                '更新记录
                .K3Lib.UpdateData strUpdate
      
        Next

    End With
End Function