clsinsource.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 = "clsinsource"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private WithEvents rs As ADODB.Recordset
Attribute rs.VB_VarHelpID = -1
Private mBills As String
Private mBilld As String
Private mTable As String
Private mTotal As Double
Private mAdd As String

Public Property Get DataMembers() As DataMembers

End Property

Private Sub Class_GetDataMember(DataMember As String, Data As Object)
    ' 分配记录集到数据对象
    Set Data = rs
End Sub

Private Sub Class_Initialize()
    
    ' 创建记录集实例
    Set rs = New ADODB.Recordset
    
    ' 设置记录集属性
    With rs
        .Fields.Append "ItemCode", adVarChar, 20, adFldKeyColumn
        .Fields.Append "ItemName", adVarChar, 50, adFldIsNullable
        .Fields.Append "ItemUnit", adVarChar, 10
        .Fields.Append "Value", adCurrency
        .Fields.Append "Price", adCurrency
        .Fields.Append "Total", adCurrency
        .Fields.Append "Quality", adVarChar, 10
        .Fields.Append "Size1", adCurrency
        .Fields.Append "Size2", adCurrency
        .Fields.Append "Size3", adCurrency
        .Fields.Append "Size4", adCurrency
        .Fields.Append "Size5", adCurrency
        .Fields.Append "Size6", adCurrency
        .Fields.Append "Size7", adCurrency
        .Fields.Append "Size8", adCurrency
        .Fields.Append "Size9", adCurrency
        .Fields.Append "Size10", adCurrency
        .Fields.Append "Size11", adCurrency
        .Fields.Append "Size12", adCurrency
        .Fields.Append "Size13", adCurrency
        .Fields.Append "Size14", adCurrency
        .Fields.Append "Size15", adCurrency
        .Fields.Append "Size16", adCurrency
        .Fields.Append "Size17", adCurrency
        .Fields.Append "Size18", adCurrency
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
        .Open
    End With
    
End Sub
Public Sub AddNew()

If rs.EOF Then
    rs.AddNew
    rs!ItemCode = ""
    rs!ItemName = ""
ElseIf rs.EditMode = adEditAdd Then
    rs.AddNew
    rs!ItemCode = ""
    rs!ItemName = ""
End If
End Sub

Public Sub LoadData() '装入数据
On Error Resume Next
Dim ss As New Recordset
Dim SQL As String
SQL = "SELECT a.ItemCode, b.ItemName, b.ItemUnit, a.Quality, a.Value, a.Price,a.Size1,a.Size2,a.Size3,a.Size4,a.Size5,a.Size6,a.Size7,a.Size8,a.Size9,a.Size10,a.Size11,a.Size12,a.Size13,a.Size14,a.Size15,a.Size16,a.Size17,a.Size18 FROM " & mTable & " a, ItemMaster b WHERE a.ItemCode = b.ItemCode AND "
SQL = SQL & mBills & "='" & mBilld & "'"
Opads ss, SQL
'MsgBox SQL
If ss.RecordCount > 0 Then
ss.MoveFirst
mTotal = 0
Do While Not ss.EOF
rs.AddNew
    rs!ItemCode = ss!ItemCode
    rs!ItemName = ss!ItemName
    rs!ItemUnit = ss!ItemUnit
    rs!Quality = ss!Quality
    rs!Value = ss!Value
    rs!Price = ss!Price
    rs!total = ss!Price * ss!Value
    rs!size1 = ss!size1
    rs!Size2 = ss!Size2
    rs!Size3 = ss!Size3
    rs!Size4 = ss!Size4
    rs!Size5 = ss!Size5
    rs!Size6 = ss!Size6
    rs!Size7 = ss!Size7
    rs!Size8 = ss!Size8
    rs!Size9 = ss!Size9
    rs!Size10 = ss!Size10
    rs!Size11 = ss!Size11
    rs!Size12 = ss!Size12
    rs!Size13 = ss!Size13
    rs!Size14 = ss!Size14
    rs!Size15 = ss!Size15
    rs!Size16 = ss!Size16
    rs!Size17 = ss!Size17
    rs!Size18 = ss!Size18
    mTotal = mTotal + rs!total
ss.MoveNext
rs.Update
Loop
ss.Close
End If
End Sub

Public Sub SaveData() '保存数据
On Error Resume Next
Dim ss As New Recordset
Dim SQL As String
SQL = "select * from " & mTable & " where " & mBills & "='" & mBilld & "'"
'MsgBox SQL
ss.LockType = adLockOptimistic
Opads ss, SQL
rs.MoveFirst
Do While Not rs.EOF
ss.AddNew
    ss.Fields(mBills) = mBilld
    ss!ItemCode = cField(rs!ItemCode)
    ss!Quality = cField(rs!Quality)
    ss!Value = rs!Value
    ss!Price = rs!Price
    ss!size1 = rs!size1
    ss!Size2 = rs!Size2
    ss!Size3 = rs!Size3
    ss!Size4 = rs!Size4
    ss!Size5 = rs!Size5
    ss!Size6 = rs!Size6
    ss!Size7 = rs!Size7
    ss!Size8 = rs!Size8
    ss!Size9 = rs!Size9
    ss!Size10 = rs!Size10
    ss!Size11 = rs!Size11
    ss!Size12 = rs!Size12
    ss!Size13 = rs!Size13
    ss!Size14 = rs!Size14
    ss!Size15 = rs!Size15
    ss!Size16 = rs!Size16
    ss!Size17 = rs!Size17
    ss!Size18 = rs!Size18
ss.Update
rs.MoveNext
Loop
ss.Close
If mAdd = "in" Then Execute "Update TrueStock a," & mTable & " b," & Left(mTable, Len(mTable) - 6) & " c Set a.Value=a.Value+b.Value where a.Itemcode=b.ItemCode and a.StockName=c.StockName and b." & mBills & "='" & mBilld & "'"
If mAdd = "Out" Then Execute "Update TrueStock a," & mTable & " b," & Left(mTable, Len(mTable) - 6) & " c Set a.Value=a.Value-b.Value where a.Itemcode=b.ItemCode and a.StockName=c.StockName and b." & mBills & "='" & mBilld & "'"

End Sub

Public Sub delete() '删除数据
If rs.RecordCount > 0 Then
    rs.MoveFirst
    Do While Not rs.EOF
        rs.delete
        rs.MoveNext
    Loop
End If
End Sub


Public Sub SetValue(table As String, billno As String, bAdd As String)
mTable = table
mBills = billno
mAdd = bAdd
End Sub

Public Sub LetValue(BillValue As String)
mBilld = BillValue
End Sub


Public Function GetTotal() As Double
GetTotal = mTotal
End Function
Public Function Recordset() As Recordset
Set Recordset = rs
End Function