⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frm_members.frm

📁 Library Management System 1
💻 FRM
📖 第 1 页 / 共 3 页
字号:
              '   ElseIf Not IsNumeric(txt_bookhnd.Text) Then
              '   MsgBox ("Book in hand must be Numeric."), vbInformation, "Invalid arguments"
                 ElseIf Not IsNumeric(txt_memid.Text) Then
                 MsgBox ("MemberID must be Numeric."), vbInformation, "Invalid arguments"
                 Else
                 flag = True
                End If
cheak = flag
End Function
Private Sub cmd_books_Click()
If (bookshow = True) Then
Me.Height = 5970
Else
Me.Height = 7755
End If
bookshow = Not bookshow
End Sub

Private Sub cmd_close_Click()
Unload Me
End Sub
Private Sub cmd_cancel_Click()
On erro GoTo cancelerr
'disablink control
    Call locktext(True)
    lblStatus.Caption = " Cancel."
 
 If Memrecordset.BOF And Memrecordset.EOF Then
   GoTo newproc
 Else
   Memrecordset.MoveFirst
   Call showdata
 End If

newproc:
  txt_fname.SetFocus
Call setbutton(True)
Exit Sub
cancelerr:
MsgBox Err.Description
End Sub

Private Sub cmd_delete_Click()
On erro GoTo lable
 Beep
str = "select Bookinhand from Member where Memid = " & CDbl(txt_memid.Text)
temp.Open str, Memconnection, adOpenStatic, adLockOptimistic
If temp(0) <> 0 Then
MsgBox "Member account cannot be deleeted because member has not returned books.", vbInformation, "Books not returned"
temp.Close
Exit Sub
End If
temp.Close
If MsgBox("Execution of command will delete current Datarecord,Are you sure you wan't to delete Datarecord ?", vbYesNo + vbExclamation, "Confirm Delete") = vbYes Then
   str = "DELETE FROM Member WHERE "
   str = str & "Memid = "
   str = str & CDbl(txt_memid.Text)
   Memconnection.Execute str
   Memrecordset.Requery
   MsgBox "Record deleted sucessfully.", vbinformayion, "Delete"

If Memrecordset.BOF And Memrecordset.EOF Then
    Call clear
    MsgBox ("The previous record was last record,Now no record left."), vbInformation, "Last record"
    cmd_delete.Enabled = False
Else
   Memrecordset.MoveNext
      If Memrecordset.EOF Then
       Memrecordset.MoveLast
      End If
   Call showdata
End If

'message for status of mode
lblStatus.Caption = " Record deleted."
End If
Exit Sub
lable:
MsgBox Err.Number & Err.Description
End Sub

Private Sub cmd_edit_Click()
Call locktext(False)
Call setbutton(False)
msk_bdate.Enabled = True
msk_expr.Enabled = True
msk_join.Enabled = True
txt_bookhnd.Locked = True
'cmd_cancel.Enabled = False
txt_fname.SetFocus
saveflag = False
lblStatus.Caption = " Edit record."
End Sub

Private Sub cmd_new_Click()
Call locktext(False)
Call clear
Call setbutton(False)
msk_bdate.Enabled = True
msk_expr.Enabled = True
msk_join.Enabled = True
txt_bookhnd.Text = 0
txt_fname.SetFocus
saveflag = True
lblStatus.Caption = " Add new record."
End Sub

Private Sub cmd_reset_Click()
Call clear
Call locktext(False)
End Sub

Private Sub cmd_save_Click()
'error cheaking and autocorrection handle
On Error GoTo errlable
If (cheak = True) Then
    If (txt_note.Text = "") Then
    txt_note.Text = "None"
    End If
    If (txt_phone.Text = "") Then
    txt_phone.Text = "None"
    End If
    If (txt_mail.Text = "") Then
    txt_mail.Text = "None"
    End If
    
If (saveflag = True) Then
           txt_bookhnd.Text = 0
            str = "INSERT INTO Member "
            str = str & "(Address, Birthdate, Bookinhand, Deposite, Doexpire, Dojoin, Email, Fname, Lname, Memid, Noted, Phone, Sex) "
            str = str & "VALUES('" & Trim(txt_add.Text) & "', "
            str = str & "'" & Trim(msk_bdate.Text) & "', "
            str = str & CDbl(txt_bookhnd.Text) & ", "
            str = str & CDbl(Trim(txt_deposite.Text)) & ", "
            str = str & "'" & Trim(msk_expr.Text) & "', "
            str = str & "'" & Trim(msk_join.Text) & "', "
            str = str & "'" & Trim(txt_mail.Text) & "', "
            str = str & "'" & Trim(txt_fname.Text) & "', "
            str = str & "'" & Trim(txt_lname.Text) & "', "
            str = str & CDbl(Trim(txt_memid.Text)) & ", "
            str = str & "'" & Trim(txt_note.Text) & "', "
            str = str & "'" & Trim(txt_phone.Text) & "', "
            str = str & "'" & Trim(cmb_sex.Text) & "' )"
            'MsgBox str
