clslistcostadjust.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 = "clsListCostAdjust"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False


Private WithEvents mfrmCost As frmAListTemplate '模版窗体
Attribute mfrmCost.VB_VarHelpID = -1
Private mclsPurchase As clsPurchase             '接口类
Private frmEdit As Form                         '接口窗体
Private mblnFinish As Boolean
Private mIsShowEdit As Boolean

Private blnIsVouchered As Boolean               '是否已生成凭证
Private blnIsVoid    As Boolean                 '是否已作废
Private lngActivityTypeID As Long
Private blnEdit As Boolean                      '编辑权限
Private blnChange As Boolean                    '只能编辑和删除自己制作的单据
Private clsListType As String
Public Function SetListType(ByVal strList As String)
    mfrmCost.strListType = strList
    clsListType = strList
End Function
Private Sub cMsgBox(strMsg As String, Optional strTitle As String)
    If Trim(strTitle) = "" Then
        strTitle = "提示信息"
    End If

    ShowMsg mfrmCost.hWnd, strMsg, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub
Private Sub Class_Initialize()
    Set mfrmCost = New frmAListTemplate
    mfrmCost.blnReceptionList = True
    mfrmCost.mTitle = "入库成本单列表"
    mfrmCost.mHelpID = 10523
    mfrmCost.Tabs = 1
    mfrmCost.SpViewID(0) = 124
    mfrmCost.blnEditByRight(0) = IsCanDo(frmRightsID.frmListCostPriceID, gclsBase.OperatorID)
    
    mfrmCost.SpSelect(0) = "CostPrice.lngCostPriceID, Min(decode(CostPrice.blnIsVoid,1,'√',' ')) AS ""作废"""
    If Not IsCanDo(276, gclsBase.OperatorID) Then
        mfrmCost.SpWhere(0) = " CostPrice.lngOperatorID=" & gclsBase.OperatorID
    End If
    mfrmCost.ShowAll(0) = "CostPrice.blnIsVoid=0"
    mfrmCost.SpGoupBy(0) = "CostPrice.lngCostPriceID"
    mfrmCost.SpPrintID(0) = 44
    mfrmCost.SpPrintTitle(0) = "入库成本单列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mfrmCost.MenuEnbaleOnPage(0) = 1
    mfrmCost.MenuEnbaleOnPage(1) = 1
    mfrmCost.MenuEnbaleOnPage(2) = 1
    mfrmCost.MenuEnbaleOnPage(3) = 1
    mfrmCost.MenuEnbaleOnPage(4) = 1
    mfrmCost.MenuEnbaleOnPage(5) = 1
    mfrmCost.MenuEnbaleOnPage(6) = 1
    mfrmCost.MenuEnbaleOnPage(7) = 1
End Sub

Public Function Showlist()
    mfrmCost.Show
    mfrmCost.ZOrder 0
    Set mclsPurchase = New clsPurchase
    mclsPurchase.SethWnd mfrmCost.hWnd
    Set frmEdit = FrmCostPrice
End Function

Private Sub mfrmCost_ListChildActive()
    Dim vntMessage As Variant
    For Each vntMessage In mfrmCost.mclsMainControl.Messages
        If vntMessage = Message.msgReceipt32 Then
            mfrmCost.ToolRefresh
            mfrmCost.mclsMainControl.Messages.Remove CStr(vntMessage) '清除消息
        End If
    Next
    mfrmCost.mclsMainControl.Messages.Clear
End Sub

Private Sub mfrmCost_ListDel()
    Dim lngActivityID As Long
    lngActivityID = mfrmCost.ListID
    If lngActivityID = 0 Then Exit Sub
    If mIsShowEdit Then
        If lngActivityID = frmEdit.getID Then
            cMsgBox "不能删除当前编辑的单据！"
            Exit Sub
        End If
    End If
    
    If blnBillIsClosed(32, lngActivityID) Then
        cMsgBox "本张单据已经结帐,不能删除！"
    End If
    If Not DeleteCostPrice(lngActivityID) Then Exit Sub
    mfrmCost.ToolRefresh
End Sub

Private Sub mfrmCost_ListEdite()
    Dim lngActivityID As Long
    
    mfrmCost.Enabled = False
    mblnFinish = True
    lngActivityID = mfrmCost.ListID
    If mIsShowEdit Then
        frmEdit.ShowAOldBill (lngActivityID) '调用接口
    Else
        mIsShowEdit = True
        frmEdit.ShowAOldBill (lngActivityID) '调用接口
    End If
    mblnFinish = False
    mfrmCost.Enabled = True
End Sub

Private Sub mfrmCost_oListInActive()
    Dim lngCostPriceID As Long
On Error GoTo TheErr
    
    lngCostPriceID = mfrmCost.ListID
    If lngCostPriceID = 0 Then Exit Sub
    If mfrmCost.IsInActive Then Exit Sub
    If blnBillIsClosed(32, lngCostPriceID) Then
        cMsgBox "本张单据已经结帐,不能作废！"
    End If
    
    If Not DeleteCostPrice(lngCostPriceID, True) Then Exit Sub
    mfrmCost.ToolRefresh
    Exit Sub
TheErr:
    cMsgBox "操作失败！"
End Sub

Private Sub mfrmCost_ListInActive(blnLevel As Boolean, blnSuceess As Boolean)
    Dim lngCostPriceID As Long
On Error GoTo TheErr
    blnLevel = False
    blnSuceess = False
    lngCostPriceID = mfrmCost.ListID
    If lngCostPriceID = 0 Then Exit Sub
    If mfrmCost.IsInActive Then Exit Sub
    If blnBillIsClosed(32, lngCostPriceID) Then
        cMsgBox "本张单据已经结帐,不能作废！"
    End If
    
    If Not DeleteCostPrice(lngCostPriceID, True) Then Exit Sub
    'mfrmCost.ToolRefresh
    blnSuceess = True
    Exit Sub
TheErr:
    cMsgBox "操作失败！"
End Sub

Private Sub mfrmCost_ListNew()
    mblnFinish = True
    If mIsShowEdit Then
        frmEdit.ShowANewBill
    Else
        frmEdit.ShowANewBill
        mIsShowEdit = True
    End If
    mblnFinish = False
End Sub

Private Sub mfrmCost_ListPrintReceipt()
    frmPrintReceipt.ShowfrmPrintReceipt 34
End Sub

Private Sub mfrmCost_ListShowAll()
    With mfrmCost
        If .chkShowall = 0 Then
            .ShowAll(0) = "CostPrice.blnIsVoid=0"
        Else
            .ShowAll(0) = ""
        End If
        .ToolRefresh
    End With
End Sub

Private Function GetItemStatus(lngCostPriceID As Long, Optional hWnd As Long = 0) As Boolean
    Dim recTemp As rdoResultset
    
    If hWnd = 0 Then hWnd = mfrmCost.hWnd
    strSql = "SELECT  CostPrice.blnIsPost ,CostPrice.lngOperatorID, CostPrice.blnIsVoid From CostPrice WHERE (((CostPrice.lngCostPriceID)=" & lngCostPriceID & "))"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTemp.BOF And recTemp.EOF Then
        cMsgBox "列表的数据已被修改，请重新刷新后再进行操作！"
        Exit Function
    End If
    
    blnIsPost = recTemp(0)
    If gclsBase.OperatorID = recTemp(1) Then
        blnChange = True
    Else
        blnChange = False
    End If
    blnIsVoid = IIf(recTemp(2) = 1, True, False)
    
    Set recTemp = Nothing
    GetItemStatus = True
End Function
'告诉列表：编辑窗口已关闭
Public Sub IAmCLosed()
    mIsShowEdit = False
End Sub


'////////////////////////////////////////////////////////////////////////////////////////
'
'                       功能代码实现
'
'////////////////////////////////////////////////////////////////////////////////////////

'删除《拆卸组装表》
'注意：拆卸组装单一次对应两对记录
Public Function DeleteCostPrice(lngCostPriceID As Long, Optional blnByVoid As Boolean, Optional hWnd As Long = 0) As Boolean
    Dim strSql As String
    Dim strDelOrVoid As String
'    Dim recTmp As rdoResultset
    If hWnd = 0 Then hWnd = mfrmCost.hWnd

