frmmain.frm

文本编辑器的源程序

   End
   Begin VB.Menu mnuTXT 
      Caption         =   "文字(&T)"
      Begin VB.Menu mnuTXTfont 
         Caption         =   "字体(&F)"
      End
      Begin VB.Menu mnuTXTColor 
         Caption         =   "颜色(&A)"
      End
      Begin VB.Menu mnuTXTBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuTXTBold 
         Caption         =   "粗体(&B)"
      End
      Begin VB.Menu mnuTXTItalic 
         Caption         =   "斜体(&I)"
      End
      Begin VB.Menu mnuTXTUnderline 
         Caption         =   "下划线(&U)"
      End
      Begin VB.Menu mnuTXTBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuTXTL 
         Caption         =   "左对齐(&L)"
      End
      Begin VB.Menu mnuTXTC 
         Caption         =   "置中(&C)"
      End
      Begin VB.Menu mnuTXTR 
         Caption         =   "右对齐(&R)"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于(&A) "
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Form_Load()
    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)
End Sub


Private Sub Form_Resize()
RichTextBox1.Width = ScaleWidth
RichTextBox1.Height = Me.ScaleHeight

End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer
    'close all sub forms
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    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 tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "新建"
           mnuFileNew_Click
        Case "打开"
            mnuFileOpen_Click
        Case "保存"
            mnuFileSave_Click
        Case "打印"
            mnuFilePrint_Click
        Case "剪切"
            mnuEditCut_Click
        Case "复制"
            mnuEditCopy_Click
        Case "粘贴"
            mnuEditPaste_Click
        Case "粗体"
            mnuTXTBold_Click
        Case "斜体"
           mnuTXTItalic_Click
        Case "下划线"
          mnuTXTUnderline_Click
        Case "左对齐"
         mnuTXTL_Click
        Case "置中"
          mnuTXTC_Click
        Case "右对齐"
           mnuTXTR_Click
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuTXTR_Click()
  mnuTXTL.Checked = False
  mnuTXTR.Checked = True
  mnuTXTC.Checked = False
  RichTextBox1.SelAlignment = 1
End Sub

Private Sub mnuTXTC_Click()
  mnuTXTL.Checked = False
  mnuTXTR.Checked = False
  mnuTXTC.Checked = True
  RichTextBox1.SelAlignment = 2
End Sub

Private Sub mnuTXTL_Click()
  mnuTXTL.Checked = True
  mnuTXTR.Checked = False
  mnuTXTC.Checked = False
  RichTextBox1.SelAlignment = 0
  
End Sub

Private Sub mnuTXTUnderline_Click()
 RichTextBox1.SelUnderline = Not RichTextBox1.SelUnderline
 
End Sub

Private Sub mnuTXTItalic_Click()
 RichTextBox1.SelItalic = Not RichTextBox1.SelItalic
 
End Sub

Private Sub mnuTXTBold_Click()
   RichTextBox1.SelBold = Not RichTextBox1.SelBold

End Sub

Private Sub mnuTXTColor_Click()
  dlgCommonDialog.ShowColor
  RichTextBox1.SelColor = dlgCommonDialog.Color
    
End Sub

Private Sub mnuTXTfont_Click()
  dlgCommonDialog.Flags = cdlCFBoth
  dlgCommonDialog.ShowFont
   RichTextBox1.SelFontName = dlgCommonDialog.FontName
   RichTextBox1.SelFontSize = dlgCommonDialog.FontSize
      RichTextBox1.SelBold = dlgCommonDialog.FontBold
      RichTextBox1.SelItalic = dlgCommonDialog.FontItalic
      RichTextBox1.SelUnderline = dlgCommonDialog.FontUnderline
      RichTextBox1.SelStrikeThru = dlgCommonDialog.FontStrikethru
 
  
End Sub

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

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

Private Sub mnuEditPaste_Click()
 RichTextBox1.SelText = Clipboard.GetText()
 
End Sub

Private Sub mnuEditCopy_Click()
   Clipboard.SetText RichTextBox1.SelText
End Sub

Private Sub mnuEditCut_Click()
  Clipboard.SetText RichTextBox1.SelText
  RichTextBox1.SelText = ""
End Sub

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

Private Sub mnuFileExit_Click()
    '卸载窗体
    Unload Me

End Sub

Private Sub mnuFilePrint_Click()
 dlgCommonDialog.Flags = cdlPDReturnDC + cdlPDNoPageNums
   If RichTextBox1.SelLength = 0 Then
    dlgCommonDialog.Flags = dlgCommonDialog.Flags + cdlPDAllPages
   Else
    dlgCommonDialog.Flags = dlgCommonDialog.Flags + cdlPDSelection
   End If
   dlgCommonDialog.ShowPrinter
   ' 显示“打印”对话框
   RichTextBox1.SelPrint dlgCommonDialog.hDC
   '打印
 
End Sub

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

Private Sub mnuFileSave_Click()
   Dim sFile As String
   sFile = Caption
   If sFile = "Notepad" Then
     mnuFileSaveAs_Click
   Else
    RichTextBox1.SaveFile sFile
  End If
  
    
    
    
End Sub

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

End Sub

Private Sub mnuFileNew_Click()
   RichTextBox1.Text = " "
   Caption = "Notepad"
    
End Sub