item.bas

金算盘软件代码

Attribute VB_Name = "mdlItem"
'  作者： 蔡奇科
'  日期：1998.07.14
'***********************************
 '修改人：肖志华  (Oracle 版) 1998/10/09
'***********************************

'说明：
'本模块提供三种类型的接口:
Option Explicit

Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long

'参数：
'strOP ：“I”插入，“D”删除
'****   要实现修改功能，请先删除再新增  ****


'第1类:提供ItemActivity的ID 或 ItemActivityDeatilID 的ID 将一次全部处理本模块所涉及的6个余额（发生额）表和Item中的库存字段
'Public Function ChangeAllItem_from_Activity(strOP As String, lngActivityID As Long) As Boolean
'           |
'            ------ Public Function DeleteAllItem_from_ActivityDetail(strOP As String, lngActivityDetailID As Long) As Boolean

'第2类：数据直接从数据库（ItemActivityDetail）中获得后改变余额表（或发生额表）-- 每个表单独处理

'仅改变Item中的库存字段

'！！！注意：改变发生额表（xxxDaily）时，将自动改变对应的余额表！！！
'！！！因此调用了发生额表改变函数后，就不能再调用余额表改变函数！！！

'Public Function ChangeItemdblStockQuantity(strOP As String, lngActivityDetailID As Long) As Boolean
'
'Public Function ChangeItemDaily1(strOP As String, lngActivityDetailID As Long) As Boolean
'           |
'            ------ Public Function TransferItemBalance1(strOP As String, lngActivityDetailID As Long) As Boolean

'Public Function ChangeItemDaily2(strOP As String, lngActivityDetailID As Long) As Boolean
'           |
'            ------ Public Function TransferItemBalance2(strOP As String, lngActivityDetailID As Long) As Boolean

'Public Function ChangePositionDaily(strOP As String, lngActivityDetailID As Long) As Boolean
'           |
'            ------ Public Function TransferPositionBalance(strOP As String, lngActivityDetailID) As Boolean



'第3类：数据不从数据库（ItemActivityDetail）中获得，数据由用户自己设置后改变余额表（或发生额表）-- 每个表单独处理
'（第二类接口被第一类接口从程序内部调用）


'Public Function NewItemDaily1(strDate As String, lngItemID As Long, lngCustomerID As Long, arrField() As String, arrValue() As Double) As Boolean
'Public Function NewItemDaily2(strDate As String, lngItemID As Long, arrField() As String, arrValue() As Double) As Boolean

'Public Function NewItemBalance1(intYear As Integer, lngItemID As Long, lngCustomerID As Long, arrField() As String, arrValue() As Double, arrField_InitChange() As String, arrValue_InitChange() As Double) As Boolean
'Public Function NewItemBalance2(intYear As Integer, lngItemID As Long, arrField() As String, arrValue() As Double, arrField_InitChange() As String, arrValue_InitChange() As Double) As Boolean

'Public Function NewPositionDaily(strDate As String, lngItemID As Long, lngPositionID As Long, arrField() As String, arrValue() As Double) As Boolean

'Public Function NewPositionBalance(intYear As Integer, lngItemID As Long, lngPositionID As Long, arrField() As String, arrValue() As Double, StockQuantity As Double) As Boolean


'删除ItemBalance1,ItemBalance2,ItemDaily1,ItemDaily2,PositionBalance,PositionDaily 中的数据

'《一类接口》
'该参数默认值为0表示不调用与余额有关的函数，非0则相反
Public Function ChangeAllItem_from_Activity(strOP As String, lngActivityID As Long, Optional FromStartPeriod As Integer = 0) As Boolean
    Dim SqlStr As String
    Dim TmpQ As New rdoQuery
    Dim rec   As Boolean
    On Error GoTo EndProc
    SqlStr = "{ ? =  CALL " & gclsBase.UID & ".ChangeAllItem_from_Activity( '" & strOP & "', " & lngActivityID & "," & FromStartPeriod & ") } "
    Set TmpQ.ActiveConnection = gclsBase.BaseDB
    TmpQ.SQL = SqlStr
    TmpQ(0).Type = rdTypeNUMERIC

    TmpQ(0).Direction = rdParamReturnValue
    TmpQ.Execute
    rec = IIf(TmpQ(0).Value = 0, True, False)
EndProc:
    Set TmpQ = Nothing
    ChangeAllItem_from_Activity = rec
End Function

'*********************************************************************************************************************************************************************
'                       *         PositionDaily         *
'*********************************************************************************************************************************************************************
'《接口》
Public Function ChangePositionDaily(strOP As String, lngActivityDetailID As Long) As Boolean
    Dim SqlStr As String
    Dim TmpQ As New rdoQuery
    Dim rec   As Boolean
    On Error GoTo EndProc
    
    SqlStr = "{ ? =  CALL " & gclsBase.UID & ".ChangePositionDaily( '" & strOP & "', " & lngActivityDetailID & ") } "
    Set TmpQ.ActiveConnection = gclsBase.BaseDB
    TmpQ.SQL = SqlStr
    TmpQ(0).Type = rdTypeNUMERIC
    TmpQ(0).Direction = rdParamReturnValue
    TmpQ.Execute
    rec = IIf(TmpQ(0).Value = 0, True, False)
EndProc:
    Set TmpQ = Nothing
    ChangePositionDaily = rec
End Function
'************************************************************************************************************************
'                       *              Item             *
'************************************************************************************************************************

'改变Item中的库存量：Item.dblStockQuantity
'注意：只有具有“存货”类性质的，才改变
Public Function ChangeItemdblStockQuantity(strOP As String, lngActivityDetailID As Long) As Boolean
    Dim SqlStr As String
    Dim TmpQ As New rdoQuery
    Dim rec   As Boolean
    On Error GoTo EndProc
    
    SqlStr = "{ ? =  CALL " & gclsBase.UID & ".ChangeItemdblStockQuantity( '" & strOP & "', " & lngActivityDetailID & ") } "
    Set TmpQ.ActiveConnection = gclsBase.BaseDB
    TmpQ.SQL = SqlStr
    TmpQ(0).Type = rdTypeNUMERIC
    TmpQ(0).Direction = rdParamReturnValue
    TmpQ.Execute
    rec = IIf(TmpQ(0).Value = 0, True, False)
EndProc:
    Set TmpQ = Nothing
    ChangeItemdblStockQuantity = rec

End Function


'************************************************************************************************************************
'                       *      PositionItemDetail       *
'************************************************************************************************************************
'删除货位商品批次明细表中的出货类型
Public Function DeletePositionItemDetail_OUT(lngActivityID As Long) As Integer
    Dim SqlStr As String
    Dim TmpQ As New rdoQuery
    Dim rec As Integer
    On Error GoTo EndProc
    
    SqlStr = "{ ? =  CALL " & gclsBase.UID & ".DeletePositionItemDetail_OUT(  " & lngActivityID & ") } "
    Set TmpQ.ActiveConnection = gclsBase.BaseDB
    TmpQ.SQL = SqlStr
    TmpQ(0).Type = rdTypeNUMERIC
    TmpQ(0).Direction = rdParamReturnValue
    TmpQ.Execute
    rec = TmpQ(0).Value
EndProc:
    Set TmpQ = Nothing
    DeletePositionItemDetail_OUT = rec
End Function


'************************************************************************************************************************
'                                   其他公用函数

'                       **************************************
'                       *  ItemActivity & ItemActivityDetail *
'                       **************************************
'判断是否生成凭证
Public Function IsVoucher_ItemActivity(lngActivityID As Long, Optional ByRef strVoucher As String) As Integer
    Dim SqlStr As String
    Dim TmpQ As New rdoQuery
    Dim rec As Integer
    On Error GoTo EndProc
    SqlStr = "{ ? =  CALL " & gclsBase.UID & ".IsVoucher_ItemActivity(   ? ,  ?  ) } "
    Set TmpQ.ActiveConnection = gclsBase.BaseDB
    TmpQ.SQL = SqlStr
    TmpQ(0).Type = rdTypeNUMERIC
    TmpQ(0).Direction = rdParamReturnValue
    
    TmpQ(1).Type = rdTypeNUMERIC
    TmpQ(1).Direction = rdParamInput
    TmpQ(1).Value = lngActivityID
    
    TmpQ(2).Type = rdTypeVARCHAR
    TmpQ(2).Direction = rdParamOutput
    
    TmpQ.Execute
     If TmpQ(0).Value = 2 Then
        rec = -1
     Else
        strVoucher = IIf(IsNull(TmpQ(2).Value), "", TmpQ(2).Value)
        rec = TmpQ(0).Value
     End If
