📄 vrental_engine.cls
字号:
End If
'-------- START ADDING ----------
rec.AddNew
rec.Fields("Title") = Trim(txtTitle.Text)
rec.Fields("Date Entered") = Trim(txtDateEntered.Text)
rec.Fields("Item Code") = Trim(txtItemCode.Text)
rec.Fields("Actor") = Trim(txtActor.Text)
rec.Fields("Year Released") = Trim(txtYearReleased.Text)
rec.Fields("Genre") = Trim(txtGenre.Text)
rec.Fields("Run Time") = Trim(txtRunTime.Text)
rec.Fields("Rental Amount") = Trim(txtRentalAmount.Text)
rec.Fields("Available") = Trim(txtAvailable.Text)
rec.Fields("RentalPeriod") = Trim(txtRentalPeriod.Text)
rec.Fields("OverdueChargePerDay") = Trim(txtOverdueChargePerDay.Text)
If IsDate(Trim(txtLastDateBorrowed.Text)) = True Then rec.Fields("LastDateBorrowed") = Trim(txtLastDateBorrowed.Text)
rec.Fields("LastDateBorrowedAddInfo") = Trim(txtLastDateBorrowedAddInfo.Text)
If IsDate(Trim(txtLastDateReturned.Text)) = True Then rec.Fields("LastDateReturned") = Trim(txtLastDateReturned.Text)
rec.Fields("LastDateReturnedAddInfo") = Trim(txtLastDateReturnedAddInfo.Text)
rec.Fields("Condition") = Trim(txtCondition.Text)
rec.Fields("Comments") = Trim(txtComments.Text)
rec.Update
'-------- END ADDING ------------
db.Close
MsgBox "Another item has been added. ", vbInformation, "Adding Successful"
Add_CD_TAPES_MovieToDB = True
End Function
Function UpdateEditedCDtapesInfo(tmpItemCodeB4Edit As String, txtTitle As TextBox, txtDateEntered As TextBox, txtItemCode As TextBox, _
txtActor As TextBox, txtYearReleased As TextBox, txtGenre As TextBox, txtRunTime As TextBox, txtRentalAmount As TextBox, _
txtAvailable As TextBox, txtRentalPeriod As TextBox, txtOverdueChargePerDay As TextBox, txtLastDateBorrowed As TextBox, txtLastDateBorrowedAddInfo As TextBox, txtLastDateReturned As TextBox, _
txtLastDateReturnedAddInfo As TextBox, txtCondition As TextBox, txtComments As TextBox) As Boolean
Dim db As Database
Dim rec As Recordset
Dim TDM As Variant
Dim loop1 As Integer
Set db = OpenDatabase(App.Path & "\Database\CD_Tapes.mdb" _
, False, False, ";pwd=AdmiN")
Set rec = db.OpenRecordset("CD Tapes Table", dbOpenTable)
' Start for ItemCode duplicates
If tmpItemCodeB4Edit <> Trim(txtItemCode.Text) Then
rec.MoveFirst
For loop1 = 1 To rec.RecordCount
TDM = DoEvents()
If Trim(txtItemCode.Text) = rec.Fields("Item Code") Then
MsgBox "Item Code already in use. ", vbInformation, "Update ERROR!"
db.Close
UpdateEditedCDtapesInfo = False
Exit Function
End If
If rec.EOF = False Then rec.MoveNext
Next loop1
End If
' End check 4 Item code duplicates
' Start - Look 4 record
rec.MoveFirst
For loop1 = 1 To rec.RecordCount
TDM = DoEvents()
If tmpItemCodeB4Edit = rec.Fields("Item Code") Then
Exit For
End If
If rec.EOF = False Then rec.MoveNext
Next loop1
' End - Look 4 rec to edit
'-------- START Update Edit ----------
rec.Edit
rec.Fields("Title") = Trim(txtTitle.Text)
rec.Fields("Date Entered") = Trim(txtDateEntered.Text)
rec.Fields("Item Code") = Trim(txtItemCode.Text)
rec.Fields("Actor") = Trim(txtActor.Text)
rec.Fields("Year Released") = Trim(txtYearReleased.Text)
rec.Fields("Genre") = Trim(txtGenre.Text)
rec.Fields("Run Time") = Trim(txtRunTime.Text)
rec.Fields("Rental Amount") = Trim(txtRentalAmount.Text)
rec.Fields("Available") = Trim(txtAvailable.Text)
rec.Fields("RentalPeriod") = Trim(txtRentalPeriod.Text)
rec.Fields("OverdueChargePerDay") = Trim(txtOverdueChargePerDay.Text)
If IsDate(Trim(txtLastDateBorrowed.Text)) = False Then
rec.Fields("LastDateBorrowed") = Null
Else
rec.Fields("LastDateBorrowed") = Trim(txtLastDateBorrowed.Text)
End If
rec.Fields("LastDateBorrowedAddInfo") = Trim(txtLastDateBorrowedAddInfo.Text)
If IsDate(Trim(txtLastDateReturned.Text)) = False Then
rec.Fields("LastDateReturned") = Null
Else
rec.Fields("LastDateReturned") = Trim(txtLastDateReturned.Text)
End If
rec.Fields("LastDateReturnedAddInfo") = Trim(txtLastDateReturnedAddInfo.Text)
rec.Fields("Condition") = Trim(txtCondition.Text)
rec.Fields("Comments") = Trim(txtComments.Text)
rec.Update
'-------- END Update Edit ------------
db.Close
MsgBox "Record has been updated. ", vbInformation, "Update Successful"
UpdateEditedCDtapesInfo = True
End Function
Sub Remove_CD_tape_Items(ItemCode As String)
Dim db As Database
Dim rec As Recordset
Dim TDM As Variant
Dim loop1 As Integer
Set db = OpenDatabase(App.Path & "\Database\CD_Tapes.mdb" _
, False, False, ";pwd=AdmiN")
Set rec = db.OpenRecordset("CD Tapes Table", dbOpenTable)
rec.MoveFirst
For loop1 = 1 To rec.RecordCount
TDM = DoEvents()
If ItemCode = rec.Fields("Item Code") Then
rec.Delete
db.Close
Exit For
End If
If rec.EOF = False Then rec.MoveNext
Next loop1
MsgBox "Record has been successfully removed. ", vbInformation, "Record removed"
End Sub
Sub Search_Movies(FlexMovies As MSFlexGrid, SearchString As String, SearchFields As String, SearchMode As Boolean, SortByFields As String, SortMode As Boolean)
Dim TDM As Variant
Dim loop1, loop2 As Long
Dim mySQL As String
Dim adoConnection As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim connectString As String
Set adoConnection = New ADODB.Connection
Set adoRecordset = New ADODB.Recordset
connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DataBase\CD_Tapes.mdb;Persist Security Info=False;Jet OLEDB:Database Password=AdmiN"
adoConnection.Open connectString
With FlexMovies
.ColWidth(0) = 600
.ColWidth(1) = 1250
.ColWidth(2) = 1350
.ColWidth(3) = 2250
.ColWidth(4) = 1900
.ColWidth(5) = 1100
.ColWidth(6) = 1180
.ColWidth(7) = 900
.TextMatrix(0, 0) = "No."
.TextMatrix(0, 1) = "Item Code"
.TextMatrix(0, 2) = "Date Entered"
.TextMatrix(0, 3) = "Title"
.TextMatrix(0, 4) = "Actor"
.TextMatrix(0, 5) = "Genre"
.TextMatrix(0, 6) = "Year Released"
.TextMatrix(0, 7) = "Available"
End With
'' ---------Start SQL
If SearchString = "[All Movies]" Or SearchString = "*" Or SearchString = "" Then
mySQL = "SELECT * from [CD Tapes Table] ORDER by [" & SortByFields & "]"
Else
If SearchMode = True Then
mySQL = "SELECT * from [CD Tapes Table] WHERE [" & SearchFields & "] LIKE '%" & SearchString & "%' ORDER by [" & SortByFields & "]"
Else
mySQL = "SELECT * from [CD Tapes Table] WHERE [" & SearchFields & "] = " & """" & SearchString & """" & "ORDER by [" & SortByFields & "]"
End If
End If
adoRecordset.Open mySQL, adoConnection, adOpenStatic, adLockOptimistic, _
adCmdText
'' --------End SQL
If adoRecordset.BOF = True And adoRecordset.EOF = True Then
MsgBox "No records found matching your search. ", vbInformation, "Not found"
Exit Sub
End If
Select Case SortMode
Case True:
'---------- Forward Processing ------------------------------------------
FlexMovies.Rows = 1
loop1 = 0
adoRecordset.MoveFirst
Do Until adoRecordset.EOF
TDM = DoEvents()
loop1 = loop1 + 1
FlexMovies.AddItem ""
For loop2 = 0 To 7
Select Case loop2
Case 0:
FlexMovies.TextMatrix(loop1, loop2) = str(loop1)
Case 1:
FlexMovies.TextMatrix(loop1, loop2) = adoRecordset![Item Code]
Case 2:
FlexMovies.TextMatrix(loop1, loop2) = adoRecordset![Date Entered]
Case 3:
FlexMovies.TextMatrix(loop1, loop2) = adoRecordset!Title
Case 4:
FlexMovies.TextMatrix(loop1, loop2) = adoRecordset!actor
Case 5:
FlexMovies.TextMatrix(loop1, loop2) = adoRecordset!Genre
Case 6:
FlexMovies.TextMatrix(loop1, loop2) = adoRecordset![Year Released]
Case 7:
FlexMovies.TextMatrix(loop1, loop2) = adoRecordset!Available
End Select
Next loop2
adoRecordset.MoveNext
Loop
'FlexMovies.Rows = FlexMovies.Rows - 1
'-----------------------------------------------
Case False:
'---START--- Backward Proceesing (Sort)
Dim tmpArray() As Variant
Dim counter, countdown As Long
counter = 0
loop1 = 0
adoRecordset.MoveFirst
FlexMovies.Rows = 1
Do Until adoRecordset.EOF
TDM = DoEvents()
loop1 = loop1 + 1
counter = counter + 8
ReDim Preserve tmpArray(counter)
'FlexMovies.AddItem ""
For loop2 = 0 To 7
Select Case loop2
Case 0:
tmpArray(counter - 7 + loop2) = str(loop1)
Case 1:
tmpArray(counter - 7 + loop2) = adoRecordset![Item Code]
Case 2:
tmpArray(counter - 7 + loop2) = adoRecordset![Date Entered]
Case 3:
tmpArray(counter - 7 + loop2) = adoRecordset!Title
Case 4:
tmpArray(counter - 7 + loop2) = adoRecordset!actor
Case 5:
tmpArray(counter - 7 + loop2) = adoRecordset!Genre
Case 6:
tmpArray(counter - 7 + loop2) = adoRecordset![Year Released]
Case 7:
tmpArray(counter - 7 + loop2) = adoRecordset!Available
End Select
Next loop2
adoRecordset.MoveNext
Loop
'------ Start Backward display
For loop1 = 1 To counter
' Debug.Print Str(loop1) & ": " & tmpArray(loop1)
Next
loop1 = 0
adoRecordset.MoveFirst
countdown = counter
For loop1 = 1 To counter / 8
TDM = DoEvents()
FlexMovies.AddItem ""
FlexMovies.TextMatrix(loop1, 7) = tmpArray(countdown)
countdown = countdown - 1
FlexMovies.TextMatrix(loop1, 6) = tmpArray(countdown)
countdown = countdown - 1
FlexMovies.TextMatrix(loop1, 5) = tmpArray(countdown)
countdown = countdown - 1
FlexMovies.TextMatrix(loop1, 4) = tmpArray(countdown)
countdown = countdown - 1
FlexMovies.TextMatrix(loop1, 3) = tmpArray(countdown)
countdown = countdown - 1
FlexMovies.TextMatrix(loop1, 2) = tmpArray(countdown)
countdown = countdown - 1
FlexMovies.TextMatrix(loop1, 1) = tmpArray(countdown)
countdown = countdown - 1
FlexMovies.TextMatrix(loop1, 0) = str(loop1)
countdown = countdown - 1
Next loop1
'---END--- Backward Proceesing (Sort)
End Select
adoRecordset.Close
adoConnection.Close
Set adoRecordset = Nothing
Set adoConnection = Nothing
End Sub
Sub Search_Members(FlexMembers As MSFlexGrid, SearchString As String, SearchFields As String, SearchMode As Boolean, SortByFields As String, SortMode As Boolean)
Dim TDM As Variant
Dim loop1, loop2 As Long
Dim mySQL As String
Dim adoConnection As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim connectString As String
Set adoConnection = New ADODB.Connection
Set adoRecordset = New ADODB.Recordset
connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DataBase\MembersDB.mdb;Persist Security Info=False;Jet OLEDB:Database Password=AdmiN"
adoConnection.Open connectString
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -