VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CList_BosShow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "This is ListEvents Interface Class, made by K3BOSPLUGINSWIZAED"
 
'定義 ListEvents 接口. 必須具有的聲明, 以此來獲得事件
Private WithEvents m_ListInterface  As ListEvents
Attribute m_ListInterface.VB_VarHelpID = -1
 
Public Sub Show(ByVal oListInterface As Object)
 
    'ListEvents 接口實現
    '注意: 此方法必須存在, 請勿修改
    '要求當前登錄人只能查由他自已做的單據
    Set m_ListInterface = oListInterface
    m_ListInterface.ListFilterString = "t_BOS200000001.fbillerID=" & m_ListInterface.K3Lib.User.UserID
 
End Sub

Private Sub Class_Terminate()
 
    '釋放接口對象
    '注意: 此方法必須存在, 請勿修改
    Set m_ListInterface = Nothing

End Sub


Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
 
    Dim vectSelect As KFO.Vector
    Dim strIdFilter As String
    Dim bGroup As Boolean
    
    Select Case BOSTool.ToolName
    Case "BillEdit"
        '此處添加處理 BillEdit 菜單對象的 Click 事件
        bBilledit = True
        Call m_ListInterface.LoadSelectedBill(Enu_BillStatusExt_Modify)
        bBilledit = False
         
    
    '因新單下推舊單目前不支持[選單一致性]的處理，目前必須通過插件手工判斷,
    Case "mnuBackData", "mnuPushOldBill_1"
        
        '目前的單據流程，新單->外購入庫單是不需要處理選單一致性，但考慮到實際應用，此處提供了此種需求的處理代碼
        '新單據到(老)外購入庫單的選單一致性的處理
        '須處理兩種情況,一種是目標單選源單時在源單序事簿選中記錄點返回按鈕時,另一種是在源單序事簿直接下推目標單時
        If BOSTool.ToolName = "mnuBackData" Then
            Set dctLink = m_ListInterface.DataSrv.dctLink
            If dctLink("FDestClasstypeid") = 1 Then bGroup = True
        Else
            bGroup = True
        End If
        
        If bGroup Then
           '得到所選記錄信息
           Set vectSelect = m_ListInterface.GetSelectedBillInfo
           '通過函數得到所有選中記錄的單據內碼
           strIdFilter = GetSelectBillIDFilter(vectSelect, "Fid")
           '因新單下推舊單目前不支持選單一致性的處理，目前必須通過插件手工判斷
           Cancel = CanPushBill(strIdFilter)
        End If
                
        
    Case Else
    End Select

End Sub

Private Sub m_ListInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
 
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand
 
'*************** 開始新增 BOS 菜單 ***************
 
    '新增 BillEdit 菜單對象，并設置屬性
    Set oTool = oMenuBar.BOSTools.Add("BillEdit")
    With oTool
        .Caption = "單據變更"
        .ToolTipText = "單據變更"
        .Description = "單據變更"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        '清除剪貼板信息
        Clipboard.Clear
        '從資源文件從讀取預先保存的圖片　須注意此處客戶內存不足時有可能執行失敗
        Clipboard.SetData LoadResPicture(101, vbResBitmap), vbCFBitmap
        .PasteToolFace
    End With
 
    Set oBand = oMenuBar.BOSBands("mnuEdit")
    oBand.BOSTools.InsertBefore "mnuEditStartMultiCheck", oTool '將菜單對象插入指定一級菜單
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertBefore "mnuCaculate", oTool    '將菜單對象插入指定工具欄
 
 
'*************** 結束新增 BOS 菜單 ***************
 

End Sub
'此函數得到所選記錄的單據內碼的字符串，字符串以","作為間隔符主要是為了在查詢SQL中方便使用
Public Function GetSelectBillIDFilter(ByVal vectSelect As KFO.Vector, ByVal strInterIDName As String) As String
    Dim i As Long
    Dim strFilter As String
    For i = vectSelect.LBound To vectSelect.UBound
        If vectSelect(i)(strInterIDName) > 0 Then
           strFilter = strFilter & IIf(i <> 1, ",", "") & CStr(vectSelect(i)(strInterIDName))
        End If
    Next
    GetSelectBillIDFilter = strFilter
End Function
'函數名稱:CanPushBill
'描述:新單下推舊單，選單一致性的判斷代碼，此按鈕增加了
'版本:V10.4
'作者: Caibo
'參數:strIdFilter 序時簿被選中行的過濾條件
'返回值: Boolean True:可以下推 False不可以下推
'修改時間: 2006-06-12
Private Function CanPushBill(ByVal strIdFilter As String) As Boolean
    '控制下推的客戶必須相同
    Dim rs As ADODB.Recordset
    Dim lDepartment As Long
    CanPushBill = False
    On Error GoTo Err_Handle
    
    '得到所有符合條件的記錄集
    Set rs = m_ListInterface.K3Lib.GetData("select FDeptID from t_BOS200000001 where fid in(" & strIdFilter & ")")
    If Not rs.EOF Then

        lDepartment = rs("FDeptID")
        '如果第一個部門和記錄集里其它部門有不同的話，則給出提示
        rs.Find "FDeptID<>" & lDepartment
        If Not rs.EOF Then
            If MsgBox(m_ListInterface.K3Lib.LoadKDString("選單的部門不一致，是否繼續?"), vbOKCancel, m_ListInterface.K3Lib.LoadKDString("金蝶提示")) = vbCancel Then
               CanPushBill = True
               Exit Function
            End If
        End If
        'If Not rs.BOF Then rs.MoveFirst
           
    End If
    GoTo ExitSub
Err_Handle:
    HandleError Err
ExitSub:
    Set rs = Nothing
End Function

Private Sub m_ListInterface_UnBusinessCheck(Cancel As Boolean)
  Dim rs As ADODB.Recordset
  Dim strsql As String
  '不允許選擇超過一條記錄
  If m_ListInterface.GetSelectedBillInfo.Size > 1 Then
     MsgBox "多級審核測試,不能選擇一條以上記錄!"
     Cancel = True
     GoTo HExit
  End If
  '從寄存入庫單取出是否有已生成記帳憑證的單據
  strsql = "select 1 from t_BOS200000001 where fvoucherid_id>0 and FID=" & m_ListInterface.GetSelectedBillInfo(1)("FID")
  Set rs = m_ListInterface.K3Lib.GetData(strsql)
  If Not rs.EOF Then
     MsgBox "單據已經生成記帳憑證,不允許反業務審核!"
     Cancel = True
     GoTo HExit
  End If
  '從寄存入庫單取出是否有已被外購入庫單關聯的單據，注意此處是通過已鉤稽數量是否大于0來判斷寄存入庫單是否已關聯
  strsql = "select 1 from t_BOS200000001entry2 where FFinishQty>0 and FID=" & m_ListInterface.GetSelectedBillInfo(1)("FID")
  Set rs = m_ListInterface.K3Lib.GetData(strsql)
  If Not rs.EOF Then
     MsgBox "單據已經被其它單據引用,不允許反業務審核!"
     Cancel = True
     GoTo HExit
  End If
  
HExit:
  Set rs = Nothing
  
  
End Sub