clscompose.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 = "clsCompose"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Private mblnFinish As Boolean
Private mIsShowEdit As Boolean

Private blnIsVouchered As Boolean '是否已生成凭证
Private blnIsVoid    As Boolean '是否已作废
Private lngActivityTypeID As Long
Private blnChange  As Boolean
Private mhWnd As Long
Public Property Let hwnd(vData As Long)
    mhWnd = vData
End Property
Public Property Get hwnd() As Long
    hwnd = mhWnd
End Property
Private Sub cMsgBox(strMsg As String, Optional strTitle As String)
    If Trim(strTitle) = "" Then
        strTitle = "提示信息"
    End If

    ShowMsg mhWnd, strMsg, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub
Private Function GetItemStatus(lngActivityID As Long) As Boolean
     Dim strSql As String
    Dim recTemp As rdoResultset
    
    strSql = "SELECT ItemActivity.lngVoucherID, ItemActivity.lngOperatorID, ItemActivity.blnIsVoid, ItemActivity.lngActivityTypeID From ItemActivity WHERE (ItemActivity.lngActivityID)=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTemp.BOF And recTemp.EOF Then
        cMsgBox "列表的数据已被修改，请重新刷新后再进行操作！"
        Exit Function
    End If
    
    If recTemp(0) > 0 Then
        blnIsVouchered = True
    Else
        blnIsVouchered = False
    End If
    If gclsBase.OperatorID = recTemp(1) Then
        blnChange = True
    Else
        blnChange = False
    End If
    blnIsVoid = IIf(recTemp(2) = 1, True, False)
    lngActivityTypeID = recTemp(3)
    
    Set recTemp = Nothing
    GetItemStatus = True
End Function

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

