yxw1.frm

文本编辑器。可以通过此列制作出自己的实用编辑器。

Private Sub rtfText_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 2 Then
      PopupMenu popmnu
   End If
End Sub

Private Sub rtfText_SelChange()
Dim copy As Button
Dim cut As Button
    fMainForm.tbToolBar.Buttons("Bold").Value = IIf(rtfText.SelBold, tbrPressed, tbrUnpressed)
    fMainForm.tbToolBar.Buttons("Italic").Value = IIf(rtfText.SelItalic, tbrPressed, tbrUnpressed)
    fMainForm.tbToolBar.Buttons("Underline").Value = IIf(rtfText.SelUnderline, tbrPressed, tbrUnpressed)
    fMainForm.tbToolBar.Buttons("Align Left").Value = IIf(rtfText.SelAlignment = rtfLeft, tbrPressed, tbrUnpressed)
    fMainForm.tbToolBar.Buttons("Center").Value = IIf(rtfText.SelAlignment = rtfCenter, tbrPressed, tbrUnpressed)
    fMainForm.tbToolBar.Buttons("Align Right").Value = IIf(rtfText.SelAlignment = rtfRight, tbrPressed, tbrUnpressed)
    If rtfText.SelLength <> 0 Then
       popcut.Enabled = True
       popcopy.Enabled = True
       
       mnuEditCut.Enabled = True
       mnuEditCopy.Enabled = True
       
      fMainForm.tbToolBar.Buttons(7).Enabled = True
      fMainForm.tbToolBar.Buttons(8).Enabled = True
      
    
    Else
       popcut.Enabled = False
       popcopy.Enabled = False
       
       mnuEditCut.Enabled = False
       mnuEditCopy.Enabled = False
       
       fMainForm.tbToolBar.Buttons(7).Enabled = False
       fMainForm.tbToolBar.Buttons(8).Enabled = False
      
      
    End If
    
   
End Sub


Private Sub Form_Load()
    Form_Resize
    popcut.Enabled = False
    popcopy.Enabled = False
    mnuEditCut.Enabled = False
    mnuEditCopy.Enabled = False

    
    mnuViewToolbar.Checked = True
    mnuViewStatusBar.Checked = True
End Sub


Private Sub Form_Resize()
    On Error Resume Next
    rtfText.Move 100 / 567, 100 / 567, Me.ScaleWidth - 200 / 567, Me.ScaleHeight - 200 / 567
    rtfText.RightMargin = rtfText.Width - 400 / 567
    
End Sub
Private Sub mnuEditDelete_Click()
On Error Resume Next
    
    Screen.ActiveForm.rtfText.SelText = vbNullString

End Sub

Private Sub mnuEditFind_Click()
If rtfText.SelText <> "" Then

  FindString = rtfText.SelText
Else
  FindString = ""
End If
  FoundString = rtfText.Text
  EditFind.Combo1.Text = FindString
 
  EditFind.Show vbModal
 
End Sub

Private Sub mnuEditSelall_Click()
   Screen.ActiveForm.rtfText.SelStart = 0
   Screen.ActiveForm.rtfText.SelLength = Len(Screen.ActiveForm.rtfText)
   Screen.ActiveForm.rtfText.SetFocus
End Sub

Private Sub mnuFormatBack_Click()
   On Error GoTo errhandler
     With fMainForm.dlgCommonDialog
        .DialogTitle = "背景颜色"
        .CancelError = True
        .Flags = cdlCCFullOpen
        .ShowColor
     End With
     Screen.ActiveForm.rtfText.BackColor = fMainForm.dlgCommonDialog.color
     
errhandler:
     Exit Sub
End Sub

Private Sub mnuFormatFont_Click()
  font_Click
End Sub

Private Sub mnuFormatFontColor_Click()
  color_Click
End Sub

Private Sub mnuHelpAbout_Click()
    MsgBox "Version " & App.Major & "." & App.Minor & "." & App.Revision
End Sub

Private Sub mnuHelpSearchForHelpOn_Click()
    Dim nRet As Integer
    

    'if there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", 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 mnuHelpContents_Click()
    Dim nRet As Integer
     On Error GoTo errhandler
     ShellExecute 0, "Open", "D:\Program Files\Microsoft Office\Office\2052\MSOHELP.CHM", 0, 0, 1
      Exit Sub
   
errhandler:
  MsgBox Err.Description
End Sub


Private Sub mnuWindowArrangeIcons_Click()
    fMainForm.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowTileVertical_Click()
   fMainForm.Arrange vbTileVertical
End Sub

Private Sub mnuWindowTileHorizontal_Click()
   fMainForm.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowCascade_Click()
   fMainForm.Arrange vbCascade
  
End Sub

Private Sub mnuWindowNewWindow_Click()
    LoadNewDoc
End Sub

Private Sub mnuViewWebBrowser_Click()
    'ToDo: Add 'mnuViewWebBrowser_Click' code.
    MsgBox "Add 'mnuViewWebBrowser_Click' code."
End Sub

Private Sub mnuViewOptions_Click()
    'ToDo: Add 'mnuViewOptions_Click' code.
    MsgBox "Add 'mnuViewOptions_Click' code."
End Sub



Private Sub mnuViewStatusBar_Click()
    ViewStatusBar_Click
End Sub





Private Sub mnuEditPaste_Click()
   Paste_Click

End Sub

Private Sub mnuEditCopy_Click()
    Copy_Click
    popcut.Enabled = False
    popcopy.Enabled = False
    
    mnuEditCopy.Enabled = False
    mnuEditCut.Enabled = False
    
    fMainForm.tbToolBar.Buttons(7).Enabled = True
    fMainForm.tbToolBar.Buttons(8).Enabled = True
End Sub

Private Sub mnuEditCut_Click()
   Cut_Click
    popcut.Enabled = False
    popcopy.Enabled = False
    
    mnuEditCopy.Enabled = False
    mnuEditCut.Enabled = False
    
    fMainForm.tbToolBar.Buttons(7).Enabled = True
    fMainForm.tbToolBar.Buttons(8).Enabled = True
End Sub

Private Sub mnuEditUndo_Click()
   undo_click
End Sub


Private Sub mnuFileExit_Click()
    mnuFileSaveAll_Click
    End

End Sub



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

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

End Sub

Private Sub mnuFilePrintPreview_Click()
    'ToDo: Add 'mnuFilePrintPreview_Click' code.
    MsgBox "Add 'mnuFilePrintPreview_Click' code."
End Sub

Private Sub mnuFilePageSetup_Click()
    On Error Resume Next
    With frmMain.dlgCommonDialog
        .DialogTitle = "Page Setup"
        .CancelError = True
        .ShowPrinter
    End With

End Sub

Private Sub mnuFileProperties_Click()
    'ToDo: Add 'mnuFileProperties_Click' code.
    MsgBox "Add 'mnuFileProperties_Click' code."
End Sub

Private Sub mnuFileSaveAll_Click()
Dim i As Integer
If Mid(fMainForm.ActiveForm.Caption, 10, 1) < 9 And Mid(fMainForm.ActiveForm.Caption, 10, 1) > 0 And fMainForm.ActiveForm.Caption <> "Project1" Then
 While TextChanged(Mid(fMainForm.ActiveForm.Caption, 10, 1))
  
  If Mid(fMainForm.ActiveForm.Caption, 10, 1) < 9 And Mid(fMainForm.ActiveForm.Caption, 10, 1) > 0 Then
     If InStr(fMainForm.ActiveForm.Caption, "Document") = 1 Then
        mnuFileSaveAs_Click
        Unload fMainForm.ActiveForm
        Exit Sub
     Else
        End
     End If
  Else
    Exit Sub
  End If
  If fMainForm.ActiveForm.Caption = "Project1" Then
    End
 
    
  End If
  
 Wend
Else
  Exit Sub
End If
 

    
End Sub

Private Sub mnuFileSaveAs_Click()
Dim sFile As String
Dim i As Integer

 If InStr(fMainForm.ActiveForm.Caption, "Document") = 1 Then

  If TextChanged(Mid(fMainForm.ActiveForm.Caption, 10, 1)) Then
   i = Mid(fMainForm.ActiveForm.Caption, 10, 1)
    With fMainForm.dlgCommonDialog
        .DialogTitle = "保存"
        .CancelError = False
        .Flags = cdlOFNOverwritePrompt
        If Len(fMainForm.ActiveForm.Caption) > 10 Then
           .FileName = Mid(fMainForm.ActiveForm.Caption, 15)
        
        Else
           .FileName = fMainForm.ActiveForm.Caption
        End If
        .Filter = "所有文件 (*.*)|*.*|文本文件(*.txt)|*.txt|WORD文档(*.doc)|*.doc"
        .ShowSave
       
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
      
  
         fMainForm.ActiveForm.Caption = "Document " & i & "----" & sFile
         fMainForm.ActiveForm.rtfText.SaveFile sFile
         TextChanged(Mid(fMainForm.ActiveForm.Caption, 10, 1)) = False

  Else
    Exit Sub
  End If
 Else
   MsgBox "不存在要保存的文件", vbOKOnly, "警告！"
 End If
End Sub

Private Sub mnuFileSave_Click()
   Save_Click
End Sub

Private Sub mnuFileClose_Click()
  Dim stat As Integer
  
     If TextChanged(Mid(fMainForm.ActiveForm.Caption, 10, 1)) Then
        stat = MsgBox("保存对该文件的修改吗？", vbYesNoCancel, "保存文件")
           If stat = 6 Then
              mnuFileSaveAs_Click
           ElseIf stat = 2 Then
             Exit Sub
          
          End If
      End If
      Unload fMainForm.ActiveForm
End Sub

Private Sub mnuFileOpen_Click()
    Open_Click
        
End Sub


Private Sub mnuFileNew_Click()
    LoadNewDoc
End Sub