【VB.NET】自己写的阅读器类源码

我经常看小说，所以自己写了个阅读器，里面涉及了一些知识，我放出来，一是记录方便我以后忘了可以查看，二是供需要的朋友参考。

如果代码有不足之处或有更好的方法，可以的话请留言交流，感激不尽！

iLabel.class（用户控件）

Public Class iLabel
    Private iText As String = ""
    Private iFontSize As Single = 12
    Private iFontBold As Boolean = True
    Private iFontName As String = "微软雅黑"
    Private iFontColor As Color = Color.White
    Private iFontBackColor As Color = Color.Black

    Public Sub SetText(ByVal T As String)
        iText = T : ReDraw()
    End Sub
    Public Function GetText() As String
        Return iText
    End Function
    Public Sub SetFont(Optional ByVal FontSize As Single = 0, _
                                    Optional ByVal FontBold As Boolean = True, _
                                    Optional ByVal FontName As String = "")
        If FontSize > 0 Then iFontSize = FontSize
        If FontBold <> iFontBold Then iFontBold = FontBold
        If FontName.Length > 0 Then
            Try
                Dim tFont As New Font(FontName, 12)
                iFontName = FontName
            Catch ex As Exception
            End Try
        End If
        ReDraw()
    End Sub
    Public Function GetFontName() As String
        Return iFontName
    End Function
    Public Function GetFontSize() As Single
        Return iFontSize
    End Function
    Public Function IsFontBold() As Boolean
        Return iFontBold
    End Function
    Public Function GetFontColor() As Color
        Return iFontColor
    End Function
    Public Function GetBackColor() As Color
        Return iFontBackColor
    End Function
    Public Sub SetColor(ByVal FontColor As Color, ByVal BackColor As Color)
        iFontBackColor = BackColor
        Me.BackColor = BackColor
        iFontColor = FontColor
        ReDraw()
    End Sub
    Public Sub SetSize(Optional ByVal Width As Integer = 0, _
                                    Optional ByVal Height As Integer = 0, _
                                    Optional ByVal Text As String = "", _
                                    Optional ByVal Left As Integer = 0, _
                                    Optional ByVal Top As Integer = 0)
        With Me
            If Left > 0 Then .Left = Left
            If Top > 0 Then .Top = Top
            If Width > 0 Then .Width = Width
            If Height > 0 Then .Height = Height
        End With
        If Text.Length > 0 Then iText = Text
        ReDraw()
    End Sub

    Public Function GetSize() As Size
        Return Me.Size
    End Function
    Public Sub ReDraw()
        Dim nBrush As New SolidBrush(iFontColor)
        Dim font As New Font(iFontName, iFontSize, CType(IIf(iFontBold, FontStyle.Bold, FontStyle.Regular), FontStyle))
        Me.Font = font
        Dim bmp As New Bitmap(Me.Width, Me.Height)
        Dim g = Graphics.FromImage(bmp)

        Dim sizef As SizeF = g.MeasureString(iText, font)
        Dim top As Single = (Me.Height - sizef.Height) / 2
        g.Clear(iFontBackColor)
        TextRenderer.DrawText(g, iText, font, New Point(0, top), iFontColor)
        ‘g.DrawString(iText, font, nBrush, 0, top)
        Me.BackgroundImage = bmp
        g = Nothing : bmp = Nothing
    End Sub

    Private Sub iLabel_Invalidated(sender As Object, e As InvalidateEventArgs) Handles Me.Invalidated
        Dim font As New Font(iFontName, iFontSize, CType(IIf(iFontBold, FontStyle.Bold, FontStyle.Regular), FontStyle))
        Me.Font = font
    End Sub
End Class

Public Class TXTClass

    Private TxtParagraghCount As Integer ‘文本总段落数
    Private TxtParagraghIndex As Integer ‘文本当前段落引索
    Private iTxt() As String ‘以段落为元素组成集合
    Private iTxtPath As String ‘文本文件位置
    Private TxtWordCount As Long ‘文本总文字数

    Public Enum TXTClass_Enum_TState  ‘当前文本状态枚举
        NoTxt = 0               ‘未打开任何文本文件
        InHead = 1             ‘已打开文件，且当前段落引索在文件头
        InMiddle = 2          ‘已打开文件，且当前段落引索在文件中部
        InTail = 3                ‘已打开文件，且当前段落引索在文件尾
    End Enum
    Private iTxtState As TXTClass_Enum_TState ‘当前文本状态

    Public Sub New()
        TxtParagraghCount = 0 : TxtParagraghIndex = 0 : iTxtPath = ""
        ReDim iTxt(0) : TxtWordCount = 0
        iTxtState = TXTClass_Enum_TState.NoTxt
    End Sub
    Public Function OpenTxt(ByVal FilePath As String, _
                             Optional ByVal FileCheck As Boolean = False, _
                             Optional ByVal HasRecord As Boolean = False) As Boolean
        Try
            If Not (FileCheck OrElse (FilePath.Length > 0 AndAlso IO.File.Exists(FilePath))) Then Return False
            Dim Tmp As String
            Dim TmpTxt() As String
            Dim TmpTxtParagraghCount As Integer
            Dim TmpWordCount As Long
            Dim iReader As IO.StreamReader
            ‘尝试打开文件并尝试获取相关信息
            Try
                iReader = New IO.StreamReader(FilePath, System.Text.Encoding.Default)
                Tmp = iReader.ReadToEnd : iReader.Dispose()
                TmpTxt = Split(Tmp, vbNewLine)
                TmpTxtParagraghCount = TmpTxt.Length
                If Not HasRecord Then TmpWordCount = Tmp.LongCount
            Catch ex As Exception
                MsgBox("方法：TXTClass.OpenTxt() ‘尝试打开文件并获取信息‘ 执行出错！", , "错误提示")
                Return False
            End Try
            ‘成功打开文件和获取信息，下面清除原来的信息并写入新文件信息
            If Not CloseTxt() Then Return False
            iTxt = TmpTxt
            If Not HasRecord Then ‘如果没有记录文件，则使用默认信息
                TxtParagraghCount = TmpTxtParagraghCount : TxtParagraghIndex = -1
                TxtWordCount = TmpWordCount
                iTxtState = TXTClass_Enum_TState.InHead
            Else  ‘如果有记录文件则使用记录的信息

            End If
            iTxtPath = FilePath
            Return True
        Catch ex As Exception
            MsgBox("方法：TXTClass.OpenTxt() 执行出错！", , "错误提示")
            Return False
        End Try
    End Function
    Public Function CloseTxt() As Boolean
        Try
            ReDim iTxt(0) : iTxtState = TXTClass_Enum_TState.NoTxt
            TxtParagraghCount = 0 : TxtParagraghIndex = 0
            TxtWordCount = 0
            Return True
        Catch ex As Exception
            MsgBox("方法：TXTClass.CloseTxt() 执行出错！", , "错误提示")
            Return False
        End Try
    End Function

    Public Function GetTxtState() As TXTClass_Enum_TState
        Return iTxtState
    End Function
    Public Function GetParagraghCount() As Integer
        Return IIf(iTxtState = TXTClass_Enum_TState.NoTxt, -1, TxtParagraghCount)
    End Function
    Public Function GetParagraghIndex() As Integer
        Return IIf(iTxtState = TXTClass_Enum_TState.NoTxt, -1, TxtParagraghIndex)
    End Function
    Public Function SetParagraghIndex(ByVal Index As Integer) As Boolean
        Try
            If Index >= 0 AndAlso Index < TxtParagraghCount Then
                TxtParagraghIndex = Index
                Return True
            End If
        Catch ex As Exception
            MsgBox(ex.ToString, , "错误提示")
            Return False
        End Try
    End Function
    Public Function GetWordCount() As Long
        Return IIf(iTxtState = TXTClass_Enum_TState.NoTxt, -1, TxtWordCount)
    End Function
    Public Function IsHOF() As Boolean ‘HeadOfFile
        ‘等同 return iif(iTxtState=TXTClass_Enum_TState.InHead,true,false)
        Return IIf(TxtParagraghIndex <= 0, True, False)
    End Function
    Public Function IsEOF(Optional ByVal Index As Integer = -1) As Boolean ‘EndOfFile
        If Index = -1 Then
            ‘等同 return iif(iTxtState=TXTClass_Enum_TState.InTail,true,false)
            Return IIf(TxtParagraghIndex >= TxtParagraghCount - 1, True, False)
        Else
            Return IIf(Index >= TxtParagraghCount - 1, True, False)
        End If
    End Function

    Public Function NextParagragh(Optional ByVal WithoutChange As Boolean = True) As String
        Try
            ‘判断是否已打开文件
            If iTxtState = TXTClass_Enum_TState.NoTxt Then Return ""
            If WithoutChange Then  ‘如果只是读取而不改变段落引索
                Return IIf(iTxtState = TXTClass_Enum_TState.NoTxt, "", _
                            IIf(TxtParagraghIndex + 1 >= TxtParagraghCount, "已到尾段！", _
                                iTxt(TxtParagraghIndex + 1)))
            Else ‘读取并自动改变段落引索
                TxtParagraghIndex += 1
                ‘判断并修改文件状态
                If TxtParagraghIndex >= TxtParagraghCount - 1 Then
                    iTxtState = TXTClass_Enum_TState.InTail
                Else
                    iTxtState = TXTClass_Enum_TState.InMiddle
                End If
                If TxtParagraghIndex >= TxtParagraghCount Then
                    TxtParagraghIndex = TxtParagraghCount - 1 : Return "已到尾段！"
                End If
                Return iTxt(TxtParagraghIndex)
            End If
        Catch ex As Exception
            MsgBox("方法：TXTClass.NextParagragh() 执行出错！", , "错误提示")
            Return ""
        End Try
    End Function
    Public Function ThisParagragh(Optional ByVal Index As Integer = -1, Optional ByVal WithoutChange As Boolean = True) As String
        Try
            ‘判断是否已打开文件
            If iTxtState = TXTClass_Enum_TState.NoTxt Then Return ""
            Dim TmpLineIndex As Integer = TxtParagraghIndex ‘临时创建段落引索副本
            If TxtParagraghIndex = -1 Then ‘当段落引索为初始值时自动调整引索为有效值
                TmpLineIndex = 0
                If Not WithoutChange Then TxtParagraghCount = 0
            End If
            If Index <> -1 Then ‘判断返回默认行还是指定行，Index=-1 默认行
                If Index >= 0 AndAlso Index < TxtParagraghCount Then ‘检查新段落引索有效性
                    TmpLineIndex = Index
                    If Not WithoutChange Then ‘如果【不是】 只读取而不改变段落引索
                        TxtParagraghIndex = Index ‘修改段落引索
                        ‘判断并修改文本状态
                        If TxtParagraghIndex > 0 AndAlso TxtParagraghIndex < TxtParagraghCount - 1 Then
                            iTxtState = TXTClass_Enum_TState.InMiddle
                        ElseIf TxtParagraghIndex = 0 Then
                            iTxtState = TXTClass_Enum_TState.InHead
                        ElseIf TxtParagraghIndex = TxtParagraghCount - 1 Then
                            iTxtState = TXTClass_Enum_TState.InTail
                        End If
                    End If
                Else
                    Return ""
                End If
            Else
                Return iTxt(TmpLineIndex)
            End If
        Catch ex As Exception
            MsgBox("方法：TXTClass.LastParagragh() 执行出错！", , "错误提示")
            Return ""
        End Try
    End Function
    Public Function LastParagragh(Optional ByVal WithoutChange As Boolean = True) As String
        Try
            ‘判断是否已打开文件
            If iTxtState = TXTClass_Enum_TState.NoTxt Then Return ""
            If Not WithoutChange Then ‘如果只是读取而不改变段落引索
                Return IIf(iTxtState = TXTClass_Enum_TState.NoTxt, "", _
                           IIf(TxtParagraghIndex - 1 < 0, "已到首段！", iTxt(TxtParagraghIndex - 1)))
            Else ‘读取并自动改变段落引索
                TxtParagraghIndex -= 1
                ‘判断并修改文件状态
                iTxtState = IIf(TxtParagraghIndex <= 0, _
                                TXTClass_Enum_TState.InHead, _
                                TXTClass_Enum_TState.InMiddle)
                If TxtParagraghIndex < 0 Then
                    TxtParagraghIndex = 0 : Return "已到首段！"
                End If
                Return iTxt(TxtParagraghIndex)
            End If
        Catch ex As Exception
            MsgBox("方法：TXTClass.LastParagragh() 执行出错！", , "错误提示")
            Return ""
        End Try
    End Function
End Class

Public Class ReadLineClass
    Inherits TXTClass

    Private iLineCount As Integer
    Private iLineIndex As Integer
    Private iLine() As String

    Private TXTWordIndex As Long

    Private Enum LState
        GoDown = 0
        GoUp = 1
    End Enum
    Private iLineState As LState

    Private iLab As iLabel

    Public Sub Init(ByRef tLab As iLabel)
        iLab = tLab
    End Sub

    Public Function IsEOL(Optional ByVal Index As Integer = -1) As Boolean ‘EndOfLine
        If Index = -1 Then
            If iLineIndex >= iLineCount - 1 Then Return True Else Return False
        Else
            If Index >= iLineCount - 1 Then Return True Else Return False
        End If
    End Function
    Public Function IsHOL() As Boolean ‘HeadOfLine
        ‘判断是否处于iLine的首元素
        If iLineIndex <= 0 Then Return True Else Return False
    End Function

    Public Function GetLineCount() As Integer
        Return iLineCount
    End Function
    Public Function GetLineIndex() As Integer
        Return iLineIndex
    End Function
    Public Function SetLineIndex(ByVal Index As Integer) As Boolean
        Try
            If Index >= 0 AndAlso Index < iLineCount Then
                iLineIndex = Index
                Return True
            End If
        Catch ex As Exception
            MsgBox(ex.ToString, , "错误提示")
            Return False
        End Try
    End Function
    Public Function GetWordIndex() As Long
        Return TXTWordIndex
    End Function
    Public Function SetWordIndex(ByVal Index As Long) As Boolean
        If GetTxtState() = TXTClass_Enum_TState.NoTxt Then Return False
        If Index < 0 OrElse Index >= GetWordCount() Then Return False
        Try
            Dim tIndex As Long = TXTWordIndex
            Dim tParagraghIndex As Integer = GetParagraghIndex(), tLineIndex As Integer = GetLineIndex()
            Dim bak_ParagraghIndex As Integer = tParagraghIndex, bak_LineIndex As Integer = tLineIndex
            If tIndex < Index Then  ‘向后跳转
                ‘步骤：计入当前行；计入剩余行；计入N段、再计入M行
                ‘判断成功：是否在当前行范围内；是否在剩余行范围内；先是否在段范围内，再判断在哪行范围内
                ‘失败：恢复之前的ParagraghIndex和LineIndex
                ‘第一步：计入当前行，判断是否在当前行范围内
                tIndex += ThisLine.Length
                If tIndex >= Index Then Return True ‘Index在当前段-当前行
                ‘第二步：在第一步的基础上，计入剩余行，判断是否在剩余行范围内
                While Not IsEOL(tLineIndex)
                    tLineIndex += 1 : tIndex += ThisLine(tLineIndex, True).Length
                    If tIndex >= Index Then
                        If SetLineIndex(tLineIndex) Then
                            Return True ‘Index在当前段-第tLineIndex行
                        Else
                            SetLineIndex(bak_LineIndex)
                            Return False
                        End If
                    End If
                End While
                ‘第三步：在第一、二步基础上，先计入N段判断在哪段范围内，再计入M行判断在哪行范围内
                Do
                    tParagraghIndex += 1 : tIndex += ThisParagragh(tParagraghIndex, True).Length
                Loop Until tIndex > Index ‘判断在哪段
                If Not (SetParagraghIndex(tParagraghIndex) AndAlso _
                        CutParagragh(ThisParagragh(-1, True), iLine) > 0) Then
                    ‘段落引索设置失败或新段落的分行失败，恢复原来的信息
                    SetParagraghIndex(bak_ParagraghIndex)
                    CutParagragh(ThisParagragh(-1, True), iLine)
                    SetLineIndex(bak_LineIndex)
                    Return False
                End If
                tLineIndex = 0 : tIndex -= ThisParagragh(tParagraghIndex, True).Length
                Do Until tIndex + ThisLine(tLineIndex, True).Length > Index
                    tIndex += ThisLine(tLineIndex, True).Length : tLineIndex += 1
                Loop
                If SetLineIndex(tLineIndex) Then
                    Return True
                Else
                    SetParagraghIndex(bak_ParagraghIndex)
                    CutParagragh(ThisParagragh(-1, True), iLine)
                    SetLineIndex(bak_LineIndex)
                    Return False
                End If
            Else  ‘向前跳转
                ‘步骤：计入多余行（向上）；计入N段、再计入M行
                ‘判断成功：是否在多余行范围内；先是否在段范围内，再判断在哪行范围内
                ‘失败：恢复之前的ParagraghIndex和LineIndex
                ‘第一步：计入多余行（向上），判断是否在多余行范围内
                While Not IsHOL()
                    tLineIndex -= 1 : tIndex -= ThisLine(tLineIndex, True).Length
                    If tIndex <= Index Then
                        If SetLineIndex(tLineIndex) Then
                            Return True
                        Else
                            SetLineIndex(bak_LineIndex)
                            Return False
                        End If
                    End If
                End While
                ‘第二步：在第一步基础上，先向上计入N段判断在哪段范围内，再向上计入M行判断在哪行范围内
                Do
                    tParagraghIndex -= 1 : tIndex -= ThisParagragh(tParagraghIndex, True).Length
                Loop Until tIndex <= Index OrElse IsHOF()
                If Not (SetParagraghIndex(tParagraghIndex) AndAlso _
                        CutParagragh(ThisParagragh(-1, True), iLine) > 0) Then
                    ‘段落引索设置失败或新段落的分行失败，恢复原来的信息
                    SetParagraghIndex(bak_ParagraghIndex)
                    CutParagragh(ThisParagragh(-1, True), iLine)
                    SetLineIndex(bak_LineIndex)
                    Return False
                End If
                tLineIndex = iLine.Length - 1 : tIndex += ThisParagragh(tParagraghIndex, True).Length
                Do Until tIndex - ThisLine(tLineIndex, True).Length <= Index
                    tIndex -= ThisLine(tLineIndex, True).Length : tLineIndex -= 1
                Loop
                If SetLineIndex(tLineIndex) Then
                    Return True
                Else
                    SetParagraghIndex(bak_ParagraghIndex)
                    CutParagragh(ThisParagragh(-1, True), iLine)
                    SetLineIndex(bak_LineIndex)
                    Return False
                End If
            End If
        Catch ex As Exception
            MsgBox(ex.ToString, , "错误提示")
            Return False
        End Try
    End Function

    Public Function GetReadRatio() As Double
        Dim wCount As Long = GetWordCount()
        If wCount <= 0 Then Return 0
        Return TXTWordIndex / wCount
    End Function
    Public Function SetReadRatio(ByVal Ratio As Double) As Boolean
        If GetTxtState() = TXTClass_Enum_TState.NoTxt Then Return False
        Dim dWordIndex As Long = CLng(GetWordCount() * Ratio) ‘定位的wordindex
        Return SetWordIndex(dWordIndex)
    End Function

    Public Function NextLine(Optional ByVal WithoutChange As Boolean = False) As String
        Try
            If Not IsEOL() Then ‘如果还有下一行
                If WithoutChange Then
                    Return iLine(iLineIndex + 1)
                Else
                    TXTWordIndex += iLine(iLineIndex).Length ‘减去当前行字数
                    iLineIndex += 1 : iLineState = LState.GoDown
                    Return iLine(iLineIndex)
                End If
            Else ‘无下一行，需要对下一段进行分行
                If IsEOF() Then Return "" ‘如果无下一段，则返回空字符串
                Dim tLine() As String : ReDim tLine(0)
                If WithoutChange Then
                    If CutParagragh(NextParagragh(True), tLine) > 0 Then
                        Return tLine(0)
                    Else
                        MsgBox("段落分行出错！" + vbCrLf + "函数：NextLine()，引索：" + GetParagraghIndex() + 1 + vbCrLf + "该段内容在下个提示框显示。", , "错误提示")
                        MsgBox(NextParagragh(True), , "段落分行出错")
                        Return "段落分行出错！"
                    End If
                Else
                    Dim tLineCount As Integer = CutParagragh(NextParagragh(False), tLine)
                    If tLineCount > 0 Then
                        iLine = tLine : iLineCount = tLineCount
                        iLineIndex = 0 : iLineState = LState.GoDown
                        Return iLine(iLineIndex)
                    Else
                        MsgBox("段落分行出错！" + vbCrLf + "函数：NextLine()，引索：" + GetParagraghIndex() + vbCrLf + "该段内容在下个提示框显示。", , "错误提示")
                        MsgBox(ThisParagragh(), , "段落分行出错")
                        Return "段落分行出错！"
                    End If
                End If
            End If
        Catch ex As Exception
            MsgBox(ex.ToString, , "错误提示")
            Return ""
        End Try
    End Function
    Public Function ThisLine(Optional ByVal Index As Integer = -1, Optional ByVal WithoutChange As Boolean = False) As String
        Try
            If Index >= 0 Then
                Return iLine(Index)
                If Not WithoutChange Then iLineIndex = Index
            Else
                Return iLine(iLineIndex)
            End If
        Catch ex As Exception
            MsgBox(ex.ToString, , "错误提示")
            Return ""
        End Try
    End Function
    Public Function LastLine(Optional ByVal WithoutChange As Boolean = False) As String
        Try
            If Not IsHOL() Then ‘如果还有上一行
                If WithoutChange Then
                    Return iLine(iLineIndex - 1)
                Else
                    iLineIndex -= 1 : iLineState = LState.GoUp
                    TXTWordIndex -= iLine(iLineIndex).Length  ‘减去上一行的字数
                    Return iLine(iLineIndex)
                End If
            Else ‘无下一行，需要对上一段进行分行
                If IsHOF() Then Return "" ‘如果没有上一段，则返回空字段
                Dim tLine() As String, tLineCount As Integer : ReDim tLine(0)
                If WithoutChange Then
                    tLineCount = CutParagragh(LastParagragh(True), tLine)
                    If tLineCount > 0 Then
                        Return tLine(tLineCount - 1)
                    Else
                        MsgBox("段落分行出错！" + vbCrLf + "函数：LastLine()，引索：" + GetParagraghIndex() - 1 + vbCrLf + "该段内容在下个提示框显示。", , "错误提示")
                        MsgBox(LastParagragh(True), , "段落分行出错")
                        Return "段落分行出错！"
                    End If
                Else
                    tLineCount = CutParagragh(LastParagragh(False), tLine)
                    If tLineCount > 0 Then
                        iLine = tLine : iLineCount = tLineCount
                        iLineIndex = iLineCount - 1 : iLineState = LState.GoUp
                        Return iLine(iLineIndex)
                    Else
                        MsgBox("段落分行出错！" + vbCrLf + "函数：LastLine()，引索：" + GetParagraghIndex() + vbCrLf + "该段内容在下个提示框显示。", , "错误提示")
                        MsgBox(ThisParagragh(), , "段落分行出错")
                        Return "段落分行出错！"
                    End If
                End If
            End If
        Catch ex As Exception
            MsgBox(ex.ToString, , "错误提示")
            Return ""
        End Try
    End Function

    Private Function CutParagragh(ByVal tText As String, ByRef tmpLine() As String) As Integer
        ‘根据tLab的信息对tText进行分行，结果以地址的形式储存到tmpLine中，返回tmpLineCount
        Try
            ReDim tmpLine(0)
            If tText.Length = 0 Then Return 1
            Dim tLab As iLabel = iLab
            Dim tFont As Font = tLab.Font
            Dim g As Graphics = tLab.CreateGraphics
            Dim tmpLineCount As Integer = 0
            Dim iLabWidth As Integer = tLab.Width  ‘经测试得出的比例
            Dim EachWordWidth As Integer = TextRenderer.MeasureText("测", tFont).Width
            Dim EachLineWordCount As Integer = iLabWidth / EachWordWidth
            EachLineWordCount += CInt(EachLineWordCount * 0.5)
            Dim iStr As String = tText
            Dim tStrWidth As Integer = 0, tStr As String = "", tStrCount As Integer = 0
            Dim iStrWidth As Integer = TextRenderer.MeasureText(g, iStr, tFont).Width
            While iStrWidth > iLabWidth ‘如果初始(剩余)字串的长度比限定的长则进行(继续)分割
                ‘判断字串的个数是否比默认的小，若比默认的小则以字串的个数作为默认值。该值用于初次截取字串
                tStrCount = iStr.Length
                tStrCount = IIf(EachLineWordCount >= tStrCount, tStrCount - 1, EachLineWordCount) ‘-1的必要性：由于已知tStrCount个字的长度比限定的长，所以按照这个值截取出来的长度肯定不符合，因此尝试截取tStrCount-1个字
                ‘判断初次截取的长度是否符合要求
                tStr = Mid(iStr, 1, tStrCount)
                tStrWidth = TextRenderer.MeasureText(tStr, tFont).Width
                If tStrWidth > iLabWidth Then ‘初次截取的字串长度较长，尝试减少字符个数
                    Do
                        ‘根据超出的长度判断减少多少个字符
                        tStrCount -= CIntA(tStrWidth - iLabWidth, EachWordWidth)
                        tStr = Mid(iStr, 1, tStrCount)
                        tStrWidth = TextRenderer.MeasureText(tStr, tFont).Width
                    Loop While tStrWidth > iLabWidth
                    ReDim Preserve tmpLine(tmpLineCount)
                    tmpLine(tmpLineCount) = tStr
                    tmpLineCount += 1
                Else ‘初次截取的字串长度较短，尝试增加字符个数
                    Do
                        ‘根据剩余的长度判断增加多少个字符
                        tStrCount += CIntA(iLabWidth - tStrWidth, EachWordWidth)
                        ‘tStrCount += 1 ‘防止增加太多导致超出范围
                        tStr = Mid(iStr, 1, tStrCount)
                        tStrWidth = TextRenderer.MeasureText(tStr, tFont).Width
                    Loop While tStrWidth < iLabWidth
                    ReDim Preserve tmpLine(tmpLineCount)
                    tStrCount -= 1 : tmpLine(tmpLineCount) = Mid(tStr, 1, tStrCount)
                    tmpLineCount += 1
                End If
                iStr = Mid(iStr, tStrCount + 1)
                iStrWidth = TextRenderer.MeasureText(iStr, tFont).Width
            End While
            ‘如果（剩余）字符串的长度小于限定的值，则直接储存。
            If iStr.Length > 0 Then
                ReDim Preserve tmpLine(tmpLineCount)
                tmpLine(tmpLineCount) = iStr
                tmpLineCount += 1
            End If
            Return tmpLineCount
        Catch ex As Exception
            MsgBox(ex.ToString, , "错误提示")
            Return 0
        End Try
    End Function
    Private Function CIntA(ByVal V1 As Integer, ByVal V2 As Integer) As Integer
        ‘作用：返回不小于V1除以V2的商的值
        Dim v As Integer = V1 \ V2
        Return IIf(V1 Mod V2 = 0, v, v + 1)
    End Function

End Class

【VB.NET】自己写的阅读器类源码,古老的榕树,5-wow.com