frmmdi.frm

类似WORD的文字编辑器

             Call protect
        Else
            If Me.Toolbar1.Buttons.Item(15).Value = tbrPressed Then
            Me.ActiveForm.RichTextBox1.SelUnderline = True
            ElseIf Me.Toolbar1.Buttons.Item(15).Value = tbrUnpressed Then
            Me.ActiveForm.RichTextBox1.SelUnderline = False
            Else
            End If
        End If
        Case "Strike"
         If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
            Call protect
        Else
            If Me.Toolbar1.Buttons.Item(16).Value = tbrPressed Then
            Me.ActiveForm.RichTextBox1.SelStrikeThru = True
            ElseIf Me.Toolbar1.Buttons.Item(16).Value = tbrUnpressed Then
            Me.ActiveForm.RichTextBox1.SelStrikeThru = False
            Else
            End If
        End If
        Case "Fore"
         If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
            Call protect
        Else
            Me.CommonDialog1.ShowColor
            Me.ActiveForm.RichTextBox1.SelColor = Me.CommonDialog1.color
        End If

        Case "Back"
            Me.CommonDialog1.ShowColor
            Me.ActiveForm.RichTextBox1.BackColor = Me.CommonDialog1.color
        Case "Left"
         If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
            Call protect
            Else
            If Me.Toolbar1.Buttons.Item(21).Value = tbrPressed Then Me.ActiveForm.RichTextBox1.SelAlignment = 0
                If Not (Err.Number = 0) Then MsgBox Err.Description
            End If
        Case "Center"
         If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
            Call protect
            Else
            If Me.Toolbar1.Buttons.Item(22).Value = tbrPressed Then Me.ActiveForm.RichTextBox1.SelAlignment = 2
                If Not (Err.Number = 0) Then MsgBox Err.Description
            End If
        Case "Right"
             If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
            Call protect
            Else
            If Me.Toolbar1.Buttons.Item(23).Value = tbrPressed Then Me.ActiveForm.RichTextBox1.SelAlignment = 1
                If Not (Err.Number = 0) Then MsgBox Err.Description
            End If
        Case "Ucase"
             If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
            Call protect
            Else
            Me.ActiveForm.RichTextBox1.SelText = UCase(Me.ActiveForm.RichTextBox1.SelText)
                If Not (Err.Number = 0) Then MsgBox Err.Description
            End If
        Case "Lcase"
             If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
            Call protect
            Else
            Me.ActiveForm.RichTextBox1.SelText = LCase(Me.ActiveForm.RichTextBox1.SelText)
                If Not (Err.Number = 0) Then MsgBox Err.Description
            End If
        Case "First"
             If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
            Call protect
            Else
            Me.ActiveForm.RichTextBox1.SelText = StrConv(Me.ActiveForm.RichTextBox1.SelText, vbProperCase)
                If Not (Err.Number = 0) Then MsgBox Err.Description
            End If
        Case "Emphasis"
             If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
            Call protect
            Else
            If Me.Toolbar1.Buttons(29).Value = tbrPressed Then
                Me.ActiveForm.RichTextBox1.SelBullet = True
            Else
                Me.ActiveForm.RichTextBox1.SelBullet = False
            End If
            End If
    End Select
End Sub

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)
    LoadNewDoc
For i = 1 To 10
  history(i) = ""
Next i
For i = 1 To 100
    Me.Combo2.AddItem i
Next i
Me.Combo2.ListIndex = 9
Me.Text1.Text = 0
Me.Toolbar2.Item(1).Buttons(9).Value = tbrPressed
Me.SpinButton1.Value = 30
filepath = ""
saveoption = 0
flag = True
place = 10
tempoffset = 0
tempsize = 10
Me.ActiveForm.Picture1.BackColor = RGB(0, 0, 0)
Me.Toolbar2(0).ButtonHeight = 350
Me.Toolbar2(0).Height = 435
End Sub


Private Sub LoadNewDoc()
    Dim frmD As frmoffice
    lDocumentCount = lDocumentCount + 1
    Set frmD = New frmoffice
    frmD.Caption = "Document " & lDocumentCount
    frmD.Show
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 mnuHelpAbout_Click()
    MsgBox "版本 " & App.Major & "." & App.Minor & "." & App.Revision
End Sub

Private Sub mnuHelpContents_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, 3, 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 mnuEditPaste_Click()
    On Error Resume Next
    ActiveForm.RichTextBox1.SelRTF = Clipboard.GetText

End Sub

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

End Sub

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

End Sub

Private Sub mnuFileExit_Click()
    '卸载窗体
    Unload Me
Load frmMain
frmMain.Show
End Sub

Private Sub mnuFileSaveAs_Click()
    Dim sFile As String
    

    If ActiveForm Is Nothing Then Exit Sub
    

    With CommonDialog1
        .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.RichTextBox1.SaveFile sFile

End Sub

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

End Sub

Private Sub mnuFileClose_Click()
        If Not (Me.ActiveForm.RichTextBox1.Text = "") Then
                response = MsgBox("需要保存当前文件吗?", 48 + 3, "提示信息")
                    If response = vbYes Then
                        Me.CommonDialog1.ShowSave
                        Me.ActiveForm.RichTextBox1.SaveFile Me.CommonDialog1.FileName, 1
                        Unload Me.ActiveForm
                        lDocumentCount = lDocumentCount - 1
                    ElseIf response = vbNo Then
                        Unload Me.ActiveForm
                        lDocumentCount = lDocumentCount - 1
                    Else
                        Exit Sub
                    End If
                Else
                    Unload Me.ActiveForm
                    lDocumentCount = lDocumentCount - 1
                End If
    
End Sub

Private Sub mnuFileOpen_Click()
    Dim sFile As String
    If ActiveForm Is Nothing Then LoadNewDoc
    With CommonDialog1
        .DialogTitle = "打开"
        .CancelError = False
        'ToDo: 设置 common dialog 控件的标志和属性
        .Filter = "所有文件 (*.*)|*.*"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    ActiveForm.RichTextBox1.LoadFile sFile
    ActiveForm.Caption = sFile
    Me.StatusBar1.Panels(1).Text = sFile

End Sub

Private Sub mnuFileNew_Click()
    LoadNewDoc
End Sub

Private Sub Toolbar2_ButtonClick(Index As Integer, ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
            Case "Explorer"
                response = Shell("C:\windows\explorer.exe", vbNormalNoFocus)
            Case "IE"
                Load FrmWebBroswer
                FrmWebBroswer.Show
            Case "Notepad"
                response = Shell("C:\windows\Notepad.exe", vbNormalNoFocus)
            Case "cal"
                Load frmCalculator
                frmCalculator.Show
            Case "Adress"
                Load frmNoteBook
                frmNoteBook.Show
            Case "paint"
                Load frmControl
                frmControl.Show
            Case "Protect"
                Me.ActiveForm.RichTextBox1.SelText = Me.ActiveForm.RichTextBox1.SelText + CStr(Now())
            Case "Time"
                Me.ActiveForm.RichTextBox1.Text = Me.ActiveForm.RichTextBox1.Text + Now()
            Case "Key"
                Load frmKey
                frmKey.Show
            Case "Lockup"
                Load frmLockup
                frmLockup.Show
            Case "partlock"
                If Me.Toolbar2.Item(1).Buttons(11).Value = tbrPressed Then
                Me.ActiveForm.RichTextBox1.SelColor = RGB(255, 0, 0)
                Me.ActiveForm.RichTextBox1.SelProtected = True
                MsgBox "被保护的文本不能进行格式设置,否则将关闭系统!"
                Else
                Me.ActiveForm.RichTextBox1.SelProtected = False
                Me.ActiveForm.RichTextBox1.SelColor = RGB(0, 0, 0)
                End If
            Case "Cover"
                If Me.Toolbar2.Item(1).Buttons(12).Value = tbrPressed Then
                
                If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
                Call protect
                Else
                If Not IsNull(Me.ActiveForm.RichTextBox1.SelFontSize) Then tempsize = Me.ActiveForm.RichTextBox1.SelFontSize
                If Not IsNull(Me.ActiveForm.RichTextBox1.SelCharOffset) Then tempoffset = Me.ActiveForm.RichTextBox1.SelCharOffset
                If Not IsNull(Me.ActiveForm.RichTextBox1.SelColor) Then Me.ActiveForm.Picture1.BackColor = Me.ActiveForm.RichTextBox1.SelColor
                Me.ActiveForm.RichTextBox1.SelFontSize = 1
                Me.ActiveForm.RichTextBox1.SelCharOffset = 700
                Me.ActiveForm.RichTextBox1.SelColor = Me.ActiveForm.RichTextBox1.BackColor
                End If
                
                Else
                If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
                Call protect
                Else
                Me.ActiveForm.RichTextBox1.SelColor = Me.ActiveForm.Picture1.BackColor
                Me.ActiveForm.RichTextBox1.SelFontSize = tempsize
                Me.ActiveForm.RichTextBox1.SelCharOffset = tempoffset
                Me.ActiveForm.Picture1.BackColor = RGB(0, 0, 0)
                tempsize = 10
                tempoffset = 0
                End If
                End If
                
    End Select

End Sub
Private Sub combo1_Change()
If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
Call protect
Else
    Me.ActiveForm.RichTextBox1.SelFontName = Me.Combo1.Text
            If Not (Err.Number = 0) Then MsgBox Err.Description
End If
End Sub

Private Sub Combo1_Click()
If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
Call protect
Else

    Me.ActiveForm.RichTextBox1.SelFontName = Me.Combo1.Text
            If Not (Err.Number = 0) Then MsgBox Err.Description
End If
End Sub

Private Sub Combo2_Change()
If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
Call protect
Else
    Me.ActiveForm.RichTextBox1.SelFontSize = Me.Combo2.Text
    If Not (Err.Number = 0) Then MsgBox Err.Description
          If Not (Err.Number = 0) Then MsgBox Err.Description
End If
End Sub

Private Sub Combo2_Click()
On Error Resume Next
If (Me.ActiveForm.RichTextBox1.SelProtected = True) Or IsNull(Me.ActiveForm.RichTextBox1.SelProtected) Then
Call protect
Else
    Me.ActiveForm.RichTextBox1.SelFontSize = Me.Combo2.Text
End If
End Sub