| 90 |
| □ 主题： 文本重排的函数代码 |
| □ 内容： | 1楼 |
本函数是使用字节型数组操作的，速度非常快。 本函数有三个参数： 1.欲重排的字符串。 2.换行字数。这个字数是按英文计数的，如果是中文文本，那么换行字数要×2。 3.半角转全角标记。该参数是可选的，但要注意，有一个英文字符“\”无法转为全角，如有必要，请 自行添加代码转换。 如果你的文本中有代码行，请勿使用本函数，除非每行代码前都有一个空格或者每两行代码间有一 空行（象本文下面就是代码行，不能使用这个函数来进行重排）。 函数中的Dat1数组用于装入欲重排的字符串的编码，Dat2数组用于接收重排后的字符编码。 Function TextRank(st As String, LineWordCount As Integer, Optional wFlags As Boolean) As String Dim Dat1() As Byte, Dat2() As Byte Dim J1 As Long ''已处理字节计数，它也是Dat2数组的当前元素下标 Dim J4 As Integer ''行字节计数 Dim S As Long, i As Long If wFlags Then st = StrConv(st, vbWide) ''半角转全角 st = StrConv(st, vbFromUnicode): Dat1 = st: S = UBound(Dat1): ReDim Dat2(S * 2) For i = 0 To S If Dat1(i) > 127 Then''如果是汉字编码 Dat2(J1) = Dat1(i): Dat2(J1 + 1) = Dat1(i + 1): J1 = J1 + 2: J4 = J4 + 2: i = i + 1 ElseIf Dat1(i) = 13 Then''如果是回车符 If i + 2 >= S Then GoSub 100: Exit For If J4 > 0 And (Dat1(i + 2) = 32 Or Dat1(i + 2) = 161 And Dat1(i + 3) = 161) Then GoSub 100 If Dat1(i + 2) = 13 Then GoSub 100: GoSub 100: i = i + 3 ElseIf Dat1(i) > 31 Then''如果是英文字符编码 Dat2(J1) = Dat1(i): J1 = J1 + 1: J4 = J4 + 1 End If If J4 >= LineWordCount Then GoSub 100 Next J1 = J1 - 1: ReDim Preserve Dat2(J1) ''删除未用的数组元素 st = Dat2: TextRank = StrConv(st, vbUnicode) st = "": ReDim Dat1(0), Dat2(0) ''释放资源 Exit Function 100 Dat2(J1) = 13: Dat2(J1 + 1) = 10: J1 = J1 + 2: J4 = 0: Return End Function |
—— |
| □ 争分夺秒背单词 → hydraulic a.水力的；水力学的 |
| □ 发帖时间：2012-2-20｜10:20:15 | |回复|返回| |
