📄 frmrent.frm
字号:
VERSION 5.00
Begin VB.Form frmRent
BackColor = &H00FF0000&
Caption = "frmRent"
ClientHeight = 6480
ClientLeft = 60
ClientTop = 345
ClientWidth = 6495
ForeColor = &H00FF0000&
LinkTopic = "Form1"
ScaleHeight = 6480
ScaleWidth = 6495
StartUpPosition = 3 'Windows Default
Begin VB.Frame Rental
BackColor = &H00FF0000&
Caption = "Videos Rental"
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 = 4335
Left = 240
TabIndex = 2
Top = 2040
Width = 6015
Begin VB.CommandButton cmdreserve
Caption = "&Reserve"
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 = 3120
TabIndex = 9
ToolTipText = "fill in rent application form."
Top = 3840
Visible = 0 'False
Width = 1215
End
Begin VB.TextBox VideosStatus
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2295
Left = 3360
MultiLine = -1 'True
TabIndex = 4
Top = 960
Width = 2415
End
Begin VB.ListBox VideosList
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2220
ItemData = "frmRent.frx":0000
Left = 240
List = "frmRent.frx":0002
TabIndex = 3
Top = 960
Width = 2895
End
Begin VB.CommandButton cmdrent
Caption = "&Ok"
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 = 4560
TabIndex = 0
ToolTipText = "fill in rent application form."
Top = 3840
Visible = 0 'False
Width = 1215
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 = 240
TabIndex = 1
ToolTipText = "Back to choices form"
Top = 3840
Width = 1215
End
Begin VB.Label Label4
BackColor = &H00FF0000&
Caption = "*Please click the above Videos List to see its status."
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 495
Left = 240
TabIndex = 10
Top = 3240
Width = 2895
End
Begin VB.Label Label1
BackColor = &H00FF0000&
Caption = "Videos List:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 375
Left = 240
TabIndex = 6
Top = 600
Width = 2415
End
Begin VB.Label Label2
BackColor = &H00FF0000&
Caption = "Video Status:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 375
Left = 3480
TabIndex = 5
Top = 600
Width = 2415
End
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 = 960
TabIndex = 8
Top = 0
Width = 4815
End
Begin VB.Label Label3
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 = 1200
TabIndex = 7
Top = 1200
Width = 4695
End
End
Attribute VB_Name = "frmRent"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdBack_Click()
'frmRent.Hide
Unload Me
frmChoices.Show
End Sub
Private Sub cmdrent_Click()
Dim Login_Id As Long, LoginID As Integer
Dim varData() As Variant, lngRowsRetrieved As Long
LoginID = frmVerify.txtverifyField(0) 'test
Login_Id = RunSelectQuery("Select * from Members WHERE ID = " & LoginID, varData)
If Login_Id > 0 Then
frmRentVideos.txtField(1).Text = ConvertToString(varData(0, 0))
End If
lngRowsRetrieved = RunSelectQuery("Select * From Videos where Title = '" & VideosList.Text & "'", varData)
If lngRowsRetrieved > 0 Then
frmRentVideos.txtField(2).Text = ConvertToString(varData(0, 0))
frmRentVideos.txtField(0).Text = ConvertToString(varData(1, 0))
Unload Me
frmRentVideos.Show
End If
End Sub
Private Sub cmdReserve_Click()
Dim strSQL1 As String, strSQL8 As String
Dim lngRowsRetrieved3 As Long, lngRowsRetrieved As Long
Dim nextdue As Date
Dim varData3() As Variant, varData() As Variant
Dim strVideoID As Integer
lngRowsRetrieved = RunSelectQuery("Select * From Videos where Title = '" & VideosList.Text & "'", varData)
strVideoID = varData(0, 0)
strSQL1 = RunSelectQuery("Select CopiesAvailable,ID from Videos " _
& "where CopiesAvailable > 0 " _
& "and ID = " & strVideoID, varData) 'check when copies available = 0
lngRowsRetrieved3 = RunSelectQuery("select MIN(DateDue) from Rentals " _
& " where VideoID = " & strVideoID, varData3)
'MsgBox varData3(0, 0)
nextdue = varData3(0, 0)
'nextdue = Format(varData(0, 0), "dd,mm,yyyy")
MsgBox "The NextDue for this video is " & nextdue
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
frmMakeReservation.Show
End If
End Sub
Private Sub Form_Load()
'MsgBox ("Welcome to Reservations") ',please enter your member ID and the video ID you want")
Dim lngRowsRetrieved As Long, strTitle As String
Dim varData() As Variant
Dim count As Integer
lngRowsRetrieved = RunSelectQuery("select Title from Videos", varData)
For count = 0 To lngRowsRetrieved - 1
strTitle = ConvertToString(varData(0, count))
VideosList.AddItem (strTitle)
Next count
End Sub
Private Sub VideosList_Click()
'Show information of the selected video
Dim lngRowsRetrieved As Long, strVideoID As String, strTitle As String, strCopiesAval As String, strNextDue As String, strCopies As String
Dim varData() As Variant
'Dim reserve As Integer
'Dim ans As Integer
lngRowsRetrieved = RunSelectQuery("select * from Videos " _
& "where Title = '" & VideosList & "'", varData)
strVideoID = ConvertToString(varData(0, 0)) 'ID
strTitle = ConvertToString(varData(1, 0)) 'Title
strCopies = ConvertToString(varData(2, 0)) 'number of copy
strCopiesAval = ConvertToString(varData(3, 0)) 'Copies avalable ava
strNextDue = ConvertToString(varData(6, 0)) 'Next due date
strNextDue = Format(varData(6, 0), "mm/dd/yyyy")
If (strCopiesAval) = 0 Then
VideosStatus.Text = "Video Title: " + strTitle + vbCrLf + _
"Video ID: " + strVideoID + vbCrLf + _
"Availability: currently unavailable (Make Reservation?)" + vbCrLf + _
"Copies: " + strCopies + vbCrLf + "Next Due: " + strNextDue
frmRent.cmdrent.Visible = False
frmRent.cmdreserve.Visible = True
Else
VideosStatus.Text = "Video Title: " + strTitle + vbCrLf + _
"Video ID: " + strVideoID + vbCrLf + _
"Availability: currently available" + vbCrLf + _
"Copies: " + strCopies
frmRent.cmdrent.Visible = True
frmRent.cmdreserve.Visible = False
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -