student_frm.frm

高校学生选课系统

    If strField = "" Then
        strField = "sno"
        strQuery = "SELECT sno As 学号,sname As 姓名, Sex As 性别, " & _
                   "birth As 出生年月, tel As 电话,address As 家庭地址,m As 备注 " & _
                   "FROM studentinfo " & _
                   "WHERE " & strField & " = '" & Trim(txtcontent.Text) & "'"
    ElseIf strField = "birth" Then
        strQuery = "SELECT sno As 学号,sname As 姓名, Sex As 性别, " & _
                   "birth As 出生年月, tel As 电话,address As 家庭地址,m As 备注 " & _
                   "FROM studentinfo " & _
                   "WHERE " & strField & "= '" & Trim(txtcontent.Text) & "'"
    Else
        strQuery = "SELECT sno As 学号,sname As 姓名, Sex As 性别, " & _
                   "birth As 出生年月, tel As 电话,address As 家庭地址,m As 备注 " & _
                   "FROM studentinfo " & _
                   "WHERE " & strField & " = '" & Trim(txtcontent.Text) & "'"
    End If
    rs.Open strQuery, con, adOpenForwardOnly, adLockReadOnly
    Set DataGrid2.DataSource = Nothing
    If Not (rs.EOF And rs.BOF) Then
        rs.MoveFirst
        rs.MoveLast
    End If
    If rs.RecordCount > 0 Then
        Set DataGrid2.DataSource = rs
        MsgBox "总共查到" & rs.RecordCount & "记录", vbInformation
    Else
        MsgBox "没有找到记录,请重新输入查询数据", vbInformation
    End If

End Sub

Private Sub cmdque2_Click()

    Dim rs As New ADODB.Recordset
    strQuery2 = "SELECT sno As 学号,sname As 姓名, Sex As 性别," & _
                "birth As 出生年月, tel As 电话,address As 家庭地址,m As 备注 " & _
                "FROM studentinfo WHERE "
    Dim sQSql As String
    
    If chkItem(0).Value = vbChecked Then
        If txtsno = "" Then
        MsgBox "请输入要查询的记录", vbInformation
        Exit Sub
        End If
        sQSql = "sno" & " like '%" & Trim(txtsno) & "%'"
    End If
    If chkItem(1).Value = vbChecked Then
        If txtsname = "" Then
            MsgBox "请输入要查询的记录", vbInformation
            Exit Sub
        End If
        If Trim(sQSql) = "" Then
            sQSql = " sname like '%" & Trim(txtsname) & "%'"
        Else
            sQSql = sQSql & " AND sname like '%" & Trim(txtsname) & "%'"
        End If
     End If

    If chkItem(2).Value = vbChecked Then
        If txtaddress = "" Then
            MsgBox "请输入要查询的记录", vbInformation
            Exit Sub
        End If
        If Trim(sQSql) = "" Then
            sQSql = " address like '%" & Trim(txtaddress) & "%'"
        Else
            sQSql = sQSql & " and address like '%" & Trim(txtaddress) & "%'"
        End If
   End If

    If chkItem(3).Value = vbChecked Then
        If Trim(sQSql) = "" Then
            sQSql = "birth" & "='" & Format(CDate(cboyear1 & "-" & cbomonth1 & "-" & cboday1), "yyyy-mm-dd") & "' "
        Else
            sQSql = sQSql & " and birth" & "='" & Format(CDate(cboyear1 & "-" & cbomonth1 & "-" & cboday1), "yyyy-mm-dd") & "'"
        End If
    End If

    If chkItem(4).Value = vbChecked And txtm <> "" Then
        If txtm = "" Then
            MsgBox "请输入要查询的记录", vbInformation
            Exit Sub
        End If
        If Trim(sQSql) = "" Then
            sQSql = " address like '%" & Trim(txtm) & "%'"
        Else
            sQSql = sQSql & " and address like '%" & Trim(txtm) & "%'"
        End If
    End If

    strQuery2 = strQuery2 & sQSql
    rs.Open strQuery2, con, adOpenForwardOnly, adLockReadOnly
    Set DataGrid2.DataSource = Nothing
    If Not (rs.EOF And rs.BOF) Then
        rs.MoveFirst
        rs.MoveLast
    End If
    If rs.RecordCount > 0 Then
        Set DataGrid2.DataSource = rs
        MsgBox "总共查到" & rs.RecordCount & "记录", vbInformation
    Else
        MsgBox "没有找到记录,请重新输入查询数据", vbInformation
    End If
End Sub

Private Sub Combo2_Click()
    Select Case Combo2.ListIndex
        Case 0
            strField = "sno"
        Case 1
            strField = "sname"
        Case 2
            strField = "address"
        Case 3
            strField = "m"
        Case 4
            strField = "birth"
    End Select
End Sub

Private Sub DataGrid1_SelChange(Cancel As Integer)
sel_info = DataGrid1.Columns(0).CellValue(DataGrid1.Bookmark)
End Sub

