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

📄 lentcd.frm

📁 很小巧的VCD影碟出租系统
💻 FRM
字号:
VERSION 5.00
Begin VB.Form LentCD 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "影碟出租"
   ClientHeight    =   3990
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   9615
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   3990
   ScaleWidth      =   9615
   Begin VB.Frame Frame3 
      Caption         =   "租借方式"
      Height          =   2775
      Left            =   8040
      TabIndex        =   18
      Top             =   1080
      Width           =   1455
      Begin VB.CommandButton Command2 
         Caption         =   "零租"
         Height          =   735
         Left            =   240
         TabIndex        =   20
         Top             =   1440
         Width           =   975
      End
      Begin VB.CommandButton Command1 
         Caption         =   "会员"
         Height          =   735
         Left            =   240
         TabIndex        =   19
         Top             =   360
         Width           =   975
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "影碟信息"
      Height          =   2775
      Left            =   120
      TabIndex        =   4
      Top             =   1080
      Width           =   7815
      Begin VB.TextBox TxtYj 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   5520
         TabIndex        =   16
         Top             =   2040
         Width           =   1575
      End
      Begin VB.TextBox TxtDATE 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   1200
         Locked          =   -1  'True
         TabIndex        =   14
         Top             =   2040
         Width           =   2055
      End
      Begin VB.TextBox TxtSum 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   5520
         Locked          =   -1  'True
         TabIndex        =   12
         Top             =   1200
         Width           =   2055
      End
      Begin VB.TextBox TxtM 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   1200
         Locked          =   -1  'True
         TabIndex        =   10
         Top             =   1200
         Width           =   2055
      End
      Begin VB.TextBox TxtCDle 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   5520
         Locked          =   -1  'True
         TabIndex        =   8
         Top             =   360
         Width           =   2055
      End
      Begin VB.TextBox TxtCDName 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   1200
         Locked          =   -1  'True
         TabIndex        =   6
         Top             =   360
         Width           =   2055
      End
      Begin VB.Label Label9 
         Caption         =   "元"
         ForeColor       =   &H000000FF&
         Height          =   255
         Left            =   7320
         TabIndex        =   17
         Top             =   2160
         Width           =   375
      End
      Begin VB.Label Label8 
         Caption         =   "需缴押金:"
         Height          =   375
         Left            =   4440
         TabIndex        =   15
         Top             =   2160
         Width           =   975
      End
      Begin VB.Label Label7 
         Caption         =   "可借天数:"
         Height          =   375
         Left            =   240
         TabIndex        =   13
         Top             =   2160
         Width           =   975
      End
      Begin VB.Label Label6 
         Caption         =   "影碟数量:"
         Height          =   255
         Left            =   4440
         TabIndex        =   11
         Top             =   1320
         Width           =   975
      End
      Begin VB.Label Label5 
         Caption         =   "影碟价格:"
         Height          =   375
         Left            =   240
         TabIndex        =   9
         Top             =   1320
         Width           =   975
      End
      Begin VB.Label Label4 
         Caption         =   "影碟类别:"
         Height          =   255
         Left            =   4440
         TabIndex        =   7
         Top             =   480
         Width           =   1095
      End
      Begin VB.Label Label3 
         Caption         =   "影碟名称:"
         Height          =   255
         Left            =   240
         TabIndex        =   5
         Top             =   480
         Width           =   975
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "影碟出租"
      Height          =   855
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   9375
      Begin VB.CommandButton Command4 
         Caption         =   "关闭(&C)"
         Height          =   375
         Left            =   7920
         TabIndex        =   22
         Top             =   240
         Width           =   1215
      End
      Begin VB.CommandButton Command3 
         Caption         =   "取消(&D)"
         Height          =   375
         Left            =   6720
         TabIndex        =   21
         Top             =   240
         Width           =   1215
      End
      Begin VB.TextBox TxtCDId 
         Appearance      =   0  'Flat
         BackColor       =   &H00C0FFFF&
         Height          =   375
         Left            =   1200
         TabIndex        =   2
         Top             =   240
         Width           =   2055
      End
      Begin VB.Label Label2 
         Caption         =   "<输入编号后按回车键>"
         ForeColor       =   &H000000FF&
         Height          =   375
         Left            =   3480
         TabIndex        =   3
         Top             =   360
         Width           =   2655
      End
      Begin VB.Label Label1 
         Caption         =   "影碟编号:"
         Height          =   255
         Left            =   240
         TabIndex        =   1
         Top             =   360
         Width           =   1095
      End
   End
