frmmain.frm

这是我们公司的题库管理系统,用VB实现,可以进行试题制作,编辑、试卷制作、试卷生成和试卷打印(A3/和A4)

      Picture         =   "FrmMain.frx":8104
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   7
      Top             =   3480
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.PictureBox Pic_hand 
      Height          =   375
      Left            =   2520
      Picture         =   "FrmMain.frx":85F6
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   6
      Top             =   1920
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.PictureBox Pic_auto 
      Height          =   375
      Left            =   1800
      Picture         =   "FrmMain.frx":8B24
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   5
      Top             =   1920
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.PictureBox restore 
      Height          =   375
      Left            =   720
      Picture         =   "FrmMain.frx":90A6
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   4
      Top             =   3000
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.PictureBox backup 
      Height          =   375
      Left            =   360
      Picture         =   "FrmMain.frx":959A
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   3
      Top             =   3000
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.PictureBox install 
      Height          =   255
      Left            =   1200
      Picture         =   "FrmMain.frx":9A8E
      ScaleHeight     =   195
      ScaleWidth      =   195
      TabIndex        =   2
      Top             =   3000
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.PictureBox modi 
      Height          =   255
      Left            =   1800
      Picture         =   "FrmMain.frx":9F82
      ScaleHeight     =   195
      ScaleWidth      =   195
      TabIndex        =   1
      Top             =   1440
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.PictureBox add_user 
      Height          =   225
      Left            =   2040
      Picture         =   "FrmMain.frx":A474
      ScaleHeight     =   165
      ScaleWidth      =   165
      TabIndex        =   0
      Top             =   1440
      Visible         =   0   'False
      Width           =   225
   End
   Begin VB.Menu mn_sys 
      Caption         =   "系统管理(&F)"
      Begin VB.Menu mn_modi_pwd 
         Caption         =   "  修改用户( &M )"
         Shortcut        =   ^M
      End
      Begin VB.Menu mn_add_user 
         Caption         =   "  用户管理( &N )"
         Shortcut        =   ^A
      End
      Begin VB.Menu mn_one 
         Caption         =   "-"
      End
      Begin VB.Menu mn_backup 
         Caption         =   "  数据备份( &B )"
         Shortcut        =   ^D
      End
      Begin VB.Menu mn_restore 
         Caption         =   "  数据恢复( &R )"
         Shortcut        =   ^R
      End
      Begin VB.Menu mn_quit 
         Caption         =   "  退出系统( &Q )"
         Shortcut        =   ^Q
      End
   End
   Begin VB.Menu mn_shijjian 
      Caption         =   "试卷管理(&S)"
      Begin VB.Menu mn_auto 
         Caption         =   "  自动生成试卷向导( &U )"
         Shortcut        =   ^{F1}
      End
      Begin VB.Menu mn_hand 
         Caption         =   "  手动生成试卷( &H )"
         Shortcut        =   ^{F2}
      End
      Begin VB.Menu mn_open 
         Caption         =   "  试卷管理( &O )"
         Shortcut        =   ^{F3}
      End
   End
   Begin VB.Menu mn_tiku 
      Caption         =   "题库管理(&T)"
      Begin VB.Menu mn_add_topic 
         Caption         =   "  试题录入( &D )"
         Shortcut        =   {F4}
      End
      Begin VB.Menu mn_tixin_install 
         Caption         =   "  题型设置( &X )"
         Shortcut        =   {F3}
      End
   End
   Begin VB.Menu mn_choice 
      Caption         =   "科目选择(&K)"
      Begin VB.Menu mn_choice_myself 
         Caption         =   "  课程章节管理( &S )"
         Shortcut        =   ^S
      End
      Begin VB.Menu mn_choice_subject 
         Caption         =   "  管理科目( &C )"
         Shortcut        =   {F7}
      End
   End
   Begin VB.Menu mn_register 
      Caption         =   "注册(&Z)"
      Begin VB.Menu mn_register_num 
         Caption         =   "  获得注册码( &G )"
         Shortcut        =   {F11}
      End
      Begin VB.Menu mn_soft_reg 
         Caption         =   "  软件注册( &S )"
         Shortcut        =   {F12}
      End
   End
   Begin VB.Menu mn_help 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mn_use 
         Caption         =   "  如何使用( &W )"
         Shortcut        =   {F1}
      End
      Begin VB.Menu mn_about 
         Caption         =   "  关于( &A )"
      End
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
'用于取得窗口中一个菜单的句柄
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
'用于取得一个弹出式菜单的句柄
Private Declare Function SetMenuItemBitmaps Lib "user32" ( _
ByVal hMenu As Long, _
ByVal nPosition As Long, _
ByVal wFlags As Long, _
ByVal hBitmapUnchecked As Long, _
ByVal hBitmapChecked As Long) As Long
'用于设置一幅选定的位图，令其在指定的菜单条目中使用，代替标准的复选符号
Const MF_BYPOSITION = &H400&
'111

Private Sub Form_Load()
  Me.Top = 0 '设置窗体上边界位置
  Me.Left = 0 '设置窗体左边界位置
  Me.Width = Screen.Width '设置窗体宽度为屏幕宽度
  Me.Height = Screen.Height '设置窗体高度为屏幕高度
  Dim mHandle As Long, lRet As Long, sHandle As Long, sHandle2 As Long
  mHandle = GetMenu(hWnd)
  sHandle = GetSubMenu(mHandle, 0)
  lRet = SetMenuItemBitmaps(sHandle, 0, MF_BYPOSITION, modi.Picture, modi.Picture)
  lRet = SetMenuItemBitmaps(sHandle, 1, MF_BYPOSITION, add_user.Picture, add_user.Picture)
  lRet = SetMenuItemBitmaps(sHandle, 5, MF_BYPOSITION, install.Picture, install.Picture)
  lRet = SetMenuItemBitmaps(sHandle, 3, MF_BYPOSITION, backup.Picture, backup.Picture)
  lRet = SetMenuItemBitmaps(sHandle, 4, MF_BYPOSITION, restore.Picture, restore.Picture)

  sHandle = GetSubMenu(mHandle, 1)
  lRet = SetMenuItemBitmaps(sHandle, 0, MF_BYPOSITION, Pic_auto.Picture, Pic_auto.Picture)
  lRet = SetMenuItemBitmaps(sHandle, 1, MF_BYPOSITION, Pic_hand.Picture, Pic_hand.Picture)
  lRet = SetMenuItemBitmaps(sHandle, 2, MF_BYPOSITION, Pic_open.Picture, Pic_open.Picture)

  sHandle = GetSubMenu(mHandle, 2)
  lRet = SetMenuItemBitmaps(sHandle, 0, MF_BYPOSITION, Pic31.Picture, Pic31.Picture)
  lRet = SetMenuItemBitmaps(sHandle, 1, MF_BYPOSITION, Pic33.Picture, Pic33.Picture)

  sHandle = GetSubMenu(mHandle, 3)
  lRet = SetMenuItemBitmaps(sHandle, 1, MF_BYPOSITION, Pic41.Picture, Pic41.Picture)
  lRet = SetMenuItemBitmaps(sHandle, 0, MF_BYPOSITION, Pic42.Picture, Pic42.Picture)

  sHandle = GetSubMenu(mHandle, 4)
  lRet = SetMenuItemBitmaps(sHandle, 0, MF_BYPOSITION, Pic61.Picture, Pic61.Picture)
  lRet = SetMenuItemBitmaps(sHandle, 1, MF_BYPOSITION, Pic52.Picture, Pic52.Picture)

  sHandle = GetSubMenu(mHandle, 5)
  lRet = SetMenuItemBitmaps(sHandle, 0, MF_BYPOSITION, Pic51.Picture, Pic51.Picture)

End Sub


Private Sub mn_about_Click()
  frmAbout.Show 1
End Sub

Private Sub mn_add_topic_Click()
  FrmAddExam.Show 1
End Sub

Private Sub mn_add_user_Click()
  FrmUserMan.Show 1
End Sub

Private Sub mn_auto_Click()
  AutoFrmExam.Show 1
End Sub

Private Sub mn_backup_Click()
  Dim mOldFile As String
  Dim mNewFile As String
  Dim mTemp As String
  mTemp = Year(Now) & Month(Now) & Day(Now) & Int(10 * Rnd)
  
  CDialog1.InitDir = "C:\"
  CDialog1.Filter = "数据库文件|*.mdb"
  CDialog1.ShowSave
  If CDialog1.FileName = "" Then
    Exit Sub
  End If
  mOldFile = App.Path & "\db1.mdb"
  mNewFile = CDialog1.FileName
  CopyFile mOldFile, mNewFile, False
  MsgBox "备份成功！"
End Sub

Private Sub mn_choice_myself_Click()
  i = 0 '表只可以对章节进行管理
  FrmclassMan.Show 1
End Sub

Private Sub mn_choice_subject_Click()
  FrmclassMan.Show 1
End Sub

Private Sub mn_hand_Click()
  FrmExamRep.Show 1
End Sub

Private Sub mn_modi_pwd_Click()
  frmmpwd.New_Name.Enabled = False
  
  frmmpwd.New_Name.Text = FrmLogin.NameKey
  
  frmmpwd.Show 1
   
End Sub
'试卷管理
Private Sub mn_open_Click()
  FrmExamRep.Show 1
End Sub

Private Sub mn_quit_Click()
  End
  
End Sub

Private Sub mn_register_num_Click()
  MsgBox "获得注册码"
End Sub

Private Sub mn_restore_Click()
  Dim mOldFile As String
  Dim mNewFile As String
  CDialog1.InitDir = "C:\"
  CDialog1.Filter = "数据库文件(*.mdb)|*.mdb"
  CDialog1.ShowOpen
  If CDialog1.FileName = "" Then
    Exit Sub
  End If
  mOldFile = CDialog1.FileName
  mNewFile = App.Path & "\db1.mdb"
  CopyFile mOldFile, mNewFile, False
  MsgBox "恢复成功！"
End Sub

Private Sub mn_soft_reg_Click()
  MsgBox "软件注册"
End Sub

Private Sub mn_tixin_install_Click()
  FrmTitleMan.Show 1
End Sub

Private Sub mn_use_Click()
  MsgBox "如何使用"
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  Select Case Button.Key
    Case "modipwd"
        mn_modi_pwd_Click
    Case "add_user"
        mn_add_user_Click
    Case "bar_help"
        mn_use_Click
    Case "bar_choice_subject"
        mn_choice_subject_Click
    Case "bar_choice_myself"
        mn_choice_myself_Click
    Case "bar_tixin_install"
        mn_tixin_install_Click
    Case "bar_choice_myself"
        mn_choice_myself_Click
    Case "bar_addtopic"
        mn_add_topic_Click
    Case "bar_hand"
        mn_hand_Click
    Case "bar_backup"
        mn_backup_Click
    Case "bar_restore"
        mn_restore_Click '恢复
    Case "bar_open" '试卷管理
        mn_open_Click
    Case "bar_auto" '自动生成试卷
        mn_auto_Click
  End Select
  
End Sub