frmoffice.frm

这是一套非常好用的软件啊

                Me.CommonDialog1.ShowSave
                Me.RichTextBox1.SaveFile Me.CommonDialog1.FileName, 1
                filepath = Me.CommonDialog1.FileName
                Else
                Me.RichTextBox1.SaveFile filepath
                End If
                ElseIf response = vbNo Then
                GoTo openfile
                Else
                Exit Sub
                End If
            End If
openfile:
            Me.CommonDialog1.ShowOpen
            Me.RichTextBox1.LoadFile Me.CommonDialog1.FileName, 1
            Me.Caption = Me.Caption + "---" + Me.CommonDialog1.FileName
            Me.StatusBar1.Panels(1).Text = Me.CommonDialog1.FileName
End Sub

Private Sub MnuPartLock_Click()
                If Me.Toolbar2.Buttons(11).Value = tbrPressed Then
                Me.RichTextBox1.SelColor = RGB(255, 0, 0)
                Me.RichTextBox1.SelProtected = True
                MsgBox "被保护的文本不能进行格式设置,否则将关闭系统!"
                Else
                Me.RichTextBox1.SelProtected = False
                Me.RichTextBox1.SelColor = RGB(0, 0, 0)
                End If

End Sub

Private Sub MnuPaste_Click()
 Me.RichTextBox1.SelText = Clipboard.GetText
End Sub

Private Sub MnuPrint_Click()
Me.RichTextBox1.SelPrint Printer.hDC
End Sub

Private Sub MnuRedo_Click()
Me.RichTextBox1.Text = history(place + 1)
            place = place + 1
            If place = 10 Then Me.Toolbar1.Buttons.Item(12).Enabled = False
            Me.Toolbar1.Buttons.Item(11).Enabled = True
            flag = False
End Sub

Private Sub MnuRight_Click()
If (Me.RichTextBox1.SelProtected = True) Or IsNull(Me.RichTextBox1.SelProtected) Then
            Call protect
            Else
            If Me.Toolbar1.Buttons.Item(26).Value = tbrPressed Then Me.RichTextBox1.SelAlignment = 1
                If Not (Err.Number = 0) Then MsgBox Err.Description
            End If
End Sub

Private Sub MnuSave_Click()
If saveoption = 0 Then
                Me.CommonDialog1.ShowSave
                Me.RichTextBox1.SaveFile Me.CommonDialog1.FileName, 1
                saveoption = 1
                filepath = Me.CommonDialog1.FileName
                Me.StatusBar1.Panels(1).Text = Me.CommonDialog1.FileName
            Else
                Me.RichTextBox1.SaveFile filepath
            End If
End Sub

Private Sub MnuStrike_Click()
If (Me.RichTextBox1.SelProtected = True) Or IsNull(Me.RichTextBox1.SelProtected) Then
            Call protect
        Else
            If Me.Toolbar1.Buttons.Item(19).Value = tbrPressed Then
            Me.RichTextBox1.SelStrikeThru = True
            ElseIf Me.Toolbar1.Buttons.Item(19).Value = tbrUnpressed Then
            Me.RichTextBox1.SelStrikeThru = False
            Else
            End If
        End If
End Sub

Private Sub MnuTime_Click()
                Me.RichTextBox1.SelText = Me.RichTextBox1.SelText + CStr(Now())

End Sub

Private Sub MnuUcase_Click()
If (Me.RichTextBox1.SelProtected = True) Or IsNull(Me.RichTextBox1.SelProtected) Then
            Call protect
            Else
            Me.RichTextBox1.SelText = UCase(Me.RichTextBox1.SelText)
                If Not (Err.Number = 0) Then MsgBox Err.Description
            End If
End Sub

Private Sub MnuUnder_Click()
If (Me.RichTextBox1.SelProtected = True) Or IsNull(Me.RichTextBox1.SelProtected) Then
             Call protect
        Else
            If Me.Toolbar1.Buttons.Item(18).Value = tbrPressed Then
            Me.RichTextBox1.SelUnderline = True
            ElseIf Me.Toolbar1.Buttons.Item(18).Value = tbrUnpressed Then
            Me.RichTextBox1.SelUnderline = False
            Else
            End If
        End If
End Sub

Private Sub MnuUndo_Click()
Me.RichTextBox1.Text = history(place - 1)
            place = place - 1
            If place = 1 Then Me.Toolbar1.Buttons.Item(11).Enabled = False
            Me.Toolbar1.Buttons.Item(12).Enabled = True
            flag = False
End Sub

Private Sub MnuWeb_Click()
                Load FrmWWWBroswer
                FrmWWWBroswer.Show

End Sub

Private Sub RichTextBox1_Change()
If flag = True Then
        For i = 1 To 9
            history(i) = history(i + 1)
        Next i
    history(10) = Me.RichTextBox1.Text
    place = 10
    Me.Toolbar1.Buttons.Item(12).Enabled = False
    Me.Toolbar1.Buttons.Item(11).Enabled = True
    flag = True
End If
End Sub

'Private Sub RichTextBox1_KeyPress(KeyAscii As Integer)

'For i = 1 To 9
' history(i) = history(i + 1)
'Next i
' history(10) = Me.RichTextBox1.Text
' place = 10
' Me.Toolbar1.Buttons.Item(12).Enabled = False
' Me.Toolbar1.Buttons.Item(11).Enabled = True
' flag = False

'   Me.StatusBar1.Panels(2).Text = "Line" + CStr(Me.RichTextBox1.SelStart)
      
 
'End Sub

Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim str As String
If Shift = vbCtrlMask Then
Select Case KeyCode
    Case vbKeyS
        Me.RichTextBox1.Span ".。?!" + Chr(13), False, True
        TextStart = Me.RichTextBox1.SelStart
        Me.RichTextBox1.Span ".。?!", True, True
        TextEnd = Me.RichTextBox1.SelStart + Me.RichTextBox1.SelLength
        Me.RichTextBox1.SelStart = TextStart
        Me.RichTextBox1.SelLength = TextEnd - TextStart
        str = Me.RichTextBox1.SelText
    Case vbKeyW
        Me.RichTextBox1.Span ",.。;:?!", False, True
        TextStart = Me.RichTextBox1.SelStart
        Me.RichTextBox1.Span ",.。;:?!", True, True
        TextEnd = Me.RichTextBox1.SelStart + Me.RichTextBox1.SelLength
        Me.RichTextBox1.SelStart = TextStart
        Me.RichTextBox1.SelLength = TextEnd - TextStart
    End Select
 End If
        
 If Shift = (vbCtrlMask Or vbShiftMask) Then
    Select Case KeyCode
    Case vbKeyS
        Me.RichTextBox1.UpTo ".。?!", True, False
    Case vbKeyW
        Me.RichTextBox1.UpTo ",.。;:?!", True, False
    End Select
End If
End Sub

Private Sub RichTextBox1_SelChange()
   If Not IsNull(Me.RichTextBox1.SelBold) Then
    If RichTextBox1.SelBold = True Then
    Toolbar1.Buttons.Item(16).Value = tbrPressed
    ElseIf RichTextBox1.SelBold = False Then
    Toolbar1.Buttons.Item(16).Value = tbrUnpressed
    Else
    End If
   Else
   End If
   
   If RichTextBox1.SelItalic = True Then
   Toolbar1.Buttons.Item(17).Value = tbrPressed
   ElseIf RichTextBox1.SelItalic = False Then
   Toolbar1.Buttons.Item(17).Value = tbrUnpressed
   Else
   End If
   
   If RichTextBox1.SelUnderline = True Then
   Toolbar1.Buttons.Item(18).Value = tbrPressed
   ElseIf RichTextBox1.SelUnderline = False Then
   Toolbar1.Buttons.Item(18).Value = tbrUnpressed
   Else
   End If
   
   If RichTextBox1.SelStrikeThru = True Then
   Toolbar1.Buttons.Item(19).Value = tbrPressed
   ElseIf RichTextBox1.SelStrikeThru = False Then
   Toolbar1.Buttons.Item(19).Value = tbrUnpressed
   Else
   End If
   
   If Me.RichTextBox1.SelAlignment = 0 Then
    Toolbar1.Buttons.Item(24).Value = tbrPressed
   ElseIf Me.RichTextBox1.SelAlignment = 1 Then
    Toolbar1.Buttons.Item(26).Value = tbrPressed
   ElseIf Me.RichTextBox1.SelAlignment = 3 Then
    Toolbar1.Buttons.Item(25).Value = tbrPressed
   Else
   End If
   
   If UCase(Me.RichTextBox1.SelText) = Me.RichTextBox1.SelText And (Not (IsEmpty(Me.RichTextBox1.SelText))) Then
    Toolbar1.Buttons.Item(28).Value = tbrPressed
   ElseIf LCase(Me.RichTextBox1.SelText) = Me.RichTextBox1.SelText And (Not (IsEmpty(Me.RichTextBox1.SelText))) Then
    Toolbar1.Buttons.Item(29).Value = tbrPressed
   Else
   End If
   
   If Not (IsNull(Me.RichTextBox1.SelFontName)) Then Me.Combo1.Text = Me.RichTextBox1.SelFontName
   If Not (IsNull(Me.RichTextBox1.SelFontSize)) Then Me.Combo2.Text = Me.RichTextBox1.SelFontSize
   If Not (IsNull(Me.RichTextBox1.SelCharOffset)) Then Me.Text1.Text = Me.RichTextBox1.SelCharOffset / 10
   If Not (IsNull(Me.RichTextBox1.SelProtected)) Then
        If Me.RichTextBox1.SelProtected Then
        Me.Toolbar2.Buttons(11).Value = tbrPressed
        Else: Me.Toolbar2.Buttons(11).Value = tbrUnpressed
        End If
   End If
   
   If Not (IsNull(Me.RichTextBox1.SelHangingIndent)) Then Me.Slider1.Value = Me.RichTextBox1.SelHangingIndent / 400
   If Not (IsNull(Me.RichTextBox1.SelIndent)) Then Me.Slider2.Value = Me.RichTextBox1.SelIndent / 400
   If Not (IsNull(Me.RichTextBox1.SelRightIndent)) Then Me.Slider3.Value = Me.Slider3.Max - Me.RichTextBox1.SelRightIndent / 400
   
   If Not (IsNull(Me.RichTextBox1.SelBullet)) Then
     If Me.RichTextBox1.SelBullet Then
        Me.Toolbar1.Buttons(32).Value = tbrPressed
     Else
        Me.Toolbar1.Buttons(32).Value = tbrUnpressed
     End If
   Else
   End If
   Me.StatusBar1.Panels(2).Text = "Line" + CStr(Me.RichTextBox1.SelStart)
   If Frmfind.Enabled = True Then Frmfind.SetFocus
       


