⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmcdtapes.frm

📁 ado+ACCE
💻 FRM
📖 第 1 页 / 共 3 页
字号:

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 + -