frmmain.frm

这是我们公司的题库管理系统

   Begin VB.Menu mnuWindow 
      Caption         =   "1026"
      WindowList      =   -1  'True
      Begin VB.Menu mnuWindowCascade 
         Caption         =   "1028"
      End
      Begin VB.Menu mnuWindowTileHorizontal 
         Caption         =   "1029"
      End
      Begin VB.Menu mnuWindowTileVertical 
         Caption         =   "1030"
      End
      Begin VB.Menu mnuWindowArrangeIcons 
         Caption         =   "1031"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "1032"
      Begin VB.Menu mnuHelpContents 
         Caption         =   "1033"
      End
      Begin VB.Menu mnuHelpSearchForHelpOn 
         Caption         =   "1034"
      End
      Begin VB.Menu mnuHelpBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "1035"
      End
   End
   Begin VB.Menu mnuExit 
      Caption         =   "1012"
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const EM_UNDO = &HC7
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)

Private Sub MDIForm_Load()
    LoadResStrings Me
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    setAuthority
End Sub

Private Sub setAuthority()
    Set cnn = New Connection
    cnn.Open sConnect
    Set rs = New Recordset
    rs.CursorLocation = adUseClient
    
    sSQL = "select * from USER_GROUP_AUTHORITY where GROUP_ID = " & userGroupId
    rs.Open sSQL, cnn, adOpenForwardOnly, adLockReadOnly
        
    While rs.EOF = False
        Select Case rs!AUTHORITY_ID
            Case 1
                mnuExplore.Enabled = True
            Case 2
                mnuArgs.Enabled = True
            Case 3
                mnuGenerateItem.Enabled = True
                mnuInputItem.Enabled = True
            Case 4
                mnuVerifyItem.Enabled = True
            Case 5
                mnuTest.Enabled = True
            Case 6
                mnuMarkAnalysis.Enabled = True
            Case 7
                mnuUserAuthority.Enabled = True
                mnuLogAdmin.Enabled = True
                mnuDatabaseAdmin.Enabled = True
            Case 8
                mnuUserChangePW.Enabled = True
        End Select
        rs.MoveNext
    Wend
    
    rs.Close
End Sub


Private Sub MDIForm_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "新建"
            'LoadNewDoc
        Case "打开"
            mnuFileOpen_Click
        Case "保存"
            mnuFileSave_Click
        Case "打印"
            mnuFilePrint_Click
        Case "剪切"
            mnuEditCut_Click
        Case "复制"
            mnuEditCopy_Click
        Case "粘贴"
            mnuEditPaste_Click
        Case "粗体"
            ActiveForm.rtfText.SelBold = Not ActiveForm.rtfText.SelBold
            Button.Value = IIf(ActiveForm.rtfText.SelBold, tbrPressed, tbrUnpressed)
        Case "斜体"
            ActiveForm.rtfText.SelItalic = Not ActiveForm.rtfText.SelItalic
            Button.Value = IIf(ActiveForm.rtfText.SelItalic, tbrPressed, tbrUnpressed)
        Case "下划线"
            ActiveForm.rtfText.SelUnderline = Not ActiveForm.rtfText.SelUnderline
            Button.Value = IIf(ActiveForm.rtfText.SelUnderline, tbrPressed, tbrUnpressed)
        Case "左对齐"
            ActiveForm.rtfText.SelAlignment = rtfLeft
        Case "置中"
            ActiveForm.rtfText.SelAlignment = rtfCenter
        Case "右对齐"
            ActiveForm.rtfText.SelAlignment = rtfRight
    End Select
End Sub

Private Sub mnuCategoryArgs_Click()
    frmArguments.Show 1
    'frmArguments.TabStrip1.TabIndex = 0
End Sub

Private Sub mnuFieldArgs_Click()
    frmArguments.Show 1
    'frmArguments.TabStrip1.TabIndex = 1
End Sub

Private Sub mnuCourseArgs_Click()
    frmArguments.Show 1
    'frmArguments.TabStrip1.TabIndex = 2
End Sub

Private Sub mnuPointArgs_Click()
    frmArguments.Show 1
    'frmArguments.TabStrip1.TabIndex = 3
End Sub

Private Sub mnuTypeArgs_Click()
    Dim f As New frmArgumentT
    f.Show 1
End Sub

Private Sub mnuExploreAll_Click()
    'If mnuExploreAll.Checked = False Then
    '    mnuExploreAll.Checked = Not mnuExploreAll.Checked
    frmItemCategory.Show 1
    If frmItemCategory.OK Then
        Dim fExp As New frmItemExplore
        exploreColName = "ALL"
        exploreRowName = "TYPE"
        fExp.Show
        fExp.Caption = "整体结构浏览"
        sbStatusBar.Panels(1).Text = fExp.Caption
    End If
    'End If
End Sub

Private Sub mnuExploreCTYg_Click()
'    If mnuExploreCTY.Checked = False Then
'        mnuExploreCTY.Checked = Not mnuExploreCTY.Checked
        Dim fExp As New frmItemExplore
        categoryId = 1
        exploreColName = "COURSE"
        exploreRowName = "TYPE"
        fExp.Show
        fExp.Caption = "公共题库——课程与题型双向细目表"
        sbStatusBar.Panels(1).Text = fExp.Caption
'    End If
End Sub

Private Sub mnuExploreFTYg_Click()
'    If mnuExploreFTY.Checked = False Then
'        mnuExploreFTY.Checked = Not mnuExploreFTY.Checked
        Dim fExp As New frmItemExplore
        categoryId = 1
        exploreColName = "FIELD"
        exploreRowName = "TYPE"
        fExp.Show
        fExp.Caption = "公共题库——科目与题型双向细目表"
        sbStatusBar.Panels(1).Text = fExp.Caption
'    End If
End Sub

Private Sub mnuExplorePLEg_Click()
'    If mnuExplorePLE.Checked = False Then
'        mnuExplorePLE.Checked = Not mnuExplorePLE.Checked
        Dim fExp As New frmItemExplore
        categoryId = 1
        exploreColName = "POINT"
        exploreRowName = "LEVEL"
        fExp.Show
        fExp.Caption = "公共题库——知识点与难度双向细目表"
        sbStatusBar.Panels(1).Text = fExp.Caption
'    End If
End Sub

Private Sub mnuExplorePTAg_Click()
'    If mnuExplorePTA.Checked = False Then
'        mnuExplorePTA.Checked = Not mnuExplorePTA.Checked
        Dim fExp As New frmItemExplore
        categoryId = 1
        exploreColName = "POINT"
        exploreRowName = "TARGET"
        fExp.Show
        fExp.Caption = "公共题库——知识点与目标双向细目表"
        sbStatusBar.Panels(1).Text = fExp.Caption
'    End If
End Sub

Private Sub mnuExplorePTYg_Click()
'    If mnuExplorePTY.Checked = False Then
'        mnuExplorePTY.Checked = Not mnuExplorePTY.Checked
        Dim fExp As New frmItemExplore
        categoryId = 1
        exploreColName = "POINT"
        exploreRowName = "TYPE"
        fExp.Show
        fExp.Caption = "公共题库——知识点与题型双向细目表"
        sbStatusBar.Panels(1).Text = fExp.Caption
'    End If
End Sub

Private Sub mnuExploreCTYz_Click()
'    If mnuExploreCTY.Checked = False Then
'        mnuExploreCTY.Checked = Not mnuExploreCTY.Checked
        Dim fExp As New frmItemExplore
        categoryId = 2
        exploreColName = "COURSE"
        exploreRowName = "TYPE"
        fExp.Show
        fExp.Caption = "专业题库——课程与题型双向细目表"
        sbStatusBar.Panels(1).Text = fExp.Caption
'    End If
End Sub

Private Sub mnuExploreFTYz_Click()
'    If mnuExploreFTY.Checked = False Then
'        mnuExploreFTY.Checked = Not mnuExploreFTY.Checked
        Dim fExp As New frmItemExplore
        categoryId = 2
        exploreColName = "FIELD"
        exploreRowName = "TYPE"
        fExp.Show
        fExp.Caption = "专业题库——专业与题型双向细目表"
        sbStatusBar.Panels(1).Text = fExp.Caption
'    End If
End Sub

Private Sub mnuExplorePLEz_Click()
'    If mnuExplorePLE.Checked = False Then
'        mnuExplorePLE.Checked = Not mnuExplorePLE.Checked
        Dim fExp As New frmItemExplore
        categoryId = 2
        exploreColName = "POINT"
        exploreRowName = "LEVEL"
        fExp.Show
        fExp.Caption = "专业题库——知识点与难度双向细目表"
        sbStatusBar.Panels(1).Text = fExp.Caption
'    End If
End Sub

Private Sub mnuExplorePTAz_Click()
'    If mnuExplorePTA.Checked = False Then
'        mnuExplorePTA.Checked = Not mnuExplorePTA.Checked
        Dim fExp As New frmItemExplore
        categoryId = 2
        exploreColName = "POINT"
        exploreRowName = "TARGET"
        fExp.Show
        fExp.Caption = "专业题库——知识点与目标双向细目表"
        sbStatusBar.Panels(1).Text = fExp.Caption
'    End If
End Sub

Private Sub mnuExplorePTYz_Click()
'    If mnuExplorePTY.Checked = False Then
'        mnuExplorePTY.Checked = Not mnuExplorePTY.Checked
        Dim fExp As New frmItemExplore
        categoryId = 2
        exploreColName = "POINT"
        exploreRowName = "TYPE"
        fExp.Show
        fExp.Caption = "专业题库——知识点与题型双向细目表"
        sbStatusBar.Panels(1).Text = fExp.Caption
'    End If
End Sub

Private Sub mnuExploreFLEm_Click()
'    If mnuExplorePTY.Checked = False Then
'        mnuExplorePTY.Checked = Not mnuExplorePTY.Checked
        Dim fExp As New frmItemExplore
        categoryId = 3
        exploreColName = "FIELD"
        exploreRowName = "LEVEL"
        fExp.Show
        fExp.Caption = "面试题库——测评要素与难度双向细目表"
        sbStatusBar.Panels(1).Text = fExp.Caption
'    End If
End Sub

Private Sub mnuGenerateItem_Click()
    frmItemCategory.Show 1
    If frmItemCategory.OK Then
        frmItemAddC.Show
        sbStatusBar.Panels(1).Text = frmItemAddC.Caption
    End If
End Sub

Private Sub mnuSingleInputItem_Click()
    frmItemCategory.Show 1
    If frmItemCategory.OK Then
        Dim f As New frmItemAddS
        f.Show
    End If
End Sub


Private Sub mnuGenerateTest_Click()
    frmItemCategory.Show 1
    If frmItemCategory.OK Then
        frmTestGenerateZ.Show 1