frminfomanage.frm

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

         Left            =   -74640
         TabIndex        =   38
         Top             =   2160
         Width           =   735
      End
      Begin VB.Label lblDate 
         Caption         =   "出生日期："
         Height          =   255
         Left            =   -74760
         TabIndex        =   37
         Top             =   3960
         Width           =   1095
      End
      Begin VB.Label lblNativePlace 
         Caption         =   "籍贯："
         Height          =   255
         Left            =   -74760
         TabIndex        =   36
         Top             =   4560
         Width           =   975
      End
      Begin VB.Label lblIDCard 
         Caption         =   "身份证号："
         Height          =   375
         Left            =   -74760
         TabIndex        =   35
         Top             =   1440
         Width           =   975
      End
      Begin VB.Label lblSchool 
         Caption         =   "所属学校："
         Height          =   255
         Left            =   -71160
         TabIndex        =   34
         Top             =   840
         Width           =   975
      End
      Begin VB.Label lblAcademy 
         Caption         =   "所属学院："
         Height          =   255
         Left            =   -71160
         TabIndex        =   33
         Top             =   1440
         Width           =   975
      End
      Begin VB.Label lblSpecialty 
         Caption         =   "所属系别："
         Height          =   255
         Left            =   -71160
         TabIndex        =   32
         Top             =   2040
         Width           =   1095
      End
      Begin VB.Label lblGrade 
         Caption         =   "所属年级："
         Height          =   255
         Left            =   -71160
         TabIndex        =   31
         Top             =   2640
         Width           =   975
      End
      Begin VB.Label lblClass 
         Caption         =   "所属班级："
         Height          =   255
         Left            =   -71160
         TabIndex        =   30
         Top             =   3240
         Width           =   1095
      End
      Begin VB.Label lblSort 
         Caption         =   "学生类别："
         Height          =   255
         Left            =   -71160
         TabIndex        =   29
         Top             =   3960
         Width           =   975
      End
   End
   Begin MSComDlg.CommonDialog dlgOpen 
      Left            =   600
      Top             =   6840
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
End
Attribute VB_Name = "frmInfoInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'定义模块级别的记录集对象变量
Dim rsBaseInfo As ADODB.Recordset
Dim rsAddInfo As ADODB.Recordset
Dim rsStudInfo As ADODB.Recordset

'定义书签变量，在数据库记录跳转的时候，用以回复
Dim BaseBookMark As Variant
Dim AddBookMark As Variant
Dim InfoBookMark As Variant

'定义字符串常量，用来存放最初的查询数据库的SQL语句
Const strBaseSql = "select * from uStudBaseInfo"
Const strAddsql = "select * from uStudInfoAdd"
Const strStudInfo = "select * from v_StudInfo"

Dim strPath As String   '图片的路径
Dim blnFind As Boolean '判断是否可以执行查询，添加状态不可以执行查询

'设置控件的Enabled属性
'利用参数，设置用来输入的控件的Enabled属性
'其中，学号的输入框永远可用，因为还需要利用学号来进行
'记录的查询定位
Public Sub ChangeEnable(blnState As Boolean)
    Dim strCboText As String
    strCboText = Trim$(cboKind.Text)
    
    txtNumber.Enabled = True 'blnState
    txtIDCard.Enabled = blnState
    txtName.Enabled = blnState
    
    radioMale.Enabled = blnState
    radioFemale.Enabled = blnState
    
    mskEdDate.Enabled = blnState
    txtSchool.Enabled = blnState
    txtAcademy.Enabled = blnState
    txtSpecialty.Enabled = blnState
    txtGrade.Enabled = blnState
    txtClass.Enabled = blnState
    cboKind.Enabled = blnState
    
    cboKind.Text = strCboText
    
    txtNativePlace.Enabled = blnState
    cmdLoadImage.Enabled = blnState
End Sub

'将数据窗体控件内容清零
'该过程主要在开始添加的时候使用，将所有的输入框内容清空
Public Sub ClearData()
    Dim strMask As String '用来存放MaskEdBox的Mask属性文本
    txtNumber.Text = vbNullString
    txtIDCard.Text = vbNullString
    txtName.Text = vbNullString
    
    radioMale = False
    radioFemale = False

    '对MaskEdBox进行清空，需要三个步骤
    '先清楚Mask属性，再清空文本Text，然后再设置
    '为原先的Mask属性
    '利用程序代码取得Mask属性比后面直接用手工输入要安全
    strMask = mskEdDate.Mask
    mskEdDate.Mask = vbNullString
    mskEdDate.Text = vbNullString
    mskEdDate.Mask = strMask '"##/##/####"
    
    txtSchool.Text = vbNullString
    txtAcademy.Text = vbNullString
    txtSpecialty.Text = vbNullString
    txtGrade.Text = vbNullString
    txtClass.Text = vbNullString
    cboKind.Text = vbNullString
    txtNativePlace.Text = vbNullString
    '清空图片框控件中的图片
    picPhoto.Picture = LoadPicture("")
    
    txtNumber.SetFocus
End Sub

Public Sub ShowData(ByVal rsBase As ADODB.Recordset, ByVal rsAdd As ADODB.Recordset)
'功    能：显示数据库记录到窗体控件上
'参    数：
'     输入：rsBase            ADODB.Recordset     基本信息库记录集
'           rsAdd             ADODB.Recordset     附加信息库记录集
    If Not (rsBase.EOF And rsBase.BOF) Then
        txtNumber.Text = rsBase("学号")
        txtIDCard.Text = rsBase("身份证号")
        txtName.Text = rsBase("姓名")
        
        If Trim$(rsBase("性别")) = "男" Then
            radioMale = True
        Else
            radioFemale = True
        End If
        
        mskEdDate.Text = rsBase("出生日期")
        txtSchool.Text = rsBase("所属学校")
        
        '利用IIF语句来判断，如果数据库的有Null记录，则用空字符串代替
        txtAcademy.Text = IIf(IsNull(rsBase("所属学院")), _
            vbNullString, rsBase("所属学院"))
        txtSpecialty.Text = IIf(IsNull(rsBase("所属系别")), _
            vbNullString, rsBase("所属系别"))
        txtGrade.Text = IIf(IsNull(rsBase("所属年级")), _
            vbNullString, rsBase("所属年级"))
            
        txtClass.Text = rsBase("所属班级")
        cboKind.Text = Trim$(rsBase("学生类别"))
        txtNativePlace.Text = rsBase("籍贯")
        
        '为图片框控件设置数据源
        Set picPhoto.DataSource = rsAdd
        picPhoto.DataField = "照片"
        
    End If
End Sub

Private Sub cmdAddData_Click()
    On Error GoTo err
    
    '利用RecordSet的AddNew方法，为数据库增加一个空记录
    rsBaseInfo.AddNew
    rsAddInfo.AddNew
    
    '将录入的数据信息分别写入该新记录中去
    rsBaseInfo("学号") = Trim$(txtNumber.Text)
    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 cmdCancelOperate_Click()
    On Error GoTo err
    rsBaseInfo.CancelUpdate
    rsAddInfo.CancelUpdate
    Exit Sub
err:
    Exit Sub
End Sub

Private Sub cmdChangeData_Click()
    '如果需要修改某条记录，那么就回到录入界面
    sstabInfo.Tab = 0
End Sub

Private Sub cmdDeleteData_Click()
    Dim iMsg As Integer
    On Error GoTo err
    
    '如果记录集非空，则可以删除记录
    If Not (rsBaseInfo.BOF And rsBaseInfo.EOF) Then
        '确认是否删除记录
        iMsg = MsgBox("确实要删除该记录吗?", vbYesNo)
        If iMsg = vbYes Then
            '可以删除，则正式向数据库中删除记录
            rsBaseInfo.Delete 'adAffectCurrent
            rsAddInfo.Delete 'adAffectCurrent
            
            rsBaseInfo.Update
            rsAddInfo.Update
            
            '下面的语句很重要，用来刷新记录集
            '使得数据能够正确的显示
            rsBaseInfo.Requery
            rsAddInfo.Requery
        Else
            Exit Sub
        End If
        
        If rsBaseInfo.EOF Then
            MsgBox "已到记录尾部！"
            rsBaseInfo.MoveLast
            rsAddInfo.MoveLast
        End If
        '显示数据
        Call ShowData(rsBaseInfo, rsAddInfo)
    End If
    Exit Sub
err:
    MsgBox err.Number & " " & err.Description
End Sub

Private Sub cmdEndChange_Click()
    '设置录入控件为不可用
    Call ChangeEnable(False)
    
    '开启利用"学号"文本框进行查询的功能
    blnFind = True
End Sub

Private Sub cmdFirst_Click()
    rsBaseInfo.MoveFirst
    rsAddInfo.MoveFirst
    
    BaseBookMark = rsBaseInfo.Bookmark
    AddBookMark = rsAddInfo.Bookmark
    Call ShowData(rsBaseInfo, rsAddInfo)
End Sub

Private Sub cmdLast_Click()
    rsBaseInfo.MoveLast
    rsAddInfo.MoveLast
    BaseBookMark = rsBaseInfo.Bookmark
    AddBookMark = rsAddInfo.Bookmark
    Call ShowData(rsBaseInfo, rsAddInfo)
End Sub

Private Sub cmdLoadImage_Click()
    With dlgOpen
        '为COmmonDIalog控件设置文件过滤文本
        '注意其格式
        .Filter = "Bmp(*.bmp)|*.bmp|All Image|*.bmp;*.jpg;*.gif|All(*.*)|*.*"
        
        '以打开的方式显示对话框
        .ShowOpen
        '获取选中的文件的完整路径
        strPath = .FileName
    End With
    
    '将picPhoto的Picture属性设置为该图片
    picPhoto.Picture = LoadPicture(strPath)
End Sub

Private Sub cmdModifyData_Click()
    On Error GoTo err
    
    '将录入的数据信息分别写入当前记录中去
    rsBaseInfo("学号") = Trim$(txtNumber.Text)