frmclassupdate.frm

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

VERSION 5.00
Begin VB.Form FrmClassUpdate 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "编辑班级"
   ClientHeight    =   2970
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4695
   Icon            =   "FrmClassUpdate.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2970
   ScaleWidth      =   4695
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   2055
      Left            =   180
      TabIndex        =   3
      Top             =   120
      Width           =   4335
      Begin VB.TextBox txtClass 
         Height          =   375
         Left            =   1500
         TabIndex        =   0
         Text            =   "Class"
         Top             =   1140
         Width           =   2355
      End
      Begin VB.Label lblUpperClass 
         AutoSize        =   -1  'True
         Caption         =   "上级分类名称"
         ForeColor       =   &H00000080&
         Height          =   180
         Left            =   1500
         TabIndex        =   6
         Top             =   540
         Width           =   1080
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "院系/班级："
         Height          =   180
         Left            =   420
         TabIndex        =   5
         Top             =   1260
         Width           =   990
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "上级分类："
         Height          =   180
         Left            =   420
         TabIndex        =   4
         Top             =   540
         Width           =   900
      End
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   400
      Left            =   780
      TabIndex        =   1
      Top             =   2340
      Width           =   1125
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   400
      Left            =   2820
      TabIndex        =   2
      Top             =   2340
      Width           =   1125
   End
End
Attribute VB_Name = "FrmClassUpdate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
  If ModifyFlag = 0 Then      '如果是添加记录
    '当前选择项为其上一级
    lblUpperClass.Caption = FrmClass.TreeView1.SelectedItem.Text
    txtClass.Text = ""
  Else                      '如果是修改记录
    '当前选择项的父项为其上一级
    lblUpperClass.Caption = FrmClass.TreeView1.SelectedItem.Parent.Text
    '当前选择项是要修改的班级或院系
    txtClass.Text = FrmClass.TreeView1.SelectedItem.Text
  End If
End Sub

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

'添加/修改记录
Private Sub cmdOk_Click()
  On Error GoTo ErrorHandle
  Dim sClassID As String      '当前班级或院系的内码
  Dim UpperId As String     '当前班级或院系的上一级内码
  Dim strSql As String
  Dim Rs As New ADODB.Recordset
  Dim Tmp_Key As String     '节点关键字
  Dim TmpNode As Node
  
  '未输入班级或院系名称，要求输入
  If Trim(txtClass.Text) = "" Then
    MsgBox "请输入院系或班级", vbExclamation + vbOKOnly, "操作提示"
    txtClass.SetFocus
    Exit Sub
  End If
  
  If ModifyFlag = 0 Then    '添加记录
    '当添加新记录时，还需判断同一上级是否存在相同名称的班级或院系
    '取上一级内码（即TreeView1中当前选中项的内码）
    UpperId = Right(FrmClass.TreeView1.SelectedItem.Key, _
              Len(FrmClass.TreeView1.SelectedItem.Key) - 1)
    strSql = "select count(*) as s_count from Classes where " & _
             "ClassName='" & txtClass.Text & "' and UpperId='" & UpperId & "'"
    Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
    If Rs!s_count > 0 Then  '同一上级且相同名称的班级或院系存在，要求重新输入
      MsgBox txtClass.Text & " 已经存在", vbExclamation + vbOKOnly, "操作提示"
      txtClass.SetFocus
      Rs.Close
      Set Rs = Nothing
      Exit Sub
    End If
    
    '如果Rs对象已打开，则先关闭
    If Rs.State = adStateOpen Then Rs.Close
    '正式添加记录，打开班级记录集（空记录集）
    strSql = "select top 0 * from classes"
    Rs.Open strSql, Conn, adOpenStatic, adLockOptimistic
    '增加新记录
    Rs.AddNew
    '生成新的内码
    sClassID = GetRndCode     '随机生成新的班级内码
    '记录集填入数据（控件->记录集）
    Rs!ClassID = sClassID           '当前班级内码
    Rs!ClassName = txtClass.Text    '班级或院系名称
    Rs!UpperId = UpperId        '上一级内码
    '更新记录集
    Rs.Update
    Rs.Close
    Set Rs = Nothing
    
    '生成新节点的关键字
    Tmp_Key = "a" + sClassID
    '在树中添加新节点（文件图标）
    With FrmClass
      Set TmpNode = .TreeView1.Nodes.Add(.TreeView1.SelectedItem.Key, _
            tvwChild, Tmp_Key, txtClass.Text, "imgDeselectedFile", "imgSelectedFile")
      '当前新加入节点展开
      .TreeView1.SelectedItem.Expanded = True
      
      '判断是否要更改上级节点图标
      If (.TreeView1.SelectedItem.Key <> "a0") Then
        .TreeView1.SelectedItem.Image = "imgClosedFolder"
        .TreeView1.SelectedItem.SelectedImage = 0
        .TreeView1.SelectedItem.ExpandedImage = "imgOpenedFolder"
      End If
    End With
  Else      '修改记录
    '当修改记录时，如果修改了班级或院系，
    '也需判断同一上级是否存在相同名称的班级或院系
    If UCase(txtClass.Text) <> UCase(FrmClass.TreeView1.SelectedItem.Text) Then
      '取当前修改项的上一级内码（即TreeView1中当前选中项的上一级内码）
      UpperId = Right(FrmClass.TreeView1.SelectedItem.Parent.Key, _
                Len(FrmClass.TreeView1.SelectedItem.Parent.Key) - 1)
      strSql = "select count(*) as s_count from Classes where " & _
               "ClassName='" & txtClass.Text & "' and UpperId='" & UpperId & "'"
      Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
      If Rs!s_count > 0 Then  '如果存在同名，要求重新输入
        MsgBox txtClass.Text + " 已经存在", vbExclamation + vbOKOnly, "操作提示"
        txtClass.SetFocus
        Rs.Close
        Set Rs = Nothing
        Exit Sub
      End If
    End If
  
    '正式修改记录
    '获取修改部门的内码
    sClassID = Right(FrmClass.TreeView1.SelectedItem.Key, _
         Len(FrmClass.TreeView1.SelectedItem.Key) - 1)
    '如果Rs对象已打开，则先关闭
    If Rs.State = adStateOpen Then Rs.Close
    '查询获取要修改部门的记录集（仅一条记录）
    strSql = "select * from classes where ClassID='" & sClassID & "'"
    Rs.Open strSql, Conn, adOpenStatic, adLockOptimistic
    If Not Rs.EOF Then
      '记录集填入数据（控件->记录集）
      Rs!ClassName = txtClass.Text    '班级或院系名称
      Rs.Update           '更新记录集
    End If
    Rs.Close
    Set Rs = Nothing
  
    '更改节点显示文本
    FrmClass.TreeView1.SelectedItem.Text = txtClass.Text
  End If
  
  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