frmstudentupdate.frm

适用一般于毕业设计！ VB代码源加SQL 数据库 ··

         BackStyle       =   0  'Transparent
         Caption         =   "籍贯"
         Height          =   180
         Left            =   360
         TabIndex        =   25
         Top             =   1680
         Width           =   360
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFC0C0&
         BackStyle       =   0  'Transparent
         Caption         =   "性别"
         Height          =   180
         Left            =   360
         TabIndex        =   24
         Top             =   840
         Width           =   360
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFC0C0&
         BackStyle       =   0  'Transparent
         Caption         =   "政治面貌"
         Height          =   180
         Left            =   3480
         TabIndex        =   23
         Top             =   1260
         Width           =   720
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFC0C0&
         BackStyle       =   0  'Transparent
         Caption         =   "出生日期"
         Height          =   180
         Left            =   3480
         TabIndex        =   22
         Top             =   840
         Width           =   720
      End
      Begin VB.Label Label13 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFC0C0&
         BackStyle       =   0  'Transparent
         Caption         =   "家庭地址"
         Height          =   180
         Left            =   360
         TabIndex        =   21
         Top             =   3360
         Width           =   720
      End
      Begin VB.Label Label16 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFC0C0&
         BackStyle       =   0  'Transparent
         Caption         =   "备注"
         Height          =   180
         Left            =   360
         TabIndex        =   20
         Top             =   4200
         Width           =   360
      End
      Begin VB.Label Label9 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFC0C0&
         BackStyle       =   0  'Transparent
         Caption         =   "宿舍号"
         Height          =   180
         Left            =   360
         TabIndex        =   19
         Top             =   2100
         Width           =   540
      End
   End
End
Attribute VB_Name = "FrmStudentUpdate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Update_Data(Rs As ADODB.Recordset, _
ClassID As String, ByVal mFlag As Integer)
  '参数Rs：学生基本信息记录集
  '参数ClassID：学生所在班级内码
  '参数mFlag：插入/修改标志，0-新增；1-修改
  If mFlag = 0 Then
    Rs.AddNew                   '新增记录
    Rs!StuID = GetRndCode                             '生成新的学生内码
    Rs!ClassID = ClassID                              '所在班级内码
  End If
  '数据：控件->记录集
  Rs!StuNo = txtStuNo.Text                            '学号
  Rs!StuName = txtStuName.Text                        '姓名
  Rs!Sex = CboSex.Text                                '性别
  If IsDate(DtBirth.Value) Then                         '生日
    Rs!Birth = Format(DtBirth.Value, "yyyy-mm-dd")
  Else
    Rs!Birth = Null
  End If
  Rs!Nationality = txtNationality.Text                  '民族
  Rs!Family_Place = txtFamily_Place.Text                '籍贯
  Rs!Political_Party = txtPolitical_Party.Text            '政治面貌
  Rs!DormRoom = txtDormRoom.Text                    '宿舍号
  Rs!DormRoom_phone = txtDormRoomPhone.Text         '宿舍电话
  Rs!Mobile = txtMobile.Text                          '移动电话
  Rs!Family_Phone = txtFamilyPhone.Text               '家庭电话
  Rs!Address = txtAddress.Text                        '家庭地址
  Rs!PostCard = txtPostCard.Text                        '邮政编码
  Rs!Id_Card = txtId_Card.Text                        '身份证号
  Rs!Duty = txtDuty.Text                              '担任职务
  Rs!Memo = txtMemo.Text                              '备注
  Rs.Update                     '更新记录集
End Sub

Private Sub Form_Load()
  Dim i As Integer
  Dim sStuID As String
  Dim strSql As String
  Dim Rs As New ADODB.Recordset

  '初始化性别组合框控件
  CboSex.Clear
  CboSex.AddItem "男", 0
  CboSex.AddItem "女", 1
    
  If ModifyFlag = 0 Then    '添加学生信息，需要清空各控件中的内容
    txtStuNo.Text = ""
    txtStuName.Text = ""
    CboSex.ListIndex = 0
    DtBirth.Value = Null
    txtNationality.Text = ""
    txtFamily_Place.Text = ""
    txtPolitical_Party.Text = ""
    txtDormRoom.Text = ""
    txtDormRoomPhone.Text = ""
    txtMobile.Text = ""
    txtFamilyPhone.Text = ""
    txtAddress.Text = ""
    txtPostCard.Text = ""
    txtId_Card.Text = ""
    txtDuty.Text = ""
    txtMemo.Text = ""
  Else                    '修改记录，在控件中填充内容
    '获取当前学生的内码
    sStuID = Right(FrmStudent.ListView1.SelectedItem.Key, _
              Len(FrmStudent.ListView1.SelectedItem.Key) - 1)
    '查询该学生的基本信息
    strSql = "SELECT * FROM students WHERE StuId='" & sStuID & "'"
    Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
    txtStuNo.Text = IIf(IsNull(Rs!StuNo), "", Rs!StuNo)
    txtStuName.Text = IIf(IsNull(Rs!StuName), "", Rs!StuName)
    For i = 0 To CboSex.ListCount - 1
      If CboSex.List(i) = IIf(IsNull(Rs!Sex), "", Rs!Sex) Then
        CboSex.ListIndex = i
        Exit For
      End If
    Next i
    DtBirth.Value = IIf(IsDate(Rs!Birth), Rs!Birth, Null)
    txtNationality.Text = IIf(IsNull(Rs!Nationality), "", Rs!Nationality)
    txtFamily_Place.Text = IIf(IsNull(Rs!Family_Place), "", Rs!Family_Place)
    txtPolitical_Party.Text = IIf(IsNull(Rs!Political_Party), "", Rs!Political_Party)
    txtDormRoom.Text = IIf(IsNull(Rs!DormRoom), "", Rs!DormRoom)
    txtDormRoomPhone.Text = IIf(IsNull(Rs!DormRoom_phone), "", Rs!DormRoom_phone)
    txtMobile.Text = IIf(IsNull(Rs!Mobile), "", Rs!Mobile)
    txtFamilyPhone.Text = IIf(IsNull(Rs!Family_Phone), "", Rs!Family_Phone)
    txtAddress.Text = IIf(IsNull(Rs!Address), "", Rs!Address)
    txtPostCard.Text = IIf(IsNull(Rs!PostCard), "", Rs!PostCard)
    txtId_Card.Text = IIf(IsNull(Rs!Id_Card), "", Rs!Id_Card)
    txtDuty.Text = IIf(IsNull(Rs!Duty), "", Rs!Duty)
    txtMemo.Text = IIf(IsNull(Rs!Memo), "", Rs!Memo)
    Rs.Close
    Set Rs = Nothing
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set FrmStudentUpdate = Nothing
End Sub

'添加/修改记录
Private Sub cmdOk_Click()
  On Error GoTo ErrorHandle
  Dim sStuID As String
  Dim sClassID As String
  Dim strSql As String
  Dim Rs As New ADODB.Recordset
  Dim itmX As ListItem
  Dim Tmp_Key As String

  '学号、姓名不得为空
  If Trim(txtStuNo.Text) = "" Then
    MsgBox "请输入学号", vbExclamation + vbOKOnly, "操作提示"
    txtStuNo.SetFocus
    Exit Sub
  End If
  
  If Trim(txtStuName.Text) = "" Then
    MsgBox "请输入姓名", vbExclamation + vbOKOnly, "操作提示"
    txtStuName.SetFocus
    Exit Sub
  End If

  '获取当前班级内码
  sClassID = Right(FrmStudent.TreeView1.SelectedItem.Key, _
                  Len(FrmStudent.TreeView1.SelectedItem.Key) - 1)
  If ModifyFlag = 0 Then        '添加记录
    '判断学号是否重复（新增学生的学号应该与现有学生的学号不重复）
    strSql = "select count(*) as s_count from students " & _
             "where StuNo='" & txtStuNo.Text & "'"
    Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
    If Rs!s_count > 0 Then      '学号已经存在，要求重新输入
      MsgBox "学号 " & txtStuNo.Text & " 已经存在", _
              vbExclamation + vbOKOnly, "操作提示"
      txtStuNo.SetFocus
      Rs.Close
      Set Rs = Nothing
      Exit Sub
    End If

    '如果Rs对象已打开，则先关闭
    If Rs.State = adStateOpen Then Rs.Close
    '学号不重复，正式添加记录，打开学生信息记录集（空记录集）
    strSql = "SELECT top 0 * FROM students"
    Rs.Open strSql, Conn, adOpenStatic, adLockOptimistic
    '调用Update_Data过程，添加学生记录
    Call Update_Data(Rs, sClassID, ModifyFlag)
    sStuID = Rs!StuID     '获取所添加学生的内码
    
    '添加该学生信息到frmStudent窗体中ListView控件上，并使该学生处于选中状态
    Tmp_Key = "b" & sStuID  '生成ListView节点关键字，格式：字母"b"+学生内码
    '加入学号
    Set itmX = FrmStudent.ListView1.ListItems.Add(, Tmp_Key, txtStuNo.Text)
    itmX.SubItems(1) = txtStuName.Text    '加入姓名
    itmX.Selected = True          '选中所添加的项
  Else                            '修改记录
    '如果修改了学号，则需判断学号是否重复（未改学号，则不必判断）
    If UCase(txtStuNo.Text) <> UCase(FrmStudent.Lbl_StuNo.Caption) Then
      strSql = "select count(*) as s_count from students " & _
               "where StuNo='" & txtStuNo.Text & "'"
      Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
      If Rs!s_count > 0 Then    '学号已经存在，要求重新输入
        MsgBox "学号 " & txtStuNo.Text & " 已经存在", _
                vbExclamation + vbOKOnly, "操作提示"
        txtStuNo.SetFocus
        Rs.Close
        Set Rs = Nothing
        Exit Sub
      End If
    End If
  
    '正式修改记录
    '获取修改学生的内码
    sStuID = Right(FrmStudent.ListView1.SelectedItem.Key, _
              Len(FrmStudent.ListView1.SelectedItem.Key) - 1)
    '如果Rs对象已打开，则先关闭
    If Rs.State = adStateOpen Then Rs.Close
    '查询获取要修改学生的记录集（仅一条记录）
    strSql = "SELECT * FROM students WHERE StuId='" & sStuID & "'"
    Rs.Open strSql, Conn, adOpenStatic, adLockOptimistic
    If Not Rs.EOF Then
      '调用Update_Data过程，修改学生记录
      Call Update_Data(Rs, sClassID, ModifyFlag)
    End If
    
    '修改该学生在frmStudent窗体中ListView控件上的显示信息
    FrmStudent.ListView1.SelectedItem.Text = txtStuNo.Text        '学号
    FrmStudent.ListView1.SelectedItem.SubItems(1) = txtStuName.Text   '姓名
  End If
  Rs.Close
  Set Rs = Nothing

  '根据学生内码显示其基本明细（刷新显示）
  Call FrmStudent.ShowStuDetail(sStuID)

  Unload Me     '关闭学生信息编辑窗体
  
  On Error GoTo 0
  Exit Sub
  
ErrorHandle:
  MsgBox Error(Err.Number), vbExclamation + vbOKOnly, "操作提示"
End Sub

Private Sub cmdCancel_Click()
  Unload Me
End Sub