📄 frm_members.frm
字号:
' 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 + -