clsbuy.cls

《超市进销存管理系统的开发与实现》 2、开发工具 Microsoft Visual Basic 6.0 3、运行环境 （1）、硬件环境 486DX/66MHz或更高

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsBuy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
'保持属性值的局部变量
Private mvarID As Long              '进货ID
Private mvarProviderId As Long      '供应商ID
Private mvarProviderName As String  '供应商名称
Private mvarMerchandiseID As Long   '商品ID
Private mvarMerchName As String     '商品名称
Private mvarStockDate As Date       '进货时间
Private mvarDeliver As String       '送货人姓名
Private mvarConsignee As String     '经手人姓名
Private mvarCount As Long           '购入量
Private mvarStockPrice As Single    '进货单价
Private mvarOperatorId As String    '操作员Id
Private mvarRemark As String        '备注
Private mvarTypeId As Long          '商品类型ID
Private mvarTypeName As String      '商品类型名
Private mvarStockTimes As Long      '进货次数
Private mvarTotalPrice As Single    '总进货价格
Public Property Let TotalPrice(ByVal vData As Single)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.TotalPrice = 5
mvarTotalPrice = vData
End Property


Public Property Get TotalPrice() As Single
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.TotalPrice
    TotalPrice = mvarTotalPrice
End Property



Public Property Let StockTimes(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.StockTimes = 5
    mvarStockTimes = vData
End Property


Public Property Get StockTimes() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.StockTimes
    StockTimes = mvarStockTimes
End Property



Public Property Let TypeName(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.TypeName = 5
    mvarTypeName = vData
End Property


Public Property Get TypeName() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.TypeName
    TypeName = mvarTypeName
End Property



Public Property Let MerchName(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.MerchName = 5
    mvarMerchName = vData
End Property


Public Property Get MerchName() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.MerchName
    MerchName = mvarMerchName
End Property



Public Property Let TypeId(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.TypeId = 5
    mvarTypeId = vData
End Property


Public Property Get TypeId() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.TypeId
    TypeId = mvarTypeId
End Property



Public Property Let Remark(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.Remark = 5
    mvarRemark = vData
End Property


Public Property Get Remark() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.Remark
    Remark = mvarRemark
End Property



Public Property Let OperatorId(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.OperatorId = 5
    mvarOperatorId = vData
End Property


Public Property Get OperatorId() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.OperatorId
    OperatorId = mvarOperatorId
End Property



Public Property Let StockPrice(ByVal vData As Single)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.StockPrice = 5
    mvarStockPrice = vData
End Property


Public Property Get StockPrice() As Single
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.StockPrice
    StockPrice = mvarStockPrice
End Property



Public Property Let Count(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.Count = 5
    mvarCount = vData
End Property


Public Property Get Count() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.Count
    Count = mvarCount
End Property



Public Property Let Consignee(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.Consignee = 5
    mvarConsignee = vData
End Property


Public Property Get Consignee() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.Consignee
    Consignee = mvarConsignee
End Property



Public Property Let Deliver(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.Deliver = 5
    mvarDeliver = vData
End Property


Public Property Get Deliver() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.Deliver
    Deliver = mvarDeliver
End Property



Public Property Let StockDate(ByVal vData As Date)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.StockDate = 5
    mvarStockDate = vData
End Property


Public Property Get StockDate() As Date
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.StockDate
    StockDate = mvarStockDate
End Property



Public Property Let MerchandiseID(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.MerchandiseId = 5
    mvarMerchandiseID = vData
End Property


Public Property Get MerchandiseID() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.MerchandiseId
    MerchandiseID = mvarMerchandiseID
End Property



Public Property Let ProviderName(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.ProviderName = 5
    mvarProviderName = vData
End Property


Public Property Get ProviderName() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.ProviderName
    ProviderName = mvarProviderName
End Property



Public Property Let ProviderId(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.ProviderId = 5
    mvarProviderId = vData
End Property


Public Property Get ProviderId() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.ProviderId
    ProviderId = mvarProviderId
End Property



Public Property Let ID(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.ID = 5
    mvarID = vData
End Property


Public Property Get ID() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.ID
    ID = mvarID
End Property


'说明：进货与库存挂勾，进加进货记录时，同时库存也要增加
Public Function AddNew() As gxcAddNew
  Dim strSQL As String
  
  '用来获取对应商品的信息，以便更新库存
  Dim obj As clsMerch
  Dim objs As New clsMerchs
  Dim rstObjs As clsMerchs
  Set rstObjs = objs.Find(Me.MerchandiseID)
  If rstObjs Is Nothing Then
    AddNew = AddNewFail
    Exit Function
  End If
  Set obj = rstObjs.Item(1)

  g_Conn.BeginTrans

  strSQL = "INSERT INTO Buy(B_ProviderId_N, B_MerchandiseId_N, B_StockDate_D, "
  strSQL = strSQL & " B_Deliver_S, B_Consignee_S, B_Count_N, "
  strSQL = strSQL & " B_StockPrice_N, B_OperatorId_S, B_Remark_R) "
  strSQL = strSQL & " VALUES("
  strSQL = strSQL & Me.ProviderId & ","         '供应商ID
  strSQL = strSQL & Me.MerchandiseID & ","      '商品ID
  strSQL = strSQL & "'" & Me.StockDate & "',"   '进货时间
  strSQL = strSQL & "'" & Me.Deliver & "',"     '送货人姓名
  strSQL = strSQL & "'" & Me.Consignee & "',"   '经手人姓名
  strSQL = strSQL & Me.Count & ","              '购入量
  strSQL = strSQL & Me.StockPrice & ","         '进货单价
  strSQL = strSQL & "'" & Me.OperatorId & "',"  '操作员Id
  strSQL = strSQL & "'" & Me.Remark & "'"       '备注
  strSQL = strSQL & ")"
  
  '执行SQL语句，
  g_Conn.Execute strSQL
  
  '更新库存
  obj.Storage = obj.Storage + Me.Count
  obj.Update
  
  '提交事务
  g_Conn.CommitTrans
  
  '如果发生错误，则返回FALSE，表示未成功添加
  If Err.Number = 0 Then
    Me.ID = MaxID("Buy", "B_ID_N")
    AddNew = AddNewOK
  Else
    AddNew = AddNewFail
  End If
  
End Function

Public Function Update() As gxcUpdate
  Dim strSQL As String
  
  '通过ID判断是否存在该记录，即该记录是否被其它商品端删除
  '如果不存在该记录，则返回相应的操作结果给调用者
  If Not ExistByID("Buy", "B_ID_N", Me.ID) Then
    Update = RecordNotExist
    Exit Function
  End If
  
  '用来获取对应商品的信息，以便更新库存
  Dim obj As clsMerch
  Dim objs As New clsMerchs
  Dim rstObjs As clsMerchs
  Set rstObjs = objs.Find(Me.MerchandiseID)
  If rstObjs Is Nothing Then
    Update = UpdateFail
    Exit Function
  End If
  Set obj = rstObjs.Item(1)
  
  '获取原来的进货量
  Dim preCnt As Long
  preCnt = Val(GetValueByID("Buy", "B_ID_N", Me.ID, "B_Count_N"))

  g_Conn.BeginTrans
  
  '构造SQL语句，注意需调用RealString函数去除字符串中的单引号
  strSQL = "Update Buy SET "
  strSQL = strSQL & "B_ProviderId_N=" & Me.ProviderId & ","       '供应商ID
  strSQL = strSQL & "B_MerchandiseId_N=" & Me.MerchandiseID & "," '商品ID
  strSQL = strSQL & "B_StockDate_D='" & Me.StockDate & "',"       '进货时间
  strSQL = strSQL & "B_Deliver_S='" & Me.Deliver & "',"           '送货人姓名
  strSQL = strSQL & "B_Consignee_S='" & Me.Consignee & "',"       '经手人姓名
  strSQL = strSQL & "B_Count_N=" & Me.Count & ", "                '购入量
  strSQL = strSQL & "B_StockPrice_N=" & Me.StockPrice & ", "      '进货单价
  strSQL = strSQL & "B_OperatorId_S='" & Me.OperatorId & "', "    '操作员Id
  strSQL = strSQL & "B_Remark_R='" & Me.Remark & "' "             '备注
  strSQL = strSQL & " WHERE B_ID_N=" & Me.ID

  '执行SQL语句，
  g_Conn.Execute strSQL
  
  '更新库存
  obj.Storage = obj.Storage + Me.Count - preCnt
  obj.Update
  
  '提交事务
  g_Conn.CommitTrans
  
  '根据是否出错，返回给调用者相应的信息
  Update = IIf(Err.Number = 0, UpdateOK, UpdateFail)

End Function

Public Function Delete(Optional lngID As Long = -1) As gxcDelete
  Dim strSQL As String
  
  '如果调用该函数时传入了ID，则更新该对象的ID
  If lngID <> -1 Then Me.ID = lngID
  
  
  '用来获取对应商品的信息，以便更新库存
  Dim obj As clsMerch
  Dim objs As New clsMerchs
  Dim rstObjs As clsMerchs
  Set rstObjs = objs.Find(Me.MerchandiseID)
  If rstObjs Is Nothing Then
    Delete = DeleteFail
    Exit Function
  End If
  Set obj = rstObjs.Item(1)
  
  '获取原来的进货量
  Dim preCnt As Long
  preCnt = Val(GetValueByID("Buy", "B_ID_N", Me.ID, "B_Count_N"))

  g_Conn.BeginTrans
  
  '执行删除操作并返回操作结果
  strSQL = "DELETE FROM Buy "
  strSQL = strSQL & " WHERE B_ID_N=" & Me.ID
  

  '执行SQL语句，
  g_Conn.Execute strSQL
  
  '更新库存
  obj.Storage = obj.Storage - preCnt
  obj.Update
  
  '提交事务
  g_Conn.CommitTrans
  
  
  Delete = IIf(Err.Number = 0, DeleteOK, DeleteFail)
  
End Function

Public Function DeleteEx() As gxcDelete
  DeleteEx = Delete(Me.ID)
End Function