frmmanager.frm

学员考试管理系统,采用VISUAL BASIC数据库编程技术,可用于课程设计,毕业设计等.

Private Sub mnuShowToolbar_Click()
    mnuShowToolbar.Checked = (Not mnuShowToolbar.Checked)
    Toolbar1.Visible = mnuShowToolbar.Checked
    
    'redraw the form
    Call Form_Resize
End Sub

Private Sub mnuShowToolbarText_Click()
    mnuShowToolbarText.Checked = (Not mnuShowToolbarText.Checked)
    SetToolbarTextLabel mnuShowToolbarText.Checked
    '
    DoEvents
    '
    Call Form_Resize
End Sub

'点击题库菜单
Private Sub mnuSubject_Click()
    Dim nodeCur As Node
    
    '获取当前节点
    Set nodeCur = TreeView1.SelectedItem
    Call SetMenuToolbarStatus(nodeCur)
End Sub

Private Sub mnuSysParam_Click()
    Dim frm As New frmSystemParam
    Load frm
    frm.Show vbModal
End Sub

Private Sub mnuTmAdd_Click()
    On Error Resume Next
    
    '添加题目
    Dim frm As New frmTmAdd
    Dim nodeCur As Node
    
    On Error Resume Next
    
    Set nodeCur = TreeView1.SelectedItem '当前节点
    
    '传入参数
    frm.TmADORecordset = Adodc1.Recordset
    frm.Tmlb_id = CInt(nodeCur.Parent.Tag)
    frm.Tmlx_id = CInt(nodeCur.Tag)
    
    Load frm
    
    frm.Show vbModal
End Sub

Private Sub mnuTmDel_Click()
    If mrsTK.RecordCount > 0 Then
        '---------------------------
        If MsgBox("真的要删除当前记录吗？", vbQuestion + vbYesNo, "提示") = vbYes Then
            mrsTK.Delete adAffectCurrent
            'save the data
            mrsTK.Update
        End If
    End If
End Sub

Private Sub mnuTmEdit_Click()
    On Error Resume Next
    
    '修改题目
    Dim frm As New frmTmEdit
    Dim nodeCur As Node
    
    On Error Resume Next
    
    If Adodc1.Recordset.RecordCount <= 0 Then
        Exit Sub
    End If
    '-----------------------------------------------
    Set nodeCur = TreeView1.SelectedItem '当前节点
    
    '传入参数
    frm.TmADORecordset = Adodc1.Recordset
    frm.Tmlb_id = CInt(nodeCur.Parent.Tag)
    frm.Tmlx_id = CInt(nodeCur.Tag)
    
    Load frm
    
    frm.Show vbModal
        
End Sub
Private Sub mnuTmlb_Click()
    Dim frm As New frmTmlb
    Dim rs As ADODB.Recordset
    Dim MaxID As Integer
    Dim szSQL As String
    
    On Error GoTo ErrHandler
    frm.Show vbModal
    If frm.IsCancelled = True Then
        Exit Sub
    End If
    '--------------------------------------
    Set rs = gadoCONN.Execute("SELECT Max(id) as MaxID FROM tbTmlb")
    If Not rs.EOF Then rs.MoveLast
    If Not rs.BOF Then rs.MoveFirst
    If rs.RecordCount >= 1 Then
        MaxID = ToInteger(rs("MaxID")) + 1
    Else
        MaxID = 1
    End If
    Set rs = Nothing
    
    szSQL = "INSERT INTO tbTmlb(id,name) VALUES(" & CStr(MaxID) & ",'" & frm.TmlbMC & "')"
    '添加到数据中
    gadoCONN.Execute szSQL
    
    '添加到树形控件中
    Call AddTmlbNode(MaxID, frm.TmlbMC)
    
    Exit Sub
ErrHandler:
    Set rs = Nothing
    ErrMessageBox "添加题目类别mnuTmlb_Click()", "提示"
End Sub
'添加题目类别到题库树上
Private Sub AddTmlbNode(ByVal Tmlb_id As Integer, ByVal tmmc As String)
    Dim nodeX As Node
    
    '添加到树形控件中
    Set nodeX = TreeView1.Nodes(1)  '树根
    Set nodeX = TreeView1.Nodes.Add(CStr(nodeX.Key), tvwChild, "TMLB_" & CStr(Tmlb_id), tmmc, 2, 2)
    nodeX.Tag = CStr(Tmlb_id)
    
    Set nodeX = TreeView1.Nodes.Add("TMLB_" & CStr(Tmlb_id), tvwChild, "TMLB_" & CStr(Tmlb_id) & "_0", "选择题", 3, 3)
    nodeX.Tag = "0"
    Set nodeX = TreeView1.Nodes.Add("TMLB_" & CStr(Tmlb_id), tvwChild, "TMLB_" & CStr(Tmlb_id) & "_1", "判断题", 3, 3)
    nodeX.Tag = "1"
End Sub

Private Sub mnuUser_Click()
    Dim frm As New frmUser
    
    Load frm
    frm.Show vbModal
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "mnuHelpContext"
            ShellExecute Me.hwnd, "Open", GetAppPath() & "jttest.chm", 0, 0, SW_SHOWNORMAL
        Case "mnuTmAdd"
            Call mnuTmAdd_Click
        Case "mnuTmEdit"
            Call mnuTmEdit_Click
        Case "mnuTmDel"
            Call mnuTmDel_Click
        Case "mnuTmlbAdd"
            Call mnuTmlb_Click
        Case Else
    End Select
End Sub

Private Sub TreeView1_Collapse(ByVal Node As MSComctlLib.Node)
    Dim nodeCur As Node
    
    'on error resume next
    Set nodeCur = TreeView1.SelectedItem
    
    If Node.Image < 3 Then
        Call TreeView1_NodeClick(Node)
        Node.Selected = True
    End If
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim szSQL As String
    
    '点击结点
    If Node.Image = 3 Then '表示题目类型
        DataGrid1.Visible = True
        imgBackground.Visible = False
        
        DataGrid1.Caption = "当前题目类别：" & Node.Parent.Text & "——" & Node.Text
        
        '打开记录
        szSQL = "SELECT * FROM tbTK WHERE tmlb_id=" & Node.Parent.Tag & " AND tmlx_id=" & Node.Tag
        If Not mrsTK Is Nothing Then
            If mrsTK.State = adStateOpen Then
                mrsTK.Close
            End If
            Set mrsTK = Nothing
        End If
        If mrsTK Is Nothing Then
            Set mrsTK = New ADODB.Recordset
        End If
        '打开记录
        mrsTK.Open szSQL, gadoCONN, adOpenKeyset, adLockPessimistic, adCmdText
        '
        Set Adodc1.Recordset = mrsTK
    Else
        DataGrid1.Visible = False
        imgBackground.Visible = True
    End If
    
    '设置菜单及工具条状态
    Call SetMenuToolbarStatus(Node)
End Sub
'设置工具条的标签
Private Sub SetToolbarTextLabel(ByVal bSetLabel As Boolean)
    Dim ct As Long
    Dim i As Long
    
    ct = Toolbar1.Buttons.Count
    Select Case bSetLabel
        Case False '不显示文本
            For i = 1 To ct
                Toolbar1.Buttons(i).Caption = ""
            Next i
        Case True '显示文本
            For i = 1 To ct
                Toolbar1.Buttons(i).Caption = Toolbar1.Buttons(i).ToolTipText
            Next i
    End Select
End Sub
'设置标题
Public Property Let Title(ByVal vNewValue As String)
    msTitle = vNewValue
End Property
'保存工具条设置
Public Sub SaveViewSettings()
    SaveSetting GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_TOOLBAR, "IsVisible", CStr(mnuShowToolbar.Checked)
    SaveSetting GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_TOOLBAR, "HasLabel", CStr(mnuShowToolbarText.Checked)
    SaveSetting GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_TOOLBAR, "IsLargeIcon", CStr(mnuShowLargeIcon.Checked)
End Sub
'获取工具条设置
Public Sub SetViewSettings()
    'show toolbar or not
    mnuShowToolbar.Checked = CBool(GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_TOOLBAR, "IsVisible", "1"))
    Toolbar1.Visible = mnuShowToolbar.Checked
    'show toolbar text or not
    mnuShowToolbarText.Checked = CBool(GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_TOOLBAR, "HasLabel", "0"))
    SetToolbarTextLabel mnuShowToolbarText.Checked
    
    'show large icon or not
    mnuShowLargeIcon.Checked = CBool(GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_TOOLBAR, "IsLargeIcon", "0"))
    ShowLargeIcon mnuShowLargeIcon.Checked
End Sub
'是否显示大图标
Private Sub ShowLargeIcon(ByVal bShowLargeIcon As Boolean)
    Dim idx() As Long
    Dim ct As Long
    Dim i As Long
    
    
    '先将原来的图片index记录下来
    ct = Toolbar1.Buttons.Count
    ReDim idx(1 To ct)
    For i = 1 To ct
        idx(i) = Toolbar1.Buttons(i).Image
    Next i
    '-------------------
    Select Case bShowLargeIcon
        Case True '当前为大图标
            '设置新的图像
            Set Toolbar1.HotImageList = Nothing
            Set Toolbar1.ImageList = ImageList4
            Set Toolbar1.HotImageList = ImageList5
        Case False '当前为小图标
            Set Toolbar1.HotImageList = Nothing
            Set Toolbar1.ImageList = ImageList1
            Set Toolbar1.HotImageList = ImageList2
    End Select
    
    '设置图像index
    For i = 1 To ct
        Toolbar1.Buttons(i).Image = idx(i)
    Next i
    'resize the controls
    DoEvents
    Call Form_Resize
End Sub
'获取背景选项设置
Private Sub GetBackgroundSettings()
    On Error Resume Next
    
    Dim idx As Long
    Dim fn As String '图片文件名
    Dim lstIdx As Long '图片索引
    '获取设置
    Picture1.BackColor = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "BackColor", &H80000001)
    
    '获取用户自定义的图片
    fn = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "BackgroundFileName", "")
    idx = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "DisplayStyle", 1)
    lstIdx = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "ListIndex", 0)
    
    If lstIdx > 0 Then
        '如果没有设置背景图片
        If fn = "" Then
            imgBackground.Picture = LoadPicture()
            Picture1.Picture = LoadPicture()
            Exit Sub
        End If
        '如果设置了背景图片
        Picture1.Picture = LoadPicture(fn)
        Picture1.AutoSize = True
        '画背景图片
        Call PaintImage(imgBackground.ScaleWidth, imgBackground.ScaleHeight, Picture1, imgBackground, idx)
    End If
End Sub
'根据文件名获取题目类别，题目类型，题目编号
Private Sub GetTmParameters(ByVal sFilename As String, lpTmlb As Long, lpTmlx As Long, lpTmbh As Long)
    Dim L1 As Long
    Dim L2 As Long
    Dim sFile As String
    
    '去除"."号
    L1 = InStrRev(sFilename, ".", , vbTextCompare)
    sFile = Left(sFilename, L1 - 1)
    
    '分离各编号
    L1 = InStr(1, sFile, "-", vbTextCompare)
    L2 = InStrRev(sFile, "-", , vbTextCompare)
        
    lpTmlb = CLng(Left(sFile, L1 - 1))
    lpTmlx = CLng(Mid(sFile, L1 + 1, L2 - L1 - 1))
    lpTmbh = CLng(Mid(sFile, L2 + 1, Len(sFile) - L2))
End Sub
Private Sub SetMenuToolbarStatus(ByVal CurNode As Node)
    If CurNode Is Nothing Then
        mnuTmlbEdit.Enabled = False
        mnuTmlbDel.Enabled = False
        mnuTmAdd.Enabled = False
        mnuTmEdit.Enabled = False
        mnuTmDel.Enabled = False
        
        Toolbar1.Buttons("mnuTmAdd").Enabled = False
        Toolbar1.Buttons("mnuTmEdit").Enabled = False
        Toolbar1.Buttons("mnuTmDel").Enabled = False
    Else
        Select Case CurNode.Image
            Case 3 '题目类型
                mnuTmlbEdit.Enabled = False
                mnuTmlbDel.Enabled = False
                
                mnuTmAdd.Enabled = True
                mnuTmEdit.Enabled = True
                mnuTmDel.Enabled = True
                Toolbar1.Buttons("mnuTmAdd").Enabled = True
                Toolbar1.Buttons("mnuTmEdit").Enabled = True
                Toolbar1.Buttons("mnuTmDel").Enabled = True
            Case 2 '题目类别
                mnuTmlbEdit.Enabled = True
                mnuTmlbDel.Enabled = True
                
                mnuTmAdd.Enabled = False
                mnuTmEdit.Enabled = False
                mnuTmDel.Enabled = False
                
                Toolbar1.Buttons("mnuTmAdd").Enabled = False
                Toolbar1.Buttons("mnuTmEdit").Enabled = False
                Toolbar1.Buttons("mnuTmDel").Enabled = False
            Case 1 'root node
                mnuTmlbEdit.Enabled = False
                mnuTmlbDel.Enabled = False
                
                mnuTmAdd.Enabled = False
                mnuTmEdit.Enabled = False
                mnuTmDel.Enabled = False
                
                Toolbar1.Buttons("mnuTmAdd").Enabled = False
                Toolbar1.Buttons("mnuTmEdit").Enabled = False
                Toolbar1.Buttons("mnuTmDel").Enabled = False
        End Select
    End If
End Sub