frmrentvideos.frm

project on Video rental system

VERSION 5.00
Begin VB.Form frmRentVideos 
   BackColor       =   &H00FF0000&
   Caption         =   "frmRentVideos"
   ClientHeight    =   5805
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5940
   ForeColor       =   &H00FF0000&
   LinkTopic       =   "Form1"
   ScaleHeight     =   5805
   ScaleWidth      =   5940
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdSubmit 
      Caption         =   "&Submit"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1200
      TabIndex        =   3
      ToolTipText     =   "Submit the rental application."
      Top             =   5160
      Width           =   1095
   End
   Begin VB.CommandButton cmdback 
      Caption         =   "&Back"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2640
      TabIndex        =   4
      ToolTipText     =   "Back to Rent form"
      Top             =   5160
      Width           =   1215
   End
   Begin VB.CommandButton cmdexit 
      Caption         =   "&Exit"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4200
      TabIndex        =   5
      ToolTipText     =   "Exit now?"
      Top             =   5160
      Width           =   1215
   End
   Begin VB.Frame Rental 
      BackColor       =   &H00FF0000&
      Caption         =   "Confirmation"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   15.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   2415
      Left            =   480
      TabIndex        =   0
      Top             =   2040
      Width           =   5295
      Begin VB.TextBox txtField 
         Enabled         =   0   'False
         Height          =   375
         Index           =   0
         Left            =   2280
         MultiLine       =   -1  'True
         TabIndex        =   10
         ToolTipText     =   "Please enter Videos ID. Click View if you not sure about the Videos ID"
         Top             =   1800
         Width           =   2775
      End
      Begin VB.TextBox txtField 
         Enabled         =   0   'False
         Height          =   375
         Index           =   2
         Left            =   2280
         MultiLine       =   -1  'True
         TabIndex        =   2
         ToolTipText     =   "Please enter Videos ID. Click View if you not sure about the Videos ID"
         Top             =   1200
         Width           =   2775
      End
      Begin VB.TextBox txtField 
         Enabled         =   0   'False
         Height          =   375
         Index           =   1
         Left            =   2280
         TabIndex        =   1
         ToolTipText     =   "Please enter Member ID."
         Top             =   600
         Width           =   2775
      End
      Begin VB.Label Label3 
         BackColor       =   &H00FF0000&
         Caption         =   "Videos Name:"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   240
         TabIndex        =   11
         Top             =   1800
         Width           =   1815
      End
      Begin VB.Label label1 
         BackColor       =   &H00FF0000&
         Caption         =   "Member ID:"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   240
         TabIndex        =   7
         Top             =   600
         Width           =   1695
      End
      Begin VB.Label Label2 
         BackColor       =   &H00FF0000&
         Caption         =   "Videos ID:"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   240
         TabIndex        =   6
         Top             =   1200
         Width           =   1575
      End
   End
   Begin VB.Label Label7 
      Alignment       =   2  'Center
      BackColor       =   &H00FF0000&
      Caption         =   "*If the information above is correct  please click Sumit."
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000E&
      Height          =   375
      Left            =   480
      TabIndex        =   13
      Top             =   4440
      Width           =   5295
   End
   Begin VB.Label Label5 
      Caption         =   "Label5"
      Height          =   495
      Left            =   2400
      TabIndex        =   12
      Top             =   2640
      Width           =   1215
   End
   Begin VB.Label Label6 
      Alignment       =   2  'Center
      BackColor       =   &H00FF0000&
      Caption         =   "Millenium Video Store"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   26.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   1215
      Left            =   600
      TabIndex        =   9
      Top             =   0
      Width           =   4815
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      BackColor       =   &H00FF0000&
      Caption         =   "Point-of-sale system"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   26.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   615
      Left            =   840
      TabIndex        =   8
      Top             =   1200
      Width           =   4695
   End
End
Attribute VB_Name = "frmRentVideos"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdBack_Click()
Unload Me
frmRent.Show
frmRent.cmdrent.Visible = False
frmRent.cmdreserve.Visible = False
frmRent.VideosStatus = ""
End Sub

Private Sub cmdexit_Click()
Dim ans As Integer

ans = MsgBox("Sure to exit?", vbYesNo)
If ans = vbYes Then End

End Sub

Private Sub cmdSubmit_Click()
 'Dim ans As Integer

If Len(Trim$(txtField(1).Text)) = 0 Or Len(Trim$(txtField(2).Text)) = 0 Then
    MsgBox "Please finish entering Videos particulars"
Else
    RentVideos
    Unload Me
    'frmRent.Show
    
 End If
End Sub

Private Sub RentVideos()
Dim strSQL As String, varData() As Variant
Dim i As Integer, confirm As Integer
Dim strSQL2 As String, strSQL3 As String, strSQL5 As String ' update
Dim strSQL1 As String, strSQL4 As String, strSQL6 As String 'copies
Dim dateDue As Variant, Login_Id As Integer
Dim strVideoID As Integer, copyID As Long, copy_id As Integer, varData3 As Long
Dim strSQL7 As String ', strSQL8 As String
'Dim lngRowsRetrieved3 As Long
'Dim nextdue As Integer

Login_Id = frmVerify.txtverifyField(0)
strVideoID = txtField(2).Text
     
 strSQL1 = RunSelectQuery("Select CopiesAvailable,ID from Videos " _
                          & "where CopiesAvailable > 0 " _
                          & "and ID = " & strVideoID, varData) 'check when copies available = 0
 
 strSQL4 = RunSelectQuery("Select TapesRented from Members " _
                        & "where TapesRented < 5 " _
                        & "and ID = " & Login_Id, varData) 'check when customer has over rented a not.
     
 
   If strSQL1 = 0 Then
    'strSQL8 = "UPDATE Videos SET " _
              & " NextDue = #" & nextdue & "#" _
              & " where ID = " & strVideoID
    'RunActionQuery (strSQL8)
    MsgBox "Sorry there is no such Video or is currently unavailable." 'check if videos is available
   frmRent.Show
   Else
   If strSQL4 = 0 Then
     MsgBox "Sorry u have Rented the Maximium Number of Videos. " _
            & " Please return your current Videos. " 'reach max no of rent liao
            Unload Me
            frmChoices.Show
            frmChoices.cmdrent.Enabled = False
            frmChoices.cmdreserve.Enabled = False
      
    End If
   End If
 
 If (strSQL1 > 0 And strSQL4 > 0) Then 'when everything is check, SUBMIT
  
confirm = MsgBox("Confirm to submit?", vbYesNo)
  If confirm = vbYes Then
   copyID = RunSelectQuery("Select ID from Copies " _
                          & "where VideoID = " & strVideoID _
                          & "and Rented = False", varData) ' copies id update
   copy_id = varData(0, 0)
   
   strSQL = "INSERT INTO Rentals(" _
           & "DateRented,DateDue,MemberID,VideoID,CopyID)" _
           & " VALUES('" & Date & "','" & Date + 3 _
           & "'," & Login_Id & "," & strVideoID & "," & copy_id & ")"
        
  If RunActionQuery(strSQL) = 0 Then
    MsgBox "Rental Unsuccessful"
    
  Else
  strSQL2 = "UPDATE Members SET " _
            & "TapesRented = TapesRented + 1" _
            & " where ID = " & Login_Id ' set the TapesRented +1 when submit
  
   If RunActionQuery(strSQL2) = 0 Then
   MsgBox "Rental Unsuccessful"
   
   Else
   strSQL3 = "UPDATE Videos SET " _
           & "CopiesAvailable = CopiesAvailable - 1 " _
           & "where ID = " & strVideoID
  
   If RunActionQuery(strSQL3) = 0 Then
   MsgBox "Rental Unsuccessful"
   
   Else
   strSQL5 = "UPDATE Copies SET " _
            & " Rented = True " _
            & " where ID = " & copy_id ' set a tick on the rented column.
   
   If RunActionQuery(strSQL5) = 0 Then
    MsgBox "Rental Unsuccessful"
   
   Else
   strSQL7 = "UPDATE Copies SET " _
             & " Reserved = False" _
             & " WHERE VideoID = " & strVideoID _
             & " AND " & " ID = " & copy_id
    
   If RunActionQuery(strSQL7) = 0 Then
    MsgBox "Rental Unsuccessful"

   Else
    MsgBox "Rental Success" ' end of insert rental
    dateDue = Date + 3
    MsgBox "Your datedue is " & dateDue ' end of update rental
    frmRent.Show
    
      End If
     End If
    End If
   End If
  End If
 End If
End If
End Sub