frmreturn1.frm

VB所写的图书管理系统

VERSION 5.00
Begin VB.Form frmReturn1 
   Caption         =   "还书信息"
   ClientHeight    =   5184
   ClientLeft      =   48
   ClientTop       =   348
   ClientWidth     =   6516
   LinkTopic       =   "Form1"
   ScaleHeight     =   5184
   ScaleWidth      =   6516
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame2 
      Caption         =   "还书日期"
      Height          =   732
      Left            =   480
      TabIndex        =   14
      Top             =   3720
      Width           =   5052
      Begin VB.ComboBox cboYear 
         Height          =   288
         Index           =   0
         Left            =   1560
         Style           =   2  'Dropdown List
         TabIndex        =   17
         Top             =   240
         Width           =   765
      End
      Begin VB.ComboBox cboMonth 
         Height          =   288
         Index           =   0
         Left            =   2760
         Style           =   2  'Dropdown List
         TabIndex        =   16
         Top             =   240
         Width           =   645
      End
      Begin VB.ComboBox cboDay 
         Height          =   288
         Left            =   3840
         Style           =   2  'Dropdown List
         TabIndex        =   15
         Top             =   240
         Width           =   612
      End
      Begin VB.Label Label1 
         Caption         =   "请设置还书时间："
         Height          =   216
         Index           =   0
         Left            =   240
         TabIndex        =   21
         Top             =   240
         Width           =   2400
      End
      Begin VB.Label Label1 
         Caption         =   "月"
         Height          =   216
         Index           =   2
         Left            =   3480
         TabIndex        =   20
         Top             =   240
         Width           =   240
      End
      Begin VB.Label Label1 
         Caption         =   "年"
         Height          =   216
         Index           =   1
         Left            =   2400
         TabIndex        =   19
         Top             =   240
         Width           =   240
      End
      Begin VB.Label Label1 
         Caption         =   "日"
         Height          =   216
         Index           =   7
         Left            =   4560
         TabIndex        =   18
         Top             =   240
         Width           =   120
      End
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "保存 (&S)"
      Height          =   375
      Left            =   2280
      TabIndex        =   8
      Top             =   4680
      Width           =   1215
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "返回 (&X)"
      Height          =   375
      Left            =   4200
      TabIndex        =   7
      Top             =   4680
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Caption         =   "借书信息"
      Height          =   3372
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   6252
      Begin VB.TextBox txtItem 
         Height          =   1920
         Index           =   0
         Left            =   120
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   13
         Top             =   1320
         Width           =   6012
      End
      Begin VB.ComboBox cboItem 
         Height          =   288
         Index           =   0
         Left            =   960
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   240
         Width           =   2175
      End
      Begin VB.ComboBox cboItem 
         Height          =   288
         Index           =   1
         Left            =   960
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   720
         Width           =   2175
      End
      Begin VB.ComboBox cboItem 
         Height          =   288
         Index           =   2
         Left            =   3960
         Style           =   2  'Dropdown List
         TabIndex        =   3
         Top             =   240
         Width           =   2175
      End
      Begin VB.ComboBox cboItem 
         Height          =   288
         Index           =   3
         Left            =   3960
         Style           =   2  'Dropdown List
         TabIndex        =   2
         Top             =   720
         Width           =   2175
      End
      Begin VB.Label Label2 
         Caption         =   "借书日期："
         Height          =   252
         Index           =   6
         Left            =   3360
         TabIndex        =   12
         Top             =   720
         Width           =   972
      End
      Begin VB.Label Label2 
         Caption         =   "备 注 信 息："
         Height          =   252
         Index           =   7
         Left            =   120
         TabIndex        =   11
         Top             =   1080
         Width           =   972
      End
      Begin VB.Label Label2 
         Caption         =   "读者编号："
         Height          =   252
         Index           =   4
         Left            =   120
         TabIndex        =   10
         Top             =   240
         Width           =   972
      End
      Begin VB.Label Label2 
         Caption         =   "读者姓名："
         Height          =   252
         Index           =   5
         Left            =   120
         TabIndex        =   9
         Top             =   720
         Width           =   972
      End
      Begin VB.Label Label2 
         Caption         =   "书籍名称："
         Height          =   252
         Index           =   0
         Left            =   3360
         TabIndex        =   6
         Top             =   240
         Width           =   972
      End
   End
   Begin VB.TextBox txtNo 
      Height          =   270
      Left            =   960
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   4680
      Visible         =   0   'False
      Width           =   735
   End
End
Attribute VB_Name = "frmReturn1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'是否改动过记录，ture为改过
Dim mblChange As Boolean
Dim mrc As ADODB.Recordset
Public txtSQL As String
Dim BookID As String


Private Sub cboItem_Change(Index As Integer)
    '有变化设置gblchange
    
    mblChange = True
    
End Sub
Private Sub cboItem_Click(Index As Integer)
    Dim mrcc As ADODB.Recordset
    Dim MsgText As String
    
    If gintBBmode = 1 Then
        If Index = 1 Then
            txtSQL = "select * from borrowinfo where returndate is null"
            Set mrcc = ExecuteSQL(txtSQL, MsgText)
            
            If Not mrcc.EOF Then
                cboItem(0).Clear
                cboItem(0).AddItem mrcc!readerid
                cboItem(0).ListIndex = 0
                
                cboItem(2).Clear
                cboItem(2).AddItem mrcc!bookname
                cboItem(2).ListIndex = 0
                
                cboItem(3).Clear
                cboItem(3).AddItem mrcc!borrowdate
                cboItem(3).ListIndex = 0
                
                txtItem(0) = mrcc.Fields(7)
                txtNo = mrcc!borrowno
                BookID = mrcc.Fields(3)
            End If
            mrcc.Close
        End If
    End If
End Sub

Private Sub cmdSave_Click()
    Dim intCount As Integer
    Dim sMeg As String
    Dim MsgText As String
    Dim returnDate As String
    Dim mrcd As ADODB.Recordset
    Dim bYear As Integer
    Dim eYear As Integer
    Dim bDays As Integer
    Dim eDays As Integer
    Dim aDays As Integer
    Dim uDays As Integer
    
    
    If Trim(txtNo) = "" Then
        MsgBox "请选择借书信息！", vbOKOnly + vbExclamation, "警告"
        cboItem(1).SetFocus
        Exit Sub
    End If
    
    returnDate = Format(CDate(cboYear(0) & "-" & cboMonth(0) & "-" & cboDay), "yyyy-mm-dd")
    If Trim(returnDate) = "" Then
        MsgBox "请选择还书日期！", vbOKOnly + vbExclamation, "警告"
        cboYear(1).SetFocus
        Exit Sub
    End If
    
    If gintBBmode = 2 Then
        txtSQL = "select * from books where bookid = '" & Trim(BookID) & "'"
        Set mrcd = ExecuteSQL(txtSQL, MsgText)
        If Not mrcd.EOF Then
            mrcd!putup = "y"
        End If
        mrcd.Update
        mrcd.Close
    End If
    
    txtSQL = "select * from borrowinfo where  borrowno = '" & Trim(txtNo) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If Not mrc.EOF Then
        mrc.Fields(6) = Trim(returnDate)
        txtSQL = "select * from books where bookid = '" & Trim(BookID) & "'"
        Set mrcd = ExecuteSQL(txtSQL, MsgText)
        
        If Not mrcd.EOF Then
            mrcd!putup = " "
        End If
        mrcd.Update
        mrcd.Close
        
    End If
    mrc.Update
    mrc.Close
    
    
    bYear = DatePart("yyyy", cboItem(3))
    eYear = DatePart("yyyy", returnDate)
    bDays = DatePart("y", cboItem(3))
    eDays = DatePart("y", returnDate)
    If bYear = eYear Then
        aDays = eDays - bDays
    Else
        aDays = (eYear - bYear - 1) * 365 + (365 - bDays) + eDays
    End If
    
    txtSQL = "select readertype from readers where readerno = '" & Trim(cboItem(0)) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    If Not mrc.EOF Then
        sMeg = mrc.Fields(0)
    End If
    mrc.Close
    
    txtSQL = "select bookdays from readertype where typename = '" & Trim(sMeg) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If Not mrc.EOF Then
        uDays = mrc.Fields(0)
    End If
    mrc.Close
    
    If uDays < aDays Then
        MsgBox "过期" & (aDays - uDays) & "天，罚款" & (0.1 * (aDays - uDays)) & "元！", vbOKOnly + vbExclamation, "警告"
    End If
    
    
    
    If gintBBmode = 1 Then
        MsgBox "添加还书信息成功!", vbOKOnly + vbExclamation, "添加借书消息"
        Unload Me
        If flagBBedit Then
            Unload frmReturn
        End If
        frmReturn.txtSQL = "select * from borrowinfo"
        frmReturn.Show
    Else
        MsgBox "修改还书信息成功!", vbOKOnly + vbExclamation, "修改借书消息"
        Unload Me
        If flagBBedit Then
            Unload frmReturn
        End If
        frmReturn.txtSQL = "select * from borrowinfo"
        frmReturn.Show
    End If
    
End Sub

Private Sub Form_Load()
    
    Dim sSql As String
    Dim intCount As Integer
    Dim MsgText As String
    Dim i As Integer
    Dim j As Integer
    
    
    
    If gintBBmode = 1 Then
        Me.Caption = Me.Caption & "添加"
        
        '初始化客房信息
        txtSQL = "select DISTINCT readername from borrowinfo where returndate is null "
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If Not mrc.EOF Then
                
            Do While Not mrc.EOF
                cboItem(1).AddItem Trim(mrc.Fields(0))
                mrc.MoveNext
            Loop
        Else
            MsgBox "没人借书！", vbOKOnly + vbExclamation, "警告"
            cmdSave.Enabled = False
            Exit Sub
        End If
        mrc.Close
        
        txtSQL = "select distinct datepart(yy,borrowdate) from borrowinfo where returndate is null "
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        If mrc.EOF = False Then
            With mrc
            Do While Not .EOF
                cboYear(0).AddItem .Fields(0)
                .MoveNext
            Loop
            End With
            
            cboYear(0).ListIndex = 0
            
            For j = 1 To 12
                cboMonth(0).AddItem j
            Next j
            cboMonth(0).Text = Month(Now())
            
            For j = 1 To 31
                cboDay.AddItem j
            Next j
            cboDay.Text = Day(Now())
            
        Else
            cmdSave.Enabled = False
        End If
        mrc.Close
            
        
            
        
            
    ElseIf gintBBmode = 2 Then
        Me.Caption = Me.Caption & "修改"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If Not mrc.EOF Then
            txtNo = mrc!borrowno
            
            For intCount = 0 To 1
                cboItem(intCount).Clear
                cboItem(intCount).AddItem mrc.Fields(intCount + 1)
                cboItem(intCount).ListIndex = 0
            Next intCount
            
            BookID = mrc.Fields(3)
            
            For intCount = 2 To 3
                cboItem(intCount).Clear
                cboItem(intCount).AddItem mrc.Fields(intCount + 2)
                cboItem(intCount).ListIndex = 0
            Next intCount
            
            txtItem(0) = mrc.Fields(7)
        End If
        
        mrc.Close
        
        txtSQL = "select distinct datepart(yy,borrowdate) from borrowinfo where returndate is not null "
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        If mrc.EOF = False Then
            With mrc
            Do While Not .EOF
                cboYear(0).AddItem .Fields(0)
                .MoveNext
            Loop
            End With
            
            cboYear(0).ListIndex = 0
            
            For j = 1 To 12
                cboMonth(0).AddItem j
            Next j
            cboMonth(0).Text = Month(Now())
            
            For j = 1 To 31
                cboDay.AddItem j
            Next j
            cboDay.Text = Day(Now())
            
        Else
            cmdSave.Enabled = False
        End If
        mrc.Close
            
        
            
            
    End If
    
    
    
    mblChange = False
        
    
    

    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    gintBBmode = 0
End Sub
Private Sub txtItem_Change(Index As Integer)
    '有变化设置gblchange
    mblChange = True
    
End Sub

Private Sub txtItem_GotFocus(Index As Integer)
    txtItem(Index).SelStart = 0
    txtItem(Index).SelLength = Len(txtItem(Index))
    
End Sub

Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
        EnterToTab KeyCode

End Sub
Private Sub cmdExit_Click()
    If mblChange And cmdSave.Enabled Then
        If MsgBox("保存当前记录的变化吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            '保存
            Call cmdSave_Click
        End If
    End If
    Unload Me
End Sub