frmmain.frm

职工信息系统

        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 mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuHelpSearchForHelpOn_Click()
    Dim nRet As Integer


    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else

    On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub




Private Sub mnuWindowArrangeIcons_Click()
    Me.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowTileVertical_Click()
    Me.Arrange vbTileVertical
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowCascade_Click()
    Me.Arrange vbCascade
End Sub

Private Sub mnuWindowNewWindow_Click()
    LoadNewDoc
End Sub

Private Sub mnuToolsOptions_Click()
    frmOptions.Show vbModal, Me
End Sub



Private Sub mnuViewOptions_Click()
    frmOptions.Show vbModal, Me
End Sub

Private Sub mnuViewRefresh_Click()
    '应做:添加 'mnuViewRefresh_Click' 代码。
    MsgBox "添加 'mnuViewRefresh_Click' 代码。"
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    StatusBar1.Visible = mnuViewStatusBar.Checked
End Sub

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

Private Sub mnuEditPasteSpecial_Click()
    '应做:添加 'mnuEditPasteSpecial_Click' 代码。
    MsgBox "添加 'mnuEditPasteSpecial_Click' 代码。"
End Sub

Private Sub mnuEditPaste_Click()
    On Error Resume Next
    ActiveForm.rtfText.SelRTF = Clipboard.GetText

End Sub

Private Sub mnuEditCopy_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.rtfText.SelRTF

End Sub

Private Sub mnuEditCut_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.rtfText.SelRTF
    ActiveForm.rtfText.SelText = vbNullString

End Sub

Private Sub mnuEditUndo_Click()
    '应做:添加 'mnuEditUndo_Click' 代码。
    MsgBox "添加 'mnuEditUndo_Click' 代码。"
End Sub




Private Sub mnuFileSend_Click()
    '应做:添加 'mnuFileSend_Click' 代码。
    MsgBox "添加 'mnuFileSend_Click' 代码。"
End Sub

Private Sub mnuFilePrint_Click()
    On Error Resume Next
    If ActiveForm Is Nothing Then Exit Sub
    

    With dlgCommonDialog
        .DialogTitle = "Print"
        .CancelError = True
        .Flags = cdlPDReturnDC + cdlPDNoPageNums
        If ActiveForm.rtfText.SelLength = 0 Then
            .Flags = .Flags + cdlPDAllPages
        Else
            .Flags = .Flags + cdlPDSelection
        End If
        .ShowPrinter
        If Err <> MSComDlg.cdlCancel Then
            ActiveForm.rtfText.SelPrint .hdc
        End If
    End With

End Sub

Private Sub mnuFilePrintPreview_Click()
    '应做:添加 'mnuFilePrintPreview_Click' 代码。
    MsgBox "添加 'mnuFilePrintPreview_Click' 代码。"
End Sub

Private Sub mnuFilePageSetup_Click()
    On Error Resume Next
    With dlgCommonDialog
        .DialogTitle = "页面设置"
        .CancelError = True
        .ShowPrinter
    End With

End Sub

Private Sub mnuFileProperties_Click()
    '应做:添加 'mnuFileProperties_Click' 代码。
    MsgBox "添加 'mnuFileProperties_Click' 代码。"
End Sub

Private Sub mnuFileSaveAll_Click()
    '应做:添加 'mnuFileSaveAll_Click' 代码。
    MsgBox "添加 'mnuFileSaveAll_Click' 代码。"
End Sub

Private Sub mnuFileSaveAs_Click()
    Dim sFile As String
    

    If ActiveForm Is Nothing Then Exit Sub
    

    With dlgCommonDialog
        .DialogTitle = "另存为"
        .CancelError = False
        'ToDo: 设置 common dialog 控件的标志和属性
        .Filter = "所有文件 (*.*)|*.*"
        .ShowSave
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    ActiveForm.Caption = sFile
    ActiveForm.rtfText.SaveFile sFile

End Sub

Private Sub mnuFileSave_Click()
    Dim sFile As String
    If Left$(ActiveForm.Caption, 8) = "Document" Then
        With dlgCommonDialog
            .DialogTitle = "保存"
            .CancelError = False
            'ToDo: 设置 common dialog 控件的标志和属性
            .Filter = "所有文件 (*.*)|*.*"
            .ShowSave
            If Len(.FileName) = 0 Then
                Exit Sub
            End If
            sFile = .FileName
        End With
        ActiveForm.rtfText.SaveFile sFile
    Else
        sFile = ActiveForm.Caption
        ActiveForm.rtfText.SaveFile sFile
    End If

End Sub

Private Sub mnuFileClose_Click()
    '应做:添加 'mnuFileClose_Click' 代码。
    'On Error Resume Next
  
End Sub

Private Sub mnuFileOpen_Click()
   Dim sFile As String
Unload frmD
    With dlgCommonDialog
        .DialogTitle = "请输入新建职工数据库路径"
        .CancelError = False
        'ToDo: 设置 common dialog 控件的标志和属性
        .Filter = "ACCESS数据库文件 (*.MDB)|*.MDB"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
        CurrentFile = sFile
    End With
  
    LoadNewDoc
End Sub

Private Sub mnuFileNew_Click()
Dim sFile As String
Unload frmD
    With dlgCommonDialog
        .DialogTitle = "请输入新建职工数据库路径"
        .CancelError = False
        'ToDo: 设置 common dialog 控件的标志和属性
        .Filter = "ACCESS数据库文件 (*.MDB)|*.MDB"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
        CurrentFile = sFile
    End With
    If Dir(CurrentFile) <> "" Then
       If MsgBox(CurrentFile & "已经存在！是否覆盖？(Y/N)", vbYesNo + vbInformation, "提示：") = vbYes Then
       Kill CurrentFile
       Else: Exit Sub
       End If
    End If
    NewDataBase (CurrentFile)
    LoadNewDoc
End Sub
Private Sub m_Menu_ItemSelect(MenuObject As MenuItem)
On Error Resume Next
   Select Case MenuObject.Caption
   Case "新建职工表(&N)": mnuFileNew_Click
   Case "打开职工表(&O)...": mnuFileOpen_Click
    Case "关闭职工表(&C)":  Unload frmD
   Case "": mnuFileSave_Click
   Case "": mnuFileSaveAs_Click
   Case "": mnuFileSaveAll_Click
   Case "软件说明书(&B)": ShowHelp
   Case "选项(&O)...": frmOptions.Show
   Case "退出(&X)": Unload Me
   Case "插入(&I)": frmInsert.Show
   
   Case "工具栏(&T)": mnuViewToolbar_Click: MenuObject.Checked = Not MenuObject.Checked
   Case "状态栏(&B)": mnuViewStatusBar_Click: MenuObject.Checked = Not MenuObject.Checked
   Case "全屏表格": MnuFullScreen_Click: MenuObject.Checked = Not MenuObject.Checked
   Case "数据库存放路径": frmDataStore.Show
   
   
   Case "新建窗口(&N)": mnuWindowNewWindow_Click
   Case "层叠(&C)": mnuWindowCascade_Click
   Case "横向平铺(&H)": mnuWindowTileHorizontal_Click
   Case "纵向平铺(&V)": mnuWindowTileVertical_Click
   Case "排列图标(&A)": mnuWindowArrangeIcons_Click
   
   Case "查找(&S)": frmSearch.Show
   Case "筛选数据(&U)": frmSelect.Show
   Case "页面设置(&U)...": mnuFilePageSetup_Click
   Case "打印预览(&V)": mnuFilePrintPreview_Click
   
   Case "打印表格(&P)...": mnuFilePrint_Click
   Case "日积月累(&R)": frmTip.Show
   Case "": mnuHelpSearchForHelpOn_Click
   Case "关于本软件(&A)...": frmAbout.Show
   End Select
   End Sub