'欢迎与我交流：[email protected]
所有源代码均在这里下载：
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
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)
Next
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)
Next
' 保持原有的选择
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
Next
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
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
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
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
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
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)
Next
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)
Next
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
'完。
本文地址：http://com.8s8s.com/it/it45493.htm