Memconnection.Execute str
Else
            str = "UPDATE Member SET "
            str = str & " Address = '" & Trim(txt_add.Text) & "',"
            str = str & " Birthdate  = '" & Trim(msk_bdate.Text) & "',"
            str = str & " Bookinhand = '" & Trim(txt_bookhnd.Text) & "',"
            str = str & " Deposite = " & CDbl(txt_deposite.Text) & ","
            str = str & " Doexpire = '" & Trim(msk_expr.Text) & "',"
            str = str & " Dojoin = '" & Trim(msk_join.Text) & "',"
            str = str & " Email = '" & Trim(txt_mail.Text) & "',"
            str = str & " Fname = '" & Trim(txt_fname.Text) & "',"
            str = str & " Lname = '" & Trim(txt_lname.Text) & "',"
            str = str & " Memid = " & CDbl(txt_memid.Text) & ","
            str = str & " Noted = '" & Trim(txt_note.Text) & "',"
            str = str & " Phone = '" & Trim(txt_phone.Text) & "',"
            str = str & " Sex = '" & Trim(cmb_sex.Text) & "'"
            str = str & " WHERE Memid= " & CDbl(txt_memid.Text)
            'MsgBox str
Memconnection.Execute str
End If

        Memrecordset.Requery
        Memrecordset.MoveFirst
        MsgBox ("Record saved successfully."), vbInformation, "Save"
        Call locktext(True)
        Call setbutton(True)
        Call showdata

End If
Exit Sub
errlable:
If (Err.Number = -2147467259) Then
MsgBox ("Member ID already exist,please enter anothe ID."), vbCritical, "MemberID exist"
txt_memid.SetFocus
ElseIf (Err.Number = -2147217913) Then
MsgBox ("May be date field pattern wrong."), vbCritical, "Date"
ElseIf Err.Number <> 0 Then
MsgBox Err.Number & Err.Description
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
  Set Memconnection = New ADODB.Connection
  Memconnection.CursorLocation = adUseClient
  Memconnection.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\Database\Library.mdb;Jet OLEDB:Database Password=Library;"

  Set Memrecordset = New ADODB.Recordset
  Memrecordset.Open "select Address,Birthdate,Bookinhand,Deposite,Doexpire,Dojoin,Email,Fname,Lname,Memid,Noted,Phone,Sex from Member Order by Memid", Memconnection, adOpenStatic, adLockOptimistic
   
 Set temp = New ADODB.Recordset
   Call showdata
  Set Flexgridset = New ADODB.Recordset
  Call flexupdate
   Call setbutton(True)
msk_bdate.Enabled = False
msk_expr.Enabled = False
msk_join.Enabled = False
bookshow = False
Exit Sub
errlable:
MsgBox Err.Number & Err.Description
End Sub
Private Sub flexupdate()

 If Memrecordset.EOF = False And Memrecordset.BOF = False Then
 Flexgridset.Open "select count(*) from Book where Bookid in(select Bookid from Issue where Memid=" & Trim(txt_memid.Text) & ")", Memconnection, adOpenStatic, adLockOptimistic
 flexgrid.Rows = Flexgridset(0) + 2
 Flexgridset.Close

 Flexgridset.Open "select Author1,Author2,Author3,Bookid,Edition,ISBNNumber,Pages,Price,Publication,Subject,Title from Book where Bookid in(select Bookid from Issue where Memid=" & Trim(txt_memid.Text) & ")", Memconnection, adOpenStatic, adLockOptimistic
  flexgrid.Visible = True
  flexgrid.Cols = 11
 For pos = 0 To flexgrid.Rows - 1
      With flexgrid
        .TextMatrix(pos, 0) = ""
        .TextMatrix(pos, 1) = ""
        .TextMatrix(pos, 2) = ""
        .TextMatrix(pos, 3) = ""
        .TextMatrix(pos, 4) = ""
        .TextMatrix(pos, 5) = ""
        .TextMatrix(pos, 6) = ""
        .TextMatrix(pos, 7) = ""
        .TextMatrix(pos, 8) = ""
        .TextMatrix(pos, 9) = ""
        .TextMatrix(pos, 10) = ""
      End With
  Next pos
 pos = 0
 With flexgrid
    .FixedAlignment(1) = flexAlignCenterCenter
   
    .TextMatrix(0, 0) = "Bookid"
    .TextMatrix(0, 1) = "Title"
    .TextMatrix(0, 2) = "Author1"
    .TextMatrix(0, 3) = "Author2"
    .TextMatrix(0, 4) = "Author3"
    .TextMatrix(0, 5) = "Publication"
    .TextMatrix(0, 6) = "Edition"
    .TextMatrix(0, 7) = "Subject"
    .TextMatrix(0, 8) = "ISBN"
    .TextMatrix(0, 9) = "Price"
    .TextMatrix(0, 10) = "Pages"

    
    .ColWidth(0) = 700
    .ColWidth(1) = 2800
    .ColWidth(2) = 1500
    .ColWidth(3) = 1500
    .ColWidth(4) = 1500
    .ColWidth(5) = 2300
    .ColWidth(6) = 1500
    .ColWidth(7) = 1700
    .ColWidth(8) = 1250
    .ColWidth(9) = 500
    .ColWidth(10) = 500
   
    While Not Flexgridset.EOF
        
        .TextMatrix(.Row, 0) = Flexgridset(3)
        .TextMatrix(.Row, 1) = Flexgridset(10)
        .TextMatrix(.Row, 2) = Flexgridset(0)
        .TextMatrix(.Row, 3) = Flexgridset(1)
        .TextMatrix(.Row, 4) = Flexgridset(2)
        .TextMatrix(.Row, 5) = Flexgridset(8)
        .TextMatrix(.Row, 6) = Flexgridset(4)
        .TextMatrix(.Row, 7) = Flexgridset(9)
        .TextMatrix(.Row, 8) = Flexgridset(5)
        .TextMatrix(.Row, 9) = Flexgridset(7)
        .TextMatrix(.Row, 10) = Flexgridset(6)
        .Row = .Row + 1
      
      Flexgridset.MoveNext
      Wend
    .Row = 1
 End With
