Page 1 of 4 1234 LastLast
Results 1 to 40 of 159

Thread: RichTextBox Tricks and Tips

Hybrid View

  1. #1

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    RichTextBox Tricks and Tips

    The following posts contain a few things that you can do with RichTextBoxes that you might not have known that you could do. If any of you know of other non-standard things that can be done with RichTextBoxes, feel free to add to this list.
    Last edited by moeur; Mar 4th, 2008 at 11:12 AM.

  2. #2

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Highlighting text

    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
    Last edited by moeur; Mar 12th, 2007 at 07:54 PM.

  3. #3

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Super and Subscripting

    Two other functions that the RichTextBox control does not gives us are super and subscripting.
    As before we can accomplish this by inserting RTF code. Notice again that I also add \up0
    and \dn0 tags so that I can determine if text has been subscripted by querying the
    .SelCharOffset property.
    Code:
    Public Sub SetSubScript(RTB As RichTextBox)
    Dim iPos As Long
    Dim strRTF As String
            With RTB
            If .SelCharOffset >= 0 Then
            'subscript the current selection
                iPos = .SelStart
                .SelText = Chr(&H9D) & .SelText & Chr(&H81)
                strRTF = Replace(.TextRTF, "\'9d", "\sub\dn2 ")
                .TextRTF = Replace(strRTF, "\'81", "\nosupersub\up0 ")
                .SelStart = iPos
            Else 'turn off subscripting
                .SelText = Chr(&H9D) & .SelText
                strRTF = .TextRTF
                .TextRTF = Replace(strRTF, "\'9d", "\nosupersub\up0 ", , 1)
            End If
            End With
    End Sub
    
    Public Sub SetSuperScript(RTB As RichTextBox)
    'add tags \super\up1 and \nosupersub\up0
    Dim iPos As Long
    Dim strRTF As String
          With RTB
            iPos = .SelStart
            If RTB.SelCharOffset <= 0 Then
            'superscript the current selection
                .SelText = Chr(&H9D) & .SelText & Chr(&H80)
                strRTF = Replace(.TextRTF, "\'9d", "\super\up2 ")
                .TextRTF = Replace(strRTF, "\'81", "\nosupersub\up0 ")
            Else 'turn off
                .SelText = Chr(&H9D) & .SelText
                strRTF = .TextRTF
                .TextRTF = Replace(strRTF, "\'9d", "\nosupersub\up0 ", , 1)
            End If
            .SelStart = iPos
           End With
    End Sub
    Last edited by moeur; Mar 12th, 2007 at 07:57 PM.

  4. #4

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Insert Tables

    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.


    Properties - all sizes are in twips
    xLeft - Position of the left edge of the table
    isCentered - Set to True to center the table
    Rows - Sets or returns the number of rows in the table
    Columns - Sets or returns the number of columns in the table
    Row - An Array of Rows (1 to Rows)
    Column - An Array of columns (1 to Columns)
    Column(i).xWidth - Width of the ith column
    Cell - A 2-d Array of Cells (1 to Rows, 1 to Columns)
    Cell(r, c).Contents - Sets or returns the contents of the cell

    Methods
    InsertTable(RTB As RichTextBox) - Inserts the table into the RichTextBox at the currrent cursor position.
    An example of use is
    Code:
    Option Explicit
    
    Dim RTFtable As clsRTFtable
    Private Declare Function LockWindowUpdate Lib "user32" ( _
        ByVal hwndLock As Long _
    ) As Long
    
    Private Sub Command1_Click()
      Dim i As Integer
      Set RTFtable = New clsRTFtable
      'stop flicker
      Call LockWindowUpdate(RichTextBox1.hWnd)
      
      For i = 1 To 5
      With RTFtable
        'set the size of the table
        .Columns = 3
        .Rows = 2
        'fill the cells
        'Row 1
        .Cell(1, 1).Contents = "Row 1"
        .Cell(1, 2).Contents = "Column2"
        .Cell(1, 3).Contents = "Column3"
    
        'Row 2
        .Cell(2, 1).Contents = "Row2"
        .Cell(2, 2).Contents = "R2C2"
        .Cell(2, 3).Contents = "R2C3"
        'do we want to center it on the page?
        .isCentered = True
        
        'insert the table at the current cursor postion
        .InsertTable RichTextBox1
      End With
      Next i
        Call LockWindowUpdate(0)
    
    End Sub
    Attached Files Attached Files
    Last edited by moeur; Mar 12th, 2007 at 08:10 PM.

  5. #5

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Insert Pictures

    There are several ways to insert pictures into a RichTextBox control.
    This is one method that does not rely on the clipboard, but does use some
    metafile stuff. Here is the routine to insert the picture
    Code:
    'Inserts the picture at the current insertion point
    Public Function InsertPicture(RTB As RichTextBox, pic As StdPicture)
    Dim strRTFall As String
    Dim lStart As Long
        With RTB
            .SelText = Chr(&H9D) & .SelText & Chr(&H81)
            strRTFall = .TextRTF
            strRTFall = Replace(strRTFall, "\'9d", PictureToRTF(pic))
            .TextRTF = strRTFall
            'position cursor past new insertion
            lStart = .Find(Chr(&H81))
            strRTFall = Replace(strRTFall, "\'81", "")
            .TextRTF = strRTFall
            .SelStart = lStart
        End With
    End Function
    Here is the routine that converts the picture into an RTF string
    Code:
    'returns the RTF string representation of our picture
    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 fn As Long, i As Long, j As Long
    
        sTempFile = App.Path & "\~pic" & ((Rnd * 1000000) + 1000000) \ 1 & ".tmp"  'some temprory file
        If 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(1 To nBytes)
        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 = 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
    
    'adds leading zero to hex value if needed.
    Public Function Hex00(icolor As Byte) As String
        Hex00 = Right("0" & Hex(icolor), 2)
    End Function
    Attached is code plus the declares
    Attached Files Attached Files
    Last edited by moeur; Mar 12th, 2007 at 08:19 PM.

  6. #6
    New Member
    Join Date
    May 2008
    Posts
    1

    Re: Insert Pictures

    Thanks so much for posting these helpful RTB functions. I would like your permission to use modRTFpic.bas in a commercial application. How would you like me to credit you in the comments?

  7. #7
    New Member
    Join Date
    Apr 2006
    Posts
    3

    Re: Insert Tables

    Hi,

    very nice codes...
    I found one bug in RTFtable

    VB Code:
    1. Public Sub InsertTable(RTB As RichTextBox)
    2. 'set column widths
    3.     For c = 1 To mvarColumns
    4.         strInsert = strInsert & "\cellx"
    5.         w = mvarxLeft
    6.         For i = 1 To c
    7.             [COLOR=Red]w = w + mvarclsColumn(c).xWidth[/COLOR]
    8.         Next i
    9.         strInsert = strInsert & CStr(w)
    10.     Next c

    If you have all columns same size you can't see difference, but

    must be:
    w = w + mvarclsColumn(i).xWidth

  8. #8
    New Member
    Join Date
    Feb 2009
    Posts
    1

    Re: Insert Tables

    moeur:
    I downloaded your program to make tables in RichTextBox.
    I am using It in a program I'm developing; when I run my program It writes the new table, but It repeats the table that was in the RichTextBox. How do I delete the first table and show only the new table?

    This is:



    1 UNO 2 12 5 5
    3 TRES 2 7 4 5
    5 CINCO 2 12 5 5
    6 SEIS 2 12 5 5
    7 SIETE 2 12 5 5
    25 25 2 12 5 5
    40 40 2 4 4 5
    41 41 2 12 5 5
    42 42 2 12 5 5
    43 43 2 12 5 5
    44 CUATROCUAT 2 10 4 5
    45 CUATROCINC 2 12 5 5
    46 CUATROSEIS 2 4 4 5
    47 CUATROSIET 2 12 5 5
    48 CUATROOCHO 2 12 5 5
    49 CUATRONUEV 2 7 4 5
    50 CINCUENTA 2 8 4 5
    51 CINCOUNO 2 11 5 5
    52 CINCODOS 2 10 4 5
    60 60 2 12 5 5
    61 61 2 5 5 5



    1 UNO 2 12 5 5
    3 TRES 2 7 4 5
    5 CINCO 2 12 5 5
    6 SEIS 2 12 5 5
    7 SIETE 2 12 5 5
    40 40 2 4 4 5
    41 41 2 12 5 5
    42 42 2 12 5 5
    43 43 2 12 5 5
    44 CUATROCUAT 2 10 4 5
    45 CUATROCINC 2 12 5 5
    46 CUATROSEIS 2 4 4 5
    47 CUATROSIET 2 12 5 5
    48 CUATROOCHO 2 12 5 5
    49 CUATRONUEV 2 7 4 5
    50 CINCUENTA 2 8 4 5
    51 CINCOUNO 2 11 5 5
    52 CINCODOS 2 10 4 5
    60 60 2 12 5 5
    61 61 2 5 5 5


    Thanks You.
    fsossaco
    {Email removed}

  9. #9
    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.

  10. #10
    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?

  11. #11
    PowerPoster
    Join Date
    Jan 2008
    Posts
    11,074

    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.

  12. #12

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Find and Replace Common Dialog

    Until recently I didn't know that you could access the "Find-And-Replace" Common Dialog.
    Here is a class that makes it easy to access. The class will work with either a standard TextBox or a RichTextBox.
    Here is an example of how you might use the class.
    Code:
    Option Explicit
    
    'declare with events so that we can override the default
    'behavior of the class and/or handle ShowHelp
    Dim WithEvents FindDialog As clsFindandReplace
    
    Private Sub Form_Load()
        Set FindDialog = New clsFindandReplace
    End Sub
    
    Private Sub Command2_Click()
        'show the Find and Replace dialog box
        'pass the handle of our RichTextBox to
        'the class
        FindDialog.ShowReplace RTB.hwnd
    End Sub
    Attached Files Attached Files
    Last edited by moeur; Mar 12th, 2007 at 08:32 PM.

  13. #13

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Full Featured Spell Checker

    Here is a class that provides full spell checking functionality for the RichTextBox. This class has only two methods:
    GetSpellingErrors checks the spelling in all the text of a RTB and returns the number of spelling errors found and marks then all. A right-click on any error brings up a popup menu with suggested changes. If the user selects a change from the menu, then the replacement is made.

    ClearSpelling clears all the marked errors.
    Here is an example of use:
    Code:
    Option Explicit
    Private SpellCheck As clsSpellCheck
    
    Private Sub cmdSpellCheck_Click()
        SpellCheck.GetSpellingErrors RTB
    End Sub
    
    Private Sub cmdStopSpell_Click()
        SpellCheck.ClearSpelling
    End Sub
    
    Private Sub Form_Load()
        Set SpellCheck = New clsSpellCheck
        RTB.LoadFile App.Path & "\recipe.rtf"
    End Sub

    This code also provides an example of several other things.
    • How to implement the EN_LINK notification function of the RichTextBox. This notification is usually used to mark hyperlinks and respond to mouse events over them. I use it to mark spelling errors and to bring up a popup menu of spelling suggestions for the user to select from.
    • I have included a class that is used to create and respond to popup menus. I put this functionality into a class because I wanted all the spell checking functionality contained within a class with none of the code in the form.
    • Also included is my "Cute Little Subclasser" class. I use this class whenever I want subclassing capabilities. When this class is declared WithEvents, the user can write code to respond to Windows messages within the form or class's own module. It also is a little more stable than doing your own subclassing since it always remembers to turn itself off.
    Attached is the source code for all the above mentioned items PLUS a free mispelled recipe!
    Attached Files Attached Files
    Last edited by moeur; Mar 12th, 2007 at 08:40 PM.

  14. #14

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Get row and column number of cursor

    Here is some simple code that will give you the cursor position in a RichTextBox, It gives you the line number and the column number of the cursor. Attached is a project that demonstrates use of the routine.
    Code:
    Option Explicit
    
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
        ByVal hwnd As Long, _
        ByVal wMsg As Long, _
        ByVal wParam As Long, _
        lParam As Any _
    ) As Long
    
    Private Const EM_GETLINECOUNT = &HBA
    Private Const EM_LINEINDEX = &HBB
    
    Private Sub GetCursorPos(RTB As RichTextBox, iLine As Integer, iPos As Integer)
    Dim lCount As Long
    Dim i As Long
    Dim LN As Long
        lCount = SendMessage(RTB.hwnd, EM_GETLINECOUNT, 0&, 0&)
        LN = SendMessage(RTB.hwnd, EM_LINEINDEX, -1&, 0&)
        For i = 1 To lCount
            If LN = SendMessage(RTB.hwnd, EM_LINEINDEX, i - 1, 0) Then Exit For
        Next i
        iLine = i
        iPos = RTB.SelStart - LN + 1
    End Sub
    Attached Files Attached Files
    Last edited by moeur; Mar 12th, 2007 at 08:42 PM.

  15. #15
    New Member
    Join Date
    Mar 2002
    Posts
    14

    Re: Full Featured Spell Checker

    Quote Originally Posted by moeur
    Here is a class that provides full spell checking functionality for the RichTextBox. This class has only two methods:
    GetSpellingErrors checks the spelling in all the text of a RTB and returns the number of spelling errors found and marks then all. A right-click on any error brings up a popup menu with suggested changes. If the user selects a change from the menu, then the replacement is made.

    ClearSpelling clears all the marked errors.
    Here is an example of use:
    Code:
    Option Explicit
    Private SpellCheck As clsSpellCheck
    
    Private Sub cmdSpellCheck_Click()
        SpellCheck.GetSpellingErrors RTB
    End Sub
    
    Private Sub cmdStopSpell_Click()
        SpellCheck.ClearSpelling
    End Sub
    
    Private Sub Form_Load()
        Set SpellCheck = New clsSpellCheck
        RTB.LoadFile App.Path & "\recipe.rtf"
    End Sub

    This code also provides an example of several other things.
    • How to implement the EN_LINK notification function of the RichTextBox. This notification is usually used to mark hyperlinks and respond to mouse events over them. I use it to mark spelling errors and to bring up a popup menu of spelling suggestions for the user to select from.
    • I have included a class that is used to create and respond to popup menus. I put this functionality into a class because I wanted all the spell checking functionality contained within a class with none of the code in the form.
    • Also included is my "Cute Little Subclasser" class. I use this class whenever I want subclassing capabilities. When this class is declared WithEvents, the user can write code to respond to Windows messages within the form or class's own module. It also is a little more stable than doing your own subclassing since it always remembers to turn itself off.
    Attached is the source code for all the above mentioned items PLUS a free mispelled recipe!


    Hi there, wanted to try your spell checker but faced some strange issues. I copied over your libraries and imported your form, but for the same actions I am getting error at GetSpellingErrors()

    For Each spError In WordDoc.SpellingErrors

    Error 13 Type mismatch

    whenever there is a misspelled word. If there are no errors, the program works fine. This error only happens to the new 'copied' project, does not happen in your program.

    I have added the components and references, even the dll even though I don't think that is needed. I have added the error image attachment here for clearer understanding (if I had not made myself clear)

    Am I missing something?
    Attached Images Attached Images   
    -scmay-

  16. #16

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Auto Detect and respond to URLs

    The RichTextBox control has the ability to detect URLs as they are typed. It can convert this text into a hyperlink which can launch a browser when clicked.

    To turn on Auto URL detection simply send the RTB an EM_AUTOURLDETECT message.

    When the control detects that a URL is being entered, it reformats the text being entered so that it looks like a hyperlink and marks that text with a CFE_LINK effect.

    When the mouse pointer is over text with a CFE_LINK effect, the RTB can be configured to send a message to its parent. In order to respond to mouse events over the hyperlink text, the parent has to be subclassed or hooked.

    The following code shows how to setup Auto URL detection
    Code:
    Public Sub EnableAutoURLDetection(RTB As RichTextBox)
    
        'enable auto URL detection
        SendMessage RTB.hwnd, EM_AUTOURLDETECT, 1&, ByVal 0&
    
        'subclass the parent of the RTB to receive EN_LINK notifications
        Set FormSubClass = New clsSubClass
        FormSubClass.Enable RTB.Parent.hwnd
        
        'set RTB to notify parent when user has clicked hyperlink
        SendMessage RTB.hwnd, EM_SETEVENTMASK, 0&, ByVal ENM_LINK
    
    End Sub
    And to respond to a left mouse click you could do the following in your form's subclass routine.
    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
    
        Select Case uMsg
        Case WM_NOTIFY
    
            CopyMemory notifyCode, ByVal lParam, LenB(notifyCode)
            If notifyCode.code = EN_LINK Then
            'A RTB sends EN_LINK notifications when it receives certain mouse messages
            'while the mouse pointer is over text that has the CFE_LINK effect:
            
            'To receive EN_LINK notifications, specify the ENM_LINK flag in the mask
            'sent with the EM_SETEVENTMASK message.
            
            'If you send the EM_AUTOURLDETECT message to enable automatic URL detection,
            'the RTB automatically sets the CFE_LINK effect for modified text that it
            'identifies as a URL.
            
                CopyMemory LinkData, ByVal lParam, Len(LinkData)
                If LinkData.Msg = WM_LBUTTONUP Then
                    'user clicked on a hyperlink
                    'get text with CFE_LINK effect that caused message to be sent
                    URL = Mid(RTB.Text, LinkData.chrg.cpMin + 1, LinkData.chrg.cpMax - LinkData.chrg.cpMin)
                    'launch the browser here
                    ShellExecute 0&, "OPEN", URL, vbNullString, "C:\", SW_SHOWNORMAL
                End If
    
            End If
            lRetVal = FormSubClass.callWindProc(hwnd, uMsg, wParam, lParam)
            
        Case Else
            lRetVal = FormSubClass.callWindProc(hwnd, uMsg, wParam, lParam)
        End Select
    
    End Sub
    Attached is a project that demonstrates the whole idea.
    Attached Files Attached Files
    Last edited by moeur; Mar 12th, 2007 at 08:46 PM.

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

    Re: Auto Detect and respond to URLs

    The code is really neat and it works.
    Unfortunately it disables the RTB's Change and SelChange events, and I need at least the Change Event to enable the Save button in my Toolbar and to ask for to save changes on exit.
    Any solutions?

  18. #18
    Frenzied Member longwolf's Avatar
    Join Date
    Oct 2002
    Posts
    1,343

    Re: RichTextBox Tricks and Tips

    Wow, you have some really great stuff here!

    But I see one major draw back.
    In SpellCheck.zip you have a dll named DBGWPROC.DLL.

    Its properties say:
    You have a license to use this file only if you have a copy of the book. You may not redistribute this file.

  19. #19

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Re: RichTextBox Tricks and Tips

    The DbgWProc.Dll is only used for debugging purposes so doesn't really need to be included, but the author ( Matthew Curland) has given his permission to redistribute it. The file is freely available many places around the iternet.
    Last edited by moeur; Oct 6th, 2005 at 12:03 PM.

  20. #20
    New Member
    Join Date
    Jan 2006
    Posts
    2

    Re: RichTextBox Tricks and Tips

    Hi:

    First off, thanks so much for posting the codes for inserting tables. That's much appreciated!!!

    I have access to the control characters for rft documents and what I'd like to do is to have codes that would allow user to change the boarder of the cell that the user's cursor is in (inside a rich text box).

    I have searched the net high and low for info. on how to programatically select all the control characters that is associated with that cell and then make modification to them (e.g.: flagging \ckbrdk to false).

    Could you kindly help me out with this? I would really appreciate it!

    Thank you in advance!

    Justin

  21. #21

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Re: RichTextBox Tricks and Tips

    Thanks darki

  22. #22
    New Member
    Join Date
    May 2006
    Posts
    1

    Re: RichTextBox Tricks and Tips

    Hi All
    I have strange problems with the syntax highlighting programming

    No.1 Sendmessage is often out of work
    '----------------------Quotation----------------------
    LN = SendMessage(RTB.hwnd, EM_LINEINDEX, Byval LineNum, 0&)
    '----------------------Quotation----------------------
    this works fine in ANSI mode(english text),but when I use UNICODE mode,it returns wrong result as always. I have to seek the preview enter key to locate the fst pos of a line.

    No.2
    '----------------------Quotation----------------------
    .SelStart
    .SelLength
    .SelColor
    '----------------------Quotation----------------------
    if selected Line number is under 200,this goes fast,but when it's above 1000,it just stuck over there with a delay of 1 second or more,within these time,the keyboard action might be all in a mess.

    can you give me some suggestion? thx a lot

  23. #23
    KING BODWAD XXI BodwadUK's Avatar
    Join Date
    Aug 2002
    Location
    Nottingham
    Posts
    2,176

    Re: RichTextBox Tricks and Tips

    Maybe I am confused but I am trying to highlight text on the go without changing the cursor position. Is there anyway to get the RTF text position? Selstart only has it for the standard text and I need the rtf selstart so that I can insert my own colour tags before and after my word.

    Just in case your wondering I am writing a script editor and the cursor jumps the box around whenever I highlight words
    If you dribble then you are as mad as me

    Lost World Creations Website (XBOX Indie games)
    Lene Marlin

  24. #24

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Re: RichTextBox Tricks and Tips

    Probably the easiest thing to do is lock the window while you are doing the highlighting with LockWindowUpdate.

    VB Code:
    1. Private Declare Function LockWindowUpdate Lib "user32" ( _
    2.     ByVal hwndLock As Long) As Long
    3.  
    4. Private Sub Command1_Click()
    5. Dim iPos As Integer
    6.     'save the current cursor position
    7.     iPos = RTB.SelStart
    8.     'prevent the window from changing
    9.     LockWindowUpdate RTB.hWnd
    10.     'highlight a word
    11.     RTB.Find "is"
    12.     HighLight RTB, vbYellow
    13.     'restore the cursor position
    14.     RTB.SelStart = iPos
    15.     'unlock the window
    16.     LockWindowUpdate 0
    17. End Sub

  25. #25
    KING BODWAD XXI BodwadUK's Avatar
    Join Date
    Aug 2002
    Location
    Nottingham
    Posts
    2,176

    Re: RichTextBox Tricks and Tips

    Thanks I shall give it a go
    If you dribble then you are as mad as me

    Lost World Creations Website (XBOX Indie games)
    Lene Marlin

  26. #26
    KING BODWAD XXI BodwadUK's Avatar
    Join Date
    Aug 2002
    Location
    Nottingham
    Posts
    2,176

    Re: RichTextBox Tricks and Tips

    Thats seems to do it thanks. I had it on the main form hwnd before but changing it to the hwnd of the rich text box itself seems to do the trick thanks
    If you dribble then you are as mad as me

    Lost World Creations Website (XBOX Indie games)
    Lene Marlin

  27. #27
    Fanatic Member
    Join Date
    Nov 2002
    Location
    Philippines
    Posts
    877

    Re: RichTextBox Tricks and Tips

    thanks for that tricks..

    but how to autoscroll the richtextbox?

  28. #28

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Re: RichTextBox Tricks and Tips

    what do you mean by autoscroll? What do you want to do?

  29. #29
    Fanatic Member
    Join Date
    Nov 2002
    Location
    Philippines
    Posts
    877

    Re: RichTextBox Tricks and Tips

    @moeur

    hi, i mean richtextbox with vertical scroller. if u put this command into command1

    VB Code:
    1. with rtb
    2.  .selcolor = vbblack
    3.  .seltext = "ok" & vbcrlf
    4. end with

    it will scroll down right? but if you scroll this scroller to up then press the button again it will not scroll.

  30. #30
    KING BODWAD XXI BodwadUK's Avatar
    Join Date
    Aug 2002
    Location
    Nottingham
    Posts
    2,176

    Re: RichTextBox Tricks and Tips

    change selstart to the location you want the cursor. It should scroll for you
    If you dribble then you are as mad as me

    Lost World Creations Website (XBOX Indie games)
    Lene Marlin

  31. #31
    Fanatic Member
    Join Date
    Nov 2002
    Location
    Philippines
    Posts
    877

    Re: RichTextBox Tricks and Tips

    Quote Originally Posted by BodwadUK
    change selstart to the location you want the cursor. It should scroll for you
    how?

  32. #32
    KING BODWAD XXI BodwadUK's Avatar
    Join Date
    Aug 2002
    Location
    Nottingham
    Posts
    2,176

    Re: RichTextBox Tricks and Tips

    you mean it doesnt scroll down until you hit the bottom of the text window with your cursor?
    If you dribble then you are as mad as me

    Lost World Creations Website (XBOX Indie games)
    Lene Marlin

  33. #33
    New Member
    Join Date
    Jun 2006
    Posts
    1

    Re: RichTextBox Tricks and Tips

    I wish to know how to, uh, well, basically, I am building a chat program for the Hell of it, but want colored text in a RichTextBox. BUT, I dunno how to do it, cause when I try to switch to a color, it ****s up. Ya, so, help?

  34. #34
    Fanatic Member
    Join Date
    Jul 2006
    Location
    Anchorage, Alaska
    Posts
    545

    Re: RichTextBox Tricks and Tips

    When I try to set the xwidth to 3.5 it dosen't not draw a table, the text is all scambled.

    I need the width of each cell to be 3.5inch
    I need the Height of each cell to be 2inch
    I need there to be 2 columns, with 5 rows.

    What is the best way to accomplish this?

    EDIT:

    I got the width correct, I was using 3.5, when I should have been using Twips, 5040.

    How do I do the Height of each cell to be exactly 2inches? Or 2880 Twips.
    Last edited by rack; Jul 30th, 2006 at 08:21 PM.
    Please RATE posts, click the RATE button to the left under the Users Name.

    Once your thread has been answered, Please use the Thread Tools and select RESOLVED so everyone knows your question has been answered.


    "As I look past the light, I see the world I wished tonight, never the less, sleep has come, and death shall soon follow..." © 1998 Jeremy J Swartwood

  35. #35
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    33,427

    Re: RichTextBox Tricks and Tips

    Using your example I've come to understand how to have text in a richtextbox act as a hyperlink, but given text that looks like this (from which I will strip away the URL tags)

    [ URL=http://www.vbforums.com/showthread.php?p=11111]this thread[/URL ]

    how can I get it to look like this?

    this thread

  36. #36

    Thread Starter
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Re: RichTextBox Tricks and Tips

    All you need to do is mark the text that you want to attach a hyperlink to with the CFE_LINK Effect. You'll have to keep the URL in a list somewhere so you can respond to user mouse clicks in your WM_NOTIFY event interception.

    See my cool spell checker example for how to do this. The spell checker marks all mispelled words with the CFE_LINK effect so that when the user right clicks on it spelling suggestions can be made.

    BTW this is much better than RobDogg's simple little spell checker

    Edit: the link you provided above does not work.

    -Bill

  37. #37

  38. #38
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    33,427

    Re: RichTextBox Tricks and Tips

    I just downloaded the clsSpellCheck example and I ran into a problem. When I run it I see the recipe (which I've made previously BTW). I click Spell Check and it underlines all the misspellings. However when I double-clicked one of them nothing happened, so I clicked Spell Check again and got an Invalid property value error in this line

    VB Code:
    1. 'find each misspelling in the document
    2.     For Each spError In WordDoc.SpellingErrors
    3.         iPos = mRTB.Find(spError, iPos + 1, , rtfWholeWord Or rtfMatchCase)
    4.         [HL="#FFFF80"]mRTB.SelStart = iPos[/HL]
    in GetSpellingErrors.

  39. #39
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    33,427

    Re: RichTextBox Tricks and Tips

    Okay I have the word "this" in my example above formatted with the CFE_LINK effect and I have the associated URL stored in a collection and the richtextbox is enabled for AutoURLDetection. How do I actually get the RTB to open the browser to the stored URL? I assume I have to do something in the RTB's Click event, but what?

  40. #40

Page 1 of 4 1234 LastLast

Posting Permissions

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



Click Here to Expand Forum to Full Width