form1.frm

一个学籍管理系统代码

      AutoSize        =   -1  'True
      BackColor       =   &H80000000&
      Caption         =   "名字"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   5
      Left            =   3360
      TabIndex        =   16
      Top             =   600
      Width           =   390
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackColor       =   &H80000000&
      Caption         =   "电话"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   4
      Left            =   3360
      TabIndex        =   15
      Top             =   1440
      Width           =   390
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackColor       =   &H80000000&
      Caption         =   "家庭住址"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   3
      Left            =   720
      TabIndex        =   14
      Top             =   3000
      Width           =   780
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackColor       =   &H80000000&
      Caption         =   "性别"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   2
      Left            =   6240
      TabIndex        =   13
      Top             =   600
      Width           =   390
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackColor       =   &H80000000&
      Caption         =   "生日"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   1
      Left            =   8760
      TabIndex        =   12
      Top             =   1440
      Width           =   390
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackColor       =   &H80000000&
      Caption         =   "学号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   0
      Left            =   720
      TabIndex        =   10
      Top             =   600
      Width           =   390
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public addrecord As Boolean
Public modifyrecord As Boolean

Private Sub Command1_Click()
On Error GoTo commanderror
Dim num As String
num = InputBox$("请输入学号(10位)", "学号搜索", "0008324231")
If num <> "" Then
num = "学号=" & " '" & num & "'"


rs1.FindFirst num
If Not rs1.NoMatch Then
displayrecord
Else
MsgBox "no data", vbExclamation + vbOKOnly, ""
End If
End If
Exit Sub
commanderror:
MsgBox Err.Description
End Sub

Private Sub Command2_Click(index As Integer)
Const move_first = 0
Const move_previous = 1
Const move_next = 2
Const move_last = 3
Select Case index
Case move_first
rs1.MoveFirst

Case move_previous
rs1.MovePrevious
If rs1.BOF Then
rs1.MoveFirst
Beep
MsgBox "This is first data", vbExclamation + vbOKOnly, ""
Exit Sub
End If
Case move_next
rs1.MoveNext
If rs1.EOF Then
rs1.MoveLast

Beep
MsgBox "This is last data", vbExclamation + vbOKOnly, ""
Exit Sub
End If
Case move_last
rs1.MoveLast
End Select
displayrecord

Exit Sub


On Error GoTo commanderror

commanderror:
MsgBox Err.Description
End Sub

Private Sub Command3_Click()
On Error GoTo commanderror
cleardisplay
Text1(0).SetFocus
addrecord = True
savecancel
Exit Sub
commanderror:
MsgBox Err.Description
End Sub

Private Sub Command4_Click()
On Error GoTo commanderror
Text1(0).SetFocus
modifyrecord = True
savecancel
Exit Sub
commanderror:
MsgBox Err.Description
End Sub

Private Sub Command5_Click()
On Error GoTo commanderror
Dim d As Integer
d = MsgBox("确定要删除这条记录吗？", vbQuestion + vbYesNo, "删除记录")
If d = vbYes Then
BeginTrans
rs1.Delete
CommitTrans
rs1.MoveNext
If rs1.RecordCount > 0 Then
If rs1.EOF Then
rs1.MoveLast
End If
displayrecord
Else
rs1.AddNew
cleardisplay
initial_button
End If
End If
Exit Sub

commanderror:
Rollback
MsgBox Err.Description
End Sub

Private Sub Command6_Click()
On Error GoTo commanderror
If Text1(0) = "" Or Text1(1) = "" Then
MsgBox "学号和名字不能为空", vbOKOnly + vbExclamation, ""
If Text1(0) = "" Then
Text1(0).SetFocus
ElseIf Text1(1) = "" Then
Text1(1).SetFocus
End If
ElseIf addrecord = True Then
On Error GoTo saveadd_modifyerror
BeginTrans
rs1.AddNew
writerecord
rs1.Update
CommitTrans
addrecord = False
lookuprecord
ElseIf modifyrecord = True Then
On Error GoTo saveadd_modifyerror
BeginTrans
rs1.Edit
writerecord
rs1.Update
CommitTrans
modifyrecord = False
End If
initial_button
Exit Sub
saveadd_modifyerror:
Rollback
MsgBox Err.Description
Exit Sub
commanderror:
MsgBox Err.Description
End Sub

