PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197

PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197
VB - RichTextBox to HTML-VBForums
Results 1 to 13 of 13

Thread: VB - RichTextBox to HTML

  1. #1

    Thread Starter
    eltiT resU motsuC Static's Avatar
    Join Date
    Oct 2000
    Location
    Rochester, NY
    Posts
    9,390

    VB - RichTextBox to HTML

    been playing around with this:
    seems to work ok, but wondering if it could be done faster
    1 RichTextBox (RTB1)
    1 Webbrowser Control (Default Name: Webbrowser1)
    1 command btn (cmdCreate)

    Paste Colored * Text into the RTB

    (*this is designed to change VB code to HTML for display.. so there is other code that colors it correctly first.... it will not pick up bold/font/etc.. just color...)

    VB Code:
    1. Dim txtHTML As String
    2.  
    3. 'Convert to HTML Color
    4. Private Function GetHTMLColor(lColor As Long) As String
    5.  
    6.     Dim sColor As String
    7.     Dim sR As String
    8.     Dim sG As String
    9.     Dim sB As String
    10.    
    11.     sColor = Right(String(6, "0") & Hex(lColor), 6)
    12.    
    13.     sR = Mid(sColor, 1, 2)
    14.     sG = Mid(sColor, 3, 2)
    15.     sB = Mid(sColor, 5, 2)
    16.     GetHTMLColor = "#" & sB & sG & sR
    17.  
    18. End Function
    19.  
    20.  
    21. 'Code to convert
    22. Private Sub cmdCreate_Click()
    23.     Dim clr As String
    24.     RTB1.SelStart = 0
    25.     clr = GetHTMLColor(RTB1.SelColor)
    26.     txtHTML = "<PRE><font face=" & Chr(34) & "courier new" & Chr(34) & " size=2><font color=" & clr & ">"
    27.     For x = 1 To Len(RTB1.Text)
    28.         RTB1.SelStart = x
    29.         If GetHTMLColor(RTB1.SelColor) <> clr And Mid(RTB1.Text, x, 1) <> " " Then
    30.             clr = GetHTMLColor(RTB1.SelColor)
    31.             txtHTML = txtHTML & "</font><font color=" & clr & ">"
    32.         End If
    33.         Select Case Mid(RTB1.Text, x, 1)
    34.             Case "<"
    35.                 txtHTML = txtHTML & "&lt"
    36.             Case ">"
    37.                 txtHTML = txtHTML & "&gt"
    38.             Case "&"
    39.                 txtHTML = txtHTML & "&amp;"
    40.             Case Else
    41.                 txtHTML = txtHTML & Mid(RTB1.Text, x, 1)
    42.         End Select
    43.        
    44.     Next
    45.     txtHTML = txtHTML & "</font></font></PRE>"
    46.     WebBrowser1.Navigate "about:blank"
    47. End Sub
    48.  
    49.  
    50. 'To Display it to the user
    51. Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    52.     If (pDisp Is WebBrowser1.Application) Then
    53.         WebBrowser1.Document.write txtHTML
    54.    
    55.     End If
    56. End Sub
    Last edited by Static; Jun 21st, 2006 at 03:19 PM. Reason: Updated code... ;)
    JPnyc rocks!! (Just ask him!)
    If u have your answer please go to the thread tools and click "Mark Thread Resolved"

  2. #2
    PoorPoster iPrank's Avatar
    Join Date
    Oct 2005
    Location
    In a black hole
    Posts
    2,728

    Re: VB - RichTextBox to HTML

    Instead of using Sel* properties, if you directly use RTF to get the ColorTable, it will be much faster.

    In the following code, I first copied the TextRTF to a RTBTemp.
    Then, GetRTFColorTable gets the color table.
    ReplaceColor then replaces the RTF color tags with HTML font tags depending on the color table. This process actually changes the .Text to a valid HTML string without destroying other RTF formats.

    I'm interested in this topic too.
    I hope Speed Gurus will come here and help us make this faster.
    VB Code:
    1. Option Explicit
    2. ' Add a webbrowser (WebBrowser1), 2 RTBs (RTB1 and RTBTemp)
    3. ' and a CommandButton (CmdCreate)
    4. Private Type RGBTRIPLE
    5.     B As Byte
    6.     G As Byte
    7.     R As Byte
    8. End Type
    9.  
    10. Private RTFColorTbl() As RGBTRIPLE ' Stores all colors used in the RTB
    11. Private txtHTML As String
    12.  
    13. '=============================================================
    14. '=============================================================
    15. ' [hl][b]Gets Colors from RTF Color Table[/b][/hl]
    16. Private Function GetRTFColorTable(strRTF As String) As RGBTRIPLE()
    17.   Dim lngColorTblStart As Long
    18.   Dim lngColorTblEnd As Long
    19.   Dim strColorTable As String
    20.   Dim strTmpColor As String
    21.   Dim strColorString As String
    22.   Dim lPos As Long
    23.   Dim lPos2 As Long
    24.   Dim lOldPos As Long
    25.   Dim lOldPos2 As Long
    26.   '
    27.   Erase RTFColorTbl
    28.   ReDim RTFColorTbl(0) ' First color is Black (not in colortable)
    29.   RTFColorTbl(0).R = 0
    30.   RTFColorTbl(0).G = 0
    31.   RTFColorTbl(0).B = 0
    32.   '
    33.   lngColorTblStart = InStr(strRTF, "{\colortbl ;")
    34.   lngColorTblEnd = InStr(lngColorTblStart + 12, strRTF, "}")
    35.   strColorTable = Mid$(strRTF, lngColorTblStart + 12, _
    36.      lngColorTblEnd - lngColorTblStart - 12)
    37.   '
    38.   lOldPos = 1
    39.  
    40.   Do
    41.     lPos = InStr(lOldPos, strColorTable, ";")
    42.  
    43.     If lPos > 0 Then
    44.       ReDim Preserve RTFColorTbl(UBound(RTFColorTbl) + 1)
    45.       strColorString = Mid$(strColorTable, lOldPos, lPos - lOldPos)
    46.       lOldPos = lPos + 1
    47.       '
    48.       'Get R ==>
    49.       lOldPos2 = 5
    50.       lPos2 = InStr(lOldPos2, strColorString, "\")
    51.       strTmpColor = Mid$(strColorString, lOldPos2, lPos2 - lOldPos2)
    52.       RTFColorTbl(UBound(RTFColorTbl)).R = CByte(strTmpColor)
    53.       '
    54.       'Get G ==>
    55.       lOldPos2 = lPos2 + 6
    56.       lPos2 = InStr(lOldPos2, strColorString, "\")
    57.       strTmpColor = Mid$(strColorString, lOldPos2, lPos2 - lOldPos2)
    58.       RTFColorTbl(UBound(RTFColorTbl)).G = CByte(strTmpColor)
    59.       '
    60.       'Get B ==>
    61.       lOldPos2 = lPos2 + 5
    62.       strTmpColor = Mid$(strColorString, lOldPos2, _
    63.          Len(strColorString) - lOldPos2 + 1)
    64.       RTFColorTbl(UBound(RTFColorTbl)).B = CByte(strTmpColor)
    65.     Else
    66.       Exit Do
    67.     End If
    68.  
    69.   Loop
    70.  
    71. End Function
    72.  
    73. '=============================================================
    74. Private Function ReplaceColor(strRTF As String) As String
    75.   Dim i As Long
    76.  
    77.   For i = 1 To UBound(RTFColorTbl)
    78.     strRTF = Replace(strRTF, "\cf" & i & " ", "<font color=" & _
    79.        GetHTMLColor(RTFColorTbl(i)) & ">")
    80.     strRTF = Replace(strRTF, "\cf" & i, "<font color=" & _
    81.        GetHTMLColor(RTFColorTbl(i)) & ">")
    82.   Next
    83.  
    84.   strRTF = Replace(strRTF, "\cf0 ", "</font>")
    85.   strRTF = Replace(strRTF, "\cf0", "</font>")
    86.   ReplaceColor = strRTF
    87.   ' Now the .Text is the string we need
    88. End Function
    89.  
    90. '=============================================================
    91. Private Function GetHTMLColor(lColor As RGBTRIPLE) As String
    92.   Dim sColor As String
    93.   Dim sR As String
    94.   Dim sG As String
    95.   Dim sB As String
    96.   sColor = Right$(String$(6, "0") & _
    97.      Hex$(RGB(lColor.R, lColor.G, lColor.B)), 6)
    98.   sR = Mid$(sColor, 1, 2)
    99.   sG = Mid$(sColor, 3, 2)
    100.   sB = Mid$(sColor, 5, 2)
    101.   GetHTMLColor = "#" & sB & sG & sR
    102. End Function
    103.  
    104. '=============================================================
    105. Private Sub cmdCreate_Click()
    106.   Dim tmpRTF As String
    107.   RTBTemp.TextRTF = RTB1.TextRTF 'copy to
    108.   GetRTFColorTable RTBTemp.TextRTF
    109.   '
    110.   txtHTML = "<HTML><BODY><PRE><font face=" & Chr$(34) & _
    111.      "courier new" & Chr$(34) & " size=2>"
    112.   '
    113.   ' May need more check here ==>
    114.   tmpRTF = Replace(RTBTemp.TextRTF, "\\", Chr$(27)) 'remove \\ RTF escape sequence
    115.   tmpRTF = Replace(tmpRTF, "&", "&amp;")
    116.   tmpRTF = Replace(tmpRTF, "<", "&lt")
    117.   tmpRTF = Replace(tmpRTF, ">", "&gt")
    118.   tmpRTF = ReplaceColor(tmpRTF)
    119.   RTBTemp.TextRTF = Replace(tmpRTF, Chr$(27), "\\") 'restore \\ RTF escape sequence
    120.   '
    121.   txtHTML = txtHTML & RTBTemp.Text
    122.   txtHTML = txtHTML & "</font></PRE></BODY></HTML>"
    123.   '
    124.   WebBrowser1.Navigate "about:blank"
    125. End Sub
    126.  
    127. '=============================================================
    128. Private Sub Form_Load()
    129.   WebBrowser1.Navigate2 "about:blank"
    130. End Sub
    131.  
    132. '=============================================================
    133. 'To Display it to the user
    134. Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, _
    135.      URL As Variant)
    136.  
    137.   If (pDisp Is WebBrowser1.Application) Then
    138.     WebBrowser1.Document.write txtHTML
    139.   End If
    140.  
    141. End Sub
    Last edited by iPrank; Jun 22nd, 2006 at 03:57 PM. Reason: Out Of Order
    Usefull VBF Threads/Posts I Found . My flickr page .
    "I love being married. It's so great to find that one special person you want to annoy for the rest of your life." - Rita Rudner


  3. #3

    Thread Starter
    eltiT resU motsuC Static's Avatar
    Join Date
    Oct 2000
    Location
    Rochester, NY
    Posts
    9,390

    Re: VB - RichTextBox to HTML

    speed? yes very fast 80ms compared to mine 1953ms

    but.. your code does not work properly...

    code that went in:

    txtHTML = txtHTML & "</font></font></PRE>"
    code that came out
    txtHTML = txtHTML & "&lt/font&gt&lt/font&gt&lt/PRE&gt"


    heres why:
    HTML Code:
    txtHTML = txtHTML &amp; <font color=#010101>"&amp;lt/font&amp;gt&amp;lt/font&amp;gt&amp;lt/PRE&amp;gt<font color=#000000>"
    its replacing < with &lt but then replacing & with &amp....
    JPnyc rocks!! (Just ask him!)
    If u have your answer please go to the thread tools and click "Mark Thread Resolved"

  4. #4
    Super Moderator si_the_geek's Avatar
    Join Date
    Jul 2002
    Location
    Bristol, UK
    Posts
    41,417

    Re: VB - RichTextBox to HTML

    just change the order of the calls to Replace

  5. #5

    Thread Starter
    eltiT resU motsuC Static's Avatar
    Join Date
    Oct 2000
    Location
    Rochester, NY
    Posts
    9,390

    Re: VB - RichTextBox to HTML

    http://home.rochester.rr.com/lgsstat...s/icon_eek.gif

    uh.. yeah. I knew that. http://home.rochester.rr.com/lgsstat...es/redface.gif

    (I must be a bit tired.. lol! a few too many wobbly pops last night)
    Last edited by Static; Jun 22nd, 2006 at 12:50 PM.
    JPnyc rocks!! (Just ask him!)
    If u have your answer please go to the thread tools and click "Mark Thread Resolved"

  6. #6
    PoorPoster iPrank's Avatar
    Join Date
    Oct 2005
    Location
    In a black hole
    Posts
    2,728

    Re: VB - RichTextBox to HTML

    First, why your smilies are not working ?

    Second, I didn't tested it with special characters.

    Third, if your .Text has a \cfX in it, then, inside TextRTF it will be represented as \\cfX. ( X is a number.)
    ( \,},{ are special characters in rtf - they are escaped with a \.). In that case we need to add more testing.
    Edit: Please see post#9

    Fourth, Is operation on byte-array is faster than string operations ? (With respect to the functions I used)
    Last edited by iPrank; Jun 22nd, 2006 at 10:03 PM.
    Usefull VBF Threads/Posts I Found . My flickr page .
    "I love being married. It's so great to find that one special person you want to annoy for the rest of your life." - Rita Rudner


  7. #7

    Thread Starter
    eltiT resU motsuC Static's Avatar
    Join Date
    Oct 2000
    Location
    Rochester, NY
    Posts
    9,390

    Re: VB - RichTextBox to HTML

    the savings of time with the byte array would be SO minimal I dont think it would matter.

    I have NO clue why my smiles arent working!???
    JPnyc rocks!! (Just ask him!)
    If u have your answer please go to the thread tools and click "Mark Thread Resolved"

  8. #8

    Thread Starter
    eltiT resU motsuC Static's Avatar
    Join Date
    Oct 2000
    Location
    Rochester, NY
    Posts
    9,390

    Re: VB - RichTextBox to HTML

    ok they work elsewhere.. maybe they are disabled in the CodeItBetter
    JPnyc rocks!! (Just ask him!)
    If u have your answer please go to the thread tools and click "Mark Thread Resolved"

  9. #9
    PoorPoster iPrank's Avatar
    Join Date
    Oct 2005
    Location
    In a black hole
    Posts
    2,728

    Re: VB - RichTextBox to HTML

    Code updated. Again.

    For problem with \\ escape sequence, I've added those Replaces with Chr$(27). As the Escape charecter can't stay inside a valid RTF string, I've used it to place bookmarks for \\.

    Any better idea ?
    Usefull VBF Threads/Posts I Found . My flickr page .
    "I love being married. It's so great to find that one special person you want to annoy for the rest of your life." - Rita Rudner


  10. #10
    Addicted Member
    Join Date
    Aug 2005
    Location
    York
    Posts
    197

    Re: VB - RichTextBox to HTML

    Quote Originally Posted by Static
    the savings of time with the byte array would be SO minimal I dont think it would matter.
    Well, integer array would be more appropriate. Time savings would be around 50% or so...at a rough estimate.

    but I guess at 80ms, unless you need it realtime, that will do

  11. #11
    PowerPoster Nitesh's Avatar
    Join Date
    Mar 2007
    Location
    Death Valley
    Posts
    2,556

    Re: VB - RichTextBox to HTML

    Guys how would I go about detecting bold,italic etc

  12. #12
    PoorPoster iPrank's Avatar
    Join Date
    Oct 2005
    Location
    In a black hole
    Posts
    2,728

    Re: VB - RichTextBox to HTML

    You'll need to replace the rtf tage with HTML tags.
    In my code, (before tmpRTF = ReplaceColor(tmpRTF) line), replace these in tmpRTF,

    \b with <b>
    \b0 with </b>

    \i with <i>
    \i0 with </i>

    \u with <u>
    \u0 with </u>

    Note: My own code in post#2 is giving me error. You may need to debug it.
    Last edited by iPrank; Mar 4th, 2008 at 09:44 AM.
    Usefull VBF Threads/Posts I Found . My flickr page .
    "I love being married. It's so great to find that one special person you want to annoy for the rest of your life." - Rita Rudner


  13. #13
    PowerPoster Nitesh's Avatar
    Join Date
    Mar 2007
    Location
    Death Valley
    Posts
    2,556

    Re: VB - RichTextBox to HTML

    Thanks for the reply iPrank ,

    Yeah, I get type mismatches on these lines:

    Code:
    RTFColorTbl(UBound(RTFColorTbl)).R = CByte(strTmpColor)
    I have no idea how to fix it. Please help.

    I will try the code to change tags. Thanks again

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width