frmoffice.frm

类似WORD的文字编辑器

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmoffice 
   Caption         =   "office"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   60
   ClientWidth     =   4680
   Icon            =   "frmoffice.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   Begin VB.PictureBox Picture1 
      Height          =   495
      Left            =   840
      ScaleHeight     =   435
      ScaleWidth      =   555
      TabIndex        =   4
      Top             =   1680
      Visible         =   0   'False
      Width           =   615
   End
   Begin RichTextLib.RichTextBox RichTextBox1 
      CausesValidation=   0   'False
      Height          =   6375
      Left            =   0
      TabIndex        =   0
      Top             =   345
      Width           =   9495
      _ExtentX        =   16748
      _ExtentY        =   11245
      _Version        =   393217
      HideSelection   =   0   'False
      ScrollBars      =   3
      BulletIndent    =   200
      AutoVerbMenu    =   -1  'True
      TextRTF         =   $"frmoffice.frx":030A
   End
   Begin MSComctlLib.Slider Slider3 
      Height          =   120
      Left            =   0
      TabIndex        =   1
      Top             =   225
      Width           =   9495
      _ExtentX        =   16748
      _ExtentY        =   212
      _Version        =   393216
      Max             =   20
      SelStart        =   20
      Value           =   20
   End
   Begin MSComctlLib.Slider Slider2 
      Height          =   120
      Left            =   0
      TabIndex        =   2
      Top             =   120
      Width           =   9495
      _ExtentX        =   16748
      _ExtentY        =   212
      _Version        =   393216
      Max             =   20
   End
   Begin ComctlLib.Slider Slider1 
      Height          =   120
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   9495
      _ExtentX        =   16748
      _ExtentY        =   212
      _Version        =   327682
      Max             =   20
   End
End
Attribute VB_Name = "frmoffice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

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

Private Sub RichTextBox1_SelChange()
    If Not IsNull(Me.RichTextBox1.SelBold) Then
    If RichTextBox1.SelBold = True Then
    frmMDI.Toolbar1.Buttons(13).Value = tbrPressed
    ElseIf RichTextBox1.SelBold = False Then
    frmMDI.Toolbar1.Buttons(13).Value = tbrUnpressed
    Else
    End If
   Else
   End If
   
   If RichTextBox1.SelItalic = True Then
   frmMDI.Toolbar1.Buttons(14).Value = tbrPressed
   ElseIf RichTextBox1.SelItalic = False Then
   frmMDI.Toolbar1.Buttons(14).Value = tbrUnpressed
   Else
   End If
   
   If RichTextBox1.SelUnderline = True Then
   frmMDI.Toolbar1.Buttons(15).Value = tbrPressed
   ElseIf RichTextBox1.SelUnderline = False Then
   frmMDI.Toolbar1.Buttons(15).Value = tbrUnpressed
   Else
   End If
   
   If RichTextBox1.SelStrikeThru = True Then
   frmMDI.Toolbar1.Buttons(16).Value = tbrPressed
   ElseIf RichTextBox1.SelStrikeThru = False Then
   frmMDI.Toolbar1.Buttons(16).Value = tbrUnpressed
   Else
   End If
   
   If Me.RichTextBox1.SelAlignment = 0 Then
    frmMDI.Toolbar1.Buttons(21).Value = tbrPressed
   ElseIf Me.RichTextBox1.SelAlignment = 1 Then
    frmMDI.Toolbar1.Buttons(23).Value = tbrPressed
   ElseIf Me.RichTextBox1.SelAlignment = 3 Then
    frmMDI.Toolbar1.Buttons(22).Value = tbrPressed
   Else
   End If
   
   If UCase(Me.RichTextBox1.SelText) = Me.RichTextBox1.SelText And (Not (IsEmpty(Me.RichTextBox1.SelText))) Then
    frmMDI.Toolbar1.Buttons(25).Value = tbrPressed
   ElseIf LCase(Me.RichTextBox1.SelText) = Me.RichTextBox1.SelText And (Not (IsEmpty(Me.RichTextBox1.SelText))) Then
    frmMDI.Toolbar1.Buttons(26).Value = tbrPressed
   Else
   End If
   
   If Not (IsNull(Me.RichTextBox1.SelFontName)) Then frmMDI.Combo1.Text = Me.RichTextBox1.SelFontName
   If Not (IsNull(Me.RichTextBox1.SelFontSize)) Then frmMDI.Combo2.Text = Me.RichTextBox1.SelFontSize
   If Not (IsNull(Me.RichTextBox1.SelCharOffset)) Then frmMDI.Text1.Text = Me.RichTextBox1.SelCharOffset / 10
   If Not (IsNull(Me.RichTextBox1.SelProtected)) Then
        If Me.RichTextBox1.SelProtected Then
        frmMDI.Toolbar2.Item(1).Buttons(11).Value = tbrPressed
        Else: frmMDI.Toolbar2.Item(1).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
        frmMDI.Toolbar1.Buttons(29).Value = tbrPressed
     Else
        frmMDI.Toolbar1.Buttons(29).Value = tbrUnpressed
     End If
   Else
   End If
   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 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
    frmMDI.Toolbar1.Buttons.Item(12).Enabled = False
    frmMDI.Toolbar1.Buttons.Item(11).Enabled = True
    flag = True
End If
End Sub
Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
If Shift = vbCtrlMask Then
Select Case KeyCode
    Case vbKeyS
        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
    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