www.pudn.com > opy_LMS.rar > frmIssue.frm
VERSION 5.00
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Begin VB.Form frmIssue
BorderStyle = 1 'Fixed Single
Caption = "图书借阅"
ClientHeight = 4995
ClientLeft = 45
ClientTop = 330
ClientWidth = 3750
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4995
ScaleWidth = 3750
Begin VB.TextBox txt_memid
Alignment = 1 'Right Justify
ForeColor = &H00400000&
Height = 285
Left = 2160
Locked = -1 'True
TabIndex = 22
Top = 840
Width = 1335
End
Begin VB.TextBox txt_bookid
Alignment = 1 'Right Justify
ForeColor = &H00400000&
Height = 285
Left = 2160
Locked = -1 'True
TabIndex = 21
Top = 1200
Width = 1335
End
Begin VB.Frame Fra_Date
Caption = "时间"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000040&
Height = 1095
Left = 0
TabIndex = 16
Top = 1560
Width = 3735
Begin MSMask.MaskEdBox msk_return
Height = 285
Left = 2160
TabIndex = 17
ToolTipText = "Administrator default settings"
Top = 720
Width = 1335
_ExtentX = 2355
_ExtentY = 503
_Version = 393216
ForeColor = 4194304
MaxLength = 11
Format = "yyyy年mm月dd日"
Mask = "####年##月##日"
PromptChar = "_"
End
Begin MSMask.MaskEdBox msk_issue
Height = 285
Left = 2160
TabIndex = 18
ToolTipText = "Administrator default settings"
Top = 360
Width = 1335
_ExtentX = 2355
_ExtentY = 503
_Version = 393216
ForeColor = 4194304
MaxLength = 11
Format = "yyyy年mm月dd日"
Mask = "####年##月##日"
PromptChar = "_"
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 = 20
Top = 720
Width = 2055
End
Begin VB.Label Doissue
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 = 360
Width = 2295
End
End
Begin VB.Frame Frame1
Height = 2295
Left = 0
TabIndex = 0
Top = 2640
Width = 3735
Begin VB.CommandButton cmdLast
Appearance = 0 'Flat
Height = 345
Left = 3240
MouseIcon = "frmIssue.frx":0000
MousePointer = 99 'Custom
Picture = "frmIssue.frx":0152
Style = 1 'Graphical
TabIndex = 8
ToolTipText = "Move Last"
Top = 1200
UseMaskColor = -1 'True
Width = 345
End
Begin VB.CommandButton cmdNext
Appearance = 0 'Flat
Height = 345
Left = 2880
MouseIcon = "frmIssue.frx":03A4
MousePointer = 99 'Custom
Picture = "frmIssue.frx":04F6
Style = 1 'Graphical
TabIndex = 7
ToolTipText = "Move Next"
Top = 1200
UseMaskColor = -1 'True
Width = 345
End
Begin VB.CommandButton cmdPrevious
Appearance = 0 'Flat
Height = 345
Left = 1800
MouseIcon = "frmIssue.frx":0702
MousePointer = 99 'Custom
Picture = "frmIssue.frx":0854
Style = 1 'Graphical
TabIndex = 6
ToolTipText = "Move Previous"
Top = 1200
UseMaskColor = -1 'True
Width = 345
End
Begin VB.CommandButton cmdFirst
Appearance = 0 'Flat
Height = 345
Left = 1440
MouseIcon = "frmIssue.frx":0A63
MousePointer = 99 'Custom
Picture = "frmIssue.frx":0BB5
Style = 1 'Graphical
TabIndex = 5
ToolTipText = "Move First"
Top = 1200
UseMaskColor = -1 'True
Width = 345
End
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 = "frmIssue.frx":0E04
MousePointer = 99 'Custom
Picture = "frmIssue.frx":0F56
Style = 1 'Graphical
TabIndex = 4
ToolTipText = "Cancel"
Top = 240
Width = 1095
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 = 120
MouseIcon = "frmIssue.frx":14D6
MousePointer = 99 'Custom
Picture = "frmIssue.frx":1628
Style = 1 'Graphical
TabIndex = 3
ToolTipText = "Switch to Return form"
Top = 1200
Width = 1095
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 = 2520
MouseIcon = "frmIssue.frx":1C31
MousePointer = 99 'Custom
Picture = "frmIssue.frx":1D83
Style = 1 'Graphical
TabIndex = 2
ToolTipText = "Issue book"
Top = 240
Width = 1095
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 = "frmIssue.frx":237D
MousePointer = 99 'Custom
Picture = "frmIssue.frx":24CF
Style = 1 'Graphical
TabIndex = 1
ToolTipText = "Add new"
Top = 240
Width = 1095
End
Begin VB.Label lbl_total
BackStyle = 0 'Transparent
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2640
TabIndex = 15
Top = 1680
Width = 975
End
Begin VB.Label lbl_rec
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1440
TabIndex = 14
Top = 1680
Width = 855
End
Begin VB.Label Label10
BackStyle = 0 'Transparent
Caption = "of"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2400
TabIndex = 13
Top = 1680
Width = 255
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "跳到归还处理"
Height = 375
Left = 120
TabIndex = 12
Top = 1845
Width = 1215
End
Begin VB.Label Label4
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "借出"
Height = 255
Left = 2520
TabIndex = 11
Top = 885
Width = 975
End
Begin VB.Label Label3
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "取消"
Height = 255
Left = 1320
TabIndex = 10
Top = 885
Width = 975
End
Begin VB.Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "新建"
Height = 255
Left = 120
TabIndex = 9
Top = 885
Width = 975
End
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 = 255
Left = 240
TabIndex = 25
Top = 885
Width = 1095
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 = 240
TabIndex = 24
Top = 1215
Width = 735
End
Begin VB.Image Image1
Height = 585
Left = 0
Top = 0
Width = 480
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "输入借书证号和书号以便借书，借出时间为当前时间，会员一定要在归还时间之前还。"
Height = 615
Left = 495
TabIndex = 23
Top = 0
Width = 3240
End
Begin VB.Line Line1
X1 = 0
X2 = 3720
Y1 = 720
Y2 = 720
End
End
Attribute VB_Name = "frmIssue"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim str As String
Dim rmem As ADODB.Recordset
Dim rbook As ADODB.Recordset
Dim riss As ADODB.Recordset
Dim Issueconnection As ADODB.Connection
Dim Issuerecord As ADODB.Recordset
Private Sub cmd_add_Click()
Call cleartext
Call setbutton(False)
Call locktext(False)
msk_issue.Text = Format$(Now, "yyyy年mm月dd日")
'msk_issue.Enabled = False
msk_return.Text = Format$(Now + dayslimit, "yyyy年mm月dd日")
'msk_return.Enabled = False
End Sub
Private Sub locate()
lbl_total.Caption = Issuerecord.RecordCount
lbl_rec.Caption = Issuerecord.AbsolutePosition
End Sub
Private Sub locktext(val As Boolean)
txt_bookid.Locked = val
msk_issue.Enabled = Not val
msk_return.Enabled = Not val
txt_memid.Locked = val
End Sub
Private Sub setbutton(val As Boolean)
cmd_add.Enabled = val
cmd_Return.Enabled = val
cmdFirst.Enabled = val
cmdLast.Enabled = val
cmdNext.Enabled = val
cmdPrevious.Enabled = val
cmd_issue.Enabled = Not val
cmd_cancel.Enabled = Not val
End Sub
Private Function cheak() As Boolean
Dim flag As Boolean
flag = False
If msk_return.Text = "____年__月__日" Then
MsgBox "请选择日期.", vbInformation, "信息不完整"
ElseIf msk_issue.Text = "____年__月__日" Then
ElseIf txt_bookid.Text = "" Then
MsgBox "请输入书ID.", vbInformation, "信息不完整"
ElseIf txt_memid.Text = "" Then
MsgBox "请输入借书证号.", vbInformation, "信息不完整"
Else
flag = True
End If
cheak = flag
End Function
Private Sub cleartext()
txt_bookid.Text = ""
msk_issue.Text = "____年__月__日"
msk_return.Text = "____年__月__日"
txt_memid.Text = ""
End Sub
Private Sub cmd_cancel_Click()
Call locktext(True)
Call setbutton(True)
If Not (Issuerecord.BOF And Issuerecord.EOF) Then
Issuerecord.MoveFirst
Call showdata
End If
End Sub
Private Sub cmd_issue_Click()
On Error GoTo errlable
If (cheak = True) Then
str = "select count(*) from Member where Memid = " & Trim(txt_memid.Text)
rmem.Open str, Issueconnection, adOpenStatic, adLockOptimistic
If rmem(0) = 0 Then
MsgBox ("此借书证号匹配会员不存在M."), vbCritical, "错误信息"
rmem.Close
Exit Sub
Else
rmem.Close
str = "select Bookinhand from Member where Memid = " & Trim(txt_memid.Text)
rmem.Open str, Issueconnection, adOpenStatic, adLockOptimistic
If rmem(0) = maxhold Then
MsgBox ("会员手头不能拥有多于 " & maxhold & "本书."), vbCritical, "错误信息"
rmem.Close
GoTo recycle
End If
End If
rmem.Close
str = "select count(*) from Book where Bookid = " & Trim(txt_bookid.Text)
rbook.Open str, Issueconnection, adOpenStatic, adLockOptimistic
If rbook(0) = 0 Then
MsgBox ("没有与书号匹配的书."), vbCritical, "错误信息"
rbook.Close
Exit Sub
Else
rbook.Close
str = "select Avano from Book where Bookid = " & Trim(txt_bookid.Text)
rbook.Open str, Issueconnection, adOpenStatic, adLockOptimistic
If rbook(0) <= refcopy Then
MsgBox ("这本书刚好剩下两本,不能借."), vbCritical, "错误信息"
rbook.Close
GoTo recycle
End If
End If
rbook.Close
str = "Select count(*) from Issue where Bookid = " & Trim(txt_bookid.Text) & " And Memid = " & Trim(txt_memid.Text)
riss.Open str, Issueconnection, adOpenStatic, adLockOptimistic
If (riss(0) <> 0) Then
MsgBox ("会员不能同时拥有相同的书."), vbCritical, "错误信息"
riss.Close
Exit Sub
End If
Beep
If MsgBox("借阅信息.:会员号为:" & CDbl(txt_memid.Text) & " 借阅书号:" & CDbl(txt_bookid.Text) & "的书", vbYesNo, "Confirm Data") = vbYes Then
str = "INSERT INTO Issue"
str = str & " (Areturndate,Bookid,Issuedate,Returndate,Memid) "
str = str & "VALUES('" & CDate(msk_return.Text) & "', "
str = str & CDbl(txt_bookid.Text) & ", "
str = str & "'" & CDate(msk_issue.Text) & "', "
str = str & "'" & CDate(msk_return.Text) & "', "
str = str & CDbl(txt_memid.Text) & ")"
Issueconnection.Execute str
str = "UPDATE Book SET "
str = str & "Avano = Avano-1,"
str = str & "Issno = Issno+1 where Bookid = " & Trim(txt_bookid.Text)
Issueconnection.Execute str
str = "UPDATE Member SET "
str = str & "Bookinhand = Bookinhand+1 where Memid = " & Trim(txt_memid.Text)
Issueconnection.Execute str
Issuerecord.Requery
MsgBox "所有记录更新成功.", vbInformation, "保存记录"
Call locktext(True)
Call setbutton(True)
Else
recycle:
Call locktext(True)
Call setbutton(True)
Call cleartext
End If
End If
Exit Sub
errlable:
MsgBox Err.Number & Err.Description
End Sub
Private Sub cmd_Return_Click()
Load frmReturn
frmReturn.Show
Unload Me
End Sub
Private Sub Form_Load()
On Error GoTo lable
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(5).Picture
Set Issueconnection = New ADODB.Connection
Issueconnection.CursorLocation = adUseClient
Set Issuerecord = New ADODB.Recordset
Issueconnection.ConnectionString = "DSN=library;UID=sa;PWD=;"
Issueconnection.Open
slis = "Select Areturndate,Bookid,Issuedate,Returndate,Memid from Issue Order by Memid"
'Set Issuerecord = exesql(slis)
Issuerecord.Open slis, Issueconnection, adOpenStatic, adLockOptimistic
Set rmem = New ADODB.Recordset
Set rbook = New ADODB.Recordset
Set riss = New ADODB.Recordset
Call showdata
Call setbutton(True)
Call locktext(True)
Exit Sub
lable:
MsgBox Err.Number & Err.Description
End Sub
Private Sub showdata()
If Issuerecord.EOF = False And Issuerecord.BOF = False Then
'msk_return.Text = Issuerecord.Fields(0)
txt_bookid.Text = Issuerecord.Fields(1)
msk_issue.Text = Format$(Issuerecord.Fields(2), "yyyy年mm月dd日")
msk_return.Text = Format$(Issuerecord.Fields(3), "yyyy年mm月dd日")
txt_memid.Text = Issuerecord.Fields(4)
End If
Call locate
End Sub
Private Sub cmdFirst_Click()
On Error GoTo GoFirstError
Issuerecord.MoveFirst
Call showdata
Exit Sub
GoFirstError:
MsgBox Err.Description
End Sub
Private Sub cmdLast_Click()
On Error GoTo GoLastError
Issuerecord.MoveLast
Call showdata
Exit Sub
GoLastError:
MsgBox Err.Description
End Sub
Private Sub cmdNext_Click()
Dim my As String
On Error GoTo GoNextError
If Not Issuerecord.EOF Then Issuerecord.MoveNext
If Issuerecord.EOF And Issuerecord.RecordCount > 0 Then
Beep
Issuerecord.MoveLast
End If
Call showdata
Exit Sub
GoNextError:
MsgBox Err.Description
End Sub
Private Sub cmdPrevious_Click()
On Error GoTo GoPrevError
If Not Issuerecord.BOF Then Issuerecord.MovePrevious
If Issuerecord.BOF And Issuerecord.RecordCount > 0 Then
Beep
Issuerecord.MovePrevious
End If
Call showdata
Exit Sub
GoPrevError:
If Err.Number = 3021 Then
MsgBox ("这是第一条记录."), vbInformation, "第一条记录"
Issuerecord.MoveNext
ElseIf Err.Number <> 0 Then
MsgBox Err.Number & Err.Description
End If
End Sub