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_SelfCompTJF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'''''''''''''''''''''''''''''''''''''''''''''''
''廠內數據結算-精粉
''建立日期：2005-10-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_AfterSelBill(ByVal lSelBillType As Long)
''選單之后觸發
    Dim iCurrSel As Long
    Dim strTemp As String
    Dim lngCurrFID As Long
    Dim sBID As String
    Dim rsRec As New Recordset
     Dim sCurrBID As String
  On Error GoTo Errhandle
    sBID = ""
    '設置物料信息,得到所有的撿斤單ID
    Dim Dic_SelectTemp As KFO.Dictionary
   
    
    For iCurrSel = Vector_SelectBill.LBound To Vector_SelectBill.UBound
        Set Dic_SelectTemp = Vector_SelectBill(iCurrSel)
        sCurrBID = Dic_SelectTemp.GetValue("FID")
        If iCurrSel = Vector_SelectBill.LBound And sCurrBID <> "" Then
           Set rsRec = m_BillInterface.K3Lib.GetData("select t3.Fnumber,t1.FTeamGroup,t1.FCarNo from t_ST_SC_BalanceBill t1 left join t_ST_SC_BalanceBillentry t2 on t1.fid=t2.fid left join t_icitem t3 on t2.Fmateriel=t3.fitemid where t1.fid=" & sCurrBID)
           If Not rsRec.EOF Then
              m_BillInterface.SetFieldValue "FMItem", rsRec("FNumber")                             '物料
           End If
        End If
        If sCurrBID <> "" Then
           If sBID <> "" Then
                sBID = sBID & ","
           End If
           sBID = sBID & sCurrBID
        Else
           Exit For
        End If
    Next
    
    InsertBillDetail sBID '添加檢斤單、扣雜單、質檢單和入庫單的信息
    
    '填寫結算信息
    strTemp = " exec IC_SP_SelfCompTJF '" & sBID & "'," & m_BillInterface.K3Lib.User.UserID
    m_BillInterface.K3Lib.UpdateData strTemp
    strTemp = "select  convert(char(10),FDateBegin,21) + '~~' + convert(char(10),FDateEnd,21) as FDateScope,FInDate,FNetQty,FDeductDis,FDeductDised,FInQty,FWaterPer,FWaterDis,FWaterDised,FWayLostPer,FCompQty," & _
                    " FMPrice,FTranPrice,FPriceSum,FTFePercent,FTFeDeltaPrice,FSiO2Percent,FSiO2DeltaPrice,FCompPrice,FMAmount," & _
                    " FMTranFee , FMAmountSum, FInvAmount, FTranFeeAmount, FCompDetail,FContractNo " & _
            " From tmpResult " & _
            " where FUID=" & m_BillInterface.K3Lib.User.UserID & _
            " order by FInDate asc,FTFePercent desc"
    Set rsRec = m_BillInterface.K3Lib.GetData(strTemp)
    
    iCurrSel = 1

    m_BillInterface.DeleteEntryData 6
    If Not rsRec.EOF Then
            
        m_BillInterface.SetFieldValue "FCompDetail", rsRec("FCompDetail")
        m_BillInterface.SetFieldValue "FContractNo", rsRec("FContractNo")
        
        While Not rsRec.EOF
             If iCurrSel <= rsRec.RecordCount Then
                m_BillInterface.InsertNewRowAndFill 6, iCurrSel, "FDateScope", rsRec("FDateScope"), "FInDate", rsRec("FInDate"), "FInQty02", rsRec("FNetQty"), "FDeductDis", rsRec("FDeductDis"), "FDeductDised", rsRec("FDeductDised"), "FWaterPer", rsRec("FWaterPer"), "FWaterDis", rsRec("FWaterDis"), "FWaterDised", rsRec("FWaterDised"), "FWayLostPer", rsRec("FWayLostPer"), "FCompQty", rsRec("FCompQty"), "FMPrice", rsRec("FMPrice"), "FTranPrice", rsRec("FTranPrice"), "FPriceSum", rsRec("FPriceSum"), "FTFePercent", rsRec("FTFePercent"), "FTFeDeltaPrice", rsRec("FTFeDeltaPrice"), "FSiO2Percent", rsRec("FSiO2Percent"), "FSiO2DeltaPrice", rsRec("FSiO2DeltaPrice"), "FCompPrice", rsRec("FCompPrice"), "FMAmount", rsRec("FMAmount"), "FMTranFee", rsRec("FMTranFee"), "FMAmountSum", rsRec("FMAmountSum"), "FInvAmount", rsRec("FInvAmount"), "FTranFeeAmount", rsRec("FTranFeeAmount"), "FInvBillQty", rsRec("FWaterDised"), "FTransFeeBillQty", rsRec("FInQty")   '插入一個新行.

             End If
             rsRec.MoveNext
             iCurrSel = iCurrSel + 1
        Wend
    End If
    
    Exit Sub
Errhandle:
    MsgBox "數據填充時發生錯誤！", vbOKOnly + vbInformation, "金蝶提示"
End Sub

Private Sub InsertBillDetail(sBalIDs As String)
Dim iCurrSel As Long
Dim strTemp As String
Dim lngCurrFID As Long
Dim sBID As String

Dim rsRec As New Recordset
On Error GoTo Errhandle
    '填寫扣雜單信息
    m_BillInterface.K3Lib.UpdateData ("exec Cg_SP_GetDeductMsg  '" & sBalIDs & "'")
    strTemp = " select DM.FDeductNo,DM.FBillNo,DM.FCarNo,isnull(A.FNumber,0) as FSItemID,B.FNumber as FQItemID,C.FNumber as FWItemID,DM.FTItemID,DM.FID,cast(DM.DQty as decimal(20,6)) as DQty,DM.Memo " & _
              "  from tmpDeductMsg DM " & _
                    " left outer join t_emp A on DM.FSItemID = A.FItemID " & _
                    " left outer join t_emp B on DM.FQItemID = B.FItemID " & _
                    " left outer join t_emp C on DM.FWItemID = C.FItemID " & _
               " order by DM.FID"
    Set rsRec = m_BillInterface.K3Lib.GetData(strTemp)
    
    iCurrSel = 1
    m_BillInterface.DeleteEntryData 3

    If Not rsRec.EOF Then
        While Not rsRec.EOF

             If iCurrSel <= rsRec.RecordCount Then
                m_BillInterface.InsertNewRowAndFill 3, iCurrSel, "FDeductBillNo", rsRec("FBillNo"), "FDeductCarNo", rsRec("FCarNo"), "FDeductNo", rsRec("FDeductNo"), "FSItemID", rsRec("FSItemID"), "FQItemID", rsRec("FQItemID"), "FWItemID", rsRec("FWItemID"), "FWDeduct", rsRec("DQty"), "FDMemo", rsRec("Memo") '插入一個新行.

             End If
             rsRec.MoveNext
             iCurrSel = iCurrSel + 1
        Wend
    End If
    
    '填寫質檢單信息
    m_BillInterface.K3Lib.UpdateData ("exec Cg_SP_GetQualityMsg  '" & sBalIDs & "'")
    Set rsRec = m_BillInterface.K3Lib.GetData("select FBillNo, FBillDate,FCarNo,FQuantity, FRecDept, FQcMemo From tmpQualityMsg order by FID")
    iCurrSel = 1
   
    
    m_BillInterface.DeleteEntryData 4
    If Not rsRec.EOF Then
        While Not rsRec.EOF
             If iCurrSel <= rsRec.RecordCount Then
               m_BillInterface.InsertNewRowAndFill 4, iCurrSel, "FQcBillNo", rsRec("FBillNo"), "FQcBillDate", rsRec("FBillDate"), "FQcCarNo", rsRec("FCarNo"), "FQcQuantity", rsRec("FQuantity"), "FQcRecDept", rsRec("FRecDept"), "FQcMemo", rsRec("FQcMemo") '插入一個新行.

             End If
             rsRec.MoveNext
             iCurrSel = iCurrSel + 1
        Wend
    End If
    
    '填寫入庫單信息
    strTemp = " select ICStockBill.FBillNo,ICStockBill.FDate,ICStockBillEntry.FBatchNo,t_Stock.FNumber,ICStockBillEntry.FQty,ICStockBillEntry.FEntrySelfA0155 as FInQtyNet ,ICStockBillEntry.FEntrySelfA0155 - ICStockBillEntry.FQty as FQtyDeducted " & _
                    " ,t_emp.FName as FKeeper,t_emp01.FName as FMChecker,t_User.FName as FBillChecker" & _
              " from ICStockBill inner join ICStockBillEntry on ICStockBill.FInterID = ICStockBillEntry.FInterID " & _
                     " inner join t_Stock on t_Stock.FItemID = icstockbillEntry.FDCStockID " & _
                     " inner join t_emp on ICStockBill.FSManagerID = t_emp.FItemID " & _
                     " inner join t_emp t_emp01 on ICStockBill.FFManagerID = t_emp01.FItemID " & _
                     " inner join t_User on ICStockBill.FCheckerID = t_User.FUserID " & _
              " where ((ICStockBillEntry.FSourceInterID in (" & sBalIDs & " ) and FSourceTranType ='200000109' ) " & _
                    " or ( ICStockBillEntry.FSourceInterID in (select distinct FID from t_ST_SC_BalMergeEntry1  where  FEntryID_SRC in (select distinct FEntryID from t_ST_SC_BalanceBillEntry where FID in (" & sBalIDs & " ))) and FSourceTranType ='200000194' ))" & _
                     " and ICStockBill.FCancellation = 0 " & _
              " order by ICStockBillEntry.FInterID"

    Set rsRec = m_BillInterface.K3Lib.GetData(strTemp)

    iCurrSel = 1

    m_BillInterface.DeleteEntryData 5
    If Not rsRec.EOF Then
        While Not rsRec.EOF
             If iCurrSel <= rsRec.RecordCount Then
                m_BillInterface.InsertNewRowAndFill 5, iCurrSel, "FStockInBillNo", rsRec("FBillNo"), "FBatchNo", rsRec("FBatchNo"), "FInWareDate", rsRec("FDate"), "FWareNo", rsRec("FNumber"), "FInQty", rsRec("FQty"), "FInQtyNet", rsRec("FInQtyNet"), "FQtyDeducted", rsRec("FQtyDeducted"), "FKeeper", rsRec("FKeeper"), "FMChecker", rsRec("FMChecker"), "FBillChecker", rsRec("FBillChecker")  '插入一個新行.

             End If
             rsRec.MoveNext
             iCurrSel = iCurrSel + 1
        Wend
    End If
    
    
    Exit Sub
Errhandle:
    MsgBox "數據填充時發生錯誤！", vbOKOnly + vbInformation, "金蝶提示"
End Sub





Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
    Dim lngFCheckerID As Long
    Dim lngFContractID As Long
    Dim sFBillStatus As String
    Dim rsRec As Recordset
    
 Select Case BOSTool.ToolName
    Case "mnuKP"
        lngFContractID = m_ListInterface.GetCurrentSelRowInfo("FID")
        sFBillStatus = "select fchecker,FBillStatus from t_EP_PB_SelfCompTJF where FID  = " & lngFContractID
        Set rsRec = m_ListInterface.K3Lib.GetData(sFBillStatus)
        If Not rsRec.EOF Then
            lngFCheckerID = rsRec("fchecker")
            sFBillStatus = rsRec("FBillStatus")
        End If
       If sFBillStatus = "是" Then
            MsgBox "當前分錄已經是未開票,不需再執行此操作！", vbOKOnly + vbInformation, "金蝶提示"
            Exit Sub
        Else
             If lngFCheckerID > 0 And sFBillStatus = "" Then
                  m_ListInterface.K3Lib.UpdateData "update  t_EP_PB_SelfCompTJF set  FBillStatus = '是' where FID=" & lngFContractID
                  MsgBox "當前分錄已成功設置開票狀態！", vbInformation + vbOKOnly, "金蝶提示"
                  Exit Sub
             Else
                 MsgBox "當前分錄還沒有審核，不能設置開票操作！", vbOKOnly + vbInformation, "金蝶提示"
                 Exit Sub
            End If
        End If
    Case "mnuFKP"
        lngFContractID = m_ListInterface.GetCurrentSelRowInfo("FID")
        sFBillStatus = "select fchecker,FBillStatus from t_EP_PB_SelfCompTJF where FID  = " & lngFContractID
        Set rsRec = m_ListInterface.K3Lib.GetData(sFBillStatus)
        If Not rsRec.EOF Then
            lngFCheckerID = rsRec("fchecker")
            sFBillStatus = rsRec("FBillStatus")
        End If
        
        If sFBillStatus = "" Then
            MsgBox "當前結算單沒有設置開票狀態，不能執行恢復操作！", vbOKOnly + vbInformation, "金蝶提示"
            Exit Sub
        Else
            m_ListInterface.K3Lib.UpdateData "update  t_EP_PB_SelfCompTJF set  FBillStatus = '' where FID=" & lngFContractID
            MsgBox "當前結算單已成功恢復開票設置操作！", vbOKOnly + vbInformation, "金蝶提示"
         End If
    Case Else
    End Select
    
End Sub

Private Sub m_ListInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
 
    If m_ListInterface.List.ShowMode = 2 Then Exit Sub '如果是選單，則不創建新的菜單對象
    
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand
 
'*************** 開始新增 BOS 菜單 ***************
 
    '新增 mnuZF 菜單對象，并設置屬性
    Set oTool = oMenuBar.BOSTools.Add("mnuKP")
    With oTool
        .Caption = "開票"
        .ToolTipText = "開票"
        .Description = "開票"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path & "\未命名.bmp"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuCaculate", oTool    '將菜單對象插入指定工具欄
 
    '新增 mnuFZF 菜單對象，并設置屬性
    Set oTool = oMenuBar.BOSTools.Add("mnuFKP")
    With oTool
        .Caption = "恢復"
        .ToolTipText = "恢復"
        .Description = "恢復"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path & "\未命名.bmp"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuCaculate", oTool '將菜單對象插入指定工具欄
 
 
'*************** 結束新增 BOS 菜單 ***************
 

End Sub