VB6文本框中的RTF文本

时间:2013-06-14 15:56:31

标签: vb6 richtextbox

有没有人知道在使用第三方文本框控件之外是否有办法将HTML输入到VB6文本框中。

我在网上找不到任何东西。

1 个答案:

答案 0 :(得分:3)

希望你能够利用这一点。我们在.Net中进行此操作,允许对表单进行简单的编辑控制以发送格式化的电子邮件。因此,我们有一个RTF文本框,其中包含用于创建文本的自定义菜单,然后我们提取RTF,将其转换为HTML并将其作为HTML内容添加为电子邮件正文。 RTF到HTML的转换使用了本文中的代码:http://www.codeproject.com/Articles/27431/Writing-Your-Own-RTF-Converter

这是我们用来将它们联系在一起的包装代码 - 它只需要一个RTF输入并直接返回一个HTML输出:

Imports Itenso.Rtf
Imports Itenso.Rtf.Support
Imports Itenso.Rtf.Parser
Imports Itenso.Rtf.Interpreter
Imports Itenso.Rtf.Converter.Image
Imports Itenso.Rtf.Converter.Html
Imports Itenso.Sys.Application
Namespace Email
  Public Class RtfToHtml

    Public Function Convert(inText As String) As String
      Dim struct = ParseRtf(inText)
      Dim doc = InterpretRtf(struct)
      Return ConvertHtml(doc)
    End Function


    Private Function ParseRtf(inText As String) As IRtfGroup
      Dim structureBuilder As New RtfParserListenerStructureBuilder
      Dim parser = New RtfParser(structureBuilder) With {.IgnoreContentAfterRootGroup = True}
      Dim source = New RtfSource(inText)
      parser.Parse(source)
      Return structureBuilder.StructureRoot
    End Function

    Private Function InterpretRtf(rtfStructure As IRtfGroup) As IRtfDocument
      Dim settings = New RtfInterpreterSettings With {.IgnoreDuplicatedFonts = True, .IgnoreUnknownFonts = True}
      Return RtfInterpreterTool.BuildDoc(rtfStructure, settings)
    End Function

    Private Function ConvertHtml(document As IRtfDocument) As String
      Dim settings As New RtfHtmlConvertSettings With {.Title = "Notification Of Shipment",
                                                       .IsShowHiddenText = False,
                                                       .UseNonBreakingSpaces = True}
      Dim converter = New RtfHtmlConverter(document, settings)
      'converter.StyleConverter = New RtfEmptyHtmlStyleConverter
      Return converter.Convert
    End Function

  End Class
End Namespace

根据您的应用程序,您可以简单地将其包装在一个程序集中并从VB6中调用它。我们过去已经做到了这一点,而且相当简单。如果您认为它可能对您有用,请再次提供更多信息