form1.frm

系统功能设计 试卷生成系统是为了对试卷生成实行计算机化的管理

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Form1 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Form1"
   ClientHeight    =   6435
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   9015
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   429
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   601
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   345
      Left            =   6810
      TabIndex        =   0
      Top             =   6000
      Width           =   2115
   End
   Begin ComctlLib.TreeView TreeView1 
      Height          =   6255
      Left            =   90
      TabIndex        =   1
      Top             =   90
      Width           =   3615
      _ExtentX        =   6376
      _ExtentY        =   11033
      _Version        =   327682
      HideSelection   =   0   'False
      Indentation     =   0
      LabelEdit       =   1
      Style           =   7
      ImageList       =   "ImageList1"
      Appearance      =   1
   End
   Begin ComctlLib.ImageList ImageList1 
      Left            =   4800
      Top             =   5400
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   327682
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
         NumListImages   =   2
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Form1.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Form1.frx":031A
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuPopup 
      Caption         =   "弹出菜单"
      Visible         =   0   'False
      Begin VB.Menu mnuAdd 
         Caption         =   "添加"
      End
      Begin VB.Menu mnuModify 
         Caption         =   "修改"
      End
      Begin VB.Menu mnuDelete 
         Caption         =   "删除"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'工程--->引用--->Microsoft ActiveX Data Object 2.x Library（版本号）

Dim cn As ADODB.Connection
Dim m_bolAddFlag As Boolean
Dim m_strKey As String, m_strParentKey As String
Dim m_TreeOpt As New CTreeOpt

Private Sub Command1_Click()
    Dim rs As New ADODB.Recordset
    
    TreeView1.Nodes.Clear
    rs.Open "SELECT * FROM tbTree", cn, adOpenDynamic, adLockReadOnly
    m_TreeOpt.AddTree rs, "ID", "CONTEXT", "PARENTID"
    rs.Close
    Set rs = Nothing
End Sub

Private Sub Form_Load()
On Error GoTo Errhandle
    Set cn = New ADODB.Connection
    '连接数据库
    cn.ConnectionString = "DBQ=" & App.Path & "\db1.mdb;DefaultDir=" & _
        App.Path & ";Driver={Microsoft Access Driver (*.mdb)};" & _
        "DriverId=25;FIL=MS Access;ImplicitCommitSync=Yes;" & _
        "MaxBufferSize=512;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;" & _
        "Threads=3;UID=ADMIN;UserCommitSync=Yes;PWD=admind1234;"
    cn.Open
    
    m_TreeOpt.CreateTreeView TreeView1
    Command1.Value = True
    
    Exit Sub
Errhandle:
    MsgBox Err.Description, vbExclamation
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
    cn.Close
    Set cn = Nothing
    Set m_TreeOpt = Nothing
End Sub

'添加结点
Private Sub mnuAdd_Click()
    Dim rs As New ADODB.Recordset
    
    m_bolAddFlag = True
    If rs.State = adStateOpen Then rs.Close
    rs.Open "SELECT IIF (ISNULL (MAX(ID)), 1, MAX(ID)) AS ID_M FROM tbTree", cn, adOpenStatic, adLockReadOnly
    If rs.EOF Then
        m_strKey = "1"
    Else
        m_strKey = CStr(rs!ID_M + 1)
    End If
    With TreeView1
        m_strParentKey = .SelectedItem.Key
        .Nodes.Add(m_strParentKey, tvwChild, "key" & m_strKey, "新加结点", 1).Selected = True
        .StartLabelEdit
    End With
    rs.Close
    Set rs = Nothing
End Sub

'删除结点
Private Sub mnuDelete_Click()
    Dim StrWhere As String
    
    With TreeView1
        If .SelectedItem.Key = "key1" Then
            MsgBox "对不起,不能删除根点!", vbExclamation
            Exit Sub
        End If
        StrWhere = m_TreeOpt.GetSubNodeKey(.SelectedItem)
        cn.Execute "DELETE FROM tbTree WHERE " & StrWhere
        .Nodes.Remove .SelectedItem.Key
    End With
End Sub

'修改结点
Private Sub mnuModify_Click()
    m_bolAddFlag = False
    
    With TreeView1
        m_strKey = Mid(.SelectedItem.Key, 4)
        .StartLabelEdit
    End With
End Sub

Private Sub TreeView1_AfterLabelEdit(Cancel As Integer, NewString As String)
    cn.Execute "UPDATE tbTree SET CONTEXT = '" & NewString & "' WHERE ID = " & m_strKey
End Sub

Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
    If m_bolAddFlag Then
        Dim strSql As String
        
        m_strParentKey = Mid(m_strParentKey, 4)
        strSql = "INSERT INTO tbTree (ID, CONTEXT, PARENTID) VALUES (" & m_strKey & ", '新加结点', " & m_strParentKey & ")"
        cn.Execute strSql
    End If
End Sub

Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then PopupMenu mnuPopup
End Sub