clsshangpin.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsShangPin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public SP_ID As Long
Public PinMing As String
Public JLDW As String
Public ShuLei As String
Public LSJ As Single
Public DLJ As Single

Dim RS As ADODB.Recordset


Public Sub Update(ByVal TmpId As Long)
  SQL = "Update 商品信息 set 零售价=" & Trim(Str(LSJ)) & ",品名='" & Trim(PinMing) & "',计量单位='" & Trim(JLDW) & "',属类='" & Trim(ShuLei) & "',代理价=" & Trim(Str(DLJ)) & " where 商品_ID=" & Trim(Str(TmpId))
  ExecuteSQL (Trim(SQL))
End Sub

Public Sub Load_PinMing()
  Dim i As Long
  Erase Arr_ShangPin
  ReDim Arr_ShangPin(0)
  
  SQL = "select 品名 from 商品信息"
  Set RS = ExecuteSQL(Trim(SQL))
  i = 0
  With RS
    Do While .EOF = False
     ReDim Preserve Arr_ShangPin(i + 1)
     Arr_ShangPin(i) = !品名
     
     i = i + 1
      .MoveNext
    Loop
  End With
End Sub

Public Sub Insert()
  SP_ID = GetNewId
  SQL = "Insert into 商品信息 (商品_ID,零售价,品名,计量单位,属类,代理价) Values(" & Trim(CStr(SP_ID)) & "," & Trim(Str(LSJ)) & ",'" & Trim(PinMing) & "','" & Trim(JLDW) & "','" & Trim(ShuLei) & "'," & Trim(Str(DLJ)) & ")"
  ExecuteSQL (SQL)
End Sub

Public Sub Init()
  SP_ID = -1
  PinMing = ""
  JLDW = ""
  ShuLei = ""
  LSJ = 0
  DLJ = 0
End Sub

Public Function In_DB(ByVal TmpSPName As String) As Boolean
  SQL = "select * from 商品信息 where 品名='" & Trim(TmpSPName) & "'"
  Set RS = ExecuteSQL(SQL)
  If RS.EOF = False Then
    In_DB = True
  Else
    In_DB = False
  End If
End Function

Public Sub GetInfo(TmpId As Long)
  SP_ID = TmpId
  If TmpId = 0 Then
    Init
    Exit Sub
  End If
  
  On Error GoTo GetInfo_error
  SQL = "SELECT * FROM 商品信息 WHERE 商品_Id=" & Trim(Str(TmpId))
  Set RS = ExecuteSQL(Trim(SQL))
  With RS
    If .EOF = False Then
      PinMing = !品名
      JLDW = !计量单位
      ShuLei = !属类
      LSJ = !零售价
      DLJ = !代理价
    Else
      Init
    End If
  End With
  
GetInfo_exit:
  If Not RS Is Nothing Then
    RS.Close
    Set RS = Nothing
  End If
  Exit Sub
  
GetInfo_error:
  If Err.Description <> "" Then
    MsgBox Err.Description
    Err.Clear
  End If
  Resume GetInfo_exit
End Sub


Public Sub Delete(TmpId As Long)
  SQL = "DELETE from 商品信息 WHERE 商品_ID=" & Trim(Str(TmpId))
  ExecuteSQL (Trim(SQL))
End Sub


Public Function GetId(ByVal strPinMing As String) As Long
  If strPinMing = "" Then
    GetId = 0
    Exit Function
  End If
  
  On Error GoTo GetId_error
  SQL = "SELECT 商品_ID FROM 商品信息 WHERE 品名='" & Trim(strPinMing) + "'"
  Set RS = ExecuteSQL(Trim(SQL))
  If RS.EOF = False Then
    GetId = RS!商品_ID
  Else
    GetId = 0
  End If
  
GetId_exit:
  If Not RS Is Nothing Then
    RS.Close
    Set RS = Nothing
  End If
  Exit Function
  
GetId_error:
  If Err.Description <> "" Then
    MsgBox Err.Description
    Err.Clear
  End If
  Resume GetId_exit
End Function


Public Function GetName(TmpId As Long) As String
  On Error GoTo GetName_error
  SQL = "SELECT 品名 FROM 商品信息 WHERE 商品_ID=" & Trim(Str(TmpId))
  Set RS = ExecuteSQL(Trim(SQL))
  If RS.EOF Then
    GetName = Trim(RS!品名)
  Else
    GetName = ""
  End If
  
GetName_exit:
  If Not RS Is Nothing Then
    RS.Close
    Set RS = Nothing
  End If
  Exit Function
  
GetName_error:
  If Err.Description <> "" Then
    MsgBox Err.Description
    Err.Clear
  End If
  Resume GetName_exit
End Function


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