End
Attribute VB_Name = "LentCD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click()
If TxtCDId.Text <> "" And TxtCDName.Text <> "" Then
VipLent.Show vbModal
End If
End Sub

Private Sub Command2_Click()
Dim SQL As String
If TxtCDId.Text <> "" And TxtCDName.Text <> "" Then
   If TxtYj.Text = "" Then
      MsgBox "请输入所收取的押金!", vbInformation + vbOKOnly, "警告"
      TxtYj.SetFocus
      Exit Sub
   End If
   If Not IsNumeric(TxtYj.Text) Then
      MsgBox "押金必须为数字!", vbInformation + vbOKOnly, "警告"
      TxtYj.SetFocus
      TxtYj.SelStart = 0
      TxtYj.SelLength = Len(TxtYj.Text)
      Exit Sub
    End If
    SQL = "insert into lentinfo(影碟编号,影碟名称,所交押金,借碟时间)values(""" _
                               & TxtCDId.Text & """,""" _
                               & TxtCDName.Text & """," _
                               & TxtYj.Text & ",#" _
                               & Date & "#)"
    OpenDBFile
    gCon.Execute SQL
    CloseDBFile
    
    SQL = "update cdinfo set 是否借出=-1 where 影碟编号=""" & TxtCDId.Text & """"
    OpenDBFile
    gCon.Execute SQL
    CloseDBFile
    
    MsgBox "租借成功,请返回!", vbInformation + vbOKOnly, "信息"
         TxtCDId.Text = ""
         TxtCDId.SetFocus
         TxtCDName.Text = ""
         TxtCDle.Text = ""
         TxtM.Text = ""
         TxtSum.Text = ""
         TxtDATE.Text = ""
         TxtYj.Text = ""
End If
End Sub

Private Sub Command3_Click()
TxtCDId.Text = ""
TxtCDId.SetFocus
TxtCDName.Text = ""
TxtCDle.Text = ""
TxtM.Text = ""
TxtSum.Text = ""
TxtDATE.Text = ""
TxtYj.Text = ""
End Sub

Private Sub Command4_Click()
Unload Me
End Sub

Private Sub txtcdid_keypress(keyascii As Integer)
Dim SQL As String
If keyascii = "13" And TxtCDId.Text <> "" Then
   SQL = "select * from cdinfo,cdtype where cdinfo.影碟类别=cdtype.影碟类别 and 影碟编号=""" & TxtCDId.Text & """"
   OpenDBFile
   OpenRS (SQL)
   If Not gRst.EOF Then
      If gRst("是否借出") = -1 Then
         MsgBox "对不起,该影碟已经借出,请从新选择!", vbInformation + vbOKOnly, "信息"
         TxtCDId.Text = ""
         TxtCDId.SetFocus
         TxtCDName.Text = ""
         TxtCDle.Text = ""
         TxtM.Text = ""
         TxtSum.Text = ""
         TxtDATE.Text = ""
         TxtYj.Text = ""
         CloseRS
         Exit Sub
      End If
      
      TxtCDName.Text = gRst("影碟名称")
      TxtCDle.Text = gRst("cdinfo.影碟类别")
      TxtM.Text = gRst("影碟价格")
      TxtSum.Text = gRst("光碟数量")
      TxtDATE.Text = gRst("借出天数")
   Else
      MsgBox "对不起,你输入的影碟编号不存在!", vbInformation + vbOKOnly, "信息"
      TxtCDId.Text = ""
      TxtCDId.SetFocus
      CloseRS
      Exit Sub
   End If
   CloseRS
   TxtYj.SetFocus
ElseIf keyascii = "13" And TxtCDId.Text = "" Then
   MsgBox "对不起,请输入影碟编号,并按回车键!", vbInformation + vbOKOnly, "警告"
   TxtCDId.Text = ""
   TxtCDId.SetFocus
End If

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -