RichTextBox Tricks and Tips - Page 4-VBForums
Page 4 of 4 FirstFirst 1234
Results 121 to 157 of 157

Thread: RichTextBox Tricks and Tips

  1. #121
    New Member
    Join Date
    Jun 2007
    Location
    Hamburg, Germany
    Posts
    7

    Re: RichTextBox Tricks and Tips

    Thanks Merri,

    the Key... events still work, but they are in no way an easy to use substitue for the SelChange event. "tracking text length" won't do me any good if a text portion replaced is as long as the replacement. And in no way do the Key... events reflect any toolbar activities. These activities will also have to be monitored.
    I came to the conclusion to do it without the hyperlink feature for now, rather than programming massive workarounds to compensate the disabled Change and SelChange events, unless - either somebody has a soution to have both the feature and the Change events or I find a reasonable workaround.

    What I don't quite understand: Exactly which part of the hyperlink feature disables these events and why?

    So there'll be no misunderstanding: I'm refering to http://www.vbforums.com/showthread.p...70#post2186470, which was submitted by moeur.

    Regards

  2. #122
    Addicted Member
    Join Date
    Jul 2007
    Posts
    228

    Re: RichTextBox Tricks and Tips

    Yes it does interfere with the messages being sent by Windows to the Rich Text Box.

    There is a work around for this with a function named RichWordOver. You can see how it works by downloading this code from PSC:

    http://www.planet-source-code.com/vb...69067&lngWId=1

    When loaded in your IDE do a search on URL and you will see the associated code and even comments on the fact of interference. I think you'll be able to see what's happening and how to make it work but if you have any specific questions let me know.

    Tom

  3. #123
    New Member
    Join Date
    Jun 2007
    Location
    Hamburg, Germany
    Posts
    7

    Re: RichTextBox Tricks and Tips

    Thanks Tom,

    I've downloaded the ZIP and will get into that later.

    Regards
    Sylvia

  4. #124
    New Member
    Join Date
    Dec 2009
    Posts
    6

    Re: RichTextBox Tricks and Tips

    Hi,
    I tried code for inserting picture into rich text box. It works only for small bmp/jpg files but if bmp is little complicated the program hangs up. Can u tell me the solution.

    amol

  5. #125
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: RichTextBox Tricks and Tips

    Update! See post #137 for the fastest version.


    This should work faster:
    Code:
    Public Function PictureToRTF(pic As StdPicture) As String
        Dim hMetaDC As Long, hMeta As Long, hPicDC As Long, hOldBmp As Long
        Dim Bmp As BITMAP, Sz As Size, Pt As POINTAPI
        Dim sTempFile As String, screenDC As Long
        Dim headerStr As String, retStr As String, byteStr As String
        Dim ByteArr() As Byte, nBytes As Long
        Dim HexHigh As Byte, HexLow As Byte
        Dim fn As Long, i As Long, j As Long
    
        sTempFile = App.Path & "\~pic" & ((Rnd * 1000000) + 1000000) \ 1 & ".tmp"  'some temprory file
        If LenB(Dir$(sTempFile)) Then Kill sTempFile
        
        'Create a metafile which is a collection of structures that store a
        'picture in a device-independent format.
        hMetaDC = CreateMetaFile(sTempFile)
        
        'set size of Metafile window
        SetMapMode hMetaDC, MM_ANISOTROPIC
        SetWindowOrgEx hMetaDC, 0, 0, Pt
        GetObject pic.Handle, Len(Bmp), Bmp
        SetWindowExtEx hMetaDC, Bmp.Width, Bmp.Height, Sz
        'save sate for later retrieval
        SaveDC hMetaDC
        
        'get DC compatible to screen
        screenDC = GetDC(0)
        hPicDC = CreateCompatibleDC(screenDC)
        ReleaseDC 0, screenDC
        
        'set out picture as new DC picture
        hOldBmp = SelectObject(hPicDC, pic.Handle)
        
        'copy our picture to metafile
        BitBlt hMetaDC, 0, 0, Bmp.Width, Bmp.Height, hPicDC, 0, 0, vbSrcCopy
        
        'cleanup - close metafile
        SelectObject hPicDC, hOldBmp
        DeleteDC hPicDC
        DeleteObject hOldBmp
        'retrieve saved state
        RestoreDC hMetaDC, True
        hMeta = CloseMetaFile(hMetaDC)
        DeleteMetaFile hMeta
        
        'header to string we want to insert
        headerStr = "{\pict\wmetafile8" & _
                    "\picw" & pic.Width & "\pich" & pic.Height & _
                    "\picwgoal" & Bmp.Width * Screen.TwipsPerPixelX & _
                    "\pichgoal" & Bmp.Height * Screen.TwipsPerPixelY & _
                    " "
        
        'read metafile from disk into byte array
        nBytes = FileLen(sTempFile)
        ReDim ByteArr(0 To nBytes - 1)
        fn = FreeFile()
        Open sTempFile For Binary Access Read As #fn
        Get #fn, , ByteArr
        Close #fn
        Dim nlines As Long
        
        'turn each byte into two char hex value
        i = UBound(ByteArr)
        ReDim Preserve ByteArr(i * 4 + 3)
        ' turn one byte to two characters to represent a hex number (1 byte -> 4 bytes)
        For i = i To 0 Step -1
            ' take 4 bits from each side of the byte thus giving a value of 0 - 15
            ' and then add character code of 0
            HexHigh = ((ByteArr(i) And &HF0) \ &H10) Or &H30
            HexLow = (ByteArr(i) And &HF) Or &H30
            ' correct characters over 0 - 9 range to a - f range
            If HexHigh > &H39 Then HexHigh = HexHigh + 39
            If HexLow > &H39 Then HexLow = HexLow + 39
            ' create the string
            ByteArr(i * 4) = HexHigh
            ByteArr(i * 4 + 1) = 0
            ByteArr(i * 4 + 2) = HexLow
            ByteArr(i * 4 + 3) = 0
        Next i
        
        'string we will be inserting
        retStr = headerStr & CStr(ByteArr) & vbCrLf & "}"
        PictureToRTF = retStr
        
        'remove temp metafile
        Kill sTempFile
    
    End Function
    Tested now.
    Last edited by Merri; Aug 11th, 2010 at 09:36 AM. Reason: Header is fixed now, so this code actually works

  6. #126
    New Member
    Join Date
    Jun 2007
    Location
    Hamburg, Germany
    Posts
    7

    Re: RichTextBox Tricks and Tips

    Quote Originally Posted by amolpatil View Post
    Hi,
    I tried code for inserting picture into rich text box. It works only for small bmp/jpg files but if bmp is little complicated the program hangs up. Can u tell me the solution.

    amol
    Hi amol,
    as stupid as this may sound: The solution is - don't load any large BMPs or other large images into a RTF box, as it takes too long and may seem that the program hangs up. You're not just loading an image, you're also storing the pre-imageloading status somewhere (the RTF box does this by design) so you can make an Undo (usually with Ctrl+Z).
    Sorry.

    HAND
    Mama Sylvia

  7. #127
    New Member
    Join Date
    Dec 2009
    Posts
    6

    Re: RichTextBox Tricks and Tips

    Thanks Merry.

    ref:- inserting picture into rtf.

    But it gives error for many statements like

    retStr = headerStr & ByteArr & vbCrLf & "}" <- Type mismatch

    If I comment that line for instance then it gives "out of subscript" error for

    ReDim Preserve ByteArr(i * 4 + 3)

    Sorry. Although i am programming with vb6 for many years. I never worked with graphics (because it is not required till now) . So please bear with me
    and help me out.

  8. #128
    New Member
    Join Date
    Dec 2009
    Posts
    6

    Re: RichTextBox Tricks and Tips

    Hi

    My another question is "Can U wrap text around picture ? " . Is it possible ? I know some commercial controls like "tx-text edit control" can do that. But they are very costly to purchase

    Thanks

    Amol

  9. #129
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: RichTextBox Tricks and Tips

    Fix: retStr = headerStr & CStr(ByteArr) & vbCrLf & "}"

  10. #130
    New Member
    Join Date
    Dec 2009
    Posts
    6

    Re: RichTextBox Tricks and Tips

    Thanks Merry.

    But the code is still having problems. I fixed some of them. I dont know whether it is correct or not.

    like for
    ReDim Preserve ByteArr(i * 4 + 3) it gives "subscript out of range " error
    b'coz before that it was redeemed as

    ReDim ByteArr(1 To nBytes). so i fixed it to ReDim ByteArr(0 To nBytes)

    then the program runs without any error until last statement. but instead of picture in rtf box it returns rtf string. Attaching my code herewith.

    Amol
    Attached Files Attached Files

  11. #131
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: RichTextBox Tricks and Tips

    I fixed the earlier code.

  12. #132
    New Member
    Join Date
    Aug 2010
    Location
    Craiova, Romania
    Posts
    7

    Talking Re: RichTextBox Tricks and Tips

    Hello moeur and all other friends around here,

    (... If you are too busy to read the whole thing, you may skip the intro and start to read below the line.)

    I know this thread is five years old, and maybe many of you moved on, but I am still using the good old VB6.

    I am working on an app that generates a monthly report using a RTB.
    Since most ot the text is the same (only the header and some numbers are changing), i have a template .rtf file which I load, already formatted as I want, with some tags like " $date , $stocks , $qty , $total" that I change by search&replace, totally "invisible" to the user.

    But I found a problem with the header: since it has a logo in the left, and four-lines of text in the right (company name, the address on two lines of text, and a phone number on the fourth line), it should be displayed this way, but it seems that there is no way to force such alignment on RTB, not even using tables (only a single row can be displayed next to the image, all the other are displayed below the image).

    So I thought I could resolve this problem by transforming the four lines of text into images, and combining it with the logo into a single image, which was not hard for me to do, since I already have the code for it (I used it in an old app in the past).

    Next, I need a way to insert that image into RTB; I found many ways that had to do with the clipboard, but since I didn't want to alter the clipboard data, I searched furthermore and I found your method from post #5.

    The only problem was that with an image of 417x153 pixels (about 190 KB), your code was painfully slow, it took several minutes on a laptop with Core2Duo CPU 1.4 Ghz with Windows 7 (running on AC, not on battery power)... perhaps in Windows XP is faster, since it doesn't have to execute the 32-bit code in "wow" mode.

    So I began to debug and examine carefully your code to see what piece makes the process so slow, and what can be improved.
    And I found the problem: you have one line of code: " byteStr = byteStr & Hex00(ByteArr(i)) " which makes this proces soo slow; it seems that huge string operations in VB6 are painfully slow.
    ___________________________________________________________
    That's why I need a way to avoid this slow process, so I approached the method in a different way.
    Instead of keeping a single string that will add values again and again, I preffered to use an array with smaller strings ( * 2 ), which whill then be joined together. In the end, I obtained the same result, but coded differently, since the Join function is a native VB6 function and thus is very fast.

    Moreover, I altered the way you transform a byte to its corresponding hex (string) value. Instead of calling the Hex function thousand of times (more than 190.000 in my case), I created an array of 256 strings * 2, in which I pre-loaded the corresponding hex values of the 256 bytes (0 to 255), which are already in lower case and with a leading zero for the first 16 bytes, so many functions are called only 256 times now: Hex, Hex00, Lcase, and Right - in the routine for inserting the leading zeros.

    So, the modified code has the following advantages:
    • we don't need to call Lcase to such a huge string, since our array with hex values are already in lower-case;
    • we don't need to call Hex00 function (for Leading Zeros) thousands of times, just 256 times;
    • huge strings operations in VB6 are very slow, so we use a faster way to concatenate the little strings;
    • the whole process takes less than a second for an image of the size mentioned above, while it took several minutes before.

    This was the old code:
    Code:
        'turn each byte into two char hex value
        i = 0
        byteStr = ""
        Do
            byteStr = byteStr & vbCrLf
            For j = 1 To 39
                i = i + 1
                If i > nBytes Then Exit For
                byteStr = byteStr & Hex00(ByteArr(i))
            Next j
        Loop While i < nBytes
        
        'string we will be inserting
        retStr = headerStr & LCase(byteStr) & vbCrLf & "}"
        PictureToRTF = retStr
        
        'remove temp metafile
        Kill sTempFile
    
    End Function

    And this is the new code:
    Code:
        ' make an array with all byte-to-hex values (256 total values)
        Dim hx(255) As String * 2 ' array is always faster than calling a Function and getting its result
        For i = 0 To 255
          hx(i) = LCase(Hex00(i))
        Next i
        
        'turn each byte into two char hex value
        ' byteStr = ""  -- we don't need this variable anymore
        ' We will use a huge array instead of a huge string, in order to keep all of our bytes-to-hex transformations
        ReDim qx(nBytes + Int(nBytes / 40) - (nBytes / 40 = nBytes \ 40)) As String ' thus, UBound = nBytes + nBytes/40 if nbytes divides by 40, otherwise, UBound = nBytes + nBytes/40 + 1
        ' Note: We cannot use fixed length-strings ( String * 2 ) in the qx array, since fixed length strings cannot be joined
        j = 0
        qx(0) = vbCrLf
        For i = 1 To nBytes
          j = j + 1
          qx(j) = hx(ByteArr(i))
           If i \ 40 = i / 40 Then
             j = j + 1
             qx(j) = vbCrLf
          End If
        Next i
        If nBytes \ 40 = nBytes / 40 Then qx(j) = vbCrLf  'if nBytes divides by 40, then don't add another CR/LF, because it was already added in the For...Next above
        
        'string we will be inserting
        retStr = headerStr & Join(qx, "") & " } "
        PictureToRTF = retStr
        
        'remove temp metafile
        Kill sTempFile
    
    End Function
    NB: if you have Option Base 1, then change "Dim hx(255) as String *2" to "Dim hx(0 to 255) as String * 2"

    I though It will be good to post the results, so other people can take the benefit of it.

    Although I write programs in VB for many years now, I am not a such a VB expert as you are, but I am obsessed with optimising the code, so, instead of adding a progress bar, I preffer to see what is causing the slow-down.

    Your method of adding a picture into RTB is by far the best I found... it only needed slight improvement

    Please excuse my English, I know it's not perfect.

  13. #133
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: RichTextBox Tricks and Tips

    Update! See post #137 for the fastest version.


    This code is untested, but uses a byte array instead to build the string and it should give a good idea on how to get a better performance. This method reduces the amount of memory required so it should be noticeably faster. The speed difference should be noticeable in a compiled application, especially if you hit Advanced optimizations with array boundary check removal.

    Code:
        Dim qx() As Byte, hx(0 To 15) As Byte
        
        ' characters 0123456789
        For i = 0 To 9: hx(i) = &H30 + i: Next
        ' characters abcdef
        For i = 0 To 5: hx(i + 10) = &H61 + i: Next
        
        ' prepare buffer (in Unicode, two bytes per character)
        ReDim qx((nBytes + (nBytes \ 40) - ((nBytes Mod 40) = 0)) * 4 + 9)
        
        j = 0
        qx(0) = 13
        qx(2) = 10
        For i = 1 To nBytes
          j = j + 4
          qx(j) = hx((ByteArr(i) And &HF0) \ &H10)
          qx(j + 2) = hx(ByteArr(i) And &HF)
          If (i Mod 40) = 0 Then
             j = j + 4
             qx(j) = 13
             qx(j + 2) = 10
          End If
        Next i
    
        If (nBytes Mod 40) = 0 Then j = j + 4: qx(j) = 13: qx(j + 2) = 10
        
        qx(j + 4) = &H20
        qx(j + 6) = &H7D
        qx(j + 8) = &H20
        
        'string we will be inserting
        retStr = headerStr & CStr(qx)
        PictureToRTF = retStr
        
        'remove temp metafile
        Kill sTempFile
    I just hope I got the math right, being untested I can't tell Unless I bother to go ahead and get the all the code together...
    Last edited by Merri; Aug 11th, 2010 at 09:37 AM. Reason: Swapped bytes, it works now.

  14. #134
    New Member
    Join Date
    Aug 2010
    Location
    Craiova, Romania
    Posts
    7

    Thumbs up Re: RichTextBox Tricks and Tips

    Hello Merri,

    Wow, that was a fast answer, thank you!

    Your code is more than three times faster than mine... in an 100-loop, my code executed in 33 seconds, while yours only in 10 seconds. And that was not in the stand-alone (compiled .EXE) application... perhaps the EXE it will be even faster.

    I still have one question though... why do qx array has to be in Unicode (with tho bytes/character), when only one char/byte should be enough?

    ... And another question... you presented another code on post #125 in which you approached the same problem differently... which one should be faster, this one, or the one in post #125?

  15. #135
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: RichTextBox Tricks and Tips

    This new one: less huge string concatenations. I had even totally forgotten about writing that one, even if it is on the same page

    qx array has to be Unicode because otherwise you'd have to use StrConv (which would do ANSI -> Unicode conversion, which is slow) and because internally VB6 strings always are Unicode. It is always much faster to do a single buffer allocation, or a single string allocation. The only problem with the byte array approach is that at some point you must make a string out of it. And that gives the only bottleneck for this code.

    You could optimize it even further with some more advanced techniques... for example, allocate a string that only reserves the memory and does not touch the data (the string would contain "garbage"). When you allocate a byte array for example, or use a function such as Space$, you always also touch all the bytes in the allocated data area. A second optimization would be to use a Integer array that is "hacked" to use the very same bytes that are contained in the allocated string. Finally you'd end the integer array hack and simply use the resulting string. Oh, and of course you'd allocate the big buffer only once (ie. include the header at the beginning of the big buffer instead of concatenation afterwards). I'd expect this to roughly double the speed.

  16. #136
    New Member
    Join Date
    Aug 2010
    Location
    Craiova, Romania
    Posts
    7

    Talking Re: RichTextBox Tricks and Tips

    Merri, I also tested your code from post #125, just for fun.
    It's much slower than the last one, but still faster than mine. In an 100-loop, it ran in almost 29 seconds.

    Perhaps one of the things that is causing the slowing down is that at the beginning of each loop, I had to redim the ByteAttr array to the initial value and to restore its contents from a " save array", because as your code runs, both the upper boundary of ByteAttr and the array contents are changing, so right after "For loop_test = 1 to 100" I added:

    ReDim ByteArr(0 To nBytes)
    ByteArr = SavedByteArr
    which probably takes a little run time.

    I have to admit I'm glad that the second code is fastest, because it has the roots on my code, and thus based on my idea . Ok, ok, at least, it has my original variables name in it (except for ByteArr, which is moeur's).

    I was kidding, I won't take credit for anything that's not mine. However, I'm glad that, even if I don't have advanced VB6 knowledges, I still managed to get a fast code. And I'm glad that I decided to post the results, because you helped me to have an even faster code.

    Speaking of advanced techniques and getting a faster code, I know there are ways to avoid duplicate things in memory, and to declare that a string is located at another variable's address.

    I found this trick in the past, when I was looking for an elegant way of swapping variables (like the good old "Swap" function back in early days of GWBasic), so instead of:

    Code:
    Sub Swap(a, b)
       Dim c
       c = a: a = b: b = c
    End Sub
    we could make var a think it's located at var b's location in memory, and the same for b.

    Unfortunately, since It was an old project (which is now abandoned somewhere on my backups), I can't find how I could do that anymore.

    If you can point me in the right direction, please do so - it will be good for future projects, and not necessarily for making this code faster, because it is already fast enough for my needs... and for most other people's needs - if I did the math right, it can transform to string an image of 1.8 - 2MB/second on a computer with the configuration mentioned by me in the first post - of course, I did it in an 100-loop, but for an image of that size, I think the code should be modified to dump the string occasionaly to a file, because eventually we will get the "out of string space" error (I heard that the total string space ov VB6 is somewhere around 2 GB, but an application could have several huge strings, and we have to keep in mind that for each 40 bytes of our image, the string has 82 bytes).

  17. #137
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: RichTextBox Tricks and Tips

    Post updated!
    Code in post #125 runs slower because it has a small bug: the header string is not separated by space from the image data. After adding a space character the image appears and you'll see it is much faster.

    This is my final contribution regarding this function: a massively optimized version. I've removed any API calls that had no real effect or which could be replaced with some simple math. The safe array trick that was in the earlier version of this post has been simplified as well and I now use a Long array for all data processing. Also, a very important change is that I've removed file creation on the disk and the metafile is in memory only! So this should be "the" function for adding images to a RTB. The only change that I can think of is to switch to enhanced metafile format instead of using the very old 16-bit Windows metafile format.

    Code:
    'returns the RTF string representation of our picture
    Public Function PictureToRTF(pic As StdPicture) As String
    ' faster version by Merri 2010-08-10
        Static hx(0 To 255) As Long
        Dim A() As Long, AH(0 To 5) As Long, AP As Long, j As Long
        Dim Meta() As Byte, MetaSize As Long
        Dim lngMetaDC As Long, lngMetaFile As Long, lngOld As Long, lngPicDC As Long, lngScreenDC As Long
        Dim strHeader As String, strFooter As String
        Dim lngHeight As Long, lngWidth As Long
        Dim udtSZ As Size
        ' calculate byte to hex characters converter only once
        If m_Hex(0) = 0 Then
            ' lower case hex notation... characters 0123456789
            For j = 0 To 9: hx(j) = &H30 + j: hx(j * 16) = hx(j): Next
            ' lower case hex notation... characters abcdef
            For j = 0 To 5: hx(j + 10) = &H61 + j: hx((j + 10) * 16) = hx(j + 10): Next
            ' m_Hex is local to the module
            For j = 0 To 255
                ' lower 16 bits contain the hex character for higher 4 bits, higher 16 bits contain the lower 4 bits
                m_Hex(j) = (hx(j And &HF&) * &H10000) Or (hx(j And &HF0&))
            Next j
        End If
        ' start our safe array hacks... create a Long safe array header
        AH(0) = 1: AH(1) = 4: AH(4) = &H3FFFFFFF
        ' a Long array is useful because you can avoid making any further PutMem4/GetMem4 calls, thus improving performance
        AP = ArrPtr(A): PutMem4 AP, VarPtr(AH(0))
        ' make a metafile in memory
        lngMetaDC = CreateMetaFile(vbNullString)
        ' himetric to twips to pixels, always round up (by using a negative value for Int)
        lngWidth = -Int(-pic.Width / 1.76388888888889 / Screen.TwipsPerPixelX)
        lngHeight = -Int(-pic.Height / 1.76388888888889 / Screen.TwipsPerPixelY)
        ' create header
        strHeader = "{\pict\wmetafile8\picw" & pic.Width & "\pich" & pic.Height & _
            "\picwgoal" & (lngWidth * Screen.TwipsPerPixelX) & "\pichgoal" & (lngHeight * Screen.TwipsPerPixelY) & " "
        ' create footer
        strFooter = "}"
        ' create a screen compatible DC
        lngScreenDC = GetDC(0)
        lngPicDC = CreateCompatibleDC(lngScreenDC)
        ReleaseDC 0, lngScreenDC
        ' set picture to the new DC
        lngOld = SelectObject(lngPicDC, pic.Handle)
        ' set size of metafile window
        SetMapMode lngMetaDC, MM_ANISOTROPIC
        SetWindowExtEx lngMetaDC, lngWidth, lngHeight, udtSZ
        ' copy bitmap to metafile
        BitBlt lngMetaDC, 0, 0, lngWidth, lngHeight, lngPicDC, 0, 0, vbSrcCopy
        'cleanup: restore original bitmap and delete (note: DeleteDC destroys lngOld as well)
        SelectObject lngPicDC, lngOld
        DeleteDC lngPicDC
        ' create file from DC
        lngMetaFile = CloseMetaFile(lngMetaDC)
        ' get size of the buffer
        MetaSize = GetMetaFileBitsEx(lngMetaFile, 0, ByVal 0&)
        ' create a buffer... and rip out the extra six bytes of a BSTR and fix pointer too
        j = SysAllocStringByteLen(0, MetaSize - 6) - 4
        ' now get the file bytes to buffer
        GetMetaFileBitsEx lngMetaFile, MetaSize, ByVal j
        ' delete the file from memory
        DeleteMetaFile lngMetaFile
        ' initialize a byte array with no data
        Meta = vbNullString
        ' get pointer to safe array header (Debug.Assert is required for VB6 IDE, there is a bug in "Not array_variable")
        AH(3) = Not Not Meta: Debug.Assert App.hInstance
        ' point to the string we created!
        A(3) = j: A(4) = MetaSize
        ' allocate final output buffer and place it to output string
        AH(3) = VarPtr(PictureToRTF)
        A(0) = SysAllocStringLen(0, Len(strHeader) + Len(strFooter) + MetaSize * 2)
        ' copy header to start of buffer
        Mid$(PictureToRTF, 1, Len(strHeader)) = strHeader
        ' copy footer to end of buffer
        Mid$(PictureToRTF, Len(PictureToRTF) - Len(strFooter) + 1, Len(strFooter)) = strFooter
        ' move array pointer to position
        AH(3) = StrPtr(PictureToRTF) + LenB(strHeader)
        ' convert metafile bytes to hex & place to output buffer
        For j = 0 To MetaSize - 1
            ' convert 8-bit byte to a Long that contains lowercase hexadecimal character representation of higher and lower 4 bits
            A(j) = m_Hex(Meta(j))
        Next j
        ' end safe array hack
        AH(3) = AP: A(0) = 0
    End Function
    Full benchmark project with updated modRTFpic.bas included. The results below are from a compiled program. The benchmark program has been updated so that the true speed of the function is timed. It happens to be so that adding the image to the RichTextBox now takes much longer than generating the RTF data for it...
    Attached Images Attached Images  
    Attached Files Attached Files
    Last edited by Merri; Aug 10th, 2010 at 10:55 AM. Reason: The attached zip contained an exe by mistake: removed it

  18. #138
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: RichTextBox Tricks and Tips

    I updated the last post to reduce amount of "worthless" code. There was no discussion on post #137 so I went ahead and made a final update into it which is about as ultimate version as it can get. The RTF image data generation is super fast now, all the performance bottlenecks have been killed off.

    Shouldn't be an issue anymore to keep adding images to your RTB. The only limitation is that adding a huge image will degrade performance of RTB itself, for example, shutting down your application will take a long time as RTB does it's cleanup. You'll notice this if you test some 1920 x 1080 pixels or bigger image.


    The modRTFpic.bas is compatible with the old one, so you can just replace the old file with the new one. It includes all the various versions of PictureToRTF posted in this thread, it is easy to remove them I have also rewritten InsertPicture function.
    Last edited by Merri; Aug 11th, 2010 at 12:02 PM.

  19. #139
    New Member
    Join Date
    Aug 2010
    Location
    Craiova, Romania
    Posts
    7

    Thumbs up Re: RichTextBox Tricks and Tips

    Wow Merri, that's a nice piece of code! Very good work, congratulations!

    It would have been nice if this code was here five years ago, so many people could use it.

    I personally thank you, since I can still take advantages of it.

  20. #140
    New Member
    Join Date
    Sep 2009
    Posts
    1

    Re: Insert Tables

    [QUOTE=moeur;2131031]Another useful functionality that can be added to the RichTextBox controls is the ability to insert tables.
    The RichTextBox controls support a limited subset of the table related Rich Text Format tags, but none
    of that is made accessible to users of the control. I've attached a class that you can use to insert tables
    into your RichTextBox controls.



    Hello,

    Please have patience with me. I am getting on in years, have a reasonable to good understanding of VB6 and would like some help on the manipulation of data within RTB coding - having never done it before.

    I have used the downloaded code to create a table having six columns and four rows. I have inserted data into the rows and columns.

    I have made the RTB dimension the same as an 'A' size sheet of paper.

    It is my aim to create six similar (identical format, different data) but separate tables on the same 'A' size RTB.

    I think I can manage this but I cannot seem to get each table displaying in different colours. I have done two tables at the moment - but each are the same colour.

    Would some kind soul put me out of my misery and point me in the right direction on how to make each table a different colour?

    Regards to all who participate in this fantastic forum.

  21. #141
    Lively Member
    Join Date
    Dec 2010
    Posts
    95

    Re: RichTextBox Tricks and Tips

    the gif animator example, both the original and the ocx form both seem to crash the app if you have to many gifs, try copy pasting his :wink: text maybe 40 times then hinting the button. It freezes then crashes the problem seems to be in the advanceframe sub, any ideas how to fix?

  22. #142
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: RichTextBox Tricks and Tips

    You can try the improved PictureToRTF in post #137 which for the least reduces unnecessary processing a good degree. It won't of course fix any possible memory leak in the GIF processing code that there may be. However it could be possible for you to have a look at LaVolpe's solutions for GIFs, figure out how to make a StdPicture of each frame and then simply swap between these frames. This would probably give you more reliable code as well as faster end results, but more work for you to do. It isn't very likely someone fixes moeur's code.

  23. #143
    Lively Member
    Join Date
    Dec 2010
    Posts
    95

    Re: RichTextBox Tricks and Tips

    thanks for the response,i'll try it out. I think ultimately, even with bug fixes the best route to do this is the approach virtual listviews do for extremely large data, in that you don't load all at once, you only load and show the data the user is currently looking at within the size of the window. Maybe i'll find a way to where only the smilies shown within the visible part of the richedit are animated and the rest not, until you scroll to a point where they're visible.

  24. #144
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: RichTextBox Tricks and Tips

    In this case it seems there is a memory leak, so you'll eventually have a crash anyway; in the other hand I guess RichEdit isn't designed for animated GIFs, but I'm not an expert in the area so I can't be sure – there may be another way of doing it that won't require constant replace of RTF data.

    It should be possible to locate the visible area so only the ones that are visible are replaced, however this will be quite complex I'm afraid – also, RichEdit is probably already optimized so that it won't do anything for out-of-visible-area data. Hard text replace may be troublesome for it.

    Anyway, good luck for whichever route you try!

  25. #145
    VBaholic & Loving It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    GetWindowRect()
    Posts
    12,228

    Re: RichTextBox Tricks and Tips

    Quote Originally Posted by Merri View Post
    In this case it seems there is a memory leak, so you'll eventually have a crash anyway...
    Yep. Taking a quick look at the clsGIFanimator only, below items are leaks.
    If someone does want to tweak the original, they should read & apply my 'Memory Leak FAQ' linked in my signature below.
    Code:
    Routine: EraseBackGround
    Line: hbrBkgnd = CreateSolidBrush(fillColor)
    Problem: brush needs to be destroyed & is not
    
    Routine: LoadGIF
    Line: SelectObject arrayFrameData(i).hDc, objPIC.Picture.Handle
    Problem: Return value should be reselected into DC when done with objPic.Picture.Handle
    
    Routine: LoadGIF
    Line: ReDim Preserve arrayFrameData(0 To i)
    Problem: If array is resized, hDCs are leaked because they are not destroyed
    
    Routine: Class_Terminate
    Line: DeleteDC arrayFrameData(i).hDc
    Problem: The SelectObject problem above causes leaks here
    Also noted. I'm not slamming that gif animation control, but the GIF processing is very resource heavy. Every frame has a DC created. If the gif had 10 frames and the GIF was pasted some 40 times: that equates to 400 DCs created, 400 stdPictures created & if transparency exists, another 400 stdPictures used as masks. I didn't analyze the code very well, maybe I might be over-exaggerating, but don't think so.

    If the system ran out of resources for more GDI objects, the object creations would fail, but no code is testing against that. And to have the code continue on ignoring failures can result in yet more leaks. All the above would have to be fixed if it were to be used.

    Even the best GIF animator I ever wrote, requires 1 DC per control + up to 3 bitmaps (1 bit, 8 bit, & 24 bit) per GIF but no less than 1 (8 bit). Those numbers are per GIF, not per GIF frame.

    Edited: I see he posted 2 versions of his control
    This is a quick look of the clsGIF class from the 'most recent version' of his control (viewed via WordPad)
    Code:
    Routine: AddFrame
    Line: SelectObject localDC, .Picture.hPAL
    Problem: Anything selected into a DC should be selected out else leaks can occur
    
    Routine: AddFrame
    Line: localDC = CreateCompatibleDC(GetDC(0))
    Problem: Calling GetDC without a subsequent ReleaseDC can cause leaks
    
    Routine: SetDC
    Line: hBitmap = CreateCompatibleBitmap(GetDC(0), mvarxWidth, mvaryHeight)
    Line: .hdc = CreateCompatibleDC(GetDC(0))
    Problem: Calling GetDC without a subsequent ReleaseDC can cause leaks
    
    Routine: hdcToPicture
    Line: hPAL = CreatePalette(LogPal)
    Problem: Palette is not destroyed
    
    Routine: Class_Terminate
    Line: Set mvarFrames = Nothing
    Problem: The collection of the clsFrame.cls which has a DC assigned. Not destroyed in this event or that class' Terminate event
    
    Routine: CopyFrame
    Line: BkgndDC = CreateCompatibleDC(hdc)
    Problem: The created DC is not destroyed
    
    Routine: CopyFrame
    Line: BkgndBM = CreateCompatibleBitmap(hdc, mvarxWidth, mvaryHeight)
    Problem: The created bitmap is not destroyed
    
    Routine: CopyFrame
    Line: SelectObject BkgndDC, BkgndBM
    Problem: Not unselecting stuff you select into a DC can cause leaks
    Edited one more time:One doesn't even need the gif control. Granted it negates users from parsing the GIF, but a gif parser can be added to class structure which also negates a custom ocx dependency. Since the RTF will accept multiple formats, the current GIF (smiley) could be updated by being converted to bitmap (not recommended by RTF sources), png, metafile or jpeg. PNG might be a suitable substitute if RTF supports transparent PNGs? Maybe a holiday weekend proof of concept project upcoming? Hmmmm....
    Last edited by LaVolpe; Dec 22nd, 2010 at 10:00 AM.
    Insomnia is just a byproduct of, "It can't be done"

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {GDI+ Classes/Samples} {Unicode Open/Save Dialog} {Icon Organizer/Extractor}
    {VBA Control Arrays} {XP/Vista Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  26. #146
    VBaholic & Loving It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    GetWindowRect()
    Posts
    12,228

    Re: RichTextBox Tricks and Tips

    Quote Originally Posted by Merri View Post
    ...The only change that I can think of is to switch to enhanced metafile format instead of using the very old 16-bit Windows metafile format.
    Merri, don't think that'll work. I can format a jpg, png, emf using the correct xxxblip tags & apply it to a VB RFTbox, but it simply won't use it. The same string pasted inside a RTF file & opened with WordPad, also won't use it. But open it with Word & all is good. The RTFbox doesn't support many of the image tags.

    For all: Here's a GDI+ solution to inserting an image into the RTF. Just another option.

    Below CLASS is provided with these notes
    1) GDI+ cannot load all image types well. For more info see GDI+ Classes & Alpha Image Control links in my signature below
    2) Supports PNG & TIFF. No animation support
    3) There is no proportional scaling, but you can add that easily enough in the pvImagetoWMFStream routine
    4) There are only 2 public functions in the class
    - GetRTFpictureFormat_ImageFile for loading image from file (unicode supported)
    - GetRTFpictureFormat_ImageArray for loading image from an array (must be 1D array)

    Sample call: RichTextBox1.SelRTF = theClass.GetRTFpictureFormat_ImageFile("C:\Test.Png", 32, 32)
    Code:
    Option Explicit
    
    Private Type GdiplusStartupInput
        GdiplusVersion           As Long
        DebugEventCallback       As Long
        SuppressBackgroundThread As Long
        SuppressExternalCodecs   As Long
    End Type
    Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
    Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
    
    Private Type RECTF
        nLeft As Single
        nTop As Single
        nWidth As Single
        nHeight As Single
    End Type
    Private Declare Function GdipRecordMetafile Lib "gdiplus" (ByVal referenceHdc As Long, ByVal pType As Long, ByRef frameRect As RECTF, ByVal frameUnit As Long, ByVal description As Long, ByRef metafile As Long) As Long
    Private Declare Function GdipEmfToWmfBits Lib "gdiplus" (ByVal hemf As Long, ByVal cbData16 As Long, ByVal pData16 As Long, ByVal iMapMode As Long, ByVal eFlags As Long) As Long
    Private Declare Function GdipGetHemfFromMetafile Lib "gdiplus" (ByVal metafile As Long, ByRef hemf As Long) As Long
    Private Declare Function GdipLoadImageFromStream Lib "gdiplus" (ByVal Stream As Long, Image As Long) As Long
    Private Declare Function GdipGetImageBounds Lib "gdiplus.dll" (ByVal nImage As Long, srcRect As RECTF, srcUnit As Long) As Long
    Private Declare Function GdipGetImageGraphicsContext Lib "gdiplus.dll" (ByVal pImage As Long, ByRef graphics As Long) As Long
    Private Declare Function GdipDrawImageRectRect Lib "gdiplus" (ByVal hGraphics As Long, ByVal hImage As Long, ByVal dstX As Single, ByVal dstY As Single, ByVal dstWidth As Single, ByVal dstHeight As Single, ByVal srcX As Single, ByVal srcY As Single, ByVal srcWidth As Single, ByVal srcHeight As Single, ByVal srcUnit As Long, ByVal imageAttributes As Long, ByVal Callback As Long, ByVal callbackData As Long) As Long
    Private Declare Function GdipDeleteGraphics Lib "gdiplus.dll" (ByVal mGraphics As Long) As Long
    Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
    Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal FileName As Long, hImage As Long) As Long
    
    Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
    Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    Private Declare Function DeleteEnhMetaFile Lib "gdi32.dll" (ByVal hemf As Long) As Long
    Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
    Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
    
    Private m_Token As Long
    
    Private Sub Class_Initialize()
        Dim GSI As GdiplusStartupInput
        Dim pa As Long, hMod As Long
        
        On Error Resume Next
        GSI.GdiplusVersion = 1&
        Call GdiplusStartup(m_Token, GSI)
    End Sub
    
    Private Sub Class_Terminate()
        If m_Token Then GdiplusShutdown m_Token
    End Sub
    
    Public Function GetRTFpictureFormat_ImageArray(ImageData() As Byte, ByVal destWidth As Long, ByVal destHeight As Long) As String
    
        ' passing 0 for width,height will have image rendered at original width,height
    
        Dim outData() As Byte, IStream As IUnknown, hImage As Long
        If m_Token = 0 Then Exit Function
        If Not Not ImageData() Then
            Set IStream = pvIStreamFromArray(VarPtr(ImageData(LBound(ImageData))), (UBound(ImageData) - LBound(ImageData) - 1&))
            If Not IStream Is Nothing Then 
                If GdipLoadImageFromStream(ObjPtr(IStream), hImage) = 0& Then
                    If pvImagetoWMFStream(hImage, outData(), destWidth, destHeight) = True Then
                        GetRTFpictureFormat_ImageArray = pvStreamToRTFwmf(outData(), destWidth, destHeight)
                    End If
                End If
            End If
        End If
        Debug.Assert App.hInstance
    
    End Function
    
    Public Function GetRTFpictureFormat_ImageFile(ByVal FileName As String, ByVal destWidth As Long, ByVal destHeight As Long) As String
    
        ' passing 0 for width,height will have image rendered at original width,height
        
        Dim hImage As Long, outData() As Byte
        If m_Token = 0 Then Exit Function
        If GdipLoadImageFromFile(StrPtr(FileName), hImage) Then Exit Function
        If pvImagetoWMFStream(hImage, outData(), destWidth, destHeight) = True Then
            GetRTFpictureFormat_ImageFile = pvStreamToRTFwmf(outData(), destWidth, destHeight)
        End If
    
    End Function
    
    Private Function pvImagetoWMFStream(hImage As Long, outArray() As Byte, Width As Long, Height As Long) As Boolean
    
        Dim lSize As Long, hDC As Long
        Dim hGraphics As Long, hMetaFile As Long
        Dim sizeF As RECTF
        Const UnitPixel As Long = 2&
        Const MetafileTypeEmf As Long = 3&
        Const MM_ANISOTROPIC As Long = 8&
        
        GdipGetImageBounds hImage, sizeF, UnitPixel
        hDC = GetDC(GetDesktopWindow)
        If GdipRecordMetafile(hDC, MetafileTypeEmf, sizeF, UnitPixel, 0&, hMetaFile) = 0& Then
            If GdipGetImageGraphicsContext(hMetaFile, hGraphics) = 0 Then
                GdipDrawImageRectRect hGraphics, hImage, 0!, 0!, sizeF.nWidth, sizeF.nHeight, sizeF.nLeft, sizeF.nTop, sizeF.nWidth, sizeF.nHeight, UnitPixel, 0&, 0&, 0&
                GdipDeleteGraphics hGraphics
            Else
                GdipDisposeImage hMetaFile: hMetaFile = 0&
            End If
        End If
        ReleaseDC GetDesktopWindow(), hDC
        GdipDisposeImage hImage
        
        If hMetaFile Then
            If GdipGetHemfFromMetafile(hMetaFile, hImage) = 0& Then
                lSize = GdipEmfToWmfBits(hImage, 0&, 0&, MM_ANISOTROPIC, 0&)
                If lSize Then
                    ReDim outArray(0 To lSize - 1&)
    
                    ' modify width/height if proportional scaling desired. Use ratios btwn passed sizes & sizeF sizes
    
                    If Width < 1& Then Width = sizeF.nWidth
                    If Height < 1& Then Height = sizeF.nHeight
                    pvImagetoWMFStream = (GdipEmfToWmfBits(hImage, lSize, VarPtr(outArray(0)), MM_ANISOTROPIC, 0&) <> 0&)
                End If
                DeleteEnhMetaFile hImage
            End If
            GdipDisposeImage hMetaFile
        End If
    
    End Function
    
    Private Function pvStreamToRTFwmf(inStream() As Byte, Width As Long, Height As Long) As String
    
        Dim Header As String
        Dim L As Long, c As Long, x As Long
        Dim lSize As Long, sLUT(0 To 255) As String * 2
        Const LineLen As Long = 256&
        
        Header = "{\pict\wmetafile8" & _
                "\picwgoal" & CStr(Width * Screen.TwipsPerPixelX) & _
                "\pichgoal" & CStr(Height * Screen.TwipsPerPixelY) & _
                " "
        
        lSize = UBound(inStream) - LBound(inStream) + 1
        pvStreamToRTFwmf = Space$(Len(Header) + 2 * (lSize \ LineLen + lSize) + 1)
        
        For x = 0& To 15&: sLUT(x) = "0" & LCase$(Hex(x)): Next '
        For x = 16& To 255&: sLUT(x) = LCase$(Hex(x)): Next
        
        c = Len(Header)
        Mid$(pvStreamToRTFwmf, 1, c) = Header
        
        c = c + 1&: x = LBound(inStream)
        For L = 1& To lSize \ LineLen
            For x = x To x + LineLen - 1&
                Mid$(pvStreamToRTFwmf, c, 2) = sLUT(inStream(x))
                c = c + 2&
            Next
            Mid$(pvStreamToRTFwmf, c, 2) = vbCrLf
            c = c + 2&
        Next
        For x = x To UBound(inStream)
            Mid$(pvStreamToRTFwmf, c, 2) = sLUT(inStream(x))
            c = c + 2&
        Next
        Mid$(pvStreamToRTFwmf, c, 1) = "}"
    
    End Function
    
    Private Function pvIStreamFromArray(ArrayPtr As Long, Length As Long) As stdole.IUnknown
        
        ' Purpose: Create an IStream-compatible IUnknown interface containing the
        ' passed byte aray. This IUnknown interface can be passed to GDI+ functions
        ' that expect an IStream interface -- neat hack
        
        On Error GoTo HandleError
        Dim o_hMem As Long
        Dim o_lpMem  As Long
         
        If ArrayPtr = 0& Then
            CreateStreamOnHGlobal 0&, 1&, pvIStreamFromArray
        ElseIf Length <> 0& Then
            o_hMem = GlobalAlloc(&H2&, Length)
            If o_hMem <> 0 Then
                o_lpMem = GlobalLock(o_hMem)
                If o_lpMem <> 0 Then
                    CopyMemory ByVal o_lpMem, ByVal ArrayPtr, Length
                    Call GlobalUnlock(o_hMem)
                    Call CreateStreamOnHGlobal(o_hMem, 1&, pvIStreamFromArray)
                End If
            End If
        End If
        
    HandleError:
    End Function
    Last edited by LaVolpe; Dec 23rd, 2010 at 08:59 AM. Reason: cut back a bit of the class
    Insomnia is just a byproduct of, "It can't be done"

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {GDI+ Classes/Samples} {Unicode Open/Save Dialog} {Icon Organizer/Extractor}
    {VBA Control Arrays} {XP/Vista Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  27. #147
    New Member richosr's Avatar
    Join Date
    Feb 2010
    Posts
    4

    Re: RichTextBox Tricks and Tips

    Hi,

    when I add your clsSubClass.cls to a project, if I click the Stop button in VB 6 VB6 closes with an error message, 'error in unkown module', any ideas?

    regards

    Steve






    "If all you own is a hammer, every problem starts looking like a nail"

  28. #148
    VBaholic & Loving It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    GetWindowRect()
    Posts
    12,228

    Re: RichTextBox Tricks and Tips

    When subclassing an uncompiled project, NEVER press the stop button, never execute an End statement.
    Insomnia is just a byproduct of, "It can't be done"

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {GDI+ Classes/Samples} {Unicode Open/Save Dialog} {Icon Organizer/Extractor}
    {VBA Control Arrays} {XP/Vista Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  29. #149
    New Member richosr's Avatar
    Join Date
    Feb 2010
    Posts
    4

    Re: RichTextBox Tricks and Tips

    Hi,

    First of all thanks for some great tips and code.

    I am using your URL detection, but now I do not seem to be able to get the selchange to function. Is this something to do with the sendmessage, and any ideas on how to fix please?

    kindest regards

    Steve
    "If all you own is a hammer, every problem starts looking like a nail"

  30. #150
    New Member richosr's Avatar
    Join Date
    Feb 2010
    Posts
    4

    Re: RichTextBox Tricks and Tips

    Quote Originally Posted by richosr View Post
    Hi,

    First of all thanks for some great tips and code.

    I am using your URL detection, but now I do not seem to be able to get the selchange to function. Is this something to do with the sendmessage, and any ideas on how to fix please?

    kindest regards

    Steve
    I think I may have fixed it:

    I added a call to the selchange event in the wmarrival sub class of the form:

    Code:
    Private Sub FormSubClass_WMArrival(hwnd As Long, uMsg As Long, wParam As Long, lParam As Long, lRetVal As Long)
    Dim notifyCode As NMHDR
    Dim LinkData As ENLINK
    Dim URL As String
            rtfTextBox_SelChange
    
        Select Case uMsg
        Case WM_NOTIFY
    and the selchange event detection now works and the URL detection still works too.

    However if the call to the selchange event is put anywhere else in the wmarrival sub, when you close the form with the X a new form always opens.

    The only issue is that the left alignment now will not operate on any text that has aleady been centered or right aligned, but thats another issue!

    Steve
    "If all you own is a hammer, every problem starts looking like a nail"

  31. #151
    PowerPoster
    Join Date
    Jan 2008
    Posts
    9,125

    Re: RichTextBox Tricks and Tips

    mouer,

    I downloaded your project from post #62, RTBGIF.zip. I have a couple of concerns with it I hope you might be able to put me on the right path.

    Instead of loading all of the gif images from storage I would like to be able to load them from Picturebox controls. I have 22 picturebox controls pre-loaded with the smilies. I want to be able to load the images from the picturebox controls in the FormLoad event into the image collection instead of reading them in from the disk.

    My other issue is that it appears I cannot do a ReplaceTag more than one time. When I double-click on a smiley (double click on the picturebox that has the smiley) that I want to put in the RTB the first one goes in OK. However, when I click on it again or even another smiley something wierd happens.

    I use the following to put a smiley on the RTB

    Code:
    Private Sub picSmilie_Click(Index As Integer)
    
     RTB.Text = RTB.Text & picSmilie(Index).Tag '<-- Tag = :wave: for this particular smiley
     GIF.replaceTags RTB
       
    End Sub
    The first time I click on the smiley picturebox it goes on the RTB OK like this: (note <smiley> is the actual picture)

    This is some text <smiley>

    Then I type more text and when I click on another picturebox I get this:

    This is some text 01 this is some more text <smiley>

    The first smiley goes away and is replaced with 01.


    Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.

  32. #152
    Super Moderator RobDog888's Avatar
    Join Date
    Apr 2001
    Location
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™
    Posts
    60,104

    Re: RichTextBox Tricks and Tips

    Looking for a way to use linked text with anchors within the RTB to have it scroll to the anchor instead of opening a browser.

    Looking into the .UpTo and .Find methods as possibilities. Any tips?
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Star Wars Gangsta Rap Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel Core 2 Extreme Ed., 2 WD Raptor 10K RPM 300 GB HDs, 2 GBs DDR2 667 MHz RAM, 2 Viewsonic 24" LCDs, Windows 7 SP-1/Windows 8.1, Office 2010, VS 2013

  33. #153
    PowerPoster
    Join Date
    Feb 2006
    Posts
    11,364

    Re: RichTextBox Tricks and Tips

    RichEdit 3.0 has hidden text, which might be used as a Find target.

  34. #154
    Super Moderator RobDog888's Avatar
    Join Date
    Apr 2001
    Location
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™
    Posts
    60,104

    Re: RichTextBox Tricks and Tips

    thinking I can use another link with an # tag and a keyword to use to locate the target.
    Just need to test if the .Find method will see the target hyperlink content or not. I kina doubt it but still looking
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Star Wars Gangsta Rap Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel Core 2 Extreme Ed., 2 WD Raptor 10K RPM 300 GB HDs, 2 GBs DDR2 667 MHz RAM, 2 Viewsonic 24" LCDs, Windows 7 SP-1/Windows 8.1, Office 2010, VS 2013

  35. #155
    PowerPoster
    Join Date
    Feb 2006
    Posts
    11,364

    Re: RichTextBox Tricks and Tips

    Without knowing what you are building this may be useful or useless, but...

    At a certain point isn't it just easier to use the DHTMLEdit control and HTML instead of RichTextBox and RTF format? In Browse mode it gives you more control over things than using a WebBrowser control, plus it offers Edit mode allowing it to be used for user input/editing as well. You can even optionally enable script inside the documents.

    Just a thought.

  36. #156
    Super Moderator RobDog888's Avatar
    Join Date
    Apr 2001
    Location
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™
    Posts
    60,104

    Re: RichTextBox Tricks and Tips

    Thanks for the suggestion but we had been using a web browser control and now we need dynamically changing text with the current xml scripting setup its not possible*




    * Easily possible if we had enough time lol.
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Star Wars Gangsta Rap Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel Core 2 Extreme Ed., 2 WD Raptor 10K RPM 300 GB HDs, 2 GBs DDR2 667 MHz RAM, 2 Viewsonic 24" LCDs, Windows 7 SP-1/Windows 8.1, Office 2010, VS 2013

  37. #157
    PowerPoster
    Join Date
    Jan 2008
    Posts
    9,125

    Re: Highlighting text

    Quote Originally Posted by moeur View Post
    Since there is no .SelHighlight property of the RichTextBox control, I created one.
    Code:
    Public Sub HighLight(RTB As RichTextBox, lColor As Long)
    'add new color to color table
    'add tags \highlight# and \highlight0
    'where # is new color number
    Dim iPos As Long
    Dim strRTF As String
    Dim bkColor As Integer
    
        With RTB
            iPos = .SelStart
            'bracket selection
            .SelText = Chr(&H9D) & .SelText & Chr(&H81)
            strRTF = RTB.TextRTF
    'add new color
            bkColor = AddColorToTable(strRTF, lColor)
    'add highlighting
             strRTF = Replace(strRTF, "\'9d", "\up1\highlight" & CStr(bkColor) & "")
             strRTF = Replace(strRTF, "\'81", "\highlight0\up0 ")
    
             .TextRTF = strRTF
            .SelStart = iPos
           End With
    
    End Sub

    Notice that in addition to inserting the \highlight tags I also insert \up# tags.
    This is so that I can check to see if a selection is highlighted by querying the
    .SelCharOffset function. This routine relies on the following function that adds
    a new color to the RTF color table
    Code:
    Function AddColorToTable(strRTF As String, lColor As Long) As Integer
    Dim iPos As Long, jpos As Long
    
    Dim ctbl As String
    Dim tagColors
    Dim nColors As Integer
    Dim tagNew As String
    Dim i As Integer
    Dim iLen As Integer
    Dim split1 As String
    Dim split2 As String
    
        'make new color into tag
        tagNew = "\red" & CStr(lColor And &HFF) & _
            "\green" & CStr(Int(lColor / &H100) And &HFF) & _
            "\blue" & CStr(Int(lColor / &H10000))
        
        'find colortable
        iPos = InStr(strRTF, "{\colortbl")
        
        If iPos > 0 Then 'if table already exists
            jpos = InStr(iPos, strRTF, ";}")
            'color table
            ctbl = Mid(strRTF, iPos + 12, jpos - iPos - 12)
            'array of color tags
            tagColors = Split(ctbl, ";")
            nColors = UBound(tagColors) + 2
            'see if our color already exists in table
            For i = 0 To UBound(tagColors)
                If tagColors(i) = tagNew Then
                    AddColorToTable = i + 1
                    Exit Function
                End If
            Next i
    '{\fonttbl{\f0\fnil\fcharset0 Verdana;}}
    '{\colortbl ;\red0\green0\blue0;\red128\green0\blue255;}
            
            split1 = Left(strRTF, jpos)
            split2 = Mid(strRTF, jpos + 1)
            strRTF = split1 & tagNew & ";" & split2
            AddColorToTable = nColors
        
        Else
            'color table doesn't exists, let's make one
            iPos = InStr(strRTF, "{\fonttbl") 'beginning of font table
            jpos = InStr(iPos, strRTF, ";}}") + 2 'end of font table
            split1 = Left(strRTF, jpos)
            split2 = Mid(strRTF, jpos + 1)
            strRTF = split1 & "{\colortbl ;" & tagNew & ";}" & split2
            AddColorToTable = 1
        End If
    
    End Function
    I don't see how this works. I ran the code, doesn't change anything. Am I supposed to do something else other than running code as is?


    Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.

Page 4 of 4 FirstFirst 1234

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

Survey posted by VBForums.