熱點推薦:
您现在的位置: 電腦知識網 >> 編程 >> .NET編程 >> 正文

用vb.net實現寫字板程序報告

2022-06-13   來源: .NET編程 
先看看界面

  
用實現寫字板程序報告(圖一)


  聲明一個全局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中文本前後間距的空間大小,大致思路就是這樣。

  所有源代碼均在這裡下載:

  


From:http://tw.wingwit.com/Article/program/net/201311/11693.html
    推薦文章
    Copyright © 2005-2022 電腦知識網 Computer Knowledge   All rights reserved.