vb.net

位置:IT落伍者 >> vb.net >> 浏览文章

用vb.net实现写字板程序报告


发布日期:2021年04月08日
 
用vb.net实现写字板程序报告
先看看界面

一) 运用控件

MainMenu,SaveFileDialog,OpenFileDialog,FontDialog,ImageList,PrintDocument,ColorDialog等。

二)关键功能

1)首先说说最关键的,就是可以多个字体样式合并适用,比如一个字它可以既是加粗,又是斜体,又是加下划线!虽然这个可以用字体对话框做到,但是能够在工具栏按钮上实现这个功能可真是花费不少心机。

2)实现了文本查找,替换功能。并且实现了控件的拖动。

3)实现了打印预览功能。

三)主要设计

一般的功能如打开文件,保存文件,复制,粘贴,剪切等等就不说了,可以参考代码文件。现在主要来说说一些关键功能的设计。

1)提示型对话框

考虑用户在退出和关闭当前文本的时候,对用户文本内容保存提示。TW.WINgwIT.cOM因此如果文本内容发生了改变,就需要在用户关闭当前文件的时候(比如新建文本,打开其他文本或者退出记事本时)弹除提示对话框,提醒用户是否保存当前文件。为了实现这个功能,需要设置一个Boolean型变量用来跟蹤RichTextBox中文本内容改变的情况。RichTextBox控件有一个TextChanged事件,当文本发生改变的时候,这个事件就会被fired,所以利用这个事件来监视文本的改变。用一个Boolean型变量bSave作为标记。只要在适当的位置加入对Bsave的检查就可以判断文本内容的改变情况。

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

Dim bSave As Boolean

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

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

bSave = False

End Sub

2)关于在ComboBox中加载用户系统上的字体列表的问题

加载用户系统上的字体到写字板ComboBox的字体栏上,为了实现他,也花费了少时间,最终在VS.NET自带的Help中找到了答案。

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

Dim allfonts As FontFamily

For Each allfonts In System.Drawing.FontFamily.Families

comboxFont.Items.Add(allfonts.Name)

Next

3) 状态栏的隐藏

就是在“查看”菜单中有个check按钮,当checked=true时点击它状态栏就隐藏,反之就取消隐藏。

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

4)关于字体样式的问题

我觉得这是这个程序中最艰难的一部分,为了实现这个功能,查阅了不少资料,最终得以实现不用字体对话框设置,只用工具栏上按钮设置就能实现几个字体样式并用的功能。

上图中的“样”字就是既加粗又斜体又下划线,不要以为这个功能实现很简单,因为最初我发现如果一个字是加粗的,当我给他选择斜体按钮时,发现她原来的粗体样式消失了,变成只有斜体样式了,也就是说字体的样式不能并用,后来终于发现解决的方法。

其中的一个“or”确实十分关键,其了决定性作用。关键还是对VB的语法不太熟悉,如果是C++语言就好了。下面看看代码

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

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

同样,取消样式也有同样的问题,当然也有同样的解决方法

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

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

3)关于查找替换功能

这里我用了一个Panel面板控件来放查找,查找下一个,替换按钮和文本框

我为什么不用一个窗体呢?因为我正好想练练拖动控件的代码,可以实现让这个面板在主窗体范围内拖动,由于看到了一个老外的教程,就顺便翻译了来练习练习。首先说说这个简单的查找替换功能,就是用户在第一个文本框中输入希望查找的字,然后点击查找按钮,程序就会在RichTextBox中查找相匹配的字,找到之后,将其高亮显示,点击下一个按钮,就会找到下一个匹配的字。。如此反复,直到结束,而替换就是把所有在RichTextBox中第一个文本框中的内容用第二个文本框的内容替换。是不是有些绕口令?还是亲自尝试一下就知道了。下面是查找替换相关代码(主要是创建一个FindText函数):

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

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

给find按钮,findNext按钮

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

拖动控件的代码:

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

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 5)有关打印预览

起初以为很简单,但最后发现预览总是无法预览到实际文件,最终还是在微软站点上获得了相关信息,并很好的利用他到本应用程序中,而且十分成功,可以成功预览了。为了怕自己误导别人,所以把它原文也打印出来。

下面是两幅图片用来演示打印预览的效果。

打印预览相关代码:

(注意!以下有关打印的代码均来自微软技术文档中)

' 必须确定所有的打印事件都是针对同一个 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 总结:

总体来说,本程序达到了windows写字板85%的功能,很可惜就是没有做标尺的效果,也有些思路,就是利用拖动控件代码,设置两个控件,左右对称。 规定这两个控件只能在一条水平线上拖动,根据两个控件的移动来确定Richtextbox中文本前后间距的空间大小,大致思路就是这样。

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

上一篇:用VB.NET设计各种形状的窗体界面二

下一篇:VB.NET中的Option Explicit和Option Strict