frmaddxj.frm

这是一个小型的教务管理系统

         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   240
      Index           =   10
      Left            =   360
      TabIndex        =   32
      Top             =   2445
      Width           =   1305
   End
End
Attribute VB_Name = "FrmAddXj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Rs As ADODB.Recordset
Dim RsLst As ADODB.Recordset
Dim AddFlg As Boolean
Dim arr() As Byte
Dim i As Long

Private Sub Command1_Click()
    DataNull
    Rs.AddNew
    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = True
    Command5.Enabled = True
    Command7.Enabled = False
    Command8.Enabled = False
    Command9.Enabled = False
    Command10.Enabled = False
    List1.Enabled = False
    AddFlg = True
    
End Sub

Private Sub Command10_Click()
  Rs.MoveLast
  List1.ListIndex = List1.ListCount - 1
  Display
End Sub

Private Sub Command11_Click()
On Error GoTo err
Rs.Close
Set Rs = New ADODB.Recordset
    Rs.Open "select * from 学籍表 order by 班级,学号", Con, adOpenStatic, adLockPessimistic, adCmdText
    RsLst.Open "select * from 学籍表 order by 班级,学号", Con, adOpenStatic, adLockPessimistic, adCmdText
List1.Clear
    List1.AddItem "班级 " & "学号" & "-" & "姓名"
If RsLst.BOF And RsLst.EOF Then
RsLst.Close
Exit Sub
Else
    RsLst.MoveFirst
   Do While RsLst.EOF = False
       If Len(RsLst!学号) = 1 Then
          List1.AddItem RsLst!班级 & "   0" & RsLst!学号 & " - " & RsLst!姓名
       Else
          List1.AddItem RsLst!班级 & "   " & RsLst!学号 & " - " & RsLst!姓名
       End If
      RsLst.MoveNext
    Loop
    RsLst.MoveFirst
End If
RsLst.Close
List1.ListIndex = 1
Display
  
Exit Sub

err:
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub

Private Sub Command2_Click()
Dim ctl As Control
For Each ctl In Controls
  If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Then
     ctl.Enabled = True
  End If
Next ctl
MaskEdBox1.Enabled = True
Frame1.Enabled = True
   Command4.Enabled = True
   Command5.Enabled = True
   Command1.Enabled = False
   Command2.Enabled = False
   Command3.Enabled = False
    Command7.Enabled = False
    Command8.Enabled = False
    Command9.Enabled = False
    Command10.Enabled = False
    List1.Enabled = False
    
   AddFlg = False
End Sub

Private Sub Command3_Click()
On Error GoTo delErr
If vbYes = MsgBox("确认索要删除此记录么？", vbYesNo, "删除对话框") Then
    Rs.Delete
    Rs.MoveNext
  If Rs.EOF Then Rs.MoveLast
   Command11_Click
    Display
End If

Exit Sub

delErr:
  DataNull
  Display
  'lstSt
End Sub

Private Sub Command4_Click()
On Error GoTo err
    Dim ctl As Control
For Each ctl In Controls
  If TypeOf ctl Is TextBox Then
     If ctl.Text = "" Then
       MsgBox "记录输入不完整！"
       Exit Sub
     End If
  End If
Next ctl
If Len(Trim(Text1.Text)) <> 7 Then
    MsgBox "初考证号输入不正确！"
       Exit Sub
End If
If Len(Trim(Text2.Text)) <> 8 Then
    MsgBox "考试号输入不正确！"
       Exit Sub
End If
If Len(Trim(Text3.Text)) = 3 And Trim(Text3.Text) Like "#0#" Then
   Else
    MsgBox "班级输入不正确！"
       Exit Sub
End If
If Combo1.ListIndex = -1 And (Combo1.Text <> "男" And Combo1.Text <> "女") Then
       MsgBox "性别输入不完整！"
       Exit Sub
End If
If Combo2.ListIndex = -1 And (Combo2.Text <> "否" And Combo2.Text <> "是") Then
       MsgBox "计外情况输入不完整！"
       Exit Sub
End If