'删除《拆卸组装表》
'注意：拆卸组装单一次对应两对记录
Public Function DeleteCompose(lngActivityID As Long, Optional blnByVoid As Boolean) As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim lngActivityID_2 As Long
    Dim lngActivityTypeID_2 As Long
    Dim strDelOrVoid As String
    On Error GoTo TheErr
    '-----------------------------------------
    Dim intYear As Integer '凭证会计年度
    Dim bytPeriod As Byte   '凭证会计期间
    Dim lngReceiptTypeID As Long
    Dim strReceiptNo As String
    Dim lngReceiptNo As Long
    '------------------------------------------
    
    If blnByVoid Then
        strDelOrVoid = "作废！"
    Else
        strDelOrVoid = "删除！"
    End If
    
    If Not GetItemStatus(lngActivityID) Then Exit Function
    If Not blnChange Then
        cMsgBox "不能" & Left(strDelOrVoid, 2) & "由他人制作的单据！"
        Exit Function
    End If
    
    If blnIsVouchered Then
        cMsgBox "本张商品拆卸组装单已生成记帐凭证，不能" & strDelOrVoid
        Exit Function
    End If
        
    If blnByVoid Then
        If ShowMsg(mhWnd, "本张拆卸组装单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
    Else
        If ShowMsg(mhWnd, "您确实要删除本张商品拆卸组装单吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
    End If
   
    '查找“组装”对应的“组装出库” 或 “拆卸”对应的“拆卸入库”
    'strSql = "SELECT ItemActivity.lngActivityID,ItemActivity.lngActivityTypeID FROM ItemActivity INNER JOIN ItemActivity AS ItemActivity_1 ON (ItemActivity.lngReceiptNO = ItemActivity_1.lngReceiptNO) AND (ItemActivity.strReceiptNO = ItemActivity_1.strReceiptNO) AND (ItemActivity.lngReceiptTypeID = ItemActivity_1.lngReceiptTypeID) WHERE (((ItemActivity_1.lngActivityID)=" & lngActivityID & ") AND ((ItemActivity.lngActivityTypeID) In (31,32)))"
  If lngActivityTypeID = 30 Then
        lngActivityTypeID_2 = 31
  ElseIf lngActivityTypeID = 31 Then
        lngActivityTypeID_2 = 30
  ElseIf lngActivityTypeID = 32 Then
        lngActivityTypeID_2 = 33
  ElseIf lngActivityTypeID = 33 Then
        lngActivityTypeID_2 = 32
  End If
    strSql = "SELECT ItemActivity.lngActivityID,ItemActivity.lngActivityTypeID " _
    & " FROM ItemActivity ,ItemActivity ItemActivity_1 " _
    & " Where ItemActivity.lngReceiptNO = ItemActivity_1.lngReceiptNO " _
    & " AND ItemActivity.strReceiptNO = ItemActivity_1.strReceiptNO" _
    & " AND ItemActivity.lngReceiptTypeID = ItemActivity_1.lngReceiptTypeID" _
    & " AND ItemActivity.strDate = ItemActivity_1.strDate" _
    & " AND ItemActivity_1.lngActivityID =" & lngActivityID & " AND ItemActivity.lngActivityTypeID=" & lngActivityTypeID_2
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic)
    If recTemp.BOF And recTemp.EOF Then
        cMsgBox "删除拆卸组装表失败！"
        Exit Function
    End If
    lngActivityID_2 = recTemp(0)
    lngActivityTypeID_2 = recTemp(0)
    Set recTemp = Nothing
    
    strSql = "SELECT * From ItemActivity WHERE (lngActivityID)=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTemp.EOF Then
        DeleteCompose = True
        Set recTemp = Nothing
        Exit Function
    End If
    '判断单据已否已作废
'    blnVoid = recTemp!blnIsVoid
    '-------------------------------------------------------------------
    intYear = gclsBase.FYearOfDate(C2Date(recTemp!strDate))
    bytPeriod = gclsBase.PeriodOfDate(C2Date(recTemp!strDate))
    lngReceiptTypeID = recTemp!lngReceiptTypeID
    strReceiptNo = recTemp!strReceiptNo
    lngReceiptNo = recTemp!lngReceiptNo
    '--------------------------------------------------------------------
    recTemp.Close
    Set recTemp = Nothing

    gclsBase.BaseWorkSpace.BeginTrans
    
    '1）单据是作废单据，不执行c
    If Not blnIsVoid Then
        If DeleteRelation(lngActivityID, lngActivityTypeID) <> 1 Then GoTo DeleteErr   '删除关系(删除采购发票与受托结算单时须标记对应商品入库单及受托入库单)
        If ChangeAllItem_from_Activity("D", lngActivityID) = False Then GoTo DeleteErr
'        If ChangeAllAccount_from_Activity("D", lngActivityID) = False Then GoTo DeleteErr
        If ModifyItemTable(lngActivityID, False) = False Then GoTo DeleteErr  '维护商品表（再定量、再销量、价格）
        If ModifyPositionWhenDeleteOutBill(lngActivityID) = False Then GoTo DeleteErr   '维护货位批次明细表
        
        If DeleteRelation(lngActivityID_2, lngActivityTypeID_2) <> 1 Then GoTo DeleteErr   '删除关系(删除采购发票与受托结算单时须标记对应商品入库单及受托入库单)
        If ChangeAllItem_from_Activity("D", lngActivityID_2) = False Then GoTo DeleteErr
'        If ChangeAllAccount_from_Activity("D", lngActivityID_2) = False Then GoTo DeleteErr
        If ModifyItemTable(lngActivityID_2, False) = False Then GoTo DeleteErr  '维护商品表（再定量、再销量、价格）
        If ModifyPositionWhenDeleteOutBill(lngActivityID_2) = False Then GoTo DeleteErr   '维护货位批次明细表
    
    End If
        
    If Not blnByVoid Then
         strSql = "DELETE  From ItemActivity WHERE (lngActivityID IN (" & lngActivityID & "," & lngActivityID_2 & "))"
         gclsBase.ExecSQL strSql
         strSql = "DELETE  From ItemActivityDetail WHERE (lngActivityID IN (" & lngActivityID & "," & lngActivityID_2 & "))"
         gclsBase.ExecSQL strSql
    Else
        strSql = "UPDATE ItemActivity SET ItemActivity.blnIsVoid = 1 WHERE (lngActivityID IN (" & lngActivityID & "," & lngActivityID_2 & "))"
        If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
    End If

'------------------------------------------------------------------------------
    If Not blnByVoid Then blnMaxNODecrease intYear, bytPeriod, lngReceiptTypeID, strReceiptNo, lngReceiptNo
'------------------------------------------------------------------------------
    
    gclsBase.BaseWorkSpace.CommitTrans
    DeleteCompose = True
    Exit Function
TheErr:
DeleteErr:
    gclsBase.BaseWorkSpace.RollBacktrans
    If Not blnByVoid Then cMsgBox "删除拆卸组装表失败！"
End Function