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

    ''''下面这个函数是用来增加字体的样式，比如加粗，下划线等等
    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

上一页  [1] [2] [3] [4] [5] [6] [7] [8] [9] [10]  下一页

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18