If AddFlg = True Then
     Rs!初考证号 = Trim(Text1.Text)
     Rs!考试号 = Trim(Text2.Text)
     Rs!班级 = Trim(Text3.Text)
     Rs!学号 = Trim(Text4.Text)
     Rs!姓名 = Trim(Text5.Text)
     Rs!家长姓名 = Trim(Text6.Text)
     Rs!联系电话 = Trim(Text7.Text)
     Rs!家庭住址 = Trim(Text8.Text)
     Rs!出生年月 = Trim(MaskEdBox1.Text)
     Rs!性别 = Trim(Combo1.Text)
     Rs!计外 = Trim(Combo2.Text)
     If Image1.Picture <> 0 Then
       Rs!照片 = arr
     End If
     Rs.Update
     
   'Rs.MoveNext
   'If Rs.EOF Then Rs.MoveLast
   Display
   MsgBox "记录成功添加！"
Else

     Rs!初考证号 = Trim(Text1.Text)
     Rs!考试号 = Trim(Text2.Text)
     Rs!班级 = Trim(Text3.Text)
     Rs!学号 = Trim(Text4.Text)
     Rs!姓名 = Trim(Text5.Text)
     Rs!家长姓名 = Trim(Text6.Text)
     Rs!联系电话 = Trim(Text7.Text)
     Rs!家庭住址 = Trim(Text8.Text)
     Rs!出生年月 = Trim(MaskEdBox1.Text)
     Rs!性别 = Trim(Combo1.Text)
     Rs!计外 = Trim(Combo2.Text)
     If Image1.Picture <> 0 Then
       Rs!照片 = arr
     End If
     Rs.UpdateBatch adAffectAllChapters
 '     Rs.MoveNext
 '   If Rs.EOF Then Rs.MoveLast
   Display
   MsgBox "记录成功修改！"
End If
List1.Enabled = True

lstSt

Exit Sub
err:
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub

Private Sub Command5_Click()
On Error GoTo CancleErr
If AddFlg = True Then
  Rs.CancelUpdate
 '   Rs.MoveNext
 '   If Rs.EOF Then Rs.MoveLast
  Display
Else
  Rs.CancelBatch adAffectAllChapters
 '   Rs.MoveNext
 '   If Rs.EOF Then Rs.MoveLast
  Display
End If
List1.Enabled = True

CancleErr:
 DataNull
 Display

End Sub

Private Sub Command6_Click()
Unload Me
End Sub

Private Sub Command7_Click()
Rs.MoveFirst
List1.ListIndex = 1
Display
End Sub

Private Sub Command8_Click()
With Rs
  .MovePrevious
  If .BOF Then .MoveFirst
End With
List1.ListIndex = Rs.Bookmark
 Display
End Sub

Private Sub Command9_Click()
ItemIndex = Rs.Index
With Rs
  .MoveNext
  If .EOF Then .MoveLast
End With
List1.ListIndex = Rs.Bookmark
 Display
End Sub

Private Sub Form_Load()
On Error GoTo err
Set Rs = New ADODB.Recordset
Set RsLst = New ADODB.Recordset
    Text3.Text = ""
    Rs.Open "select * from 学籍表 order by 班级,学号", Con, adOpenStatic, adLockPessimistic, adCmdText
List1.Clear
    List1.AddItem "班级 " & "学号" & "-" & "姓名"
If Rs.BOF And Rs.EOF Then
Else
    Rs.MoveFirst
   Do While Rs.EOF = False
       If Len(Rs!学号) = 1 Then
          List1.AddItem Rs!班级 & "   0" & Rs!学号 & " - " & Rs!姓名
       Else
          List1.AddItem Rs!班级 & "   " & Rs!学号 & " - " & Rs!姓名
       End If
      Rs.MoveNext
    Loop
    Rs.MoveFirst
    List1.ListIndex = 1
End If
Display
Cdlg.DialogTitle = "打开照片文件："
Cdlg.Filter = "GIF Images|*.gif|Bitmap Images|*.bmp|JPG Images|*.jpg|JPEG Images|*.jpeg|ICONS|*.ico|CURSORS|*.cur|所有文件|*.*"

Exit Sub
err:
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub

Private Sub Display()
On Error GoTo err
    DataNull
    Const TempFile As String = "tempfile.tmp"
If Rs.BOF = True And Rs.EOF = True Then
    MsgBox "学籍表中没有任何数据！"
    Command1.Enabled = True
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
    Command5.Enabled = False
    Command7.Enabled = False
    Command8.Enabled = False
    Command9.Enabled = False
    Command10.Enabled = False
    Command11_Click
Else
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = False
    Command5.Enabled = False
    Command7.Enabled = True
    Command8.Enabled = True
    Command9.Enabled = True
    Command10.Enabled = True
    Text1.Text = "" & Rs!初考证号
    Text2.Text = "" & Rs!考试号
    Text3.Text = "" & Rs!班级
    Text4.Text = "" & Rs!学号
    Text5.Text = "" & Rs!姓名
    Text6.Text = "" & Rs!家长姓名
    Text7.Text = "" & Rs!联系电话
    Text8.Text = "" & Rs!家庭住址
    If Rs!出生年月 <> "" Then
        MaskEdBox1.Text = "" & Rs!出生年月
    End If
    If Rs!照片.ActualSize > 0 Then
        arr = Rs![照片]
        Open TempFile For Binary Access Write As #1
        Put #1, , arr
        Close #1
        Image1.Picture = LoadPicture(TempFile)
        Kill (TempFile)
    End If
    Combo1.Text = "" & Rs!性别
    Combo2.Text = "" & Rs!计外

End If

Dim ctl As Control
For Each ctl In Controls
  If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Then
     ctl.Enabled = False
  End If
Next ctl
 MaskEdBox1.Enabled = False
 Frame1.Enabled = False
Exit Sub

err:
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub

Private Sub DataNull()
Dim ctl As Control
For Each ctl In Controls
  If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Then
     ctl.Enabled = True
  End If
Next ctl
 MaskEdBox1.Enabled = True
 Frame1.Enabled = True
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    Text5.Text = ""
    Text6.Text = ""
    Text7.Text = ""
    Text8.Text = ""
     MaskEdBox1.Text = "1990.01"
     
     Image1.Picture = Nothing
    Combo1.Text = Combo1.List(0)
    Combo2.Text = Combo2.List(0)
    
End Sub

Private Sub Image1_Click()
On Error GoTo err
    Cdlg.ShowOpen
    If Cdlg.FileName = "" Then Exit Sub
    Image1.Picture = LoadPicture(Cdlg.FileName)
    Open Cdlg.FileName For Binary As 1
    ReDim arr(LOF(1))
    Do While Not EOF(1)
        Get #1, , arr
        i = i + 1
    Loop
    Close #1
    
Exit Sub
err:
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub

Private Sub List1_Click()
If List1.ListIndex < 1 Then
Else
Rs.Move List1.ListIndex - 1, adBookmarkFirst
End If
Display
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then
   KeyAscii = 0
End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then
   KeyAscii = 0
End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then
   KeyAscii = 0
End If
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then
   KeyAscii = 0
End If
End Sub

Private Sub Text7_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then
   KeyAscii = 0
End If
End Sub

Private Sub lstSt()
On Error GoTo err
    RsLst.Open "select * from 学籍表 order by 班级,学号 ", Con, adOpenStatic, adLockPessimistic, adCmdText
List1.Clear
    List1.AddItem "班级 " & "学号" & "-" & "姓名"
If RsLst.BOF And RsLst.EOF Then
  RsLst.Close
  Exit Sub
Else
    RsLst.MoveFirst
   Do While RsLst.EOF = False
       If Len(RsLst!学号) = 1 Then
          List1.AddItem RsLst!班级 & "   0" & RsLst!学号 & " - " & RsLst!姓名
       Else
          List1.AddItem RsLst!班级 & "   " & RsLst!学号 & " - " & RsLst!姓名
       End If
      RsLst.MoveNext
    Loop
    RsLst.MoveFirst
End If
RsLst.Close
List1.ListIndex = Rs.Bookmark
Exit Sub
err:
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub

Private Sub Text9_Change()

End Sub