frminfomanage.frm

一个功能强大、程序条理分明的学生学籍管理系统

    rsBaseInfo("身份证号") = Trim$(txtIDCard.Text)
    rsBaseInfo("姓名") = Trim$(txtName.Text)
    
     '处理选择性别的单选按钮
    If radioMale = True Then
        rsBaseInfo("性别") = Trim$(radioMale.Caption)
    Else
        rsBaseInfo("性别") = Trim$(radioFemale.Caption)
    End If
    
    '将出生日期转换为日期格式存入数据库
    rsBaseInfo("出生日期") = CDate(mskEdDate.Text)
    rsBaseInfo("所属学校") = Trim$(txtSchool.Text)
    rsBaseInfo("所属学院") = Trim$(txtAcademy.Text)
    rsBaseInfo("所属系别") = Trim$(txtSpecialty.Text)
    rsBaseInfo("所属年级") = Trim$(txtGrade.Text)
    rsBaseInfo("所属班级") = Trim$(txtClass.Text)
    rsBaseInfo("学生类别") = Trim$(cboKind.Text)
    rsBaseInfo("籍贯") = Trim$(txtNativePlace.Text)
    
    '写入附加信息数据库表
    rsAddInfo("学号") = Trim$(txtNumber.Text)
     '如果有图片文件存在，则将其添加到数据库中去
    '此处调用了StartModule中声明的过程来完成存储图片到数据库的功能
    If strPath <> vbNullString Then
        Call newSaveToDB(rsAddInfo("照片"), strPath)
    End If
    
    '执行更新操作，将录入的信息正式写入数据库
    rsBaseInfo.Update
    rsAddInfo.Update
    Exit Sub
    
err:
    '产生错误，则取消添加数据的操作
    MsgBox err.Number & " " & err.Description
    rsBaseInfo.CancelUpdate
    rsAddInfo.CancelUpdate
End Sub

Private Sub cmdNext_Click()
    On Error GoTo err
    If Not rsBaseInfo.EOF Then
        rsBaseInfo.MoveNext
        rsAddInfo.MoveNext
        '记录指针移动后再次判断是否到了记录结尾
        If Not rsBaseInfo.EOF Then
            BaseBookMark = rsBaseInfo.Bookmark
            AddBookMark = rsAddInfo.Bookmark
        Else
            MsgBox "已到记录尾部！"
            rsBaseInfo.MoveLast
            rsAddInfo.MoveLast
        End If
        Call ShowData(rsBaseInfo, rsAddInfo)
    Else
        MsgBox "已到记录尾部！"
    End If
    Exit Sub
err:
    MsgBox err.Number & " " & err.Description
    rsBaseInfo.MoveLast
    rsAddInfo.MoveLast
End Sub

Private Sub cmdPrevious_Click()
    On Error GoTo err:
    If Not rsBaseInfo.BOF Then
        rsBaseInfo.MovePrevious
        rsAddInfo.MovePrevious
        
        '移动后再次判断是否已经到了记录的首部
        If Not rsBaseInfo.BOF Then
            BaseBookMark = rsBaseInfo.Bookmark
            AddBookMark = rsAddInfo.Bookmark
        Else
            MsgBox "已到记录首部！"
            rsBaseInfo.MoveFirst
            rsAddInfo.MoveFirst
        End If
        Call ShowData(rsBaseInfo, rsAddInfo)
    Else
        MsgBox "已到记录首部！"
    End If
    Exit Sub
err:
    MsgBox err.Number & " " & err.Description
    rsBaseInfo.MoveFirst
    rsAddInfo.MoveFirst
End Sub

Private Sub cmdSaveImage_Click()
    txtNumber.Text = rsAddInfo("学号")
    With dlgOpen
        .Filter = "Bmp(*.bmp)|*.bmp|All Image|*.bmp;*.jpg;*.gif|All(*.*)|*.*"
        '以保存的方式使用CommonDialog对话框
        .ShowSave
        
        '填写在对话框中文件名文本框里的文件名与其他信息组成了完整的文件名
        '将这个完整文件路径名赋值给strPath
        strPath = .FileName
    End With
    
    If Not (rsAddInfo("照片") Is Nothing) Then
        '调用在StarModule里的将图片从数据库中读出的函数，
        '将图片按strPath变量指定的路径存放
        Call newGetFromDB(rsAddInfo("照片"), strPath)
        
        '存储图片到磁盘上后，从磁盘上显示该图片
        picPhoto.Picture = LoadPicture(strPath)
    End If
End Sub

Private Sub cmdStarAdd_Click()
    '设置录入控件可用
    '清空录入控件中的内容
    Call ChangeEnable(True)
    Call ClearData
    
    '设置“完成添加”按钮可用
    cmdAddData.Enabled = True
    '设置“完成修改按钮不可用”
    cmdModifyData.Enabled = False
    '停止利用“学号”文本框进行查询的功能
    blnFind = False
End Sub

Private Sub cmdStarModify_Click()
    '设置录入控件可用
    Call ChangeEnable(True)
    
    '设置“完成添加”按钮不可用
    cmdAddData.Enabled = False
    '设置“完成修改”按钮可用
    cmdModifyData.Enabled = True
    
    '开启利用"学号"文本框进行查询的功能
    blnFind = True
End Sub

Private Sub dgrInfo_Click()
    '功能： 单击DataGrid控件，则将学生附加信息表中的一些信息和图片
    '       显示到窗体上
    Dim strNumber As String
    Dim rsTemAddInfo As ADODB.Recordset
    Dim strFind As String
    
    '利用Find方法进行查询定位
    strNumber = Trim$(rsBaseInfo("学号"))
    strFind = "学号=" & "'" & strNumber & "'"
    
    rsAddInfo.MoveFirst
    rsAddInfo.Find (strFind)
   
    '显示学号、显示数据库中的图片，这其实是一种主从表的方式
    txtAddNumber = Trim$(rsBaseInfo("学号"))
    Set picBrowPhoto.DataSource = rsAddInfo
    picBrowPhoto.DataField = "照片"
    
    BaseBookMark = rsBaseInfo.Bookmark
    AddBookMark = rsAddInfo.Bookmark
End Sub

Private Sub Form_Activate()
    On Error GoTo err
    '当窗体激活的时候，保存当前状态到书签变量
    rsBaseInfo.Bookmark = BaseBookMark
    rsAddInfo.Bookmark = AddBookMark
    
    '重新获取一次记录集
    rsBaseInfo.Requery
    rsAddInfo.Requery
    
    '将数据信息显示到录入窗体
    Call ShowData(rsBaseInfo, rsAddInfo)
    Call ChangeEnable(False)
    Exit Sub
err:
    MsgBox err.Number & " " & err.Description
End Sub

Private Sub Form_Deactivate()
    On Error GoTo err
    '目的是保持当前记录的位置
    '当窗体转为非激活状态的时候
    '记录当前状态
    If rsBaseInfo.EOF Then
        rsBaseInfo.MoveLast
        rsAddInfo.MoveLast
    End If
    If rsAddInfo.BOF Then
        rsBaseInfo.MoveFirst
        rsAddInfo.MoveFirst
    End If
      
    BaseBookMark = rsBaseInfo.Bookmark
    AddBookMark = rsAddInfo.Bookmark
    Exit Sub
err:
    MsgBox err.Number & " " & err.Description
End Sub

Private Sub Form_Initialize()
    On Error GoTo err
    '窗体初始的化的时候，通过调用GetRecordSet函数设置
    '针对存放学生信息的两个表的两个记录集对象
    Set rsBaseInfo = GetRecordSet(strBaseSql)
    Set rsAddInfo = GetRecordSet(strAddsql)
    
    '将记录集的当前状态分别赋值给书签变量
    BaseBookMark = rsBaseInfo.Bookmark
    AddBookMark = rsAddInfo.Bookmark
    Exit Sub
err:
    MsgBox err.Number & " " & err.Description
End Sub

Private Sub Form_Load()
    '初始化cboKind控件，为其添加几项学生类别
    cboKind.Clear
    cboKind.AddItem "本科"
    cboKind.AddItem "硕士研究生"
    cboKind.AddItem "博士研究生"
    cboKind.AddItem "专科"
    cboKind.ListIndex = 0
    
    '调用MDI父窗体的事件，将MDI窗体的子窗体属性加1
    '激活相应的窗体菜单
    frmMainMDI.WindowCreated
    '开始的时候允许利用学号文本框进行查询定位
    blnFind = True
End Sub

Private Sub Form_Resize()
    '定义变量来存放记录窗体以及控件位置、大小的数据
    Dim xWidth As Long, yHeight As Long, _
        frmBtm As Long, frmLft As Long
    
    '防止窗体最小化的时候与下面的代码发生冲突产生错误
    On Error GoTo err
    '信息录入窗体改变大小时候的宽度和高度
    xWidth = frmInfoInput.ScaleWidth
    yHeight = frmInfoInput.ScaleHeight
    
    '为Frame框架的移动准备数据
    frmBtm = frmInfoInput.ScaleHeight - 1.1 * frameMoveData.Height
    frmLft = frmInfoInput.ScaleWidth - 1.05 * frameMoveData.Width
    
    '始终将数据移动的按钮组放于窗体最下方
    frameMoveData.Move frmLft, frmBtm
    
    '设置SSTab控件的高度，使得该控件始终不能与Frame控件有重复部分
    sstabInfo.Height = yHeight - 1.1 * frameMoveData.Height
    '调整SSTab的宽度与窗体的宽度一致
    sstabInfo.Width = xWidth
    
    '调整DataGrid控件的宽度与SStab控件的宽度一致
    dgrInfo.Width = sstabInfo.Width
    
    '确保窗体保持原始大小，当窗体大小改变太多的时候
    '将窗体设置为不可用，重而不能再改变大小
    '然后调整窗体的宽度和高度，再将窗体设置为可用
    If xWidth < 10800 Or yHeight < 8250 Then
        frmInfoInput.Enabled = False
        frmInfoInput.Height = 8250
        frmInfoInput.Width = 10800
    End If
    frmInfoInput.Enabled = True
    Exit Sub
err:
    '如果，MDI父窗体也调整大小，并设置了一次不可用，那么
    '其所有的子窗体将都不可用，此时再调整子窗体的大小时候将
    '产生一个错误，捕获该错误，就能使得子窗体重新处于激活状态
    frmInfoInput.Enabled = True
    Exit Sub
End Sub

Private Sub Form_Terminate()
    '窗体关闭的时候，将记录集所占用的内存资源释放
    rsBaseInfo.Close
    rsAddInfo.Close
    
    Set rsBaseInfo = Nothing
    Set rsAddInfo = Nothing
End Sub

Private Sub Form_Unload(Cancel As Integer)
    frmMainMDI.WindowDestroyed
End Sub

Private Sub mskEdDate_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    End If
End Sub

Private Sub mskEdDate_LostFocus()
    Dim strDate As String
    Dim iSpace As Integer
    strDate = Trim$(mskEdDate.Text)
    iSpace = InStr(strDate, "_")
    If iSpace > 0 Then
        MsgBox "请按照DD/MM/YYYY的格式输入日期！"
        mskEdDate.SetFocus
        Exit Sub
    End If
End Sub

Private Sub sstabInfo_Click(PreviousTab As Integer)
    On Error GoTo err
    
    '根据不同的页面，执行存放当前数据状态信息的功能
    '另外，为“浏览界面”的图片框控件设置数据源。
    If sstabInfo.Tab = 1 Then
        Set dgrInfo.DataSource = rsBaseInfo
        Set picBrowPhoto.DataSource = rsAddInfo
        picBrowPhoto.DataField = "照片"
        txtAddNumber.Text = Trim$(rsAddInfo("学号"))
    End If
    If sstabInfo.Tab = 0 Then
        rsBaseInfo.Bookmark = BaseBookMark
        rsAddInfo.Bookmark = AddBookMark
        Call ShowData(rsBaseInfo, rsAddInfo)
    End If
    Exit Sub
err:
    MsgBox err.Number & " " & err.Description
End Sub

Private Sub txtNumber_KeyPress(KeyAscii As Integer)
    '定位数据的功能，与修改记录配套使用
    Dim strFind As String
    Dim strNum As String
    
    strFind = "学号=" & Trim$(txtNumber.Text)
    '如果开启了查找定位功能，而且按下回车键，那么
    '就开始执行查找功能
    If blnFind = True And KeyAscii = 13 Then
        rsBaseInfo.Find (strFind)
        rsAddInfo.Find (strFind)
        On Error GoTo err
        strNum = Trim$(rsBaseInfo("学号"))
        
        If strNum = vbNullString Then
            Exit Sub
        Else
            ShowData rsBaseInfo, rsAddInfo
        End If
    End If
    Exit Sub
err:
    MsgBox "没有找到该记录！"
End Sub