用vb.net实现类似写字板程序的部分源代码

'欢迎与我交流：luluhai@eastday.com

所有源代码均在这里下载：

http://www.up2e.com/resource.php

'本程序代码是VB.NET课程设计的作业

'代码编写及整理：路海

Imports System.Drawing.Printing

Imports System.Drawing.Font

Public Class formMain

Inherits System.Windows.Forms.Form

#Region " Windows 窗体设计器生成的代码 "

Public Sub New()

MyBase.New()

'该调用是 Windows 窗体设计器所必需的。

InitializeComponent()

'在 InitializeComponent() 调用之后添加任何初始化

End Sub

'窗体重写处置以清理组件列表。

Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)

If disposing Then

If Not (components Is Nothing) Then

components.Dispose()

End If

MyBase.Dispose(disposing)

End Sub

'Windows 窗体设计器所必需的

Private components As System.ComponentModel.IContainer

'注意：以下过程是 Windows 窗体设计器所必需的

'可以使用 Windows 窗体设计器修改此过程。

'不要使用代码编辑器修改它。

Friend WithEvents MainMenu1 As System.Windows.Forms.MainMenu

Friend WithEvents mFile As System.Windows.Forms.MenuItem

Friend WithEvents mNew As System.Windows.Forms.MenuItem

Friend WithEvents mOpen As System.Windows.Forms.MenuItem

'.....................

'.......................

'.....................

'由于很长，我把他略去了

'.................

'..................

Me.Panel1.SuspendLayout()

Me.SuspendLayout()

'MainMenu1

Me.MainMenu1.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mFile, Me.mEdit, Me.mView, Me.mFormat, Me.mHelp})

'mFile

Me.mFile.Index = 0

Me.mFile.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mNew, Me.mOpen, Me.mSave, Me.mSaveas, Me.MenuItem6, Me.mPrint, Me.mPrintpreview, Me.mPagesetup, Me.MenuItem10, Me.mExit})

Me.mFile.Text = "文件(&F)"

'mNew

Me.mNew.Index = 0

Me.mNew.Shortcut = System.Windows.Forms.Shortcut.CtrlN

Me.mNew.Text = "新建(&N)..."

'mOpen

Me.mOpen.Index = 1

Me.mOpen.Shortcut = System.Windows.Forms.Shortcut.CtrlO

Me.mOpen.Text = "打开(&O)... "

'mSave

Me.mSave.Index = 2

Me.mSave.Shortcut = System.Windows.Forms.Shortcut.CtrlS

Me.mSave.Text = "保存(&S) "

'mSaveas

Me.mSaveas.Index = 3

Me.mSaveas.Text = "另存为(&A)..."

'MenuItem6

Me.MenuItem6.Index = 4

Me.MenuItem6.Text = "-"

'mPrint

Me.mPrint.Index = 5

Me.mPrint.Shortcut = System.Windows.Forms.Shortcut.CtrlP

Me.mPrint.Text = "打印(&P)..."

'mPrintpreview

Me.mPrintpreview.Index = 6

Me.mPrintpreview.Text = "打印预览(&V)"

'mPagesetup

Me.mPagesetup.Index = 7

Me.mPagesetup.Text = "页面设置(&U)..."

'MenuItem10

Me.MenuItem10.Index = 8

Me.MenuItem10.Text = "-"

'mExit

Me.mExit.Index = 9

Me.mExit.Text = "退出(&X)"

'mEdit

Me.mEdit.Index = 1

Me.mEdit.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mUndo, Me.MenuItem1, Me.mCut, Me.mCopy, Me.mPaste, Me.mClear, Me.mSelectall, Me.MenuItem21, Me.mFind, Me.mFindnext, Me.mReplace})

Me.mEdit.Text = "编辑(&E)"

'mUndo

Me.mUndo.Index = 0

Me.mUndo.Shortcut = System.Windows.Forms.Shortcut.CtrlZ

Me.mUndo.Text = "撤销(&U)"

'MenuItem1

Me.MenuItem1.Index = 1

Me.MenuItem1.Text = "-"

'mCut

Me.mCut.Index = 2

Me.mCut.Shortcut = System.Windows.Forms.Shortcut.CtrlX

Me.mCut.Text = "剪切(&T)"

'mCopy

Me.mCopy.Index = 3

Me.mCopy.Shortcut = System.Windows.Forms.Shortcut.CtrlC

Me.mCopy.Text = "复制(&C)"

'mPaste

Me.mPaste.Index = 4

Me.mPaste.Shortcut = System.Windows.Forms.Shortcut.CtrlP

Me.mPaste.Text = "粘贴(&P)"

'mClear

Me.mClear.Index = 5

Me.mClear.Shortcut = System.Windows.Forms.Shortcut.Del

Me.mClear.Text = "清除(&A)"

'mSelectall

Me.mSelectall.Index = 6

Me.mSelectall.Shortcut = System.Windows.Forms.Shortcut.CtrlA

Me.mSelectall.Text = "全选(&L)"

'MenuItem21

Me.MenuItem21.Index = 7

Me.MenuItem21.Text = "-"

'mFind

Me.mFind.Index = 8

Me.mFind.Shortcut = System.Windows.Forms.Shortcut.CtrlF

Me.mFind.Text = "查找(&F)..."

'mFindnext

Me.mFindnext.Index = 9

Me.mFindnext.Shortcut = System.Windows.Forms.Shortcut.F3

Me.mFindnext.Text = "查找下一个(&N)"

'mReplace

Me.mReplace.Index = 10

Me.mReplace.Shortcut = System.Windows.Forms.Shortcut.CtrlH

Me.mReplace.Text = "替换(&E)..."

'mView

Me.mView.Index = 2

Me.mView.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mStatusbar})

Me.mView.Text = "查看(&V)"

'mStatusbar

Me.mStatusbar.Checked = True

Me.mStatusbar.Index = 0

Me.mStatusbar.Text = "状态栏(&S)"

'mFormat

Me.mFormat.Index = 3

Me.mFormat.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mFont, Me.MenuItem2})

Me.mFormat.Text = "格式(&D)"

'mFont

Me.mFont.Index = 0

Me.mFont.Text = "字体(&F)..."

'MenuItem2

Me.MenuItem2.Index = 1

Me.MenuItem2.Text = "颜色(&C)..."

'mHelp

Me.mHelp.Index = 4

Me.mHelp.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mHelptopics, Me.MenuItem34, Me.mAbout})

Me.mHelp.Text = "帮助(&H)"

'mHelptopics

Me.mHelptopics.Index = 0

Me.mHelptopics.Text = "帮助主题(&H)"

'MenuItem34

Me.MenuItem34.Index = 1

Me.MenuItem34.Text = "-"

'mAbout

Me.mAbout.Index = 2

Me.mAbout.Text = "关于本写字板作业(&A)"

'SaveFileDialog1

Me.SaveFileDialog1.FileName = "doc1"

'ToolBar1

Me.ToolBar1.AllowDrop = True

Me.ToolBar1.AutoSize = False

Me.ToolBar1.Buttons.AddRange(New System.Windows.Forms.ToolBarButton() {Me.tbbNew, Me.tbbOpen, Me.tbbSave, Me.ToolBarButton1, Me.ToolBarButton2, Me.vbbPrint, Me.tbbPreview, Me.ToolBarButton3, Me.ToolBarButton4, Me.tbbFind, Me.ToolBarButton5, Me.ToolBarButton6, Me.tbbCut, Me.tbbCopy, Me.tbbPaste, Me.tbbUndo})

Me.ToolBar1.ButtonSize = New System.Drawing.Size(25, 24)

Me.ToolBar1.DropDownArrows = True

Me.ToolBar1.ImageList = Me.ImageList1

Me.ToolBar1.Name = "ToolBar1"

Me.ToolBar1.ShowToolTips = True

Me.ToolBar1.Size = New System.Drawing.Size(688, 32)

Me.ToolBar1.TabIndex = 0

'tbbNew

Me.tbbNew.ImageIndex = 5

Me.tbbNew.ToolTipText = "新建"

'tbbOpen

Me.tbbOpen.ImageIndex = 6

Me.tbbOpen.ToolTipText = "打开"

'tbbSave

Me.tbbSave.ImageIndex = 10

Me.tbbSave.ToolTipText = "保存"

'ToolBarButton1

Me.ToolBarButton1.Style = System.Windows.Forms.ToolBarButtonStyle.Separator

'ToolBarButton2

Me.ToolBarButton2.Style = System.Windows.Forms.ToolBarButtonStyle.Separator

'vbbPrint

Me.vbbPrint.ImageIndex = 9

Me.vbbPrint.ToolTipText = "打印"

'tbbPreview

Me.tbbPreview.ImageIndex = 8

Me.tbbPreview.ToolTipText = "打印预览"

'ToolBarButton3

Me.ToolBarButton3.Style = System.Windows.Forms.ToolBarButtonStyle.Separator

'ToolBarButton4

Me.ToolBarButton4.Style = System.Windows.Forms.ToolBarButtonStyle.Separator

'tbbFind

Me.tbbFind.ImageIndex = 12

Me.tbbFind.ToolTipText = "查找"

'ToolBarButton5

Me.ToolBarButton5.Style = System.Windows.Forms.ToolBarButtonStyle.Separator

'ToolBarButton6

Me.ToolBarButton6.Style = System.Windows.Forms.ToolBarButtonStyle.Separator

'tbbCut

Me.tbbCut.ImageIndex = 4

Me.tbbCut.ToolTipText = "剪切"

'tbbCopy

Me.tbbCopy.ImageIndex = 3

Me.tbbCopy.ToolTipText = "复制"

'tbbPaste

Me.tbbPaste.ImageIndex = 7

Me.tbbPaste.ToolTipText = "粘贴"

'tbbUndo

Me.tbbUndo.ImageIndex = 11

Me.tbbUndo.ToolTipText = "撤销"

'ImageList1

Me.ImageList1.ColorDepth = System.Windows.Forms.ColorDepth.Depth8Bit

Me.ImageList1.ImageSize = New System.Drawing.Size(16, 16)

Me.ImageList1.ImageStream = CType(resources.GetObject("ImageList1.ImageStream"), System.Windows.Forms.ImageListStreamer)

Me.ImageList1.TransparentColor = System.Drawing.Color.Transparent

'rtbox

Me.rtbox.Anchor = (((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _

Or System.Windows.Forms.AnchorStyles.Left) _

Or System.Windows.Forms.AnchorStyles.Right)

Me.rtbox.Font = New System.Drawing.Font("宋体", 9.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(134, Byte))

Me.rtbox.Location = New System.Drawing.Point(0, 64)

Me.rtbox.Name = "rtbox"

Me.rtbox.Size = New System.Drawing.Size(688, 424)

Me.rtbox.TabIndex = 3

Me.rtbox.Text = ""

'PrintDialog1

Me.PrintDialog1.Document = Me.PrintDocument1

'comboxFont

Me.comboxFont.Font = New System.Drawing.Font("宋体", 9.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(134, Byte))

Me.comboxFont.Location = New System.Drawing.Point(184, 40)

Me.comboxFont.Name = "comboxFont"

Me.comboxFont.Size = New System.Drawing.Size(121, 20)

Me.comboxFont.TabIndex = 5

Me.comboxFont.Text = "字体"

'comboxSize

Me.comboxSize.Items.AddRange(New Object() {"8", "9", "10", "11", "12", "14", "16", "18", "20", "22", "24", "26", "28", "36", "48", "72"})

Me.comboxSize.Location = New System.Drawing.Point(304, 40)

Me.comboxSize.Name = "comboxSize"

Me.comboxSize.Size = New System.Drawing.Size(48, 20)

Me.comboxSize.TabIndex = 6

Me.comboxSize.Text = "大小"

'tbbbold

Me.tbbbold.ImageIndex = 0

Me.tbbbold.Style = System.Windows.Forms.ToolBarButtonStyle.ToggleButton

Me.tbbbold.ToolTipText = "加粗"

'tbbi

Me.tbbi.ImageIndex = 1

Me.tbbi.Style = System.Windows.Forms.ToolBarButtonStyle.ToggleButton

Me.tbbi.ToolTipText = "斜体"

'tbbu

Me.tbbu.ImageIndex = 2

Me.tbbu.Style = System.Windows.Forms.ToolBarButtonStyle.ToggleButton

Me.tbbu.ToolTipText = "下划线"

'tbbcolor

Me.tbbcolor.ImageIndex = 16

Me.tbbcolor.ToolTipText = "这个是颜色！因为找不到合适的。"

'ToolBarButton8

Me.ToolBarButton8.Style = System.Windows.Forms.ToolBarButtonStyle.Separator

'ToolBarButton7

Me.ToolBarButton7.Style = System.Windows.Forms.ToolBarButtonStyle.Separator

'tbbleft

Me.tbbleft.ImageIndex = 13

Me.tbbleft.Style = System.Windows.Forms.ToolBarButtonStyle.ToggleButton

Me.tbbleft.ToolTipText = "靠左"

'tbbmiddle

Me.tbbmiddle.ImageIndex = 15

Me.tbbmiddle.Style = System.Windows.Forms.ToolBarButtonStyle.ToggleButton

Me.tbbmiddle.ToolTipText = "靠中"

'tbbright

Me.tbbright.ImageIndex = 14

Me.tbbright.Style = System.Windows.Forms.ToolBarButtonStyle.ToggleButton

Me.tbbright.ToolTipText = "靠右"

'ToolBar2

Me.ToolBar2.Buttons.AddRange(New System.Windows.Forms.ToolBarButton() {Me.tbbbold, Me.tbbi, Me.tbbu, Me.tbbcolor, Me.ToolBarButton8, Me.ToolBarButton7, Me.tbbleft, Me.tbbmiddle, Me.tbbright})

Me.ToolBar2.ButtonSize = New System.Drawing.Size(23, 22)

Me.ToolBar2.DropDownArrows = True

Me.ToolBar2.ImageList = Me.ImageList1

Me.ToolBar2.Location = New System.Drawing.Point(0, 32)

Me.ToolBar2.Name = "ToolBar2"

Me.ToolBar2.ShowToolTips = True

Me.ToolBar2.Size = New System.Drawing.Size(688, 25)

Me.ToolBar2.TabIndex = 7

'StatusBar1

Me.StatusBar1.Location = New System.Drawing.Point(0, 467)

Me.StatusBar1.Name = "StatusBar1"

Me.StatusBar1.Size = New System.Drawing.Size(688, 22)

Me.StatusBar1.TabIndex = 8

'Panel1

Me.Panel1.BorderStyle = System.Windows.Forms.BorderStyle.FixedSingle

Me.Panel1.Controls.AddRange(New System.Windows.Forms.Control() {Me.PictureBox1, Me.closepanel, Me.Label1, Me.mpreplace, Me.findnext, Me.find, Me.rpbox, Me.txtbox})

Me.Panel1.Location = New System.Drawing.Point(192, 160)

Me.Panel1.Name = "Panel1"

Me.Panel1.Size = New System.Drawing.Size(272, 96)

Me.Panel1.TabIndex = 9

Me.Panel1.Visible = False

'PictureBox1

Me.PictureBox1.Image = CType(resources.GetObject("PictureBox1.Image"), System.Drawing.Bitmap)

Me.PictureBox1.Location = New System.Drawing.Point(8, 8)

Me.PictureBox1.Name = "PictureBox1"

Me.PictureBox1.Size = New System.Drawing.Size(16, 16)

Me.PictureBox1.TabIndex = 7

Me.PictureBox1.TabStop = False

'closepanel

Me.closepanel.Font = New System.Drawing.Font("宋体", 9.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(134, Byte))

Me.closepanel.ForeColor = System.Drawing.Color.Black

Me.closepanel.Location = New System.Drawing.Point(240, 64)

Me.closepanel.Name = "closepanel"

Me.closepanel.Size = New System.Drawing.Size(24, 24)

Me.closepanel.TabIndex = 6

Me.closepanel.Text = "关"

'Label1

Me.Label1.Location = New System.Drawing.Point(24, 8)

Me.Label1.Name = "Label1"

Me.Label1.Size = New System.Drawing.Size(61, 16)

Me.Label1.TabIndex = 5

Me.Label1.Text = "查找-可拖"

'mpreplace

Me.mpreplace.Location = New System.Drawing.Point(112, 64)

Me.mpreplace.Name = "mpreplace"

Me.mpreplace.Size = New System.Drawing.Size(72, 23)

Me.mpreplace.TabIndex = 4

Me.mpreplace.Text = "替换"

'findnext

Me.findnext.Location = New System.Drawing.Point(192, 32)

Me.findnext.Name = "findnext"

Me.findnext.TabIndex = 3

Me.findnext.Text = "下一个"

'find

Me.find.Location = New System.Drawing.Point(112, 32)

Me.find.Name = "find"

Me.find.Size = New System.Drawing.Size(72, 23)

Me.find.TabIndex = 2

Me.find.Text = "查找"

'rpbox

Me.rpbox.Location = New System.Drawing.Point(8, 64)

Me.rpbox.Name = "rpbox"

Me.rpbox.TabIndex = 1

Me.rpbox.Text = ""

'txtbox

Me.txtbox.Location = New System.Drawing.Point(8, 32)

Me.txtbox.Name = "txtbox"

Me.txtbox.TabIndex = 0

Me.txtbox.Text = ""

'formMain

Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)

