frmmain.frm

vb试卷生成系统！能够生成8开vb考试试卷

      End
      Begin VB.Menu z1 
         Caption         =   "-"
      End
      Begin VB.Menu mnucontrolexit 
         Caption         =   "退出(&X)"
         Shortcut        =   ^Q
      End
   End
   Begin VB.Menu mnuView 
      Caption         =   "视图(&V)"
      Begin VB.Menu mnuViewToolbar 
         Caption         =   "工具栏(&T)"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuViewStatusBar 
         Caption         =   "状态栏(&B)"
         Checked         =   -1  'True
      End
      Begin VB.Menu fgs 
         Caption         =   "-"
      End
      Begin VB.Menu skin1 
         Caption         =   "皮肤"
         Begin VB.Menu formskin 
            Caption         =   "宝石蓝"
            Index           =   0
         End
         Begin VB.Menu formskin 
            Caption         =   "青草绿"
            Index           =   1
         End
         Begin VB.Menu formskin 
            Caption         =   "紫水晶"
            Index           =   2
         End
         Begin VB.Menu formskin 
            Caption         =   "火玫瑰"
            Index           =   3
         End
         Begin VB.Menu formskin 
            Caption         =   "大虾青"
            Index           =   4
         End
      End
      Begin VB.Menu fg21 
         Caption         =   "-"
      End
      Begin VB.Menu mnuclose 
         Caption         =   "关闭(&E)"
         Shortcut        =   ^E
      End
   End
   Begin VB.Menu mnuwh 
      Caption         =   "试题库维护(&W)"
      Begin VB.Menu mnubackup 
         Caption         =   "备份数据库"
         Shortcut        =   ^B
      End
      Begin VB.Menu fg 
         Caption         =   "-"
      End
      Begin VB.Menu mnutk 
         Caption         =   "填空题(&F)"
         Shortcut        =   ^F
      End
      Begin VB.Menu mnuxz 
         Caption         =   "选择题(&C)"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnujd 
         Caption         =   "简答题(&J)"
         Shortcut        =   ^J
      End
      Begin VB.Menu fg3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuscsj 
         Caption         =   "生成试卷(&S)"
         Shortcut        =   ^S
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpContents 
         Caption         =   "主题(&C)"
      End
      Begin VB.Menu mnuHelpBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout 
         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
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function HtmlHelpA Lib "hhctrl.ocx" (ByVal hwndCaller As Long, ByVal pszFile As String, ByVal uCommand As Long, ByVal dwData As Long) As Long
Const HH_DISPLAY_TOPIC = &H0
Const HH_DISPLAY_INDEX = &H2
Const HH_HELP_CONTEXT = &HF
Const HH_DISPLAY_SEARCH = &H3
Const HH_DISPLAY_TEXT_POPUP = &HE
Private m_cN1 As cNeoCaption
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 formskin_Click(Index As Integer)
picname = App.Path + "\ico\skin\" + formskin(Index).Caption + ".gif"
picbname = App.Path + "\ico\skin\" + formskin(Index).Caption + "2.gif"
PicCaption.Picture = LoadPicture(picname)
PicBorder.Picture = LoadPicture(picbname)
Skin Me, m_cN1
End Sub

Private Sub MDIForm_Activate()
If hmessage Then
    frmTip.Show
End If
End Sub
Private Sub MDIForm_Load()
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\SHIJUAN.MDB;Persist Security Info=False"
Adodc1.RecordSource = "yxuanze1"
Adodc1.Refresh
Set m_cN1 = New cNeoCaption
Skin Me, m_cN1
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
mnucontrolexit_Click
If tuichu <> 6 Then
    Cancel = 1
End If
End Sub
Private Sub mnubackup_Click()
Dim ss As Long
With dlgCommonDialog
    Dim sFile, dfile As String
    .DialogTitle = "另存为"
    .CancelError = False
    .Filter = "所有文件 (*.*)|*.*"
    .ShowSave
    If Len(.FileName) = 0 Then
        Exit Sub
    End If
    sFile = .FileName
    dfile = App.Path & "\data\kaoti.mdb"
End With
ss = CopyFile(dfile, sFile, 2)
If ss <> 0 Then
    MsgBox "数据库备份失败，请重试！", vbExclamation, "错误"
Else
    MsgBox "数据库备份成功！", vbInformation, "成功"
End If
End Sub

Private Sub mnuclose_Click()
If Screen.ActiveForm.Caption <> "VB试题库" Then
    Unload Screen.ActiveForm
End If
End Sub

Public Sub mnucontrolexit_Click()
tuichu = MsgBox("确定退出么？", vbYesNo + vbQuestion, "退出？")
If tuichu = 6 Then
    For i = 1 To 12
        biao = "yxuanze" + Trim(Str(i))
        Adodc1.RecordSource = biao
        Adodc1.Refresh
        While Adodc1.Recordset.RecordCount <> 0
            Adodc1.Recordset.Delete (adAffectCurrent)
            Adodc1.Recordset.Update
            Adodc1.Refresh
        Wend
        biao = "zaixuanze" + Trim(Str(i))
        Adodc1.RecordSource = biao
        Adodc1.Refresh
        While Adodc1.Recordset.RecordCount <> 0
            Adodc1.Recordset.Delete (adAffectCurrent)
            Adodc1.Recordset.Update
            Adodc1.Refresh
        Wend
    Next i
    Unload frmtiankong
    Unload frmxuanze
    Unload frmjianda
    Unload Frmkaojuan
    Unload frmTip
    Unload frmmnu
    Unload frmmnlx
    Unload frmLogin
    Unload fMainForm
    'End
End If
End Sub
Private Sub mnuControlrelogin_Click()
Me.Hide
frmLogin.Show
End Sub

Private Sub mnuControltip_Click()
frmTip.Show
End Sub
Private Sub mnujd_Click()
'frmc.Visible = True
frmjianda.Show
End Sub
Private Sub mnumn_Click()
Me.Hide
frmmnlx.Show
End Sub
Private Sub mnuscsj_Click()
'frmd.Visible = True
Frmkaojuan.Show
End Sub
Private Sub mnutk_Click()
'frma.Visible = True
frmtiankong.Show
End Sub
Private Sub mnuxz_Click()
'frmb.Visible = True
frmxuanze.Show
End Sub


Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "tbmrts"
            mnuControltip_Click
        Case "tbcxdl"
            mnuControlrelogin_Click
        Case "beifen"
            mnubackup_Click
        Case "toolcs"
            mnumn_Click
        Case "toolsj"
            mnuscsj_Click
        Case "toolexit"
            mnucontrolexit_Click
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
    MsgBox "版本 " & App.Major & "." & App.Minor & "." & App.Revision
End Sub
Private Sub mnuHelpContents_Click()
    If Dir(App.Path & "\data\help.chm") = "" Then
        MsgBox "帮助文件:" + App.Path & "\data\help.chm 未找到无法显示帮助主题", vbInformation, Me.Caption
    Else
        'On Error Resume Next
        HtmlHelpA fMainForm.hwnd, App.Path & "\data\help.CHM", 0, 0
        If Err Then
            MsgBox Err.Description
        End If
    End If
End Sub
Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
End Sub