📄 clssell.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 = "clsSell"
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 '销售编号
Private mvarMerchandiseID As Long '商品ID
Private mvarMerchName As String '商品名称
Private mvarRegDate As Date '登记日期
Private mvarCount As Long '售出数量
Private mvarSellPrice As Single '售出单价
Private mvarOperatorId As String '操作员Id
Private mvarRemark As String '备注
Private mvarTypeId As Long '类型ID
'以下供分析用
Private mvarTypeName As String '商品类型名称
Private mvarRegTimes 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 RegTimes(ByVal vData As Long)
'向属性指派值时使用,位于赋值语句的左边。
'Syntax: X.RegTimes = 5
mvarRegTimes = vData
End Property
Public Property Get RegTimes() As Long
'检索属性值时使用,位于赋值语句的右边。
'Syntax: Debug.Print X.RegTimes
RegTimes = mvarRegTimes
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 SellPrice(ByVal vData As Single)
'向属性指派值时使用,位于赋值语句的左边。
'Syntax: X.SellPrice = 5
mvarSellPrice = vData
End Property
Public Property Get SellPrice() As Single
'检索属性值时使用,位于赋值语句的右边。
'Syntax: Debug.Print X.SellPrice
SellPrice = mvarSellPrice
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 RegDate(ByVal vData As Date)
'向属性指派值时使用,位于赋值语句的左边。
'Syntax: X.RegDate = 5
mvarRegDate = vData
End Property
Public Property Get RegDate() As Date
'检索属性值时使用,位于赋值语句的右边。
'Syntax: Debug.Print X.RegDate
RegDate = mvarRegDate
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 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 Sell(S_MerchandiseID_N, S_RegDate_D, "
strSQL = strSQL & " S_Count_N, S_SellPrice_N, S_OperatorId_S, S_Remark_R) "
strSQL = strSQL & " VALUES("
strSQL = strSQL & Me.MerchandiseID '商品名称
strSQL = strSQL & ",'" & Me.RegDate & "'" '商品介绍
strSQL = strSQL & "," & Me.Count '商品类型ID
strSQL = strSQL & "," & Me.SellPrice '商品类型ID
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("Sell", "S_ID_N")
AddNew = AddNewOK
Else
AddNew = AddNewFail
End If
End Function
Public Function Update() As gxcUpdate
Dim strSQL As String
'通过ID判断是否存在该记录,即该记录是否被其它商品端删除
'如果不存在该记录,则返回相应的操作结果给调用者
If Not ExistByID("Sell", "S_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("Sell", "S_ID_N", Me.ID, "S_Count_N"))
g_Conn.BeginTrans
'构造SQL语句,注意需调用RealString函数去除字符串中的单引号
strSQL = "Update Sell SET "
strSQL = strSQL & "S_MerchandiseID_N=" & Me.MerchandiseID & ","
strSQL = strSQL & "S_RegDate_D='" & Me.RegDate & "',"
strSQL = strSQL & "S_Count_N=" & Me.Count & ","
strSQL = strSQL & "S_SellPrice_N=" & Me.SellPrice & ","
strSQL = strSQL & "S_OperatorId_S='" & Me.OperatorId & "',"
strSQL = strSQL & "S_Remark_R='" & Me.Remark & "' "
strSQL = strSQL & " WHERE S_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("Sell", "S_ID_N", Me.ID, "S_Count_N"))
g_Conn.BeginTrans
'执行删除操作并返回操作结果
strSQL = "DELETE FROM Sell "
strSQL = strSQL & " WHERE S_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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -