clsgequleixing.cls
来自「音像店(CD刻录)进销存管理系统」· CLS 代码 · 共 113 行
CLS
113 行
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsGeQuLeiXing"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public GQLX_ID As Long
Public LeiXing As String
Public ShuoMing As String
Dim RS As ADODB.Recordset
Public Sub Update(ByVal TmpID As Long)
SQL = "Update 歌曲类型 set 类型=" & Trim(LeiXing) & ",说明='" & Trim(ShuoMing) & "' where 歌曲类型_ID=" & Trim(Str(TmpID))
ExecuteSQL (Trim(SQL))
End Sub
Public Sub Load_LeiXing()
Dim i As Long
Erase Arr_GQLX
ReDim Arr_GQLX(0)
SQL = "select 类型 from 歌曲类型"
Set RS = ExecuteSQL(Trim(SQL))
i = 0
With RS
Do While .EOF = False
ReDim Preserve Arr_GQLX(i + 1)
Arr_GQLX(i) = !类型
i = i + 1
.MoveNext
Loop
End With
End Sub
Public Sub Insert()
GQLX_ID = GetNewID
SQL = "Insert into 歌曲类型 (歌曲类型_ID,类型,说明) Values(" & Trim(CStr(GQLX_ID)) & ",'" & Trim(LeiXing) & "','" & Trim(ShuoMing) & "')"
ExecuteSQL (SQL)
End Sub
Public Sub Init()
GQLX_ID = -1
LeiXing = ""
ShuoMing = ""
End Sub
Public Function In_DB(ByVal TmpLXName As String) As Boolean
SQL = "select * from 歌曲类型 where 类型='" & Trim(TmpLXName) & "'"
Set RS = ExecuteSQL(SQL)
If RS.EOF = False Then
In_DB = True
Else
In_DB = False
End If
End Function
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 + -
显示快捷键?