EndProc:
     Set TmpQ = Nothing
      IsVoucher_ItemActivity = rec
       
End Function


'删除ItemActivity 和 ItemActivityDetail
Public Function DeleteItemActivityANDItemActivityDetail(lngActivityID As Long) As Integer
    Dim SqlStr As String
    Dim TmpQ As New rdoQuery
    Dim rec As Integer
    On Error GoTo EndProc
    
    SqlStr = "{ ? =  CALL " & gclsBase.UID & ".DelItemActANDItemActDetail(  " & lngActivityID & ") } "
    Set TmpQ.ActiveConnection = gclsBase.BaseDB
    TmpQ.SQL = SqlStr
    TmpQ(0).Type = rdTypeNUMERIC
    TmpQ(0).Direction = rdParamReturnValue
    TmpQ.Execute
    rec = TmpQ(0).Value
EndProc:
    Set TmpQ = Nothing
    If rec <> 0 Then
        DeleteItemActivityANDItemActivityDetail = -1
    Else
        DeleteItemActivityANDItemActivityDetail = rec
    End If
End Function
'                       *********************************
'                       *             对照表            *
'                       *********************************
'删除某张单据时，同时处理与本单据相关的对应业务类型的记录
'这里，删除的是使用记录(ItemActivityDeltail_Del) 改变的是源记录(ItemActivityDetail)
Public Function DeleteRelation(lngActivityID As Long, ByVal lngActivityTypeID As Long, Optional ByVal hWnd As Long = 0) As Integer
    Dim SqlStr As String
    Dim TmpQ As New rdoQuery
    Dim rec As Integer
    On Error GoTo EndProc
    
    SqlStr = "{ ? =  CALL " & gclsBase.UID & ".DeleteRelation(  " & lngActivityID & ", " & lngActivityTypeID & ") } "
    Set TmpQ.ActiveConnection = gclsBase.BaseDB
    TmpQ.SQL = SqlStr
    TmpQ(0).Type = rdTypeNUMERIC
    TmpQ(0).Direction = rdParamReturnValue
    TmpQ.Execute
    rec = IIf(TmpQ(0).Value = 0, 1, -1)
EndProc:
    Set TmpQ = Nothing
    DeleteRelation = rec

End Function
'修改某张单据时，同时处理与本单据相关的对应业务类型的记录
'这里，修改的是使用记录(ItemActivityDeltail_Del) 改变的是源记录(ItemActivityDetail)
Public Function ModifyRelation(ByVal lngActivityID As Long, ByVal lngReceiptTypeID As Long, Optional ByVal blnAdd As Boolean = True, Optional ByVal lnghWnd As Long = 0) As Integer
    Dim SqlStr As String
    Dim TmpQ As New rdoQuery
    Dim rec As Integer
    On Error GoTo EndProc
    lnghWnd = 0
    SqlStr = "{ ? =  CALL " & gclsBase.UID & ".ModifyRelation(  " & lngActivityID & ",  " & lngReceiptTypeID & ",  " & IIf(blnAdd, 1, 0) & ", " & lnghWnd & ") } "
    Set TmpQ.ActiveConnection = gclsBase.BaseDB
    TmpQ.SQL = SqlStr
    TmpQ(0).Type = rdTypeNUMERIC
    TmpQ(0).Direction = rdParamReturnValue
    TmpQ.Execute
    rec = IIf(TmpQ(0).Value = 0, 1, -1)
EndProc:
    Set TmpQ = Nothing
    ModifyRelation = rec
End Function