common.bas

用VB语言编写的电子书阅读器

Attribute VB_Name = "Common"
Option Explicit
Public strBookFlag() As String    '存放从文本文件读出的关于各个书籍的记录信息
Public boolBookFlag As Boolean      '标志strBookFlag()是否使用
Public strOneChapterTem() As String        '暂时存放从文件中读出的一章内容，编排后存入strOneChapter()
Public strOneChapter() As String
Public intChapterLinesNum As Integer        '记录文件的行数

Public Sub OpenFile(strAddress As String)       '打开文件
    Dim strTem As String
    intChapterLinesNum = 1
    
    ReDim strOneChapter(0)
    ReDim strOneChapterTem(0)
           
    Open strAddress For Input As #1      '打开文件
    Do Until EOF(1)     '读出文件，存入Public字符数组strOneChapter()中
        Line Input #1, strTem
        If Not strTem Like "<*" And Not strTem Like "*>" And Not strTem = "" Then       '清除html的标记
            ReDim Preserve strOneChapterTem(intChapterLinesNum)
            strOneChapterTem(intChapterLinesNum - 1) = RTrim(strTem)
            intChapterLinesNum = intChapterLinesNum + 1
        End If
    Loop
    Close #1
End Sub

Public Sub Transfer()       '将临时数组strOneChapterTem()的内容按书的显示格式转换，每行17个字符，存入strOneChapter()
    Dim strTem As String
    Dim i As Integer
    Dim boolNewPara As Boolean
    intChapterLinesNum = 1
    strTem = ""
    
    For i = 0 To UBound(strOneChapterTem())
        
        If Mid(strOneChapterTem(i), 1, 2) = "  " Then         '新段落开始，半角空格都作为新段落的标志
            
            If Not strTem = "" Then
                If boolNewPara Then     '上一行为一新段，但是还未处理，取全部
                    ReDim Preserve strOneChapter(intChapterLinesNum)
                    strOneChapter(intChapterLinesNum - 1) = Mid(strTem, 1)
                    intChapterLinesNum = intChapterLinesNum + 1
                    boolNewPara = False
                Else        '上一行不是新段落或是新段落但已处理，则清空strTem
                    Do Until Len(strTem) < 17        '开始清空strTem
                        ReDim Preserve strOneChapter(intChapterLinesNum)
                        strOneChapter(intChapterLinesNum - 1) = Mid(strTem, 1, 17)
                        strTem = Mid(strTem, 18)
                        intChapterLinesNum = intChapterLinesNum + 1
                    Loop
                
                    ReDim Preserve strOneChapter(intChapterLinesNum)
                    strOneChapter(intChapterLinesNum - 1) = Mid(strTem, 1)      '清空完毕
                    intChapterLinesNum = intChapterLinesNum + 1
           
                End If
            End If
            
            strTem = strOneChapterTem(i)        '赋予strTem新段落的内容
            If Not Len(strTem) < 19 Then        '新段落，由于有四个空格却只占用了两个汉字的显示空间，所以应该在这行多加两个汉字
                ReDim Preserve strOneChapter(intChapterLinesNum)
                strOneChapter(intChapterLinesNum - 1) = Mid(strTem, 1, 19)
                strTem = Mid(strTem, 20)
                intChapterLinesNum = intChapterLinesNum + 1
                boolNewPara = False
                Do Until Len(strTem) < 17       '编排新段落余下的内容，当其字符数少于17时，循环读入新行
                    ReDim Preserve strOneChapter(intChapterLinesNum)
                    strOneChapter(intChapterLinesNum - 1) = Mid(strTem, 1, 17)
                    strTem = Mid(strTem, 18)
                    intChapterLinesNum = intChapterLinesNum + 1
                Loop
            Else        '新段落字符少于19，设置新段落处理标志，读下一行
                boolNewPara = True
            End If
            
        ElseIf Mid(strOneChapterTem(i), 1, 1) = "　" Then       '标题，以全角空格作为标志
            strTem = Replace(strOneChapterTem(i), "　", "")     '删除全部全角空格
            strTem = Space(17 - Len(strTem)) & strTem     '添加半角空格，使文字居中
            ReDim Preserve strOneChapter(intChapterLinesNum)
            strOneChapter(intChapterLinesNum - 1) = Mid(strTem, 1)
            strTem = ""
            intChapterLinesNum = intChapterLinesNum + 1
            
        Else        '不是新段落，继续在已有基础上编排
            strTem = strTem & strOneChapterTem(i)
            If boolNewPara Then     '上一行为一新段，但是还未处理
                If Not Len(strTem) < 19 Then        '新段落，由于有四个空格却只占用了两个汉字的显示空间，所以应该在这行多加两个汉字
                    ReDim Preserve strOneChapter(intChapterLinesNum)
                    strOneChapter(intChapterLinesNum - 1) = Mid(strTem, 1, 19)
                    strTem = Mid(strTem, 20)
                    intChapterLinesNum = intChapterLinesNum + 1
                    boolNewPara = False
                    
                    Do Until Len(strTem) < 17
                        ReDim Preserve strOneChapter(intChapterLinesNum)
                        strOneChapter(intChapterLinesNum - 1) = Mid(strTem, 1, 17)
                        strTem = Mid(strTem, 18)
                        intChapterLinesNum = intChapterLinesNum + 1
                    Loop
                End If
            Else        '上一行不是新段落或是新段落但已处理
                Do Until Len(strTem) < 17
                    ReDim Preserve strOneChapter(intChapterLinesNum)
                    strOneChapter(intChapterLinesNum - 1) = Mid(strTem, 1, 17)
                    strTem = Mid(strTem, 18)
                    intChapterLinesNum = intChapterLinesNum + 1
                Loop
            End If
        End If
        
    Next i
    
    ReDim Preserve strOneChapter(intChapterLinesNum)        '末尾的处理
    strOneChapter(intChapterLinesNum - 1) = Mid(strTem, 1)
    ReDim strOneChapterTem(0)       '清除临时信息
    
End Sub

Public Sub EndProgram()     '退出程序
    Dim i As Integer
    Dim strTem As String
    
    If boolBookFlag Then        '书签可用时
        Open App.Path & "\bookflag.txt" For Output As #1        '将本次阅读情况写入书签文件
        For i = 0 To UBound(strBookFlag(), 2)
            If Not strBookFlag(2, i) = "" Then
                strTem = "#" & strBookFlag(2, i) & "#" & strBookFlag(1, i) & "#" & strBookFlag(0, i)
                Print #1, strTem
            End If
        Next i
        Close #1
    End If
    
    End
End Sub