📄 frmcdtapes.frm
字号:
Private Sub cmdUpdate_Click()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
If cmdAddMovie.Caption = "&Cancel Add..." Then
'Start - Validate input
If ValidateTextBoxesEntries = True Then
'' Do nothing
Else
Exit Sub
End If
'End - Validate input
'Update DB
If vr_engine.Add_CD_TAPES_MovieToDB(txtTitle, txtDateEntered, txtItemCode, _
txtActor, txtYearReleased, txtGenre, txtRunTime, txtRentalAmount, _
txtAvailable, txtRentalPeriod, txtOverdueChargePerDay, txtLastDateBorrowed, txtLastDateBorrowedAddInfo, txtLastDateReturned, _
txtLastDateReturnedAddInfo, txtCondition, txtComments) = True Then
Call vr_engine.LoadMoviesList(lstTitles)
lstTitles.Text = Trim(txtTitle.Text) & " [" & Trim(txtItemCode.Text) & "]"
lstTitles.Enabled = True
lstTitles.SetFocus
cmdUpdate.Enabled = False
cmdClear.Enabled = False
cmdAddMovie.Caption = "&Add Entry"
Call LockTextboxes
Else
'' Do Nothing
End If
'End update
Exit Sub
End If
'-----------------------------------------------------------------------------------------------------------------
If cmdEdit.Caption = "Ca&ncel Edit" Then
'Start - Validate input
If ValidateTextBoxesEntries = True Then
'' Do nothing
Else
Exit Sub
End If
'End - Validate input
If vr_engine.UpdateEditedCDtapesInfo(tmpItemCodeB4Edit, txtTitle, txtDateEntered, txtItemCode, _
txtActor, txtYearReleased, txtGenre, txtRunTime, txtRentalAmount, _
txtAvailable, txtRentalPeriod, txtOverdueChargePerDay, txtLastDateBorrowed, txtLastDateBorrowedAddInfo, txtLastDateReturned, _
txtLastDateReturnedAddInfo, txtCondition, txtComments) = True Then
Call vr_engine.LoadMoviesList(lstTitles)
lstTitles.Text = Trim(txtTitle.Text) & " [" & Trim(txtItemCode.Text) & "]"
lstTitles.Enabled = True
cmdAddMovie.Enabled = True
lstTitles.SetFocus
cmdUpdate.Enabled = False
cmdClear.Enabled = False
cmdEdit.Caption = "&Edit"
Call LockTextboxes
Else
End If
End If
'-----------------------------------------------------------------------------------------------------------------
End Sub
Private Sub Form_Load()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Call vr_engine.LoadMoviesList(lstTitles)
End Sub
Private Sub lstTitles_Click()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Call vr_engine.GetCD_TapesInfo(lstTitles, txtTitle, txtDateEntered, txtItemCode, _
txtActor, txtYearReleased, txtGenre, txtRunTime, txtRentalAmount, _
txtAvailable, txtRentalPeriod, txtOverdueChargePerDay, txtLastDateBorrowed, txtLastDateBorrowedAddInfo, txtLastDateReturned, _
txtLastDateReturnedAddInfo, txtCondition, txtComments)
lstTEXT = lstTitles.Text
cmdEdit.Enabled = True
End Sub
Sub UnlockTextboxes()
txtTitle.Locked = False
''txtDateEntered.Locked = False
txtItemCode.Locked = False
txtActor.Locked = False
txtYearReleased.Locked = False
txtGenre.Locked = False
txtRunTime.Locked = False
txtRentalAmount.Locked = False
txtAvailable.Locked = False
txtOverdueChargePerDay.Locked = False
txtRentalPeriod.Locked = False
txtLastDateBorrowed.Locked = False
txtLastDateBorrowedAddInfo.Locked = False
txtLastDateReturned.Locked = False
txtLastDateReturnedAddInfo.Locked = False
txtCondition.Locked = False
txtComments.Locked = False
End Sub
Sub LockTextboxes()
txtTitle.Locked = True
txtDateEntered.Locked = True
txtItemCode.Locked = True
txtActor.Locked = True
txtYearReleased.Locked = True
txtGenre.Locked = True
txtRunTime.Locked = True
txtRentalAmount.Locked = True
txtAvailable.Locked = True
txtOverdueChargePerDay.Locked = True
txtRentalPeriod.Locked = True
txtLastDateBorrowed.Locked = True
txtLastDateBorrowedAddInfo.Locked = True
txtLastDateReturned.Locked = True
txtLastDateReturnedAddInfo.Locked = True
txtCondition.Locked = True
txtComments.Locked = True
End Sub
Function ValidateTextBoxesEntries() As Boolean
'-----------------------------------------------------------------
If Trim(txtTitle.Text) = "" Then
MsgBox "You must enter a title. ", vbInformation, "Cannot update"
ValidateTextBoxesEntries = False
txtTitle.SetFocus
Exit Function
End If
'-----------------------------------------------------------------
If Trim(txtItemCode.Text) = "" Then
MsgBox "You must enter your Item Code. ", vbInformation, "Cannot update"
ValidateTextBoxesEntries = False
txtItemCode.SetFocus
Exit Function
End If
'START - CHECKt Itemcode Format
Dim str2 As String
str2 = Trim(txtItemCode.Text)
If Len(str2) <> 8 Then
MsgBox "Item Code must be 8 characters long. ", vbInformation, "Invalid Item Code"
txtItemCode.SetFocus
Exit Function
Else
Dim t As String
If UCase(Mid(str2, 1, 4)) <> UCase("VHS-") _
And UCase(Mid(str2, 1, 4)) <> UCase("VCD-") _
And UCase(Mid(str2, 1, 4)) <> UCase("DVD-") Then
MsgBox "Fisrt four characters of item code " & vbCrLf & "must be either 'VHS-', 'VCD-', or 'DVD-'. ", vbInformation, "Invalid Item Code"
txtItemCode.SetFocus
Exit Function
Else
If IsNumeric(Mid(str2, 5, 1)) = False Then
MsgBox "Last four characters of item code " & vbCrLf & "must be a numeric character. ", vbInformation, "Invalid Item Code"
txtItemCode.SetFocus
Exit Function
End If
If IsNumeric(Mid(str2, 6, 1)) = False Then
MsgBox "Last four characters of item code " & vbCrLf & "must be a numeric character. ", vbInformation, "Invalid Item Code"
txtItemCode.SetFocus
Exit Function
End If
If IsNumeric(Mid(str2, 7, 1)) = False Then
MsgBox "Last four characters of item code " & vbCrLf & "must be a numeric character. ", vbInformation, "Invalid Item Code"
txtItemCode.SetFocus
Exit Function
End If
If IsNumeric(Mid(str2, 8, 1)) = False Then
MsgBox "Last four characters of item code " & vbCrLf & "must be a numeric character. ", vbInformation, "Invalid Item Code"
txtItemCode.SetFocus
Exit Function
End If
End If
End If
txtItemCode.Text = UCase(txtItemCode.Text)
'END - CHECK Itemcode format
'-----------------------------------------------------------------
If Trim(txtActor.Text) = "" Then
MsgBox "You must enter name of the actor. ", vbInformation, "Cannot update"
ValidateTextBoxesEntries = False
txtActor.SetFocus
Exit Function
End If
'-----------------------------------------------------------------
If Trim(txtYearReleased.Text) = "" Then
If MsgBox("""Year Released"" field is blank. " & vbCrLf & vbCrLf & "Do you want to continue?", vbYesNo, "Update Info") = vbNo Then
ValidateTextBoxesEntries = False
txtYearReleased.SetFocus
Exit Function
End If
End If
'-----------------------------------------------------------------
If Trim(txtGenre.Text) = "" Then
If MsgBox("""Genre"" field is blank. " & vbCrLf & vbCrLf & "Do you want to continue?", vbYesNo, "Update Info") = vbNo Then
ValidateTextBoxesEntries = False
txtGenre.SetFocus
Exit Function
End If
End If
'-----------------------------------------------------------------
If Trim(txtRunTime.Text) = "" Then
If MsgBox("""Run Time"" field is blank. " & vbCrLf & vbCrLf & "Do you want to continue?", vbYesNo, "Update Info") = vbNo Then
ValidateTextBoxesEntries = False
txtRunTime.SetFocus
Exit Function
End If
End If
'-----------------------------------------------------------------
If Trim(txtRentalAmount) = "" Then
MsgBox """Rental Amount"" is blank. ", vbInformation, "Cannot update"
txtRentalAmount.SetFocus
ValidateTextBoxesEntries = False
Exit Function
Else
If IsNumeric(Trim(txtRentalAmount.Text)) Then
'' do nothing
Else
MsgBox """Rental Amount"" is invalid. ", vbInformation, "Cannot update"
txtRentalAmount.SetFocus
ValidateTextBoxesEntries = False
Exit Function
End If
End If
'-----------------------------------------------------------------
If Trim(txtAvailable.Text) = "" Then
MsgBox """Available"" field is blank. " & vbCrLf & vbCrLf & "Please enter 'Yes' or 'No' ", vbInformation, "Cannot update"
txtAvailable.SetFocus
ValidateTextBoxesEntries = False
Exit Function
Else
If UCase(Trim(txtAvailable.Text)) = "YES" Or UCase(Trim(txtAvailable.Text)) = "NO" Then
If Left(UCase(Trim(txtAvailable.Text)), 1) = "Y" Then txtAvailable.Text = "Yes"
If Left(UCase(Trim(txtAvailable.Text)), 1) = "N" Then txtAvailable.Text = "No"
Else
MsgBox """Available"" field entry is invalid. " & vbCrLf & vbCrLf & "Please enter 'Yes' or 'No' ", vbInformation, "Cannot update"
txtAvailable.SetFocus
ValidateTextBoxesEntries = False
Exit Function
End If
End If
' ----------------------------------------------------------------
If IsNumeric(Trim(txtRentalPeriod.Text)) = True Then
If Int(Val(Trim(txtRentalPeriod.Text))) <= 0 Then
MsgBox "Rental Period field is blank or invalid. ", vbInformation, "Input Error: "
ValidateTextBoxesEntries = False
txtRentalPeriod.SetFocus
Exit Function
End If
txtRentalPeriod.Text = Trim(str(Int(Trim(txtRentalPeriod.Text))))
Else
MsgBox "Rental Period field is blank or invalid. ", vbInformation, "Input Error: "
ValidateTextBoxesEntries = False
txtRentalPeriod.SetFocus
Exit Function
End If
' ----------------------------------------------------------------
'txtOverdueChargePerDay
If IsNumeric(Trim(txtOverdueChargePerDay.Text)) = True Then
If Int(Val(Trim(txtOverdueChargePerDay.Text))) < 0 Then
MsgBox "Overdue Charge Per Day field is blank or invalid. ", vbInformation, "Input Error: "
ValidateTextBoxesEntries = False
txtOverdueChargePerDay.SetFocus
Exit Function
End If
txtOverdueChargePerDay.Text = Trim(txtOverdueChargePerDay.Text)
Else
MsgBox "Overdue Charge Per Day field is blank or invalid. ", vbInformation, "Input Error: "
ValidateTextBoxesEntries = False
txtOverdueChargePerDay.SetFocus
Exit Function
End If
'-----------------------------------------------------------------
If IsDate(Trim(txtLastDateBorrowed.Text)) Then
txtLastDateBorrowed.Text = Format(Trim(txtLastDateBorrowed.Text), "mmm. dd, yyyy")
Else
If Trim(txtLastDateBorrowed.Text) <> "" Then
MsgBox """Last Date Borrowed"" entry is invalid. ", vbInformation, "Cannot update"
txtLastDateBorrowed.SetFocus
ValidateTextBoxesEntries = False
Exit Function
End If
End If
'-----------------------------------------------------------------
If IsDate(Trim(txtLastDateReturned.Text)) Then
txtLastDateReturned.Text = Format(Trim(txtLastDateReturned.Text), "mmm. dd, yyyy")
Else
If Trim(txtLastDateReturned.Text) <> "" Then
MsgBox """Last Date Returned"" entry is invalid. ", vbInformation, "Cannot update"
txtLastDateReturned.SetFocus
ValidateTextBoxesEntries = False
Exit Function
End If
End If
'-----------------------------------------------------------------
If Trim(txtCondition.Text) = "" Then
MsgBox "Please enter the condition of the item. " & vbCrLf & vbCrLf & "Type: Good, Defective, Damaged, or Lost ", vbInformation, "Cannot update"
txtCondition.SetFocus
ValidateTextBoxesEntries = False
Exit Function
Else
If Trim(UCase(txtCondition.Text)) = "GOOD" Or Trim(UCase(txtCondition.Text)) = "DEFECTIVE" Or Trim(UCase(txtCondition.Text)) = "DAMAGED" Or _
Trim(UCase(txtCondition.Text)) = "LOST" Or Trim(UCase(txtCondition.Text)) = "D" Or Trim(UCase(txtCondition.Text)) = "DF" Or Trim(UCase(txtCondition.Text)) = "G" Or _
Trim(UCase(txtCondition.Text)) = "L" Then
If Trim(UCase(txtCondition.Text)) = "GOOD" Then txtCondition.Text = "Good"
If Trim(UCase(txtCondition.Text)) = "G" Then txtCondition.Text = "Good"
If Trim(UCase(txtCondition.Text)) = "DEFECTIVE" Then txtCondition.Text = "Defective"
If Trim(UCase(txtCondition.Text)) = "DF" Then txtCondition.Text = "Defective"
If Trim(UCase(txtCondition.Text)) = "DAMAGED" Then txtCondition.Text = "Damaged"
If Trim(UCase(txtCondition.Text)) = "D" Then txtCondition.Text = "Damaged"
If Trim(UCase(txtCondition.Text)) = "LOST" Then txtCondition.Text = "Lost"
If Trim(UCase(txtCondition.Text)) = "L" Then txtCondition.Text = "Lost"
Else
MsgBox "Invalid condition for the item. " & vbCrLf & vbCrLf & "Type: Good, Defective, Damaged, or Lost ", vbInformation, "Cannot update"
txtCondition.SetFocus
ValidateTextBoxesEntries = False
Exit Function
End If
End If
'-----------------------------------------------------------------
ValidateTextBoxesEntries = True
End Function
Private Sub txtAvailable_LostFocus()
If UCase(txtAvailable.Text) = "Y" Then txtAvailable.Text = "Yes"
If UCase(txtAvailable.Text) = "N" Then txtAvailable.Text = "No"
End Sub
Private Sub txtItemCode_LostFocus()
Dim str As String
Dim loop1 As Integer
If Trim(txtItemCode.Text) <> "" Then
For loop1 = 1 To Len(txtItemCode.Text)
If Mid(Trim(txtItemCode.Text), loop1, 1) = " " Then
MsgBox "Item Code should not contain a 'space' character. ", vbInformation, "Invalid Entry"
txtItemCode.Text = ""
txtItemCode.SetFocus
End If
Next
End If
End Sub
Private Sub txtRentalAmount_LostFocus()
If IsNumeric(txtRentalAmount) = True Then txtRentalAmount.Text = Format(txtRentalAmount.Text, "##,##0.00")
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -