vcdreturn.frm

原创VB+SQL影音租赁系统 醮简单 具体看里边的文本文档

   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      Caption         =   "应交租金"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   4920
      TabIndex        =   19
      Top             =   1680
      Width           =   840
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "罚金"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   3360
      TabIndex        =   18
      Top             =   1680
      Width           =   420
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "影片名称"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   1200
      TabIndex        =   17
      Top             =   1080
      Width           =   840
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "应还日期"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   5760
      TabIndex        =   16
      Top             =   1080
      Width           =   840
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "正常租金"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   1200
      TabIndex        =   15
      Top             =   1680
      Width           =   840
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "租借日期"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   5760
      TabIndex        =   14
      Top             =   480
      Width           =   840
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "会员ID"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   1440
      TabIndex        =   13
      Top             =   480
      Width           =   630
   End
End
Attribute VB_Name = "VCDReturn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim id, memid, vcdname, tablename, tbname, remoney, ReturnDate, OrderNo As String
Dim rst As Recordset
Dim com As Command
Dim NorReturnData As Data
Dim overday As Integer

Private Sub ExitBT_Click()
Unload Me
End Sub

Private Sub Form_Load()
Set com = New Command
Set rst = New Recordset
com.ActiveConnection = con
'Text1.SetFocus
'NorReturnData = Data
'ReturnDateText.Text = Data
ReturnBT.Enabled = False
ReturnAllBT.Enabled = False
ReturnDate = Format(Now, "yy-m-d hh:mm:ss")
'ReturnDateText.Text = Data
With ReturnGrid
     .ColWidth(0) = 800
     .ColWidth(1) = 800
     .ColWidth(2) = 2000
     .ColWidth(3) = 800
     .ColWidth(4) = 500
     .ColWidth(5) = 1000
     .ColWidth(6) = 1000
     .ColWidth(7) = 1000
     .ColWidth(8) = 450
End With
End Sub

Private Sub ReturnBT_Click()

Select Case tablename
    Case "爱情"
        tbname = "love"
    Case "喜剧"
       tbname = "comedy"
    Case "卡通"
       tbname = "cartoon"
    Case "科幻"
       tbname = "science"
    Case "冒险"
       tbname = "venture"
    Case "动作"
       tbname = "action"
    Case "艺术"
       tbname = "art"
    Case "战争"
       tbname = "war"
    Case "广告"
       tbname = "advertisement"
    Case "恐怖"
       tbname = "terror"
End Select
MsgBox tbname
If FaText.Text <> "" Then
   MsgBox "由于您没有按规定时间还影片！我们将从您的账户扣除" & Trim(NormalRentalText.Text) & "元正常租金以外，还要多扣除0" & Trim(FaText.Text) & "元罚金！"
End If
   rst.Open "update " & tbname & " set istock=istock+1 where cname='" & vcdname & "'", con, adOpenDynamic, adLockBatchOptimistic
   MsgBox "库存回复！"
   rst.Open "update member set mmoney = mmoney -" & CDbl(Trim(FacRentalText.Text)) & " where cmemberid='" & memid & "'", con, adOpenDynamic, adLockBatchOptimistic
   MsgBox "会员账户已更新！"
   rst.Open "update orders set dfreturndate='" & ReturnDate & "',irental=" & FacRentalText.Text & " where corderno='" & OrderNo & "' and cvcdname='" & vcdname & "'", con, adOpenDynamic, adLockBatchOptimistic
   MsgBox "租借信息修改成功！"
   rst.Open "select '租借号'=corderno,'会员ID'=cmemberid,'影片名称'=cvcdname,'影片类型'=ctype,'数量'=irentnum,'租借日期'=dorderdate,'应归还日期'=dcreturndate,'实际归还日期'=dfreturndate,'固定租金'=irental from orders where cmemberid='" & memid & "' and dfreturndate is null", con, adOpenDynamic, adLockBatchOptimistic
   If rst.EOF = True Then
      MsgBox "您已经归还了所有的影片！暂时还没有未归还的影片！"
      Set ReturnGrid.DataSource = rst
      Text4.Text = ""
      Text8.Text = ""
      NormalRentalText.Text = ""
      FaText.Text = ""
      FacRentalText.Text = ""
      OrderDateText.Text = ""
      ReturnDateText.Text = ""
      rst.Close
    Else
      rst.Requery
      Set ReturnGrid.DataSource = rst
      rst.Close
    End If
End Sub

Private Sub ReturnGrid_Click()
ReturnGrid.Refresh
rows = ReturnGrid.Row
MsgBox rows
If rows = 0 Then
   MsgBox "您没有还未归还的影片！"
Else
id = VCDAdd.getid(rows - 2)
MsgBox id
trueid = "00" & id + 1
MsgBox "00" & id + 1
'ReturnData.rsComReturn.Requery
'Set ReturnGrid.DataSource = ReturnData
ReturnGrid.Row = trueid
ReturnGrid.Col = 0
OrderNo = Trim(ReturnGrid.Text)
MsgBox OrderNo
ReturnGrid.Col = 2
vcdname = Trim(ReturnGrid.Text)
MsgBox vcdname
ReturnGrid.Col = 3
tablename = Trim(ReturnGrid.Text)
MsgBox tablename
ReturnGrid.Col = 8
remoney = Trim(ReturnGrid.Text)
MsgBox remoney
rst.Open "select * from orders where cvcdname='" & vcdname & "'", con, adOpenDynamic, adLockBatchOptimistic
Text4.Text = rst!cvcdname
OrderDateText.Text = rst!dorderdate
ReturnDateText.Text = rst!dcreturndate
'overday = CInt(DateDiff("d", CDate(Trim(OrderDateText.Text)), CDate(Trim(ReturnDateText.Text))) - 2)
'If overday > 0 Then
'   Text8.Text = overday
'Else
'   Text8.Text = 0
'End If
MsgBox CDate(Trim(OrderDateText.Text))
MsgBox CDate(ReturnDate)
MsgBox CDate(Trim(OrderDateText.Text))
MsgBox CDate(Trim(ReturnDateText.Text))
If DateDiff("d", CDate(Trim(OrderDateText.Text)), CDate(ReturnDate)) <= 2 Then
   MsgBox DateDiff("d", CDate(Trim(OrderDateText.Text)), CDate(Trim(ReturnDateText.Text)))
   MsgBox "没有超过规定日期！"
   NormalRentalText.Text = DateDiff("d", CDate(Trim(OrderDateText.Text)), CDate(ReturnDate)) * 0.5
   MsgBox DateDiff("d", CDate(Trim(OrderDateText.Text)), CDate(ReturnDate)) * 0.5
   FacRentalText.Text = CDbl(NormalRentalText.Text)
   rst.Close
Else
   Text8.Text = DateDiff("d", CDate(Trim(ReturnDateText.Text)), CDate(ReturnDate))
   NormalRentalText.Text = DateDiff("d", CDate(Trim(OrderDateText.Text)), CDate(Trim(ReturnDate))) * 0.5
   FaText.Text = CDbl(DateDiff("d", CDate(Trim(ReturnDateText.Text)), CDate(Trim(ReturnDate)))) * 0.1
   FacRentalText.Text = CDbl(NormalRentalText.Text) + CDbl(FaText.Text)
   
   rst.Close
End If
End If
End Sub

Private Sub SureBT_Click()
If Text1.Text = "" Then
   MsgBox "请输入您的会员ID！"
   Text1.SetFocus
Else
   memid = Trim(Text1.Text)
   'On Error GoTo err
   rst.Open "select * from member where cmemberid='" & memid & "'", con, adOpenDynamic, adLockBatchOptimistic
   If rst.EOF = True Then
       MsgBox "没有此会员！"
       rst.Close
   Else
        rst.Close
        rst.Open "select '租借号'=corderno,'会员ID'=cmemberid,'影片名称'=cvcdname,'影片类型'=ctype,'数量'=irentnum,'租借日期'=dorderdate,'应归还日期'=dcreturndate,'实际归还日期'=dfreturndate,'固定租金'=irental from orders where cmemberid='" & memid & "' and dfreturndate is null", con, adOpenDynamic, adLockBatchOptimistic
        If rst.EOF = True Then
           MsgBox "您没有还未归还的影片！"
           Set ReturnGrid.DataSource = rst
           ReturnGrid.Enabled = False
           rst.Close
           Exit Sub
        Else
           'ReturnData.ComReturn Text1.Text
           'ReturnData.rsComReturn.Requery
           'Set ReturnGrid.DataSource = ReturnData
           rst.Close
           rst.Open "select '租借号'=corderno,'会员ID'=cmemberid,'影片名称'=cvcdname,'影片类型'=ctype,'数量'=irentnum,'租借日期'=dorderdate,'应归还日期'=dcreturndate,'实际归还日期'=dfreturndate,'固定租金'=irental from orders where cmemberid='" & memid & "' and dfreturndate is null", con, adOpenDynamic, adLockBatchOptimistic
           Set ReturnGrid.DataSource = rst
           ReturnGrid.Enabled = True
           ReturnBT.Enabled = True
           ReturnAllBT.Enabled = True
           rst.Close
        End If
        'rst.Close
    End If
   'Exit Sub
End If
Exit Sub
err:
MsgBox "数据库未连接！"

End Sub