Private Sub Form_Load()
    Me.Left = (MDIForm1.ScaleWidth - Me.Width) / 2
    Me.Top = (MDIForm1.ScaleHeight - Me.Height) / 2

    '添加有关查询信息
    Combo2.AddItem "学号"
    Combo2.AddItem "姓名"
    Combo2.AddItem "家庭地址"
    Combo2.AddItem "备注"
    Combo2.AddItem "出生年月"

    Combo1.AddItem "男"
    Combo1.AddItem "女"
    Dim j As Integer

    For j = 1970 To 2010
        cboyear.AddItem j   '增加记录
        cboyear1.AddItem j '查询记录
    Next j
 
    cboyear.Text = Year(Now())
    cboyear1.Text = Year(Now())
    For j = 1 To 12
        cbomonth.AddItem j
        cbomonth1.AddItem j
    Next j
    cbomonth.Text = Month(Now())
    cbomonth1.Text = Month(Now())
 
    For j = 1 To 31
        cboDay.AddItem j
        cboday1.AddItem j
    Next j
    cboDay.Text = Day(Now())
    cboday1.Text = Day(Now())
        
    Adodc1.ConnectionString = ConnectionString
    Adodc1.CommandType = adCmdText
    Adodc1.CursorLocation = adUseClient
    Refresh_data '调用过程执行操作
  
End Sub

Private Sub cmdadd_Click()
    Call AddRecord
End Sub
Private Sub cmdCancel_Click()
    Call CancelEdit
End Sub
Private Sub cmdSave_Click()
    Call SaveEdit
End Sub

Private Sub Command1_Click()
    Call AddRecord
End Sub

Private Sub Command3_Click()
    Call EditRecord
End Sub
Private Sub Command4_Click()
On Error GoTo error_proc
If sel_info = "" Then
 MsgBox "请选择要删除的记录!", vbOKOnly + vbExclamation, "警告"
 Exit Sub
End If

Dim answer As String
answer = MsgBox("确定要删除吗?", vbYesNo, "")
If answer = vbYes Then
'-- Create ADODB Command Object
   Dim objCmd As New ADODB.Command

   '-- Set properties of Command Object
   With objCmd
       .ActiveConnection = con.ConnectionString
       .CommandText = "sp_Delete_stuinfo"
       .CommandType = adCmdStoredProc

       '-- Create ADODB Command Parameters
       .Parameters.Append objCmd.CreateParameter("@RETURN_VALUE", adInteger, adParamReturnValue)
       .Parameters.Append objCmd.CreateParameter("@sno", adChar, adParamInput, 50)

       '-- Set Parameter Values
       .Parameters("@sno") = Trim(sel_info)
   End With

   '-- Run the stored procedure
   Dim objRS As Recordset
   Set objRS = objCmd.Execute
   MsgBox "删除成功!", vbOKOnly, ""
If objCmd.State = adStateOpen Then objRS.Close
   Set objRS = Nothing
   Set objCmd = Nothing
   DataGrid1.Refresh
Else
 sel_info = ""
 Exit Sub
End If
 
 On Error GoTo delerror
delerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
   End If

error_proc:
 If Err.Number = -2147467259 Then
      MsgBox "请先从choice表删除该同学的选课记录，然后再删除该同学记录", vbExclamation, "出错"
 Else
    MsgBox "无法删除数据,错误:" & Err.Description, vbExclamation, "出错"
 End If
End Sub
Private Sub DataGrid1_DblClick()
    EditRecord
End Sub
Private Sub Image1_Click()
    '如果没有选择学生，则返回
    If Trim(Text1) = "" Then
        MsgBox "请输入学生学号", vbInformation, "注意"
        Exit Sub
    End If
  
    '使用CommonDialog控件读取图像文件
    CommonDialog1.Filter = "JPEG文件(*.jpg)|*.jpg|BMP文件(*.bmp)|*.bmp|GIF文件(*.gif)|*.gif"
    CommonDialog1.ShowOpen
    DiskFile = CommonDialog1.FileName
    If DiskFile = "" Then
        MsgBox "请选择照片文件", vbInformation, "注意"
        Exit Sub
    End If
    Image1.Picture = LoadPicture(DiskFile)
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
    If PreviousTab = 1 And cmdAdd.Enabled = False Then
        SSTab1.Tab = 1
    End If
End Sub

Private Sub Text4_LostFocus()
    Dim hold As Variant
    hold = Text4.Text
    If IsDate(hold) = False Then
        Text4.Text = ""
        MsgBox "输入数据要求日期格式", vbInformation, "注意"
        Text4.SetFocus
        Exit Sub
    Else
        Text4.Text = Format(hold, "yyyy/mm/dd")
    End If
End Sub
Private Sub txtcontent_LostFocus()
    If strField = "birth" Then
        Dim hold As Variant
        hold = txtcontent.Text
        If IsDate(hold) = False Then
            txtcontent.Text = ""
            MsgBox "输入数据要求日期格式", vbInformation, "注意"
            txtcontent.SetFocus
            Exit Sub
        Else
            txtcontent.Text = Format(hold, "yyyy/mm/dd")
        End If
    End If