Flexgridset.Close
End If
End Sub
Private Sub showdata()
  If Memrecordset.EOF = False And Memrecordset.BOF = False Then
                    txt_add.Text = Memrecordset.Fields(0)
                    msk_bdate.Text = Format$(Memrecordset.Fields(1), "MM/dd/yyyy")
                    txt_bookhnd.Text = Memrecordset.Fields(2)
                    txt_deposite.Text = Memrecordset.Fields(3)
                    msk_expr.Text = Format$(Memrecordset.Fields(4), "MM/dd/yyyy")
                    msk_join.Text = Format$(Memrecordset.Fields(5), "MM/dd/yyyy")
                    txt_mail.Text = Memrecordset.Fields(6)
                    txt_fname.Text = Memrecordset.Fields(7)
                    txt_lname.Text = Memrecordset.Fields(8)
                    txt_memid.Text = Memrecordset.Fields(9)
                    txt_note.Text = Memrecordset.Fields(10)
                    txt_phone.Text = Memrecordset.Fields(11)
                    cmb_sex.Text = Memrecordset.Fields(12)
 End If
 End Sub


Private Sub cmdFirst_Click()
 On Error GoTo GoFirstError

   Memrecordset.MoveFirst
   lblStatus.Caption = "      <<     Move"
'show thw current data record
   Call showdata
   Call flexupdate

Exit Sub

GoFirstError:
  MsgBox Err.Description
End Sub

Private Sub cmdLast_Click()
 On Error GoTo GoLastError
  lblStatus.Caption = "               Move       >>"

   Memrecordset.MoveLast
'show thw current data record
   Call showdata
   Call flexupdate

Exit Sub

GoLastError:
  MsgBox Err.Description
End Sub

Private Sub cmdNext_Click()
Dim my As String
On Error GoTo GoNextError
 lblStatus.Caption = "               Move       >"
  
  If Not Memrecordset.EOF Then Memrecordset.MoveNext
  If Memrecordset.EOF And Memrecordset.RecordCount > 0 Then
     Beep
     'moved off the end so go back
     Memrecordset.MoveLast
    
  End If
'show thw current data record
     Call showdata
     Call flexupdate
Exit Sub
GoNextError:
  MsgBox Err.Description
End Sub

Private Sub cmdPrevious_Click()
 On Error GoTo GoPrevError
   lblStatus.Caption = "      <       Move"

  If Not Memrecordset.BOF Then Memrecordset.MovePrevious
  If Memrecordset.BOF And Memrecordset.RecordCount > 0 Then
    Beep
    'moved off the end so go back
    Memrecordset.MovePrevious
 
  End If
'show thw current data record
    Call showdata
    Call flexupdate
Exit Sub

GoPrevError:
  If Err.Number = 3021 Then
MsgBox ("This is first Record."), vbInformation, "First record"
ElseIf Err.Number <> 0 Then
MsgBox Err.Number & Err.Description
End If
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -