clstuidiechuli.cls

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

CLS
104
字号
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsTuiDieChuLi"
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 TD_ID As Long '退碟_ID
Public DLS_ID As Long '代理商_ID
Public GKXM As String '顾客姓名
Public GKDH As Single '顾客电话
Public DJRQ As String '登记日期
Public TDRQ As String '退碟日期
Public CLRQ As String '处理日期
Public YYD As String '原用碟
Public CLYD As String '处理用碟
Public BZ As String '备注

Dim RS As ADODB.Recordset


Public Sub Update(ByVal TmpId As Long)
  SQL = "Update 退碟 set 退碟_ID=" & Trim(Str(TD_ID)) & ",代理商_ID=" & Trim(Str(DLS_ID)) _
                & ",顾客姓名='" & Trim(GKXM) & "',顾客电话='" & Trim(GKDH) & "',登记日期='" _
                & Trim(DJRQ) & "',退碟日期='" & Trim(TDRQ) & "',处理日期='" & Trim(CLRQ) _
                & "',原用碟='" & Trim(YYD) & "',处理用碟='" & Trim(CLYD) & "',备注='" _
                & Trim(BZ) & "' 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(DLS_ID)) & ",'" & Trim(GKXM) & "'," & Trim(GKDH) & ",'" & Trim(DJRQ) & "','" & Trim(TDRQ) & "','" & Trim(CLRQ) & "','" & Trim(YYD) & "','" & Trim(CLYD) & "','" & Trim(BZ) & "')"
  ExecuteSQL (SQL)
End Sub

Public Sub Init()
  TD_ID = -1 '退碟_ID
  DLS_ID = -1 '代理商_ID
  GKXM = "" '顾客姓名
  GKDH = "" '顾客电话
  DJRQ = "" '登记日期
  TDRQ = "" '退碟日期
  CLRQ = "" '处理日期
  YYD = "" '原用碟
  CLYD = "" '处理用碟
  BZ = "" '备注
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

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?