End Sub
Private Sub AddRecord()
    SSTab1.Tab = 1
    Enable_proc
    cmdCancel.Enabled = True
    cmdSave.Enabled = True
    cmdAdd.Enabled = False
    ShowClear
    Text1.SetFocus
    Text4.Text = Date
    SaveUpdate_flag = True
    
End Sub
Private Sub EditRecord()
    SSTab1.Tab = 1
    Enable_proc
    cmdCancel.Enabled = True
    cmdSave.Enabled = True
    cmdAdd.Enabled = False
    RefreshAllText
    'Text1.SetFocus
    SaveUpdate_flag = False
End Sub
Private Sub SaveEdit()
    Dim str1 As String
    Dim str2 As String
    Dim RsTemp As New ADODB.Recordset
    Dim rs As New ADODB.Recordset
    Set cmd.ActiveConnection = con
    cmd.CommandType = adCmdText
    If Text1.Text = Empty Then
        MsgBox "该字段不能为空，请输入！", vbExclamation, "注意"
        Text1.SetFocus
        Exit Sub
    End If
    If Text2.Text = Empty Then
        MsgBox "该字段不能为空，请输入！", vbExclamation, "注意"
        Text2.SetFocus
        Exit Sub
    End If
    If Combo1.Text = Empty Then
        MsgBox "该字段不能为空，请输入！", vbExclamation, "注意"
        Combo1.SetFocus
        Exit Sub
    End If

    If Len(masktel.ClipText) < 11 Then
        MsgBox "请输入正确的电话号码！", vbExclamation, "注意"
        masktel.SetFocus
        Exit Sub
    Else
        Text5 = masktel.Text
    End If
   
    If Text6.Text = Empty Then
        MsgBox "该字段不能为空，请输入！", vbExclamation, "注意"
        Text6.SetFocus
        Exit Sub
    End If
    Text4.Text = Format(CDate(cboyear & "-" & cbomonth & "-" & cboDay), "yyyy-mm-dd")
    If IsDate(Trim(Text4.Text)) = False Then
        MsgBox "该字段为日期格式数据，请核对！", vbExclamation, "注意"
        Text4.SetFocus
        Exit Sub
    End If
    '进行唯一性检验
    '修改时不进行有效性检验，但insert即要！
    If SaveUpdate_flag = True Then
        str2 = "SELECT * FROM studentinfo WHERE sno='" & Trim(Text1.Text) & "';"
        RsTemp.Open str2, con, adOpenStatic, adLockPessimistic, adCmdText
        If RsTemp.EOF = False Then
            MsgBox "学号唯一，请重新输入！", vbExclamation, "注意"
            Text1.Text = Empty
            Text1.SetFocus
            RsTemp.Close
            Exit Sub
        End If
        RsTemp.Close
    End If
    RichTextBox1.Text = RichTextBox1.Text & " " '防止空字符，出错

On Error GoTo error_process

    rs.Open "SELECT * FROM studentinfo", con, adOpenDynamic, adLockOptimistic, adCmdText
    If SaveUpdate_flag = True Then rs.AddNew
    rs.Fields(0) = Text1.Text
    rs.Fields(1) = Text2.Text
    rs.Fields(2) = Combo1.Text
    rs.Fields(3) = Text4.Text
    rs.Fields(4) = Text5.Text
    rs.Fields(5) = Text6.Text
    rs.Fields(6) = RichTextBox1.Text
    Call SaveImage(DiskFile, rs)
    rs.Update
    rs.Close
  
    SaveUpdate_flag = False
    Disable_proc
    cmdSave.Enabled = False   '保存完后，记录更新（修改、添加、删除）重新来过
    cmdCancel.Enabled = False
    cmdAdd.Enabled = True
    Call Refresh_data
    
    Exit Sub
error_process:
    MsgBox "更新数据库错误:" & Err.Description & Err.Number
End Sub
Private Sub CancelEdit()
    RefreshAllText
    SaveUpdate_flag = False
    Disable_proc
    cmdCancel.Enabled = False
    cmdSave.Enabled = False
    cmdAdd.Enabled = True
End Sub
Private Sub RefreshAllText()
    With student_frm
        .Text1 = Adodc1.Recordset.Fields(0).Value
        .Text2 = Adodc1.Recordset.Fields(1).Value
        .Combo1 = Adodc1.Recordset.Fields(2).Value
        .Text4 = Adodc1.Recordset.Fields(3).Value
        .masktel.Text = Adodc1.Recordset.Fields(4).Value
        .Text6 = Adodc1.Recordset.Fields(5).Value
        .RichTextBox1 = Adodc1.Recordset.Fields(6).Value
        .Text1.Enabled = False
    End With
    'Debug.Print Adodc1.Recordset.Fields(7).ActualSize
    Call ShowImage(student_frm.Image1, Adodc1)    '显示图片
    
    '保存当前的记录位置
    Pos = Adodc1.Recordset.AbsolutePosition

End Sub