clsrukucaozuo.cls

来自「音像店(CD刻录)进销存管理系统」· CLS 代码 · 共 134 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsRuKuCaoZuo"
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

Public RK_ID As Long
Public SP_ID As Long
Public CZLX As String
Public RKDJ As Single
Public ShuLiang As Integer
Public RK_Date As Date
Public JSR As String

Dim RS As ADODB.Recordset


Public Sub Update(ByVal TmpId As Long)
  SQL = "Update 入库操作 set 商品_ID=" & Trim(Str(SP_ID)) & ",操作类型='" & Trim(CZLX) & "',入库单价=" & Trim(Str(RKDJ)) & ",数量=" & Trim(Str(ShuLiang)) & ",入库日期='" & Trim(RK_Date) & "' where 入库_ID=" & Trim(Str(TmpId))
  ExecuteSQL (Trim(SQL))
End Sub


Public Sub Insert()
  Dim lngTmpID As Long
  
  lngTmpID = GetNewID
  SQL = "Insert into 入库操作 (入库_ID,商品_ID,操作类型,入库单价,数量,入库日期,经手人) Values(" & Trim(CStr(lngTmpID)) & "," & Trim(Str(SP_ID)) & ",'" & Trim(CZLX) & "'," & Trim(Str(RKDJ)) & "," & Trim(Str(ShuLiang)) & ",'" & Trim(RK_Date) & "','" & Trim(JSR) & "')"
  ExecuteSQL (SQL)
End Sub

Public Sub Init()
  RK_ID = -1
  SP_ID = -1
  CZLX = ""
  RKDJ = 0
  ShuLiang = 0
  RK_Date = ""
  JSR = ""
End Sub


Public Sub Load_JSR()
  Dim i As Long
  Erase Arr_RKJSR
  ReDim Arr_RKJSR(0)
  
  SQL = "select distinct 经手人 from 入库操作"
  Set RS = ExecuteSQL(Trim(SQL))
  i = 0
  With RS
    Do While .EOF = False
     ReDim Preserve Arr_RKJSR(i + 1)
     Arr_RKJSR(i) = !经手人
     
     i = i + 1
      .MoveNext
    Loop
  End With
End Sub


Public Sub Load_RKRQ()
  Dim i As Long
  Erase Arr_RKRQ
  ReDim Arr_RKRQ(0)
  
  SQL = "select distinct 入库日期 from 入库操作"
  Set RS = ExecuteSQL(Trim(SQL))
  i = 0
  With RS
    Do While .EOF = False
     ReDim Preserve Arr_RKRQ(i + 1)
     Arr_RKRQ(i) = !入库日期
     
     i = i + 1
      .MoveNext
    Loop
  End With
End Sub


Public Sub Delete(TmpId As Long)
  SQL = "DELETE from 入库操作 WHERE 入库_ID=" & Trim(Str(TmpId))
  ExecuteSQL (Trim(SQL))
End Sub


Private Function GetNewID() As Long
  Dim lngTmpID As Long
  Dim i As Long
  
  On Error GoTo GetNewID_error
  i = 1
  SQL = "select 入库_ID from 入库操作 order by 入库_ID"
  Set RS = ExecuteSQL(Trim(SQL))
  With RS
  Do While .EOF = False
    If !入库_ID = i Then
      i = i + 1
    Else
      GetNewID = i
      GoTo GetNewID_exit '当入库_ID不连续时
    End If
    RS.MoveNext
  Loop
  End With
  GetNewID = i '当入库_ID连续时
  
GetNewID_exit:
  If Not RS Is Nothing Then
    RS.Close
    Set RS = Nothing
  End If
  Exit Function
GetNewID_error:
  If Err.Description <> "" Then
    MsgBox Err.Description
    Err.Clear
  End If
  Resume GetNewID_exit
End Function