当前位置: 源码素材网 » VB教程 » 详情页

VB6将RTF控件内容转换为Ubb字符串

  •   时间:2019-06-08
  • 概述:RTF UBB

VB6将RTF控件内容转换为Ubb字符串,这是一个函数,操作对象类型为:RichTextBox,返回结果是UBB格式的HTML字符串:

'*Rtf2Ubb
'*功能:    将RTF控件内容转换为Ubb字符串
'*说明:
'*传入参数:
'*    rTxt      类型:RichTextBox
'*返回参数:
'*      HTML字符串
Public Function Rtf2Ubb(ctrl As RichTextBox) As String
Dim byt()       As Byte
Dim sFileName   As String
    sFileName = TempFileName
    HighLightCtrl ctrl, sFileName, False
    '*读入文件
    Open sFileName For Binary As #1
        ReDim byt(1 To FileLen(sFileName))
        Get #1, , byt
    Close #1
    If Dir(sFileName) <> "" Then
        Kill sFileName
    End If
    Rtf2Ubb = StrConv(byt, vbUnicode)
    '*将特殊字符恢复
    Rtf2Ubb = Replace(Rtf2Ubb, "\\", "\")
    Rtf2Ubb = Replace(Rtf2Ubb, "\{", "{")
    Rtf2Ubb = Replace(Rtf2Ubb, "\}", "}")
    '*先删除RTF文件头
    Rtf2Ubb = Replace(Rtf2Ubb, HEAD_FIRST & m_sColorRtf & HEAD_LAST, "", , 1)
    '*转换换行符号
    Rtf2Ubb = Replace(Rtf2Ubb, "\par ", vbCrLf)
    '*转换注释字体符号
    FontRtf2Ubb Rtf2Ubb, m_objQuotFont
    FontRtf2Ubb Rtf2Ubb, m_objCommFont
    Dim i       As Integer
    For i = 1 To m_iKwdCount
        FontRtf2Ubb Rtf2Ubb, m_objKwdFont(i)
    Next i
    '*去除最后一个"}"
    Rtf2Ubb = Left(Rtf2Ubb, Len(Rtf2Ubb) - 4)
End Function
Private Sub FontRtf2Ubb(ByRef sDeal As String, ByRef objFont As CFont)
'*对sDeal字符串进行RTF到UBB的字体转换
    sDeal = Replace(sDeal, objFont.getRtfHead(m_objColorManager), objFont.getUBBHead(m_objColorManager))
    sDeal = Replace(sDeal, objFont.getRtfTail, objFont.getUBBTail)
End Sub

    相关声明:

      若“VB6将RTF控件内容转换为Ubb字符串”有损您的权益,请告之我们删除内容。
      部分文章来源于网络,版权归原作者所有。