End Sub

Private Sub Slider1_Change()
    Me.RichTextBox1.SetFocus
    Me.RichTextBox1.SelHangingIndent = Me.Slider1.Value * 400
End Sub

Private Sub Slider2_Click()
    Me.RichTextBox1.SetFocus
    Me.RichTextBox1.SelIndent = Me.Slider2.Value * 400
End Sub
Private Sub Slider2_Scroll()
    Me.RichTextBox1.SetFocus
    Me.RichTextBox1.SelIndent = Me.Slider2.Value * 400
End Sub
Private Sub Slider3_Change()
    Me.RichTextBox1.SetFocus
    Me.RichTextBox1.SelRightIndent = (Me.Slider3.Max - Me.Slider3.Value) * 400
End Sub

Private Sub Slider3_Click()
    Me.RichTextBox1.SetFocus
    Me.RichTextBox1.SelRightIndent = (Me.Slider3.Max - Me.Slider3.Value) * 400
End Sub

Private Sub Slider3_Scroll()
    Me.RichTextBox1.SetFocus
    Me.RichTextBox1.SelRightIndent = (Me.Slider3.Max - Me.Slider3.Value) * 400
End Sub

Private Sub Slider1_Click()
    Me.RichTextBox1.SetFocus
    Me.RichTextBox1.SelHangingIndent = Me.Slider1.Value * (400)
End Sub
Private Sub Slider1_Scroll()
    Me.RichTextBox1.SetFocus
    Me.RichTextBox1.SelHangingIndent = Me.Slider1.Value * (400)
End Sub

Private Sub SpinButton1_Change()
Me.Text1.Text = Me.SpinButton1.Value - 30
End Sub

Private Sub Text1_Change()
If (Me.RichTextBox1.SelProtected = True) Or IsNull(Me.RichTextBox1.SelProtected) Then
Call protect
Else
    
    If Not (Me.Text1.Text = "") Then
        Me.RichTextBox1.SelCharOffset = Me.Text1.Text * 10
        Me.SpinButton1.Value = Me.Text1.Text + 30
        If Not (Err.Number = 0) Then MsgBox Err.Description
    Else
    End If
End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim response As Integer
       Select Case Button.Index
        Case 1
            saveoption = 0
            If Not (Me.RichTextBox1.Text = "") Then
            response = MsgBox("需要保存当前文件吗?", 48 + 3, "提示信息")
                If response = vbYes Then
                Me.CommonDialog1.ShowSave
                Me.RichTextBox1.SaveFile Me.CommonDialog1.FileName, 1
                filepath = Me.CommonDialog1.FileName
                ElseIf response = vbNo Then
                Me.RichTextBox1.Text = ""
                Else
                Exit Sub
                End If
            End If
        Case 2
            If Not (Me.RichTextBox1.Text = "") Then
            response = MsgBox("需要保存当前文件吗?", 48 + 3, "提示信息")
                If response = vbYes Then
                If saveoption = 0 Then
                Me.CommonDialog1.ShowSave
                Me.RichTextBox1.SaveFile Me.CommonDialog1.FileName, 1
                filepath = Me.CommonDialog1.FileName
                Else
                Me.RichTextBox1.SaveFile filepath
                End If
                ElseIf response = vbNo Then