请登录[¤ 阳光论坛 ¤]参与讨论


阳光宝宝
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 
       
      
——
      
争分夺秒背单词 → push  vt.推,逼迫 vi.推
 □ 发帖时间:2012-2-20|10:20:15 |回复|返回|

 页次:1/1页 每页10  本主题贴数0 分页: 1


你还没有登录论坛,所以不能发表你的意见。你可以选择:

1、我已注册,我要

2、我还没注册,我要

3、太麻烦了,我还是

Go Top

Copyright by(C)2003-2015 http://abc.sy578.cn