⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.vb

📁 用VB.NET开发的记事本,功能强大 用VB.NET开发的记事本,功能强大
💻 VB
📖 第 1 页 / 共 2 页
字号:
Imports System.IO
Imports System.Drawing.Printing
Public Class form1
    Inherits System.Windows.Forms.Form
    Private WithEvents pdoc As New PrintDocument()
    Dim mfilename As String
    Dim print_Font As New Font("标准楷体", 20)
    '读文件
    Sub readfile()
        Dim sr As StreamReader
        OpenFileDialog1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
        If OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then
            mfilename = OpenFileDialog1.FileName
            sr = New StreamReader(mfilename, System.Text.Encoding.Default)
            RichTextBox1.Text = sr.ReadToEnd
            sr.Close()
        End If
    End Sub
    '写文件
    Sub writefile()
        Dim sw As StreamWriter
        sw = New StreamWriter(mfilename, False, System.Text.Encoding.Default)
        sw.Write(RichTextBox1.Text)
        sw.Close()
        RichTextBox1.Modified = False
    End Sub
    '保存文件
    Sub saveasfile()
        SaveFileDialog1.FileName = "*.txt"
        SaveFileDialog1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
        If SaveFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then
            mfilename = SaveFileDialog1.FileName
            writefile()
        End If
    End Sub
    'MessageBox对话框
    Function oldfilehandle() As Boolean
        Dim result As DialogResult
        If RichTextBox1.Modified = True Then
            result = MessageBox.Show("文件" & "," & "文字已经改变。" & ControlChars.NewLine & "想保存文件吗?", "蓝色空间", MessageBoxButtons.YesNoCancel, MessageBoxIcon.Exclamation)
            Select Case result
                Case Windows.Forms.DialogResult.Yes
                    If mfilename = "" Then
                        saveasfile()
                    Else
                        writefile()
                    End If
                Case Windows.Forms.DialogResult.Cancel
                    Return False
            End Select
        End If
        Return True
    End Function








    '记事本菜单栏


    '鼠标图标
    'Private Sub RichtextBox1_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles RichTextBox1.MouseMove
    ' RichTextBox1.Cursor = New System.Windows.Forms.Cursor("E:\软件\用用\魔法ICO v2.00\ico\dou.ico")
    ' End Sub


    Private Sub 新建ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 新建ToolStripMenuItem.Click
        If oldfilehandle() Then
            RichTextBox1.Clear()
            mfilename = ""
        End If
    End Sub

    Private Sub 打开ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 打开ToolStripMenuItem.Click
        If oldfilehandle() Then
            readfile()
        End If
    End Sub

    Private Sub 保存ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 保存ToolStripMenuItem.Click
        If mfilename = "" Then
            saveasfile()
        Else
            writefile()
        End If
    End Sub

    Private Sub 另存为ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 另存为ToolStripMenuItem.Click
        saveasfile()
    End Sub

    Private Sub 字体ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 字体ToolStripMenuItem.Click
        FontDialog1.ShowDialog()
        RichTextBox1.SelectionFont = FontDialog1.Font
    End Sub

    Private Sub 列表形式ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 列表形式ToolStripMenuItem.Click
        列表形式ToolStripMenuItem.Checked = Not 列表形式ToolStripMenuItem.Checked

        If 列表形式ToolStripMenuItem.Checked = False Then
            Me.RichTextBox1.SelectionBullet = False
        Else
            Me.RichTextBox1.SelectionBullet = True
        End If
    End Sub

    Private Sub 剪贴ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 剪贴ToolStripMenuItem.Click
        RichTextBox1.Cut()
    End Sub

    Private Sub 复制ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 复制ToolStripMenuItem.Click
        RichTextBox1.Copy()
    End Sub

    Private Sub 粘贴ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 粘贴ToolStripMenuItem.Click
        RichTextBox1.Paste()
    End Sub

    Private Sub 颜色CToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 颜色CToolStripMenuItem.Click
        ColorDialog1.ShowDialog()
        RichTextBox1.SelectionColor = ColorDialog1.Color
    End Sub

    'Private Sub HToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles HToolStripMenuItem.Click
    '    MessageBox.Show("暂时未编!")
    'End Sub



    Private Sub 打印ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 打印ToolStripMenuItem.Click
        'Dim pd As System.Drawing.Printing.PrintDocument
        'pd = New System.Drawing.Printing.PrintDocument()
        'PrintDialog1.Document = pd
        'If PrintDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then
        '    pd.Print()
        'End If

        Dim dialog As New PrintDialog
        '设置打印文档
        dialog.Document = pdoc
        If dialog.ShowDialog = Windows.Forms.DialogResult.OK Then
            '打印文档
            pdoc.Print()
        End If
    End Sub

    Private Sub 页面设置ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 页面设置ToolStripMenuItem.Click
        Dim psd As New PageSetupDialog
        With psd
            .Document = pdoc
            .PageSettings = pdoc.DefaultPageSettings
        End With
        If psd.ShowDialog = Windows.Forms.DialogResult.OK Then
            pdoc.DefaultPageSettings = psd.PageSettings
        End If
    End Sub
    Private Sub 打印预览VToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 打印预览VToolStripMenuItem1.Click
        'Dim pd As System.Drawing.Printing.PrintDocument
        'pd = New System.Drawing.Printing.PrintDocument()
        'Try
        '    PrintPreviewDialog1.Document = pd
        '    PrintPreviewDialog1.ShowDialog()
        'Catch ex As Exception
        '    MessageBox.Show("加载打印文档时出现异常,请确认打印机已连接", Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Error)
        'End Try

        Dim ppd As New PrintPreviewDialog
        Try
            ppd.Document = pdoc
            ppd.ShowDialog()
        Catch ex As Exception
            MessageBox.Show("加载打印文档时出现异常,请确认打印机已连接", Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try
    End Sub

    '用 PrintPage 事件被触发后传递一个图象上下文,在其中可绘制预览图片
    Private Sub pdoc_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles pdoc.PrintPage
        Static intcurrentchar As Int32
        Dim font As New Font("microsoft sans serif", 24)
        Dim intprintareaheight, intprintareawidth, marginleft, margintop As Int32
        With pdoc.DefaultPageSettings
            intprintareaheight = .PaperSize.Height - .Margins.Top - .Margins.Bottom  '打印区域高度
            intprintareawidth = .PaperSize.Width - .Margins.Left - .Margins.Right      ' 打印区域宽度
            margintop = .Margins.Top 'Y坐标
            marginleft = .Margins.Left 'X坐标
        End With
        '如果选择横排模式,调整打印区域的宽度和高度
        If pdoc.DefaultPageSettings.Landscape Then
            Dim inttemp As Int32
            inttemp = intprintareawidth
            intprintareaheight = intprintareawidth
            intprintareawidth = inttemp
        End If
        '根据打印区域的高度和字体的高度计算文档的总行数
        Dim intlinecount As Int32 = CInt(intprintareaheight / font.Height)
        '初始化打印区域的矩形结构
        Dim rectprintingarea As New RectangleF(marginleft, margintop, intprintareawidth, intprintareaheight)
        '实例化STRINGFORMAT类
        Dim fmt As New StringFormat(StringFormatFlags.LineLimit)
        '调用measurstring设知识和打印区域的字符数
        Dim intlinesfilled, intcharsfitted As Int32
        e.Graphics.MeasureString(Mid(RichTextBox1.Text, intcurrentchar + 1), font, New SizeF(intprintareawidth, intprintareaheight), fmt, intcharsfitted, intlinesfilled)
        '将文本打印至页面
        e.Graphics.DrawString(Mid(RichTextBox1.Text, intcurrentchar + 1), font, Brushes.Black, rectprintingarea, fmt)
        '从当前字符前进至本页的最后一个字符。由于intcurrentchar是一个static变量
        '其值可用于下一页打印,增加1后传递给mid()打印下一页
        intcurrentchar += intcharsfitted
        'hasmorepages告知打印模块是否激活另一个printpage事件
        If intcurrentchar < RichTextBox1.Text.Length Then
            e.HasMorePages = True
        Else
            e.HasMorePages = False
            '必须将intcurrentchar重设为初始值
            intcurrentchar = 0
        End If
    End Sub



    Private Sub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
        Dim yPosition As Single = 0
        Dim leftBounds As Single = e.MarginBounds.Left
        e.Graphics.DrawString(RichTextBox1.Text, print_Font, Brushes.Black, leftBounds, yPosition, New StringFormat)
    End Sub

    Private Sub 背景ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 背景ToolStripMenuItem.Click
        ColorDialog1.ShowDialog()
        RichTextBox1.BackColor = ColorDialog1.Color
    End Sub

    Private Sub 自动换行ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 自动换行ToolStripMenuItem.Click

        RichTextBox1.WordWrap = Not RichTextBox1.WordWrap
        自动换行ToolStripMenuItem.Checked = Not 自动换行ToolStripMenuItem.Checked
    End Sub

    Private Sub 重复RToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 重复RToolStripMenuItem.Click
        RichTextBox1.Redo()
    End Sub
    Private Sub 撤销ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 撤销ToolStripMenuItem.Click
        RichTextBox1.Undo()
    End Sub

    Private Sub 退出ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 退出ToolStripMenuItem.Click
        Me.Close()
    End Sub

    Private Sub 全选ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 全选ToolStripMenuItem.Click
        RichTextBox1.SelectAll()
    End Sub

    Private Sub 删除ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 删除ToolStripMenuItem.Click
        RichTextBox1.SelectedText = ""
    End Sub

    Private Sub 查找ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 查找ToolStripMenuItem.Click
        ToolStrip2.Visible = Not ToolStrip2.Visible
    End Sub
    Private Sub 查找下一个ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
        ToolStrip2.Visible = Not ToolStrip2.Visible
    End Sub


    Private Sub 替换ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 替换ToolStripMenuItem.Click
        ToolStrip2.Visible = Not ToolStrip2.Visible
    End Sub

    Private Sub 工具兰GToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 工具兰GToolStripMenuItem.Click
        ToolStrip1.Visible = Not ToolStrip1.Visible
        工具兰GToolStripMenuItem.Checked = Not 工具兰GToolStripMenuItem.Checked
    End Sub
    Private Sub AToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AToolStripMenuItem.Click
        关于.Show()
    End Sub

    Private Sub 状态栏FToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 状态栏FToolStripMenuItem.Click
        StatusStrip1.Visible = Not StatusStrip1.Visible
        状态栏FToolStripMenuItem.Checked = Not 状态栏FToolStripMenuItem.Checked
    End Sub




    ''获取鼠标点击处的行数和列数
    'Private Sub RichTextBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles RichTextBox1.MouseDown

    '    Dim int_ln As Double
    '    Dim int_col As Double
    '    Dim offset As Double
    '    With RichTextBox1
    '        int_ln = .GetLineFromCharIndex(.SelectionStart)
    '        offset = 1
    '        If int_ln > 0 Then
    '            While AscW(.Text.Chars(.SelectionStart - offset)) <> 10
    '                offset += 1
    '            End While
    '            int_col = offset
    '        Else
    '            int_col = .SelectionStart
    '        End If
    '    End With
    '    hanglie.Text = "          行: " & (int_ln + 1).ToString & "," + "          列: " & int_col.ToString
    '    Exit Sub
    'End Sub



    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        '记事本自动换行
        RichTextBox1.WordWrap = True
        '记事本工具栏
        工具兰GToolStripMenuItem.Checked = True
        '记事本列表
        列表形式ToolStripMenuItem.Checked = False
        '背景音乐
        My.Computer.Audio.Play("背景2.wav", AudioPlayMode.Background)
    End Sub

    Private Sub RichTextBox1_SelectionChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles RichTextBox1.SelectionChanged

        zongshu.Text = "     总字符数: " & Len(RichTextBox1.Text)
        xuanshu.Text = "        当前选中: " & Len(RichTextBox1.SelectedText)
    End Sub


    '状态栏
    'Public ts_URL As New ToolStripStatusLabel("目前所在网址:")
    'Public ts_Title As New ToolStripStatusLabel("目前所在标题:")

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        '状态栏()
        'StatusStrip1.Items.Add(ts_URL)
        'StatusStrip1.Items.Add(ts_Title)
        'ts_URL.Text = "时间:" & My.Computer.Clock.LocalTime & "  操作系统名称:" & My.Computer.Info.OSFullName
        'ts_Title.Text = " 物理内存:" & My.Computer.Info.AvailablePhysicalMemory & "  操作平台:" & My.Computer.Info.OSPlatform
        xitong.Text = "      操作系统名称:" & My.Computer.Info.OSFullName & "      物理内存:" & My.Computer.Info.AvailablePhysicalMemory
        shijian.Text = "  ^_^     当前时间:" & My.Computer.Clock.LocalTime

    End Sub

    Private Sub 编辑ToolStripMenuItem_MouseHover(ByVal sender As Object, ByVal e As System.EventArgs) Handles 编辑ToolStripMenuItem.MouseHover
        If RichTextBox1.Text = "" Then
            '菜单栏
            全选ToolStripMenuItem.Enabled = False
        Else
            '菜单栏
            全选ToolStripMenuItem.Enabled = True
        End If
        If RichTextBox1.SelectedText <> "" Then
            '菜单栏
            复制ToolStripMenuItem.Enabled = True
            剪贴ToolStripMenuItem.Enabled = True
            删除ToolStripMenuItem.Enabled = True
        Else
            '菜单栏
            复制ToolStripMenuItem.Enabled = False
            剪贴ToolStripMenuItem.Enabled = False

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -