clsadjust.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 = "clsAdjust"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'蔡奇科

'本类模块实现如下列表的删除功能
'《受托调价（23）》
'《代销调拨--包括代销调入（24）、代销调出（25）》
'《代销调价（26）》
'《商品调拨--包括商品调入（27）、商品调出（28）》
'《商品调价（29）》

'注意：调拨单每笔业务存两条记录（一条入，一条出），两条记录单据类型一样，业务类型相对
'所以：删除调拨单时应删除两条记录

Option Explicit

Dim lngActivityID As Long
Dim thehWnd As Long

Public Sub SethWnd(arghWnd As Long)
    thehWnd = arghWnd
End Sub

Private Sub cMsgBox(strMsg As String, Optional strTitle As String)
    If Trim(strTitle) = "" Then
        strTitle = "提示信息"
    End If

    ShowMsg thehWnd, strMsg, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub
'判断单据是否作废
Public Function HaveActivity(lngActivityID As Long) As Boolean
   Exit Function
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim strItemID As String
    On Error Resume Next
    strSql = "SELECT ItemActivityDetail.lngItemID FROM ItemActivityDetail WHERE ItemActivityDetail.lngActivityID=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then
        Exit Function
    End If
    strItemID = "( 0"
    Do While recTemp.EOF = False
        strItemID = strItemID & "," & recTemp(0)
        recTemp.MoveNext
    Loop
    strItemID = strItemID & ")"
'    strSql = " SELECT ItemActivityDetail.lngActivityID " & _
'             " FROM (ItemActivityDetail INNER JOIN ItemActivity ON ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID) " & _
'             " WHERE ItemActivityDetail.lngActivityID>" & lngActivityID & " AND ItemActivityDetail.lngItemID IN " & strItemID & " AND ItemActivity.blnIsVoid=False "
    strSql = " SELECT ItemActivityDetail.lngActivityID " & _
             " FROM ItemActivityDetail,ItemActivity WHERE ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID " & _
             " AND ItemActivityDetail.lngActivityID>" & lngActivityID & " AND ItemActivityDetail.lngItemID IN " & strItemID & " AND ItemActivity.blnIsVoid=0 "
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then
        Exit Function
    End If
    HaveActivity = True
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
End Function

'判断单据是否作废
Public Function IsVoid(lngActivityID As Long) As Integer
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    strSql = "SELECT ItemActivity.blnIsVoid FROM ItemActivity WHERE ItemActivity.lngActivityID=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then
        cMsgBox "列表的数据已被修改，请重新刷新后再进行操作！"
        IsVoid = -1
        Exit Function
    End If
    
    If recTemp(0) <> 0 Then
        IsVoid = 1 '作废
    Else
        IsVoid = 0 '没有作废
    End If
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
End Function

'判断有批次管理标志的调入类型业务是否已发生了调出类型等对应业务
Private Function IsProduce() As Integer
    Dim strSql As String
    Dim recTemp As rdoResultset
'On Error GoTo theErr
    strSql = "SELECT PositionItemDetail.lngInActivityDetailID" _
           & " FROM PositionItemDetail,ItemActivityDetail " _
           & " WHERE PositionItemDetail.lngInActivityDetailID = ItemActivityDetail.lngActivityDetailID AND ItemActivityDetail.lngActivityID=" & lngActivityID & " AND PositionItemDetail.lngOutActivityDetailID<>0"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTemp.EOF Then
        IsProduce = 1 '批次商品已发生出库业务
    Else
        IsProduce = 0 '没有发生出库业务
    End If
    Set recTemp = Nothing
    Exit Function
TheErr:
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    IsProduce = -1
End Function

'*****************************************受托调价(23)*****************************************
Public Function DeleteConsignee(arglngActivityID As Long, Optional blnByVoid As Boolean) As Boolean
    Dim strSql As String
    Dim intResult As Integer
    Dim strDelOrVoid As String
    Dim blnVoid As Boolean
On Error GoTo TheErr

    If blnByVoid Then
        strDelOrVoid = "作废！"
    Else
        strDelOrVoid = "删除！"
    End If
    
    lngActivityID = arglngActivityID
    
    '规则判断
    Select Case IsVoucher_ItemActivity(lngActivityID)
    Case -1
        GoTo TheErr
    Case 1
        cMsgBox "本张受托调价单已经生成记帐凭证，不能" & strDelOrVoid
        DeleteConsignee = 0
        Exit Function
    End Select
    
    '提问
    If blnByVoid Then
        If ShowMsg(thehWnd, "本张受托代销调价单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
    Else
        If ShowMsg(thehWnd, "您确定要删除本张受托调价单吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
    End If
   
    '判断单据已否已作废
    intResult = IsVoid(lngActivityID)
    If intResult = -1 Then Exit Function
    If intResult = 1 Then
        blnVoid = True
    End If
    
    gclsBase.BaseWorkSpace.BeginTrans
    
    '1）单据是作废单据，不执行
    If Not blnVoid Then
        If ChangeAllItem_from_Activity("D", lngActivityID) = False Then GoTo TheErr
    End If
    
    '2）作废操作不执行
    If Not blnByVoid Then
        If DeleteItemActivityANDItemActivityDetail(lngActivityID) <> 0 Then GoTo TheErr
    Else
'        strSql = "UPDATE ItemActivity SET ItemActivity.blnIsVoid = Not [ItemActivity]![blnIsVoid] WHERE (((ItemActivity.lngActivityID)=" & lngActivityID & "))"
        strSql = "UPDATE ItemActivity SET ItemActivity.blnIsVoid = (1-ItemActivity!blnIsVoid) WHERE (((ItemActivity.lngActivityID)=" & lngActivityID & "))"
        If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
    End If
    
    gclsBase.BaseWorkSpace.CommitTrans
    DeleteConsignee = True
    Exit Function
TheErr:
    gclsBase.BaseWorkSpace.RollBacktrans
    cMsgBox Left(strDelOrVoid, 2) & "受托调价单失败！"
End Function

'*****************************************代销调拨*****************************************
'arglngActivityID 为调入的ID
Public Function DeleteLendAdjust(arglngActivityID As Long, Optional blnByVoid As Boolean) As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim lngActivityID_OUT As Long
    Dim intResult As Integer
    Dim strDelOrVoid As String
    Dim blnVoid As Boolean
    '-----------------------------------------
    Dim intYear As Integer '凭证会计年度
    Dim bytPeriod As Byte   '凭证会计期间
    Dim lngReceiptTypeID As Long
    Dim strReceiptNo As String
    Dim lngReceiptNo As Long
    Dim blnNoAlert As Boolean
    '------------------------------------------
    On Error GoTo TheErr1

    If blnByVoid Then
        strDelOrVoid = "作废！"
    Else
        strDelOrVoid = "删除！"
    End If
    
    lngActivityID = arglngActivityID
    
    '规则判断
    strSql = "SELECT * From ItemActivity WHERE (lngActivityID)=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.EOF Then
        cMsgBox "列表的数据已被修改，请重新刷新后再进行操作！"
        Set recTemp = Nothing
        Exit Function
    End If
    '判断单据已否已作废
    blnVoid = (recTemp!blnIsVoid <> 0)
    If blnVoid = False Then
      If recTemp!blnIsPrinted <> 0 Then
         If gclsBase.blnEditPrinted = False Then
            ShowMsg thehWnd, "本张委托代销商品调拨单已经打印，不能" & Left(strDelOrVoid, 2) & "！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, Left(strDelOrVoid, 2) & "单据"
            recTemp.Close
            Set recTemp = Nothing
            Exit Function
         Else
            If ShowMsg(thehWnd, "本张委托代销商品调拨单已经打印，您确实要" & Left(strDelOrVoid, 2) & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, Left(strDelOrVoid, 2) & "单据") <> IDYES Then
               recTemp.Close
               Set recTemp = Nothing
               Exit Function
            End If
            blnNoAlert = True
         End If
      End If
    End If
    '-------------------------------------------------------------------
    intYear = gclsBase.FYearOfDate(C2Date(recTemp!strDate))
    bytPeriod = gclsBase.PeriodOfDate(C2Date(recTemp!strDate))
    lngReceiptTypeID = recTemp!lngReceiptTypeID
    strReceiptNo = LTrim(recTemp!strReceiptNo)
    lngReceiptNo = recTemp!lngReceiptNo
    '--------------------------------------------------------------------
    recTemp.Close
    Set recTemp = Nothing