On Error GoTo TheErr
    If blnByVoid Then
        strDelOrVoid = "作废！"
    Else
        strDelOrVoid = "删除！"
    End If
    If GetItemStatus(lngCostPriceID, hWnd) = False Then Exit Function
    If Not blnChange Then
        cMsgBox "不能" & Left(strDelOrVoid, 2) & "由他人制作的单据！"
        Exit Function
    End If
        
    If blnByVoid Then
        If blnIsVoid Then Exit Function
        If ShowMsg(hWnd, "本张入库成本单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
    Else
        If blnIsVoid Then
            If ShowMsg(hWnd, "您确实要删除本张已作废的入库成本单吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
        Else
            If ShowMsg(hWnd, "您确实要删除本张入库成本单吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
        End If
    End If
    '------------- By SM
    If blnIsPrintedBill(lngCostPriceID, Left(strDelOrVoid, 2), hWnd) = True Then
         Exit Function
    End If
    '-------------
    
    gclsBase.BaseWorkSpace.BeginTrans
    
    '1）单据是作废单据，不执行
'    If Not blnIsVoid Then
'        strSql = "DELETE  From CostPriceToPurchase WHERE (((CostPriceToPurchase.lngCostPriceID)=" & lngCostPriceID & "))"
'        gclsBase.ExecSQL strSql
'
'    End If
    
    '2）作废操作不执行
    If Not blnByVoid Then
        strSql = "DELETE  From CostPriceDetail WHERE (((CostPriceDetail.lngCostPriceID)=" & lngCostPriceID & "))"
        If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
        strSql = "DELETE  From CostPrice WHERE (((CostPrice.lngCostPriceID)=" & lngCostPriceID & "))"
        If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
    Else
         strSql = "UPDATE CostPrice SET CostPrice.blnIsVoid = 1 WHERE (((CostPrice.lngCostPriceID)=" & lngCostPriceID & "))"
        If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
    End If
   ' strSql = "SELECT ItemActivityDetail.lngOrderDetailID FROM ItemActivityDetail INNER JOIN ItemActivity ON ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID " & _
            " WHERE ((ItemActivity.lngReceiptTypeID=9) AND ((ItemActivityDetail.lngOrderDetailID)=" & lngCostPriceID & "));"
'    strSQL = "SELECT ItemActivityDetail.lngOrderDetailID " _
'            & " FROM ItemActivityDetail ,ItemActivity " _
'            & " Where (ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID) " _
'            & " AND (ItemActivity.lngReceiptTypeID=9 AND ItemActivityDetail.lngOrderDetailID=" & lngCostPriceID & ")"
'    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenDynamic)
'
'    If recTmp.RowCount <> 0 Then
'        Do While Not recTmp.EOF
'            recTmp.Edit
'            recTmp(0) = 0
'            recTmp.Update
'            recTmp.MoveNext
'        Loop
'    End If
'    recTmp.Close
'    Set recTmp = Nothing
    strSql = "UPDATE ItemActivityDetail SET lngOrderDetailID=0 WHERE EXISTS (" & _
        " SELECT lngActivityDetailID FROM ItemActivity " & _
        " WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID " & _
        " AND ItemActivity.lngReceiptTypeID=9) AND " & _
        " ItemActivityDetail.lngOrderDetailID=" & lngCostPriceID
    If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
    gclsBase.BaseWorkSpace.CommitTrans
    DeleteCostPrice = True
    Exit Function
TheErr:
    gclsBase.BaseWorkSpace.RollBacktrans
    cMsgBox Left(strDelOrVoid, 2) & "入库成本表失败！"
End Function

Private Function blnIsPrintedBill(ByVal lngCostPriceID As Long, _
   ByVal strDelOrVoid As String, Optional hWnd As Long = 0) As Boolean
   
   Dim strSql As String
   Dim recTmp As rdoResultset
   
   blnIsPrintedBill = True
   
   strSql = "SELECT blnIsVoid, blnIsPrinted FROM CostPrice WHERE lngCostPriceID = " & lngCostPriceID
   Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
   With recTmp
      If .BOF And .EOF Then
         cMsgBox "本张入库成本单已经被删除，请刷新列表后再操作！"
         GoTo EndProc
      End If
      If !blnIsVoid Then
         blnIsPrintedBill = False
         GoTo EndProc
      End If
      If !blnIsPrinted Then
         If gclsBase.blnEditPrinted Then
            If ShowMsg(hWnd, "本张入库成本单已经打印，您确实要" & strDelOrVoid & "吗？", _
               MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2) = vbNo Then
               GoTo EndProc
            End If
         Else
            cMsgBox "本张入库成本单已经打印，不能" & strDelOrVoid & "！", strDelOrVoid & "单据"
            GoTo EndProc
         End If
      End If
   End With
   blnIsPrintedBill = False
EndProc:
   If Not recTmp Is Nothing Then
      recTmp.Close
      Set recTmp = Nothing
   End If
End Function