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 + -
显示快捷键?