frmissue.frm

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

         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