Private Sub Command7_Click()
On Error GoTo commanderror
addrecord = False
modifyrecord = False
If rs1.RecordCount > 0 Then
displayrecord
Else
cleardisplay
End If
initial_button
Exit Sub
commanderror:
MsgBox Err.Description
End Sub

Private Sub Command8_Click()
On Error GoTo commanderror
Form2.Enabled = True
Unload Form1
Exit Sub
commanderror:
MsgBox Err.Description
End Sub

Private Sub Form_Load()
Dim sql As String
sql = "SELECT 学生.* FROM 学生 ORDER BY 学生.学号"
Set rs1 = db.OpenRecordset(sql, dbOpenDynaset)
If rs1.RecordCount > 0 Then
displayrecord
Else
MsgBox "对不起，没有找到您要的数据", vbExclamation + vbOKOnly, ""
cleardisplay
rs1.AddNew
End If
addrecord = False
modifyrecord = False
initial_button
Exit Sub
loaderror:
MsgBox Err.Description

End Sub
Public Sub displayrecord()
Dim i As Integer
For i = 0 To 10
If i = 2 Then
If Not IsNull(rs1.Fields(i)) Then
   If rs1.Fields(i) = "1" Then
   Text1(i) = "男"
   Else
   Text1(i) = "女"
   End If
   Else
   Text1(i) = ""
   End If
   Else
   If Not IsNull(rs1.Fields(i)) Then
   Text1(i) = rs1.Fields(i)
Else
Text1(i) = ""
End If
End If
Next
End Sub

Public Sub cleardisplay()
Dim i As Integer
For i = 0 To 10
Text1(i) = ""
Next

End Sub
Public Sub initial_button()
Dim i As Integer
If rs1.RecordCount > 0 Then
Command1.Enabled = True
For i = 0 To 3
Command2(i).Enabled = True
Next
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = False
Command7.Enabled = False
Command8.Enabled = True
Else
Command1.Enabled = False
For i = 0 To 3
Command(i).Enabled = True
Next
Command3.Enabled = True
Command4.Enabled = False
Command5.Enabled = False
Command6.Enabled = False
Command7.Enabled = False
Command8.Enabled = True
End If
End Sub

Public Sub savecancel()
Dim i As Integer
Command1.Enabled = False
For i = 0 To 3
Command2(i).Enabled = False
Next
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
Command6.Enabled = True
Command7.Enabled = True
Command8.Enabled = False

End Sub

Public Sub writerecord()
Dim i As Integer
For i = 0 To 10
If i = 2 Then

   If Text1(i) = "男" Then
   rs1.Fields(i) = "1"
   
   ElseIf Text1(i) = "女" Then
   rs1.Fields(i) = "0"
   
   End If
   Else
   If Text1(i) <> "" Then rs1.Fields(i) = Text1(i)
   End If
Next
End Sub

Public Sub lookuprecord()
Dim s As String
rs1.Requery
s = "学号=" & "'" & Text1(0) & "'"
If s <> "" Then
rs1.FindFirst s
End If
End Sub

Public Sub text1_gotfocus(index As Integer)
If addrecord = True Or modifyrecord = True Then Text1(index).BackColor = RGB(255, 255, 0)
If addrecord = False And modifyrecord = False Then
Beep
MsgBox "请先选 ‘ 添加 ’或 ‘ 取消 ’按钮", vbOKOnly + vbExclamation, ""
End If
End Sub
Public Sub text1_lostfocus(index As Integer)
 Text1(index).BackColor = RGB(255, 255, 255)
End Sub