www.pudn.com > opy_LMS.rar > frmReturn.frm
VERSION 5.00
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Begin VB.Form frmReturn
BorderStyle = 1 'Fixed Single
Caption = "归还处理"
ClientHeight = 4635
ClientLeft = 45
ClientTop = 330
ClientWidth = 3630
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4635
ScaleWidth = 3630
Begin VB.TextBox txt_bookid
Alignment = 1 'Right Justify
ForeColor = &H00400000&
Height = 285
Left = 2160
Locked = -1 'True
TabIndex = 13
Top = 1200
Width = 1335
End
Begin VB.TextBox txt_memid
Alignment = 1 'Right Justify
ForeColor = &H00400000&
Height = 285
Left = 2160
Locked = -1 'True
TabIndex = 12
Top = 840
Width = 1335
End
Begin VB.TextBox txt_fine
Alignment = 1 'Right Justify
BackColor = &H8000000F&
ForeColor = &H00400000&
Height = 285
Left = 2160
TabIndex = 11
Top = 2040
Width = 1335
End
Begin VB.Frame Frame1
Height = 2175
Left = 0
TabIndex = 0
Top = 2400
Width = 3615
Begin VB.CommandButton cmd_cancel
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 1320
MouseIcon = "frmReturn.frx":0000
MousePointer = 99 'Custom
Picture = "frmReturn.frx":0152
Style = 1 'Graphical
TabIndex = 5
ToolTipText = "Cancel"
Top = 240
Width = 975
End
Begin VB.CommandButton cmd_fine
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 1920
MouseIcon = "frmReturn.frx":06D2
MousePointer = 99 'Custom
Picture = "frmReturn.frx":0824
Style = 1 'Graphical
TabIndex = 4
ToolTipText = "Fine information"
Top = 1200
Width = 1575
End
Begin VB.CommandButton cmd_issue
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 120
MouseIcon = "frmReturn.frx":0D8F
MousePointer = 99 'Custom
Picture = "frmReturn.frx":0EE1
Style = 1 'Graphical
TabIndex = 3
ToolTipText = "Switch to Issue"
Top = 1200
Width = 1575
End
Begin VB.CommandButton cmd_Return
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 2520
MouseIcon = "frmReturn.frx":1461
MousePointer = 99 'Custom
Picture = "frmReturn.frx":15B3
Style = 1 'Graphical
TabIndex = 2
ToolTipText = "Return book"
Top = 240
Width = 975
End
Begin VB.CommandButton cmd_add
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 120
MouseIcon = "frmReturn.frx":1BBC
MousePointer = 99 'Custom
Picture = "frmReturn.frx":1D0E
Style = 1 'Graphical
TabIndex = 1
ToolTipText = "Add new"
Top = 240
Width = 975
End
Begin VB.Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "添加"
Height = 255
Left = 120
TabIndex = 10
Top = 885
Width = 975
End
Begin VB.Label Label3
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "取消"
Height = 255
Left = 1320
TabIndex = 9
Top = 885
Width = 975
End
Begin VB.Label Label4
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "还书"
Height = 255
Left = 2520
TabIndex = 8
Top = 885
Width = 975
End
Begin VB.Label Label5
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "跳到借书管理"
Height = 375
Left = 120
TabIndex = 7
Top = 1830
Width = 1575
End
Begin VB.Label Label6
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "罚款信息"
Height = 255
Left = 1920
TabIndex = 6
Top = 1830
Width = 1575
End
End
Begin MSMask.MaskEdBox msk_return
Height = 285
Left = 2160
TabIndex = 14
ToolTipText = "Administrator default settings"
Top = 1680
Width = 1335
_ExtentX = 2355
_ExtentY = 503
_Version = 393216
ForeColor = 4194304
MaxLength = 11
Format = "yyyy年mm月dd日"
Mask = "####年##月##日"
PromptChar = "_"
End
Begin VB.Label lbl_bookid
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 = 19
Top = 1245
Width = 735
End
Begin VB.Label lbl_memberid
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 = 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