frmborrowback.frm

录像出租系统源代码 录像出租公司都有库存的录像以备出租。每盘录像用分类号唯一标识。同一盘录像有多份拷贝

VERSION 5.00
Begin VB.Form frmBorrow 
   Caption         =   "录像借出"
   ClientHeight    =   4050
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5850
   LinkTopic       =   "Form1"
   ScaleHeight     =   4050
   ScaleWidth      =   5850
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdBack 
      Caption         =   "返      回"
      Height          =   495
      Left            =   3720
      TabIndex        =   4
      Top             =   2760
      Width           =   1335
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "清      空"
      Height          =   495
      Left            =   2040
      TabIndex        =   3
      Top             =   2760
      Width           =   1335
   End
   Begin VB.CommandButton cmdSub 
      Caption         =   "确      定"
      Height          =   495
      Left            =   360
      TabIndex        =   2
      Top             =   2760
      Width           =   1335
   End
   Begin VB.TextBox txtMember 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2040
      TabIndex        =   1
      Top             =   1680
      Width           =   2535
   End
   Begin VB.TextBox txtDisk 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2040
      TabIndex        =   0
      Top             =   600
      Width           =   2535
   End
   Begin VB.Label Label2 
      Caption         =   "会员编号："
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   600
      TabIndex        =   6
      Top             =   1680
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "录像编号："
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   600
      TabIndex        =   5
      Top             =   600
      Width           =   1215
   End
End
Attribute VB_Name = "frmBorrow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db1 As Database '设置变量
Dim rs1 As Recordset
Dim db2 As Database '设置变量
Dim rs2 As Recordset
Dim db3 As Database '设置变量
Dim rs3 As Recordset

Private Sub cmdBack_Click()
Unload Me
frmAdmin.Show
End Sub

Private Sub cmdDelete_Click()
txtDisk.Text = ""
txtMember.Text = ""
End Sub

Private Sub cmdSub_Click()
If txtDisk.Text = "" Then
MsgBox "对不起,请输入录像编号！", vbOKOnly + vbExclamation, "错误"
Exit Sub
End If
If txtMember.Text = "" Then
MsgBox "对不起,请输入会员编号！", vbOKOnly + vbExclamation, "错误"
Exit Sub
End If
Set db1 = OpenDatabase("Haiyu.mdb")
Set rs1 = db1.OpenRecordset("SELECT * FROM Customer")
Set db2 = OpenDatabase("Haiyu.mdb")
Set rs2 = db2.OpenRecordset("SELECT * FROM EDisk")
Set db3 = OpenDatabase("Haiyu.mdb")
Set rs3 = db3.OpenRecordset("SELECT * FROM Disk")
rs1.MoveFirst
rs2.MoveFirst
Do Until rs2.EOF
If rs2!录像编号 = txtDisk.Text Then
Exit Do
Else
rs2.MoveNext
End If
Loop
If rs2.EOF Then
MsgBox "对不起,该录像编号不存在，请重新输入！", vbOKOnly + vbExclamation, "错误"
txtDisk.Text = ""
txtDisk.SetFocus
Exit Sub
End If
Do Until rs1.EOF
If rs1!ID = txtMember.Text Then
Exit Do
Else
rs1.MoveNext
End If
Loop
If rs1.EOF Then
MsgBox "对不起,该会员编号不存在，请重新输入！", vbOKOnly + vbExclamation, "错误"
txtMember.Text = ""
txtMember.SetFocus
Exit Sub
End If

Do Until rs3.EOF
If rs2!分类编号 = rs3!分类编号 Then
Exit Do
Else
rs3.MoveNext
End If
Loop


  If rs2!是否借出 = True Then
  MsgBox "对不起,该录像已经被借出，请重新输入！", vbOKOnly + vbExclamation, "错误"
  txtDisk.Text = ""
  Exit Sub
  End If
  If rs2!是否损坏 = True Then
  MsgBox "对不起,该录像已经损坏，请重新输入！", vbOKOnly + vbExclamation, "错误"
  txtDisk.Text = ""
  Exit Sub
  End If
  With rs2
  .Edit
  !是否借出 = True
  !租借人编号 = rs1!ID
  !租借日期 = Date
  .Update
  End With
  Dim temp As Integer
  temp = rs3!库存数量
  With rs3
  .Edit
  !库存数量 = temp - 1
  .Update
  End With
  MsgBox "该录像借出成功！", vbOKOnly + vbExclamation, "错误"
  txtDisk.Text = ""
  txtMember.Text = ""
  txtDisk.SetFocus
End Sub