frmreturn.frm

自己的作品。。基于VB的图书馆管理系统。 感觉很有现实意义

         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00800000&
      Height          =   285
      Left            =   120
      TabIndex        =   18
      Top             =   885
      Width           =   1095
   End
   Begin VB.Label lbl_Doreturn 
      BackStyle       =   0  'Transparent
      Caption         =   "还书日期 "
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00800000&
      Height          =   255
      Left            =   120
      TabIndex        =   17
      Top             =   1725
      Width           =   2055
   End
   Begin VB.Label lbl_fine 
      BackStyle       =   0  'Transparent
      Caption         =   "罚款金额"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00800000&
      Height          =   255
      Left            =   120
      TabIndex        =   16
      Top             =   2040
      Width           =   975
   End
   Begin VB.Image Image1 
      Height          =   600
      Left            =   0
      Top             =   0
      Width           =   480
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "输入借书证号和书号去还书，在还书后罚款信息将显示出来。"
      Height          =   615
      Left            =   500
      TabIndex        =   15
      Top             =   0
      Width           =   3135
   End
End
Attribute VB_Name = "frmReturn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Integer
Dim amount As Integer
Dim str As String
Dim temp As ADODB.Recordset
Dim Returnconnection As ADODB.Connection
Private Sub setlock(val As Boolean)
msk_return.Enabled = Not val
txt_bookid.Locked = val
txt_memid.Locked = val
End Sub
Private Sub setbutton(val As Boolean)
cmd_add.Enabled = val
cmd_Return.Enabled = Not val
cmd_cancel.Enabled = Not val
End Sub
Private Sub cleartext()
msk_return.Text = "____年__月__日"
txt_bookid.Text = ""
txt_memid.Text = ""
txt_fine.Text = ""
End Sub
Private Function cheak() As Boolean
Dim flag As Boolean
flag = False
If msk_return.Text = "____年__月__日" Then
MsgBox "请选择日期.", vbInformation, "信息不完整"
ElseIf txt_bookid.Text = "" Then
MsgBox "请输入书号.", vbInformation, "信息不完整"
ElseIf txt_memid.Text = "" Then
MsgBox "请输入会员号.", vbInformation, "信息不完整"
Else
flag = True
End If
cheak = flag
End Function
Private Sub cmd_add_Click()
Call setlock(False)
Call setbutton(False)
Call cleartext
msk_return.Text = Format$(Now, "yyyy年mm月dd日")
'msk_return.Enabled = False
End Sub
Private Sub cmd_cancel_Click()
Call setlock(True)
Call cleartext
Call setbutton(True)
End Sub

Private Sub cmd_fine_Click()
Load frmFine
frmFine.Show
Unload Me
End Sub
Private Sub cmd_issue_Click()
Load frmIssue
frmIssue.Show
Unload Me
End Sub
Private Sub cmd_Return_Click()
On Error GoTo errlable
If (cheak = True) Then

'Search for return bookid and memid entry
str = "select count(*) from Issue where Memid = " & CDbl(txt_memid.Text) & " and Bookid = " & CDbl(txt_bookid.Text)
temp.Open str, Returnconnection, adOpenStatic, adLockOptimistic
            If (temp(0) = 0) Then
                    MsgBox "There is no such book issued for specified fields.", vbCritical, "错误信息 "
                    temp.Close
                    Call setlock(True)
                    Call setbutton(True)
                    Exit Sub
            End If
            temp.Close
'display info. & ask user for allow
If MsgBox("还书信息.:会员号为" & CDbl(txt_memid.Text) & " 现还书号为" & CDbl(txt_bookid.Text), vbYesNo, "确认信息") = vbYes Then
  str = "select Areturndate,Bookid,Issuedate,Returndate,Memid from Issue where Memid = " & CDbl(txt_memid.Text) & " and Bookid = " & CDbl(txt_bookid.Text)
  temp.Open str, Returnconnection, adOpenStatic, adLockOptimistic
           amount = (Date - temp.Fields(3)) * fratepday
                
ignoreoverflow:
                If (amount < 0) Then
                  amount = 0  'convert negative amount to zero
                End If
          ' for amount case
                If (amount <= 0) Then
                    GoTo withoutfine    'submit book without fine
                ElseIf (amount > 0) Then
                'option for providing fine amount
                i = MsgBox("Members Total fine amount Rs : " & amount & " as per Rs : " & fratepday & " per Day charge.click yes if paying or click No if fine is collected from Members Deposite.", vbYesNoCancel + vbExclamation, "Confirm Data")
                    Select Case i
                    Case vbYes
                    Case vbNo
                    'transfer from deposite
                    str = "UPDATE Member SET Deposite = Deposite-" & CDbl(amount) & " WHERE Memid= " & Trim(txt_memid.Text)
                    Returnconnection.Execute str
                    MsgBox "The fine amount is transfer from members deposite.", vbInformation, "Fine"
                    Case vbCancel
                    'cancelling process of making entry
                    Call setlock(True)
                    Call setbutton(True)
                    MsgBox "Return process was cancelled.No more entry Updated.", vbInformation, "Fine"
                    Exit Sub
                    End Select
                        
                        'make entry in fine table
                        str = "INSERT INTO Fine (Areturndate,Bookid,Fine,Memid)"
                        str = str & "VALUES ('" & Format$(msk_return.Text, "yyyy年mm月dd日") & "', "
                        str = str & CDbl(txt_bookid.Text) & ", "
                        str = str & CDbl(amount) & ", "
                        str = str & CDbl(txt_memid.Text) & ")"
                        Returnconnection.Execute str
                        
withoutfine:            'Update entry in Book table
                        str = "UPDATE Book SET "
                        str = str & "Avano = Avano+1,"
                        str = str & "Issno = Issno-1 WHERE Bookid = " & Trim(txt_bookid.Text)
                        Returnconnection.Execute str
                           
                        'Update entry in member table
                        str = "UPDATE Member SET "
                        str = str & "Bookinhand = Bookinhand-1 WHERE Memid = " & Trim(txt_memid.Text)
                        Returnconnection.Execute str
                           
                'delete entry from Issue table
                str = "DELETE  FROM Issue WHERE Memid = " & CDbl(txt_memid.Text) & " and Bookid = " & CDbl(txt_bookid.Text)
                Returnconnection.Execute str
                
                txt_fine.Text = amount
                
                MsgBox "还书成功", vbInformation, "还书"
                
                End If
Else
Call setlock(True)
Call setbutton(True)
Exit Sub
End If
Call setlock(True)
Call setbutton(True)

End If 'validity check condition over
Exit Sub
errlable:
If (Err.Number = 6) Then
amount = 0
GoTo ignoreoverflow
ElseIf (Err.Number <> 0) Then
MsgBox Err.Number & Err.Description & Err.Source
End If
End Sub

Private Sub Form_Load()
On Error GoTo errlable
     If (view = 1) Then
     Me.Top = 50
     Me.Left = 50
     ElseIf (view = 2) Then
     Me.Top = 700
     Me.Left = (Screen.Width - Me.Width) / 2
     End If
'Image1.Picture = mdi_start.ImageList1.ListImages(6).Picture
Set Returnconnection = New ADODB.Connection
Returnconnection.CursorLocation = adUseClient
Returnconnection.ConnectionString = "DSN=library;UID=sa;PWD=;"
Returnconnection.Open
Set temp = New ADODB.Recordset

txt_fine.Locked = True

Call setlock(True)
Call setbutton(True)
Exit Sub
errlable:
MsgBox Err.Number & Err.Description
End Sub

Private Sub txt_fine_GotFocus()
MsgBox "Fine amount will be decided by itself.", vbInformation, "Self field propery"
End Sub