Me.ClientSize = New System.Drawing.Size(688, 489)

Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.Panel1, Me.StatusBar1, Me.comboxSize, Me.comboxFont, Me.ToolBar2, Me.rtbox, Me.ToolBar1})

Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)

Me.Menu = Me.MainMenu1

Me.Name = "formMain"

Me.Text = "VB.NET课程设计作业2-写字板:::::By SunnyGroup 2002:::Shanghai Fisheries University:::::"

Me.Panel1.ResumeLayout(False)

Me.ResumeLayout(False)

End Sub

#End Region

'声明一个全局boolean变量，用来标记richtextbox中文本变化和保存情况

Dim bSave As Boolean

'下面这段程序用于对对话框属性和全局变量进行初始化设置

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

'为bSave首先赋初值

bSave = True

'为savefiledialog进行初始化

SaveFileDialog1.FileName = ""

SaveFileDialog1.DefaultExt = "txt"

SaveFileDialog1.Filter = "Text files (*.txt) |*.txt|All files (*.*) |*.*"

SaveFileDialog1.Title = "保存文件.."

'为openfiledialog进行初始化

OpenFileDialog1.FileName = ""

OpenFileDialog1.DefaultExt = "txt"

OpenFileDialog1.Filter = "Text files (*.txt) |*.txt|All files (*.*) |*.*"

OpenFileDialog1.Title = "打开文件.."

'下面这段代码是加载当地系统中所有字体到Combobox中

Dim allfonts As FontFamily

For Each allfonts In System.Drawing.FontFamily.Families

comboxFont.Items.Add(allfonts.Name)

End Sub

Private Sub rtbox_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles rtbox.TextChanged

'文本发生了改变，则将变量bSave置为False

bSave = False

End Sub

'********************************************************************************************

'字体

'下面这个函数是用来去除用户指定的字体样式，如加粗，下划线等等

Public Sub RemoveFontStyle(ByVal rtb As RichTextBox, _

ByVal style As System.Drawing.FontStyle)

' 如果选择文本的长度大于0，将一个一个去除样式。

' 这是十分必要的！因为选择的文本中可能有许多不同的样式，而我们的原意是

' 保持所有原来的样式，除了那个要被去除的样式

If rtb.SelectionLength > 0 Then

Dim selStart As Integer = rtb.SelectionStart

Dim selLength As Integer = rtb.SelectionLength

Dim currFont As System.Drawing.Font

Dim currStyle As System.Drawing.FontStyle

Dim i As Integer

For i = 0 To selLength - 1

' 选择一个字符

rtb.Select(selStart + i, 1)

' 得到被选择字符的字体

currFont = rtb.SelectionFont

' 得到被选择字符的样式，同时去除要被除去的那个样式

currStyle = currFont.Style

currStyle = currStyle And Not style

' 然后赋予这些字符新的字体和样式

rtb.SelectionFont = New Font(currFont.FontFamily, currFont.Size, _

currStyle)

' 保持原有的选择

rtb.Select(selStart, selLength)

Else

rtb.SelectionFont = New Font(rtb.SelectionFont, _

rtb.SelectionFont.Style And Not style)

End If

End Sub

'下面这个函数是用来增加字体的样式，比如加粗，下划线等等

Public Sub AddFontStyle(ByVal rtb As RichTextBox, _

ByVal style As System.Drawing.FontStyle)

' 如果选择的文本长度大于0，将一个一个字符地增加样式。

'这是十分必要的!因为被选择的字符可能同时含有多种样式，

' 而我们的原意只是保持所有原来的样式，同时增加上指定的样式

If rtb.SelectionLength > 0 Then

Dim selStart As Integer = rtb.SelectionStart

Dim selLength As Integer = rtb.SelectionLength

Dim currFont As System.Drawing.Font

Dim currStyle As System.Drawing.FontStyle

Dim i As Integer

For i = 0 To selLength - 1

' 选择的字符

rtb.Select(selStart + i, 1)

' 得到被选择字符的字体

currFont = rtb.SelectionFont

' 得到现在的样式，同时增加指定的样式

currStyle = currFont.Style

currStyle = currStyle Or style

' 然后使字符拥有新的字体和新的样式，有可能出现异常，

'因为不是所有字体都支持所有的样式，所以这里捕捉异常

Try

rtb.SelectionFont = New Font(currFont.FontFamily, currFont.Size, _

currStyle)

Catch ex As Exception

End Try

rtb.Select(selStart, selLength)

Else

rtb.SelectionFont = New Font(rtb.SelectionFont, _

rtb.SelectionFont.Style Or style)

End If

End Sub

'并不是所有的字体都支持所有的样式，下面这个函数是用来检查新字体是否支持选择的样式，若不支持，则移除该样式

'使用举例： GetSafeStyleForFontFamily(richTextBox1.SelectionFont.FontFamily,richTextBox1.SelectionFont.Style)

Public Function GetSafeStyleForFontFamily(ByVal fontFam As FontFamily, _

ByVal style As FontStyle) As FontStyle

' 移除不支持的样式

If (style And FontStyle.Regular) = FontStyle.Regular Then

If Not fontFam.IsStyleAvailable(FontStyle.Regular) Then

style = style And Not FontStyle.Regular

End If

If (style And FontStyle.Bold) = FontStyle.Bold Then

If Not fontFam.IsStyleAvailable(FontStyle.Bold) Then

style = style And Not FontStyle.Bold

End If

If (style And FontStyle.Italic) = FontStyle.Italic Then

If Not fontFam.IsStyleAvailable(FontStyle.Italic) Then

style = style And Not FontStyle.Italic

End If

If (style And FontStyle.Underline) = FontStyle.Underline Then

If Not fontFam.IsStyleAvailable(FontStyle.Underline) Then

style = style And Not FontStyle.Underline

End If

If (style And FontStyle.Strikeout) = FontStyle.Strikeout Then

If Not fontFam.IsStyleAvailable(FontStyle.Strikeout) Then

style = style And Not FontStyle.Strikeout

End If

Return style

End Function

'下面这个SetFontSize函数是用来设置字体的大小

Public Sub SetFontSize(ByVal rtb As RichTextBox, ByVal fontSize As Single)

If rtb.SelectionLength > 0 Then

Dim selStart As Integer = rtb.SelectionStart

Dim selLength As Integer = rtb.SelectionLength

Dim currFont As System.Drawing.Font

Dim i As Integer

For i = 0 To selLength - 1

rtb.Select(selStart + i, 1)

currFont = rtb.SelectionFont

rtb.SelectionFont = New Font(currFont.FontFamily, fontSize, _

currFont.Style)

rtb.Select(selStart, selLength)

Else

rtb.SelectionFont = New Font(rtb.SelectionFont.Name, fontSize, _

rtb.SelectionFont.Style)

End If

End Sub

'下面这个SetFontFamily函数是用来设置字体的变化

Public Sub SetFontFamily(ByVal rtb As RichTextBox, ByVal fontName As String)

Dim fontFam As New System.Drawing.FontFamily(fontName)

Dim style As System.Drawing.FontStyle

If rtb.SelectionLength > 0 Then

Dim selStart As Integer = rtb.SelectionStart

Dim selLength As Integer = rtb.SelectionLength

Dim i As Integer

For i = 0 To selLength - 1

rtb.Select(selStart + i, 1)

style = GetSafeStyleForFontFamily(fontFam, rtb.SelectionFont.Style)

rtb.SelectionFont = New Font(fontFam, rtb.SelectionFont.Size, style)

rtb.Select(selStart, selLength)

Else

style = GetSafeStyleForFontFamily(fontFam, rtb.SelectionFont.Style)

rtb.SelectionFont = New Font(fontFam, rtb.SelectionFont.Size, style)

End If

End Sub

'************************************************************************************

'下面这个函数是用来新建文件

Private Sub newfile()

Dim flag As Integer

'如果文本已经被保存，则清空rtbox内容，所有变量重置以新建文本

If bSave Then

rtbox.Clear()

SaveFileDialog1.FileName = ""

bSave = True

Else

'如果文本没有保存，则提示是否要保存

flag = MessageBox.Show("文件内容已更改，想保存文件吗？？", "info", MessageBoxButtons.YesNoCancel, MessageBoxIcon.Information)

Select Case flag

'case 6是当用户选择了“保存”，则执行保存文件的操作

Case 6

'如果没有选择要保存的文件名，则弹出保存对话框，由用户选择要保存的文件名后保存文本

If SaveFileDialog1.FileName = "" Then

If SaveFileDialog1.ShowDialog Then

rtbox.SaveFile(SaveFileDialog1.FileName, RichTextBoxStreamType.PlainText)

End If

Else

'如果已经选择了要保存的文件名，则保存文本到文件中

rtbox.SaveFile(SaveFileDialog1.FileName, RichTextBoxStreamType.PlainText)

End If

'然后就是清空rtbox的内容，重置变量以新建文本

bSave = True

rtbox.Clear()

SaveFileDialog1.FileName = ""

'case 7就是当用户选择了no也就是不保存时，立即清空rtbox内容，重置变量以新建文本

Case 7

rtbox.Clear()

SaveFileDialog1.FileName = ""

bSave = True

'case else就是当用户选择了取消，则取消新建操作，也就是Do Nothing

Case Else

End Select

End If

End Sub

'下面这个函数是用来打开文件

Private Sub openfile()

Dim flag As Integer

'如果文本内容没有保存，询问用户是否保存

If Not bSave Then

flag = MessageBox.Show("文件内容已更改，想保存文件吗？？", "info", MessageBoxButtons.YesNoCancel, MessageBoxIcon.Information)

Select Case flag

'case 6是当用户选择了“保存”，则执行保存文件的操作

Case 6

'如果没有选择要保存的文件名，则弹出保存对话框，由用户选择要保存的文件名后保存文本

If SaveFileDialog1.FileName = "" Then

If SaveFileDialog1.ShowDialog Then

rtbox.SaveFile(SaveFileDialog1.FileName, RichTextBoxStreamType.PlainText)

End If

Else

'如果已经选择了要保存的文件名，则保存文本到文件中

rtbox.SaveFile(SaveFileDialog1.FileName, RichTextBoxStreamType.PlainText)

End If

'弹出打开文件对话框，执行打开文件操作

bSave = True

If OpenFileDialog1.ShowDialog() = DialogResult.OK Then

rtbox.LoadFile(OpenFileDialog1.FileName, RichTextBoxStreamType.PlainText)

End If

'case 7的意思是如果用户选择了“不保存”，则直接执行打开文件操作

Case 7

If OpenFileDialog1.ShowDialog() = DialogResult.OK Then

rtbox.LoadFile(OpenFileDialog1.FileName, RichTextBoxStreamType.PlainText)

End If

bSave = True

'case else也就是用户选择了取消

Case Else

End Select

'else文本已经保存，直接执行打开文件操作

Else

If OpenFileDialog1.ShowDialog() = DialogResult.OK Then

rtbox.LoadFile(OpenFileDialog1.FileName, RichTextBoxStreamType.PlainText)

End If

bSave = True

End If

End Sub

'下面这个函数是用来保存文件

Private Sub savefile()

'如果没有选择要保存的文件名，则弹出保存对话框，由用户选择要保存的文件名后保存文本

If SaveFileDialog1.FileName = "" Then

If SaveFileDialog1.ShowDialog Then

rtbox.SaveFile(SaveFileDialog1.FileName, RichTextBoxStreamType.PlainText)

End If

Else

'如果已经选择了要保存的文件名，则保存文本到文件中

rtbox.SaveFile(SaveFileDialog1.FileName, RichTextBoxStreamType.PlainText)

End If

bSave = True

End Sub

'*****************************************************************************

'打印，打印预览

' 必须确定所有的打印事件都是针对同一个 PrintDocument

Private WithEvents pdoc As New PrintDocument()

' 打印文件是一个函数性的打印事件，每当要打印时该事件被触发

' 下面是一个非常快速和有用的精确计算要打印的文本是否能够被包括到整张打印页面

'是我从微软站点上得到的资料，我把它应用到了我的程序中

Private Sub pdoc_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles pdoc.PrintPage

' Declare a variable to hold the position of the last printed char. Declare

' as static so that subsequent PrintPage events can reference it.

Static intCurrentChar As Int32

' Initialize the font to be used for printing.

Dim font As New font("Microsoft Sans Serif", 24)

Dim intPrintAreaHeight, intPrintAreaWidth, marginLeft, marginTop As Int32

With pdoc.DefaultPageSettings

' Initialize local variables that contain the bounds of the printing

' area rectangle.

intPrintAreaHeight = .PaperSize.Height - .Margins.Top - .Margins.Bottom

intPrintAreaWidth = .PaperSize.Width - .Margins.Left - .Margins.Right

' Initialize local variables to hold margin values that will serve

' as the X and Y coordinates for the upper left corner of the printing

' area rectangle.

marginLeft = .Margins.Left ' X coordinate

marginTop = .Margins.Top ' Y coordinate

End With

' If the user selected Landscape mode, swap the printing area height

' and width.

If pdoc.DefaultPageSettings.Landscape Then

Dim intTemp As Int32

intTemp = intPrintAreaHeight

intPrintAreaHeight = intPrintAreaWidth

intPrintAreaWidth = intTemp

End If

' Calculate the total number of lines in the document based on the height of

' the printing area and the height of the font.

Dim intLineCount As Int32 = CInt(intPrintAreaHeight / font.Height)

' Initialize the rectangle structure that defines the printing area.

Dim rectPrintingArea As New RectangleF(marginLeft, marginTop, intPrintAreaWidth, intPrintAreaHeight)

' Instantiate the StringFormat class, which encapsulates text layout

' information (such as alignment and line spacing), display manipulations

' (such as ellipsis insertion and national digit substitution) and OpenType

' features. Use of StringFormat causes MeasureString and DrawString to use

' only an integer number of lines when printing each page, ignoring partial

' lines that would otherwise likely be printed if the number of lines per

' page do not divide up cleanly for each page (which is usually the case).

' See further discussion in the SDK documentation about StringFormatFlags.

Dim fmt As New StringFormat(StringFormatFlags.LineLimit)

' Call MeasureString to determine the number of characters that will fit in

' the printing area rectangle. The CharFitted Int32 is passed ByRef and used

' later when calculating intCurrentChar and thus HasMorePages. LinesFilled

' is not needed for this sample but must be passed when passing CharsFitted.

' Mid is used to pass the segment of remaining text left off from the

' previous page of printing (recall that intCurrentChar was declared as

' static.

Dim intLinesFilled, intCharsFitted As Int32

e.Graphics.MeasureString(Mid(rtbox.Text, intCurrentChar + 1), font, _

New SizeF(intPrintAreaWidth, intPrintAreaHeight), fmt, _

intCharsFitted, intLinesFilled)

' Print the text to the page.

e.Graphics.DrawString(Mid(rtbox.Text, intCurrentChar + 1), font, _

Brushes.Black, rectPrintingArea, fmt)

' Advance the current char to the last char printed on this page. As

' intCurrentChar is a static variable, its value can be used for the next

' page to be printed. It is advanced by 1 and passed to Mid() to print the

' next page (see above in MeasureString()).

intCurrentChar += intCharsFitted

' HasMorePages tells the printing module whether another PrintPage event

' should be fired.

If intCurrentChar < rtbox.Text.Length Then

e.HasMorePages = True

Else

e.HasMorePages = False

' You must explicitly reset intCurrentChar as it is static.

intCurrentChar = 0

End If

End Sub

Private Sub printpreview()

Dim ppd As New PrintPreviewDialog()

Try

ppd.Document = pdoc

ppd.ShowDialog()

Catch exp As Exception

MessageBox.Show("有错误发生！！不能预览！" & _

"确信现在你是否能够 " & _

"连接到一个打印机？" & _

"然后预览才可以.", Me.Text, _

MessageBoxButtons.OK, MessageBoxIcon.Error)

End Try

End Sub

Private Sub mPrintpreview_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mPrintpreview.Click

printpreview()

End Sub

Private Sub mPagesetup_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mPagesetup.Click

Dim psd As New PageSetupDialog()

With psd

.Document = pdoc

.PageSettings = pdoc.DefaultPageSettings

End With

If psd.ShowDialog = DialogResult.OK Then

pdoc.DefaultPageSettings = psd.PageSettings

End If

End Sub

Private Sub printfile()

Dim dialog As New PrintDialog()

dialog.Document = pdoc

If dialog.ShowDialog = DialogResult.OK Then

pdoc.Print()

End If

End Sub

'********************************************************************************

Private Sub mNew_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mNew.Click

newfile()

End Sub

Private Sub mOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mOpen.Click

openfile()

End Sub

Private Sub mSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mSave.Click

savefile()

End Sub

Private Sub mSaveas_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mSaveas.Click

'将保存文件窗口标题改为“文件另存为”

SaveFileDialog1.Title = "文件另存为"

If SaveFileDialog1.ShowDialog() = DialogResult.OK Then

rtbox.SaveFile(SaveFileDialog1.FileName, RichTextBoxStreamType.PlainText)

bSave = True

End If

'将标题改回

SaveFileDialog1.Title = "保存文件"

End Sub

Private Sub mExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mExit.Click

'退出操作

Close()

End Sub

'在关闭程序之前，判断文本是否需要保存

Private Sub formMain_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing

If bSave = False Then

Dim flag As Integer

flag = MessageBox.Show("文件内容已更改，想保存文件吗？？", "info", MessageBoxButtons.YesNo, MessageBoxIcon.Information)

Select Case flag

'case 6是当用户选择了“保存”，则执行保存文件的操作

Case 6

'如果没有选择要保存的文件名，则弹出保存对话框，由用户选择要保存的文件名后保存文本

If SaveFileDialog1.FileName = "" Then

If SaveFileDialog1.ShowDialog Then

rtbox.SaveFile(SaveFileDialog1.FileName, RichTextBoxStreamType.PlainText)

End If

Else

'如果已经选择了要保存的文件名，则保存文本到文件中

rtbox.SaveFile(SaveFileDialog1.FileName, RichTextBoxStreamType.PlainText)

End If

Case Else

'不保存

End Select

End If

End Sub

'关于显示“关于”窗体的代码

Private Sub mAbout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mAbout.Click

'首先需要定义一个“关于”Form的实例

Dim fAbout As New formAbout()

'显示他

fAbout.Show()

End Sub

Private Sub mFont_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mFont.Click

If FontDialog1.ShowDialog() = DialogResult.OK Then

rtbox.Font = FontDialog1.Font

End If

End Sub

Private Sub mUndo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mUndo.Click

rtbox.Undo()

End Sub

Private Sub mCut_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mCut.Click

rtbox.Cut()

End Sub

Private Sub mCopy_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mCopy.Click

rtbox.Copy()

End Sub

Private Sub mPaste_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mPaste.Click

rtbox.Paste()

End Sub

Private Sub mClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mClear.Click

rtbox.Clear()

End Sub

Private Sub mSelectall_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mSelectall.Click

rtbox.SelectAll()

End Sub

Private Sub ToolBar1_ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ToolBarButtonClickEventArgs) Handles ToolBar1.ButtonClick

Select Case ToolBar1.Buttons.IndexOf(e.Button)

Case 0

newfile()

Case 1

openfile()

Case 2

savefile()

Case 5

printfile()

Case 6

printpreview()

Case 9

Panel1.Visible = True

Case 12

rtbox.Cut()

Case 13

rtbox.Copy()

Case 14

rtbox.Paste()

Case 15

rtbox.Undo()

End Select

End Sub

Private Sub mPrint_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mPrint.Click

printfile()

End Sub

Private Sub comboxFont_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles comboxFont.SelectedIndexChanged

SetFontFamily(rtbox, comboxFont.Text)

End Sub

Private Sub comboxSize_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles comboxSize.SelectedIndexChanged

SetFontSize(rtbox, comboxSize.SelectedItem)

End Sub

Private Sub ToolBar2_ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ToolBarButtonClickEventArgs) Handles ToolBar2.ButtonClick

Select Case ToolBar2.Buttons.IndexOf(e.Button)

Case 0

If tbbbold.Pushed = True Then

AddFontStyle(rtbox, FontStyle.Bold)

Else

RemoveFontStyle(rtbox, FontStyle.Bold)

End If

Case 1

If tbbi.Pushed = True Then

AddFontStyle(rtbox, FontStyle.Italic)

Else

RemoveFontStyle(rtbox, FontStyle.Italic)

End If

Case 2

If tbbu.Pushed = True Then

AddFontStyle(rtbox, FontStyle.Underline)

Else

RemoveFontStyle(rtbox, FontStyle.Underline)

End If

Case 3

ColorDialog1.ShowDialog()

rtbox.ForeColor = ColorDialog1.Color

Case 6

rtbox.SelectionAlignment = HorizontalAlignment.Left

tbbmiddle.Pushed = False

tbbright.Pushed = False

Case 7

rtbox.SelectionAlignment = HorizontalAlignment.Center

tbbleft.Pushed = False

tbbright.Pushed = False

Case 8

rtbox.SelectionAlignment = HorizontalAlignment.Right

tbbleft.Pushed = False

tbbmiddle.Pushed = False

End Select

End Sub

'********************************************

'菜单中的隐藏状态栏功能

Private Sub mStatusbar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mStatusbar.Click

If mStatusbar.Checked = True Then

StatusBar1.Visible = False

mStatusbar.Checked = False

Else

StatusBar1.Visible = True

mStatusbar.Checked = True

End If

End Sub

'********************************************

'状态栏的信息

Private Sub HandleSelect(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mStatusbar.Select, mAbout.Select, mClear.Select, mCopy.Select, mNew.Select, mCut.Select, mEdit.Select, mExit.Select, mFile.Select, mFind.Select, mFindnext.Select, mFont.Select, mHelp.Select, mHelptopics.Select, mOpen.Select, mPagesetup.Select, mPaste.Select, mPrint.Select, mPrintpreview.Select, mReplace.Select, mSave.Select, mSaveas.Select, mSelectall.Select, mStatusbar.Select, mUndo.Select, mView.Select

Dim strText As String

If sender Is mStatusbar Then

strText = "决定是否隐藏状态栏...."

ElseIf sender Is mAbout Then

strText = "您将看到我们开发小组的一些资料"

ElseIf sender Is mClear Then

strText = "清空所有内容！"

ElseIf sender Is mExit Then

strText = "退出程序！"

ElseIf sender Is mNew Then

strText = "新建一个文档，会提示保存。。。"

ElseIf sender Is mCopy Then

strText = "复制选中的内容"

ElseIf sender Is mCut Then

strText = "剪切制定的内容"

ElseIf sender Is mEdit Then

strText = "编辑菜单"

ElseIf sender Is mFile Then

strText = "文件菜单"

ElseIf sender Is mFind Then

strText = "显示查找面板。。"

ElseIf sender Is mFindnext Then

strText = "查找下一个"

ElseIf sender Is mFont Then

strText = "显示字体设置对话框"

ElseIf sender Is mOpen Then

strText = "打开菜单"

ElseIf sender Is mEdit Then

strText = "编辑菜单"

ElseIf sender Is mPagesetup Then

strText = "页面设置选项"

ElseIf sender Is mEdit Then

strText = "编辑菜单"

'.........

'........

Else

strText = String.Empty

End If

WriteToStatusBar(strText)

End Sub

Public Sub WriteToStatusBar(ByVal Text As String)

StatusBar1.Text = Text

End Sub

Private Sub MenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem2.Click

ColorDialog1.ShowDialog()

rtbox.ForeColor = ColorDialog1.Color

End Sub

'***********************************************************************************************

'下面是关于实现查找功能

Dim MyPos As Integer '先声明一个全局变量

Private Sub FindText(ByVal start As Integer) '创建findtext函数

Dim pos As Integer

Dim target As String

'获取用户输入的要查找的字符串

target = txtbox.Text

pos = InStr(start, rtbox.Text, target)

If pos > 0 Then '找到了匹配字符串

MyPos = pos

rtbox.SelectionStart = MyPos - 1 '高亮显示

rtbox.SelectionLength = Len(txtbox.Text)

rtbox.Focus()

Else

MsgBox("没找到！")

End If

End Sub

Private Sub find_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles find.Click

FindText(1)

End Sub

Private Sub findnext_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles findnext.Click

FindText(MyPos + 1)

End Sub

Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles closepanel.Click

Panel1.Visible = False

End Sub

'*************************************************************************************************************

'下面这段程序，用作拖拽“查找面板”使用

Dim dragging As Boolean

Dim mousex As Integer

Dim mousey As Integer

Private Sub panel1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Panel1.MouseDown

If e.Button = MouseButtons.Left Then

dragging = True

mousex = -e.X

mousey = -e.Y

Dim clipleft As Integer = Me.PointToClient(MousePosition).X - Panel1.Location.X

Dim cliptop As Integer = Me.PointToClient(MousePosition).Y - Panel1.Location.Y

Dim clipwidth As Integer = Me.ClientSize.Width - (Panel1.Width - clipleft)

Dim clipheight As Integer = Me.ClientSize.Height - (Panel1.Height - cliptop)

Cursor.Clip = Me.RectangleToScreen(New Rectangle(clipleft, cliptop, clipwidth, clipheight))

Panel1.Invalidate()

End If

End Sub

Private Sub panel1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Panel1.MouseMove

If dragging Then

'移动控件到新的位置

Dim MPosition As New Point()

MPosition = Me.PointToClient(MousePosition)

MPosition.Offset(mousex, mousey)

'确实控件不能离开主窗口

Panel1.Location = MPosition

End If

End Sub

Private Sub panel1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Panel1.MouseUp

If dragging Then

'结束拖拽

dragging = False

Cursor.Clip = Nothing

Panel1.Invalidate()

End If

End Sub

'****************************************************************************************************************

Private Sub replace_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mpreplace.Click

rtbox.Text = rtbox.Text.Replace(txtbox.Text, rpbox.Text)

End Sub

Private Sub mFind_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mFind.Click

Panel1.Visible = True

End Sub

Private Sub mFindnext_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mFindnext.Click

FindText(MyPos + 1)

End Sub

Private Sub mReplace_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mReplace.Click

rtbox.Text = rtbox.Text.Replace(txtbox.Text, rpbox.Text)

End Sub

End Class

'完。