form1.frm

我自己用vb编的一个小记事本

      End
      Begin VB.Menu savef 
         Caption         =   "保存(&S)"
         Shortcut        =   ^S
      End
      Begin VB.Menu saveef 
         Caption         =   "另存(&E)"
         Shortcut        =   ^E
      End
      Begin VB.Menu b 
         Caption         =   "-"
      End
      Begin VB.Menu printf 
         Caption         =   "打印(&P)"
         Shortcut        =   ^P
      End
   End
   Begin VB.Menu editf 
      Caption         =   "编辑(&E)"
      Begin VB.Menu copyf 
         Caption         =   "复制(&Z)"
         Shortcut        =   ^Z
      End
      Begin VB.Menu pastef 
         Caption         =   "粘贴(&Q)"
         Shortcut        =   ^Q
      End
      Begin VB.Menu cutf 
         Caption         =   "剪切(&T)"
         Shortcut        =   ^T
      End
      Begin VB.Menu deletef 
         Caption         =   "删除(&D)"
         Shortcut        =   ^D
      End
      Begin VB.Menu c 
         Caption         =   "-"
      End
      Begin VB.Menu allf 
         Caption         =   "全选(&A)"
         Shortcut        =   ^A
      End
   End
   Begin VB.Menu stylef 
      Caption         =   "格式(&S)"
      Begin VB.Menu fontf 
         Caption         =   "字体(&F)"
         Shortcut        =   ^F
      End
      Begin VB.Menu colorf 
         Caption         =   "颜色(&G)"
         Shortcut        =   ^G
      End
   End
   Begin VB.Menu serchf 
      Caption         =   "搜索(&O)"
      Begin VB.Menu findf 
         Caption         =   "查找(&J)"
         Shortcut        =   ^J
      End
   End
   Begin VB.Menu helpf 
      Caption         =   "帮助(&H)"
      Begin VB.Menu aboutf 
         Caption         =   "关于(&B)"
         Shortcut        =   ^B
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim filename1 As String     '操作的文件路径
Dim txt As String           '要查找的内容
Dim FoundPos As Integer     '要查找的内容的位置

Private Sub allf_Click()    '全选
    RichTextBox1.SelStart = 0
    RichTextBox1.SelLength = Len(RichTextBox1.Text)
    RichTextBox1.SetFocus
End Sub

Private Sub closef_Click()  '关闭
    If filename1 = "" Then  '如果没有保存过，先保存文件
        saveef_Click
    Else                    '防止未保存，保存文件
        savef_Click
    End If
    Unload Me
End Sub

Private Sub colorf_Click()  '颜色
    CommonDialog1.ShowColor
    RichTextBox1.SelColor = CommonDialog1.Color
End Sub

Private Sub copyf_Click()   '复制
    Clipboard.SetText RichTextBox1.SelText
End Sub

Private Sub cutf_Click()    '剪切
    Clipboard.SetText RichTextBox1.SelText
    RichTextBox1.SelText = ""
End Sub

Private Sub deletef_Click() '删除
    RichTextBox1.SelText = ""
End Sub

Private Sub findf_Click()   '查找
    txt = InputBox("要查找的内容", "查找")
    If txt = "" Then        '未输入则结束
        End
    End If
    FoundPos = RichTextBox1.Find(txt, , Len(RichTextBox1.Text))
    If FoundPos = -1 Then
        MsgBox "找不到" & txt & "!", vbExclamation, "提示"
    End If
End Sub

Private Sub fontf_Click()   '字体
    CommonDialog1.Flags = cdlCFBoth Or cdlCFEffects Or cdlCCFullOpen
    CommonDialog1.ShowFont
    RichTextBox1.SelFontName = CommonDialog1.FontName
    RichTextBox1.SelFontSize = CommonDialog1.FontSize
    RichTextBox1.SelBold = CommonDialog1.FontBold
    RichTextBox1.SelItalic = CommonDialog1.FontItalic
    RichTextBox1.SelUnderline = CommonDialog1.FontUnderline
    RichTextBox1.SelStrikeThru = CommonDialog1.FontStrikethru
    RichTextBox1.SelColor = CommonDialog1.Color
End Sub

Private Sub newf_Click()    '新建
    If RichTextBox1.Text <> "" Then '有文本则先保存
        saveef_Click
        RichTextBox1.Text = ""
    Else                            '然后再新建
        filename1 = CommonDialog1.FileName
        RichTextBox1.SaveFile filename1
        RichTextBox1.Text = ""
        filename1 = ""
    End If
End Sub

Private Sub openf_Click()   '打开
    CommonDialog1.Filter = "文本文件 (*.txt)|*.txt|rtf文件 (*.rtf)|*.rtf|所有文件 (*.*)|*.*"
    CommonDialog1.ShowOpen
    filename1 = CommonDialog1.FileName
    RichTextBox1.LoadFile filename1
End Sub

Private Sub pastef_Click()  '粘贴
    RichTextBox1.SelText = Clipboard.GetText
End Sub

Private Sub printf_Click()  '打印
    CommonDialog1.ShowPrinter
End Sub

Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    StatusBar1.Panels.Item(3).Text = "X=" & x & ",Y=" & y   '坐标显示
End Sub

Private Sub saveef_Click()  '另存为
    CommonDialog1.Filter = "文本文件 (*.txt)|*.txt|rtf文件 (*.rtf)|*.rtf|所有文件 (*.*)|*.*"
    CommonDialog1.ShowSave
    filename1 = CommonDialog1.FileName
    RichTextBox1.SaveFile filename1
End Sub

Private Sub savef_Click()   '保存
    If filename1 = "" Then
        CommonDialog1.Filter = "文本文件 (*.txt)|*.txt|rtf文件 (*.rtf)|*.rtf|所有文件 (*.*)|*.*"
        CommonDialog1.ShowSave
        filename1 = CommonDialog1.FileName
        RichTextBox1.SaveFile filename1
    Else
        filename1 = CommonDialog1.FileName
        RichTextBox1.SaveFile filename1
    End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key  '工具栏按钮
        Case "B1":
            newf_Click
        Case "B2":
            openf_Click
        Case "B3":
            savef_Click
        Case "B4":
            printf_Click
        Case "B5":
            copyf_Click
        Case "B6":
            cutf_Click
        Case "B7":
            pastef_Click
        Case "B8":
            findf_Click
        Case "B9":
            If CommonDialog1.FontUnderline = True Then
                CommonDialog1.FontUnderline = False
                RichTextBox1.SelUnderline = CommonDialog1.FontUnderline
            Else
                CommonDialog1.FontUnderline = True
                RichTextBox1.SelUnderline = CommonDialog1.FontUnderline
            End If
    End Select
End Sub

Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
    Select Case ButtonMenu.Key  '工具栏菜单
        Case "fontf":
            fontf_Click
        Case "colorf":
            colorf_Click
    End Select
End Sub