Results 1 to 15 of 15

Thread: [RESOLVED] RichTextBox - add columns to existing table?

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Jan 2021
    Posts
    29

    Resolved [RESOLVED] RichTextBox - add columns to existing table?

    In a Rich Text Box, is it possible to add/remove columns in a table?

    If yes, how?

    Thanx

  2. #2
    Frenzied Member
    Join Date
    Feb 2003
    Posts
    1,343

    Re: RichTextBox - add columns to existing table?


  3. #3

    Thread Starter
    Junior Member
    Join Date
    Jan 2021
    Posts
    29

    Re: RichTextBox - add columns to existing table?

    I can insert a new table without problem. The problem is how to insert or delete a column from an existing table.

    I am thinking of copying existing table to memory, storing the cell contents into an array, then create a new table from the array. So effectively deleting and inserting a new table.

  4. #4
    PowerPoster
    Join Date
    Sep 2005
    Location
    Modesto, Ca.
    Posts
    4,683

    Re: RichTextBox - add columns to existing table?

    I have to ask, Why are you using a RTB to display a table? Also, where is this Table coming from? Maybe this is the best approach but can't really say without more information.

  5. #5

    Thread Starter
    Junior Member
    Join Date
    Jan 2021
    Posts
    29

    Re: RichTextBox - add columns to existing table?

    Quote Originally Posted by wes4dbt View Post
    I have to ask, Why are you using a RTB to display a table? Also, where is this Table coming from? Maybe this is the best approach but can't really say without more information.
    I am adding the table in rich text box with following code.

    Code:
        Public Sub RTBAddTable(ByVal col As Integer, ByVal width As Integer)
            Try
                Dim rtbTemp As New RichTextBox
                Dim sbTaRtf As New System.Text.StringBuilder
    
                Dim ColWidth As Integer = width * 1000
    
                'These strings are necessary so that it will be visible in MS Word
                sbTaRtf.Append("{\rtf1\fbidis\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fswiss\fprq2\fcharset0 Calibri;}{\f1\fnil\fcharset0 Microsoft Sans Serif;}}")
                sbTaRtf.Append("\viewkind4\uc1\trowd\trgaph108\trleft5\trbrdrt\brdrs\brdrw10 \trbrdrl\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 ")
    
                For j As Integer = 1 To col
                    sbTaRtf.Append("\clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs")
                    sbTaRtf.Append("\cellx" & CStr(ColWidth * j)) 'set the width of  cell
                Next
    
                sbTaRtf.Append("\pard\intbl\ltrpar\sl252\slmult1\lang3082\f0\fs22\cell\cell\cell\row")
    
                sbTaRtf.Append("\pard\ltrpar\lang1033\f1\fs17\par")
                sbTaRtf.Append("}")
    
                rtbTemp.Rtf = sbTaRtf.ToString()
    
                'This prevents the new table from deleting the text
                rtb.SelectedRtf = rtbTemp.Rtf
    
                rtbTemp.Undo()
    
                Me.rtb.Focus()
                Me.rtb.SelectionStart = Me.rtb.SelectionStart - 1
                Me.rtb.SelectionLength = 0
            Catch xx As Exception
                MessageBox.Show(xx.Message, "Table adding error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
        End Sub

  6. #6
    Hyperactive Member
    Join Date
    Sep 2004
    Posts
    477

    Re: RichTextBox - add columns to existing table?

    Quote Originally Posted by mobi12 View Post
    In a Rich Text Box, is it possible to add/remove columns in a table?

    If yes, how?

    Thanx
    Yes it is possible. Below is some code I used to do way back in 2010 when I was just starting with .Net, so it doesn't use newer technologies like Regex or Linq and such, which could probably be used to simplify this and make it a bit better. I am actually revisiting this project now and came here looking for how to programatically add cell shading correctly (I can do it but it adds nested tables). So I may rewrite some of this.

    Also if you are using tables and other advanced RTF bits, I HIGHLY suggest you not use the base RichTextBox for this. I'll add a second post with a better option.

    In this code you will find methods to add tables, insert columns to the right, rows above or below, and to delete rows, plus all the needed helper methods.

    Code:
        Public Sub InsertTable(ByVal vRows As Integer, ByVal vCols As Integer)
            Dim A As String, i As Integer, j As Integer
            A = ""
            For i = 1 To vRows
                A = A & "\trowd\trgaph108\trleft-108\trbrdrl\brdrs\brdrw10 \trbrdrt\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trpaddl108\trpaddr108\trpaddfl3\trpaddfr3"
                For j = 1 To vCols
                    A = A & "\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs\cellx" & _
                    CStr(CInt((((Me.Width / 2) / vCols) * 20) * j)) 'CONSIDER CHANGING THIS TO A FLAT 2000
                Next
                'A = A & "\pard\intbl\sl276\slmult1\f1\fs22"
                A = A & "\pard\intbl\brdrl\brdrs\brdrw10 \brdrt\brdrs\brdrw10 \brdrr\brdrs\brdrw10 \brdrb\brdrs\brdrw10 \sl276\slmult1"
                For j = 1 To vCols
                    A = A & "\cell"
                Next
                A = A & "\row"
            Next
            A = A & "\pard\f0\fs17"
            'mark current insertion point    
            Me.SelectedText = Chr(&HA7)
            'get current rtf text
            Me.Rtf = Me.Rtf.Replace("\'a7", A.ToString())
    
        End Sub
    
        Public Sub InsertColumnRight()
            Dim curPos As Integer 'Holds the current location of the caret
            Dim selLen As Integer
            Dim Doc As String 'Holds the Rich text code of the Table to parse
            Dim A As String
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim numCols As Integer
            Dim curCol As Integer
            Dim colWidth As Integer
            Dim numRows As Integer
            Dim tStart As Integer
            Dim tEnd As Integer
            Dim curRow As Integer
            curPos = Me.SelectionStart
            selLen = Me.SelectionLength
            Doc = getTable(tStart, tEnd)
            numCols = getNumCols(Doc)
            curCol = getCurCol(Doc)
            numRows = getNumRows(Doc)
            curRow = getCurRow(Doc)
    
            subStart = 0
            For R = 1 To numRows 'Add the column to each row
                For C = 1 To curCol 'Navigate to the end of the current column
                    subStart = InStr(subStart + 1, Doc, "\cellx") + 5
                    subEnd = InStr(subStart + 1, Doc, "\") - 1
                Next
                colWidth = Doc.Substring(subStart, subEnd - subStart)
                colWidth = colWidth + 2000
                A = "\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx" & colWidth
                Doc = Doc.Insert(subEnd, A) 'insert the column data
                'Move to the end of the column we just inserted
                subStart = InStr(subStart + 1, Doc, "\cellx") + 5
                subEnd = InStr(subStart + 1, Doc, "\") - 1
                For C = curCol + 1 To numCols
                    'Update the remaining columns with poper end points
                    subStart = InStr(subStart + 1, Doc, "\cellx") + 5
                    subEnd = InStr(subStart + 1, Doc, "\") - 1
                    colWidth = Doc.Substring(subStart, subEnd - subStart)
                    Doc = Doc.Remove(subStart, subEnd - subStart).Insert(subStart, (colWidth + 2000).ToString)
                Next
                'Add \cell tag in the right spot
                For C = 1 To curCol 'Navigate to the end of the current column's \cell tag
                    subStart = InStr(subStart + 1, Doc, "\cell")
                    subEnd = InStr(subStart + 1, Doc, "ll") + 1
                Next
                Doc = Doc.Insert(subEnd, "\cell") 'insert the \cell tag
            Next
            Me.Rtf = Me.Rtf.Remove(tStart, tEnd - tStart).Insert(tStart, Doc)
            'do next 2 lines of code to remove special character and put curser back in correct spot
            subStart = InStr(Me.Text, Chr(&HA7)) + 1
            removeSpecialChar(subStart, curPos + (curRow - 1), selLen)
        End Sub
    
        Public Sub InsertRowAbove()
            'Dim ph As String 'Holds the currently selected text while we manipulate things
            Dim Doc As String 'Holds the Rich text code of the Table to parse
            Dim curPos As Integer 'Holds the current location of the caret
            Dim A As String
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim strSubstr As String
            Dim numCols As Integer
            Dim curCol As Integer
            Dim numRows As Integer
            Dim tStart As Integer
            Dim tEnd As Integer
            Dim cStart As Integer
            Dim cEnd As Integer
            Dim curRow As Integer
            Dim colWidth As Integer
            Dim x As Integer
            Dim selLen As Integer
            'ph = Me.SelectedRtf
            curPos = Me.SelectionStart
            selLen = Me.SelectionLength
            Doc = getTable(tStart, tEnd)
            Debug.Print("Doc premod = " & Doc)
            numCols = getNumCols(Doc)
            curCol = getCurCol(Doc)
            numRows = getNumRows(Doc)
            curRow = getCurRow(Doc)
            subStart = 0
            cStart = 0
            strSubstr = ""
            x = 0
            Do Until x > 0
                subStart = InStr(subStart + 1, Doc, "\trowd")
                subEnd = InStr(subStart, Doc, "\row") + 4
                strSubstr = Doc.Substring(subStart - 1, subEnd - subStart) 'This isolates the current row
                x = InStr(strSubstr, "\'a7")
            Loop 'When finished subStart -1 is where we need to insert the row.
            A = "\trowd\trgaph108\trleft-108\trbrdrl\brdrs\brdrw10 \trbrdrt\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trpaddl108\trpaddr108\trpaddfl3\trpaddfr3"
            For j = 1 To numCols
                cStart = InStr(cStart + 1, strSubstr, "\cellx") + 5
                cEnd = InStr(cStart, strSubstr, "\") - 1
                'tmpStr = strSubstr.Substring(cStart, cEnd - cStart)
                colWidth = strSubstr.Substring(cStart, cEnd - cStart)
                A = A & "\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs\cellx" & colWidth
            Next
            A = A & "\pard\intbl\brdrl\brdrs\brdrw10 \brdrt\brdrs\brdrw10 \brdrr\brdrs\brdrw10 \brdrb\brdrs\brdrw10 \sl276\slmult1"
            For j = 1 To numCols
                A = A & "\cell"
            Next
            A = A & "\row"
            Doc = Doc.Insert(subStart - 1, A) 'insert the row insto the Doc string
            Debug.Print("Doc postmod = " & Doc)
            Dim tmpStr As String
            tmpStr = Me.Rtf
            Debug.Print("tmpStr premod = " & tmpStr)
            Me.Rtf = Me.Rtf.Remove(tStart, tEnd - tStart).Insert(tStart, Doc) 'Put the Doc String back into the main document
            tmpStr = Me.Rtf
            Debug.Print("tmpStr postmod = " & tmpStr)
            'do next 2 lines of code to remove special character and put curser back in correct spot
            tmpStr = Chr(&HA7).ToString
            'subStart = Me.Rtf.Find("Z")
            removeSpecialChar(subStart, curPos + (curRow - 1), selLen)
        End Sub
    
        Public Sub InsertRowBelow()
            Dim ph As String 'Holds the currently selected text while we manipulate things
            Dim Doc As String 'Holds the Rich text code of the Table to parse
            Dim curPos As Integer 'Holds the current location of the caret
            Dim A As String
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim strSubstr As String
            Dim numCols As Integer
            Dim curCol As Integer
            Dim numRows As Integer
            Dim tStart As Integer
            Dim tEnd As Integer
            Dim cStart As Integer
            Dim cEnd As Integer
            Dim curRow As Integer
            Dim colWidth As Integer
            Dim x As Integer
            ph = Me.SelectedRtf
            curPos = Me.SelectionStart
            Doc = getTable(tStart, tEnd)
            numCols = getNumCols(Doc)
            curCol = getCurCol(Doc)
            numRows = getNumRows(Doc)
            curRow = getCurRow(Doc)
            subStart = 0
            cStart = 0
            strSubstr = ""
            Do Until x > 0
                subStart = InStr(subStart + 1, Doc, "\trowd")
                subEnd = InStr(subStart, Doc, "\row") + 3
                strSubstr = Doc.Substring(subStart, subEnd - subStart) 'This isolates the current row
                x = InStr(strSubstr, "\'80")
            Loop 'When finished subStart is where we need to insert the row.
            A = "\trowd\trgaph108\trleft-108\trbrdrl\brdrs\brdrw10 \trbrdrt\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trpaddl108\trpaddr108\trpaddfl3\trpaddfr3"
            For j = 1 To numCols
                cStart = InStr(cStart + 1, strSubstr, "\cellx") + 6
                cEnd = InStr(cStart, strSubstr, "\")
                colWidth = Doc.Substring(cStart, cEnd - cStart)
                A = A & "\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs\cellx" & colWidth
            Next
            A = A & "\pard\intbl\brdrl\brdrs\brdrw10 \brdrt\brdrs\brdrw10 \brdrr\brdrs\brdrw10 \brdrb\brdrs\brdrw10 \sl276\slmult1"
            For j = 1 To numCols
                A = A & "\cell"
            Next
            A = A & "\row"
            Doc = Doc.Insert(subEnd, A) 'insert the row insto the Doc string
            Me.Rtf = Me.Rtf.Remove(tStart, tEnd - tStart).Insert(tStart, Doc) 'Put the Doc String back into the main document
            'do next 2 lines of code to remove special character and put curser back in correct spot
            Me.Rtf = Me.Rtf.Replace("\'80", ph)
            Me.SelectionStart = curPos + (curRow - 1) 'need to add current Row number to maintain original position
        End Sub
    
        Public Sub DeleteRow()
            Dim ph As String 'Holds the currently selected text while we manipulate things
            Dim curPos As Integer 'Holds the current location of the caret
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim x As Integer
            ph = Me.SelectedRtf
            curPos = Me.SelectionStart
            Me.SelectedText = Chr(&H80)
            subStart = 0
            x = InStr(Me.Rtf, "\'80")
            subStart = InStrRev(Me.Rtf, "\trowd", x) - 1
            subEnd = InStr(x, Me.Rtf, "\row") + 3
            Me.Rtf = Me.Rtf.Remove(subStart, subEnd - subStart)
            Me.SelectionStart = curPos
        End Sub
    
        Private Function getNumCols(ByVal doc As String) As Integer
            Dim strSubstr As String
            Dim index As Integer
            Dim index2 As Integer
            Dim index3 As Integer
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim numCols As Integer
            Dim x As Integer
            index = InStr(doc, "\'a7")
            subStart = InStrRev(doc, "\trowd", index)
            subEnd = InStr(index, doc, "\row")
            strSubstr = doc.Substring(subStart, subEnd - subStart) 'This isolates the entire row
            numCols = 0
            index2 = InStr(strSubstr, "\'a7")
            index3 = InStr(strSubstr, "\pard\intbl")
            x = 1
            Do Until x = 0
                x = InStr(x + 1, strSubstr, "\clbrdrl")
                If x > 0 Then numCols = numCols + 1
            Loop
            Return numCols
        End Function
    
        Private Function getCurCol(ByVal doc As String) As Integer
            Dim strSubstr As String
            Dim index As Integer
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim curCol As Integer
            Dim x As Integer
            Dim c As Integer
    
            index = InStr(doc, "\'a7") 'Where the character is in the whole doc
            subStart = InStrRev(doc, "\pard\intbl", index)
            subEnd = InStr(index, doc, "\row")
            strSubstr = doc.Substring(subStart, subEnd - subStart) 'This isolates the part of the row with the \cell tags
            index = InStr(strSubstr, "\'a7") 'Where the character is in the isolated string
            x = 1
            c = 0
            Do Until x = 0
                x = InStr(x + 1, strSubstr, "\cell")
                If x < index And x <> 0 Then c = c + 1
            Loop
            curCol = c + 1
            Return curCol
        End Function
    
        Private Function getNumRows(ByVal doc As String) As Integer
            Dim numRows As Integer
            Dim x As Integer
            numRows = 0
            x = doc.Length
            Do Until x = 0
                If x > 1 Then
                    x = InStrRev(doc, "\trowd", x - 1)
                Else
                    x = 0
                End If
                If x > 0 Then numRows = numRows + 1
            Loop
            Return numRows
        End Function
    
        Private Function getCurRow(ByVal doc As String) As Integer
            Dim x As Integer
            Dim c As Integer
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim strSubstr As String
            c = 0
            x = 0
            subStart = 0
            Do Until x > 0
                subStart = InStr(subStart + 1, doc, "\trowd")
                subEnd = InStr(subStart, doc, "\row")
                strSubstr = doc.Substring(subStart, subEnd - subStart) 'This isolates the current row
                x = InStr(strSubstr, "\'a7")
                c = c + 1
            Loop
            Return c
        End Function
    
        Private Function getTable(ByRef subStart As Integer, ByRef subEnd As Integer) As String
            Dim Doc As String 'Holds the Rich text code of the Document to parse and look for table defs
            Dim curPos As Integer 'Holds the current location of the caret
            Dim strSubstr As String
            Dim parLoc As Integer
            Dim pardLoc As Integer
            Dim selLen As Integer
            Dim charStart As Integer
    
            curPos = Me.SelectionStart
            selLen = Me.SelectionLength
            charStart = addSpecialChar()
            Doc = Me.Rtf
            'Debug.Print("Doc = " & Doc)
            parLoc = charStart
            pardLoc = charStart
            subStart = 0
            Do Until parLoc <> pardLoc
                pardLoc = InStrRev(Doc, "\pard", parLoc - 1)
                parLoc = InStrRev(Doc, "\par", parLoc - 1)
                If parLoc = 0 Then 'This is to prevent problems is the table is at the very top.
                    subStart = InStr(Doc, "\trowd") - 1
                    Exit Do
                End If
            Loop
            If subStart = 0 Then subStart = parLoc + 3 ' This if prevents the subStart from being changed if set above.
    
            parLoc = charStart
            pardLoc = charStart
            Do Until parLoc <> pardLoc
                pardLoc = InStr(parLoc + 1, Doc, "\pard")
                parLoc = InStr(parLoc + 1, Doc, "\par")
            Loop
            subEnd = parLoc
            strSubstr = Doc.Substring(subStart, (subEnd - subStart) - 1)
            removeSpecialChar(charStart, curPos, selLen)
            'Now I need to get the end of the table without the special character
            parLoc = charStart
            pardLoc = charStart
            Do Until parLoc <> pardLoc
                pardLoc = InStr(parLoc + 1, Doc, "\pard")
                parLoc = InStr(parLoc + 1, Doc, "\par")
            Loop
            subEnd = parLoc
            'Debug.Print("subStart = " & subStart)
            'Debug.Print("subEnd = " & subEnd)
            'Debug.Print("strSubstr = " & strSubstr)
            Return strSubstr
        End Function
    
        Public Function isTable() As Boolean
            Dim Doc As String 'Holds the Rich text code of the Document to parse and look for table defs
            Dim curPos As Integer 'Holds the current location of the caret so we can put it back where it was
            Dim strSubstr As String
            Dim index As Integer
            Dim charStart As Integer
            Dim selLen As Integer
            curPos = Me.SelectionStart
            selLen = Me.SelectionLength
            charStart = addSpecialChar() 'Inserts the character and returns it's location.
            Doc = Me.Rtf 'Load the document with the special character into the variable
            index = InStr(Doc, "\'a7") ' Get the location of the character
            strSubstr = Doc.Substring(index) 'Get everything to the right of the character
            index = InStr(strSubstr, "\par") 'Look for the next /par
            strSubstr = strSubstr.Substring(0, index) 'Isolates everything between the special character and the \par
            index = InStr(strSubstr, "\cell") 'Look for the \cell tag if 0 then not a table, anything else and it is.
            removeSpecialChar(charStart, curPos, selLen)
    
            If index = 0 Then 'Return True or False
                Return False
            Else
                Return True
            End If
        End Function
    
        Private Function addSpecialChar() As Integer 'Returns the location of the character
            Dim insStart As Integer
            Dim selLen As Integer
            selLen = Me.SelectionLength
            If selLen = 0 Then
                insStart = Me.SelectionStart
                Me.SelectedText = Chr(&HA7) 'Insert a special character into the document at the current location. "\'80" is the RTF of the Chr.
                'Me.SelectedText = Chr(&H80) 'Insert a special character into the document at the current location. "\'80" is the RTF of the Chr.
            Else
                insStart = Me.SelectionStart + (Me.SelectionLength / 2)
                Me.Select(insStart, 0)
                insStart = Me.SelectionStart
                Me.SelectedText = Chr(&HA7) 'Insert a special character into the document at the current location. "\'80" is the RTF of the Chr.
            End If
            Return insStart
        End Function
    
        Private Sub removeSpecialChar(ByVal charStart As Integer, ByVal selStart As Integer, ByVal selLen As Integer)
            Me.Select(charStart, 1) 'Select the special char
            Me.SelectedText = "" 'remove the special char
            Me.Select(selStart, selLen) 're-highlight the original selection
        End Sub

  7. #7
    Hyperactive Member
    Join Date
    Sep 2004
    Posts
    477

    Re: RichTextBox - add columns to existing table?

    OK I said not to use the base RichtextBox, because it doesn't handle a lot of the RTF very well. The good news is every Windows PC already has a much better alternative that you can use: "RICH EDIT" found in msftedit.dll.

    To use it:
    Create a new Class, name it "BetterRichTextBox"
    Paste the code from first code box below
    Run the program once
    Then the "BetterRichTextBox should show up as a tool at the very top of your toolbar as a control. use that instead.
    You can extend this control to add any methods or properties you need.
    If you uncomment the line " 'params.ExStyle = params.ExStyle Or &H20 " it will make the box transparent.

    Optionally you can paste in the code from the second box instead, which already includes the code from my first post, plus some methods for adding various bullet point types.

    Code:
    Imports System.Runtime.InteropServices
    
    Public Class BetterRichTextBox
        Inherits RichTextBox
    
        <DllImport("kernel32.dll", CharSet:=CharSet.Auto)> _
        Private Shared Function LoadLibrary(ByVal lpFileName As String) As IntPtr
        End Function
    
        Protected Overrides ReadOnly Property CreateParams() As CreateParams
            Get
                Dim params As CreateParams = MyBase.CreateParams
                If LoadLibrary("msftedit.dll") <> IntPtr.Zero Then
                    'params.ExStyle = params.ExStyle Or &H20
                    params.ClassName = "RICHEDIT50W"
                End If
                Return params
            End Get
        End Property
    End Class
    The full code:

    Code:
    Imports System.Runtime.InteropServices
    
    Public Class BetterRichTextBox
        Inherits RichTextBox
    
        <DllImport("kernel32.dll", CharSet:=CharSet.Auto)> _
        Private Shared Function LoadLibrary(ByVal lpFileName As String) As IntPtr
        End Function
    
        Protected Overrides ReadOnly Property CreateParams() As CreateParams
            Get
                Dim params As CreateParams = MyBase.CreateParams
                If LoadLibrary("msftedit.dll") <> IntPtr.Zero Then
                    'params.ExStyle = params.ExStyle Or &H20
                    params.ClassName = "RICHEDIT50W"
                End If
                Return params
            End Get
        End Property
    
        Dim NumBulletOn As Boolean
        Dim AlLoBulletOn As Boolean
        Dim AlUpBulletOn As Boolean
        Dim RoLoBulletOn As Boolean
        Dim RoUpBulletOn As Boolean
    
    
        Public Property SelectionNumberedBullet() As Boolean
            Get
                Return Me.NumBulletOn
            End Get
            Set(ByVal value As Boolean)
                Me.NumBulletOn = value
                If NumBulletOn = True Then
                    AlLoBulletOn = False
                    AlUpBulletOn = False
                    RoLoBulletOn = False
                    RoUpBulletOn = False
                    Me.SelectionBullet = True
                    SendKeys.Send("+(^L)")
                    Me.BulletIndent = 20
                Else
                    Me.SelectionBullet = True
                    Me.SelectionBullet = False
                End If
            End Set
        End Property
    
        Public Property SelectionAplhabetLowerBullet() As Boolean
            Get
                Return Me.AlLoBulletOn
            End Get
            Set(ByVal value As Boolean)
                NumBulletOn = False
                AlUpBulletOn = False
                RoLoBulletOn = False
                RoUpBulletOn = False
                Me.AlLoBulletOn = value
                If AlLoBulletOn = True Then
                    Me.SelectionBullet = True
                    SendKeys.Send("+(^L)")
                    SendKeys.Send("+(^L)")
                    Me.BulletIndent = 20
                Else
                    Me.SelectionBullet = True
                    Me.SelectionBullet = False
                End If
            End Set
        End Property
    
        Public Property SelectionAplhabetUpperBullet() As Boolean
            Get
                Return Me.AlUpBulletOn
            End Get
            Set(ByVal value As Boolean)
                NumBulletOn = False
                AlLoBulletOn = False
                RoLoBulletOn = False
                RoUpBulletOn = False
                Me.AlUpBulletOn = value
                If AlUpBulletOn = True Then
                    Me.SelectionBullet = True
                    SendKeys.Send("+(^L)")
                    SendKeys.Send("+(^L)")
                    SendKeys.Send("+(^L)")
                    Me.BulletIndent = 20
                Else
                    Me.SelectionBullet = True
                    Me.SelectionBullet = False
                End If
            End Set
        End Property
    
        Public Property SelectionRomanLowerBullet() As Boolean
            Get
                Return Me.RoLoBulletOn
            End Get
            Set(ByVal value As Boolean)
                NumBulletOn = False
                AlLoBulletOn = False
                AlUpBulletOn = False
                RoUpBulletOn = False
                Me.RoLoBulletOn = value
                If RoLoBulletOn = True Then
                    Me.SelectionBullet = True
                    SendKeys.Send("+(^L)")
                    SendKeys.Send("+(^L)")
                    SendKeys.Send("+(^L)")
                    SendKeys.Send("+(^L)")
                    Me.BulletIndent = 20
                Else
                    Me.SelectionBullet = True
                    Me.SelectionBullet = False
                End If
            End Set
        End Property
    
        Public Property SelectionRomanUpperBullet() As Boolean
            Get
                Return Me.RoUpBulletOn
            End Get
            Set(ByVal value As Boolean)
                NumBulletOn = False
                AlLoBulletOn = False
                AlUpBulletOn = False
                RoLoBulletOn = False
                Me.RoUpBulletOn = value
                If RoUpBulletOn = True Then
                    Me.SelectionBullet = True
                    SendKeys.Send("+(^L)")
                    SendKeys.Send("+(^L)")
                    SendKeys.Send("+(^L)")
                    SendKeys.Send("+(^L)")
                    SendKeys.Send("+(^L)")
                    Me.BulletIndent = 20
                Else
                    Me.SelectionBullet = True
                    Me.SelectionBullet = False
                End If
            End Set
        End Property
    
        Public Sub InsertTable(ByVal vRows As Integer, ByVal vCols As Integer)
            Dim A As String, i As Integer, j As Integer
            A = ""
            For i = 1 To vRows
                A = A & "\trowd\trgaph108\trleft-108\trbrdrl\brdrs\brdrw10 \trbrdrt\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trpaddl108\trpaddr108\trpaddfl3\trpaddfr3"
                For j = 1 To vCols
                    A = A & "\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs\cellx" & _
                    CStr(CInt((((Me.Width / 2) / vCols) * 20) * j)) 'CONSIDER CHANGING THIS TO A FLAT 2000
                Next
                'A = A & "\pard\intbl\sl276\slmult1\f1\fs22"
                A = A & "\pard\intbl\brdrl\brdrs\brdrw10 \brdrt\brdrs\brdrw10 \brdrr\brdrs\brdrw10 \brdrb\brdrs\brdrw10 \sl276\slmult1"
                For j = 1 To vCols
                    A = A & "\cell"
                Next
                A = A & "\row"
            Next
            A = A & "\pard\f0\fs17"
            'mark current insertion point    
            Me.SelectedText = Chr(&HA7)
            'get current rtf text
            Me.Rtf = Me.Rtf.Replace("\'a7", A.ToString())
    
        End Sub
    
        Public Sub InsertColumnRight()
            Dim curPos As Integer 'Holds the current location of the caret
            Dim selLen As Integer
            Dim Doc As String 'Holds the Rich text code of the Table to parse
            Dim A As String
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim numCols As Integer
            Dim curCol As Integer
            Dim colWidth As Integer
            Dim numRows As Integer
            Dim tStart As Integer
            Dim tEnd As Integer
            Dim curRow As Integer
            curPos = Me.SelectionStart
            selLen = Me.SelectionLength
            Doc = getTable(tStart, tEnd)
            numCols = getNumCols(Doc)
            curCol = getCurCol(Doc)
            numRows = getNumRows(Doc)
            curRow = getCurRow(Doc)
    
            subStart = 0
            For R = 1 To numRows 'Add the column to each row
                For C = 1 To curCol 'Navigate to the end of the current column
                    subStart = InStr(subStart + 1, Doc, "\cellx") + 5
                    subEnd = InStr(subStart + 1, Doc, "\") - 1
                Next
                colWidth = Doc.Substring(subStart, subEnd - subStart)
                colWidth = colWidth + 2000
                A = "\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx" & colWidth
                Doc = Doc.Insert(subEnd, A) 'insert the column data
                'Move to the end of the column we just inserted
                subStart = InStr(subStart + 1, Doc, "\cellx") + 5
                subEnd = InStr(subStart + 1, Doc, "\") - 1
                For C = curCol + 1 To numCols
                    'Update the remaining columns with poper end points
                    subStart = InStr(subStart + 1, Doc, "\cellx") + 5
                    subEnd = InStr(subStart + 1, Doc, "\") - 1
                    colWidth = Doc.Substring(subStart, subEnd - subStart)
                    Doc = Doc.Remove(subStart, subEnd - subStart).Insert(subStart, (colWidth + 2000).ToString)
                Next
                'Add \cell tag in the right spot
                For C = 1 To curCol 'Navigate to the end of the current column's \cell tag
                    subStart = InStr(subStart + 1, Doc, "\cell")
                    subEnd = InStr(subStart + 1, Doc, "ll") + 1
                Next
                Doc = Doc.Insert(subEnd, "\cell") 'insert the \cell tag
            Next
            Me.Rtf = Me.Rtf.Remove(tStart, tEnd - tStart).Insert(tStart, Doc)
            'do next 2 lines of code to remove special character and put curser back in correct spot
            subStart = InStr(Me.Text, Chr(&HA7)) + 1
            removeSpecialChar(subStart, curPos + (curRow - 1), selLen)
        End Sub
    
        Public Sub InsertRowAbove()
            'Dim ph As String 'Holds the currently selected text while we manipulate things
            Dim Doc As String 'Holds the Rich text code of the Table to parse
            Dim curPos As Integer 'Holds the current location of the caret
            Dim A As String
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim strSubstr As String
            Dim numCols As Integer
            Dim curCol As Integer
            Dim numRows As Integer
            Dim tStart As Integer
            Dim tEnd As Integer
            Dim cStart As Integer
            Dim cEnd As Integer
            Dim curRow As Integer
            Dim colWidth As Integer
            Dim x As Integer
            Dim selLen As Integer
            'ph = Me.SelectedRtf
            curPos = Me.SelectionStart
            selLen = Me.SelectionLength
            Doc = getTable(tStart, tEnd)
            Debug.Print("Doc premod = " & Doc)
            numCols = getNumCols(Doc)
            curCol = getCurCol(Doc)
            numRows = getNumRows(Doc)
            curRow = getCurRow(Doc)
            subStart = 0
            cStart = 0
            strSubstr = ""
            x = 0
            Do Until x > 0
                subStart = InStr(subStart + 1, Doc, "\trowd")
                subEnd = InStr(subStart, Doc, "\row") + 4
                strSubstr = Doc.Substring(subStart - 1, subEnd - subStart) 'This isolates the current row
                x = InStr(strSubstr, "\'a7")
            Loop 'When finished subStart -1 is where we need to insert the row.
            A = "\trowd\trgaph108\trleft-108\trbrdrl\brdrs\brdrw10 \trbrdrt\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trpaddl108\trpaddr108\trpaddfl3\trpaddfr3"
            For j = 1 To numCols
                cStart = InStr(cStart + 1, strSubstr, "\cellx") + 5
                cEnd = InStr(cStart, strSubstr, "\") - 1
                'tmpStr = strSubstr.Substring(cStart, cEnd - cStart)
                colWidth = strSubstr.Substring(cStart, cEnd - cStart)
                A = A & "\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs\cellx" & colWidth
            Next
            A = A & "\pard\intbl\brdrl\brdrs\brdrw10 \brdrt\brdrs\brdrw10 \brdrr\brdrs\brdrw10 \brdrb\brdrs\brdrw10 \sl276\slmult1"
            For j = 1 To numCols
                A = A & "\cell"
            Next
            A = A & "\row"
            Doc = Doc.Insert(subStart - 1, A) 'insert the row insto the Doc string
            Debug.Print("Doc postmod = " & Doc)
            Dim tmpStr As String
            tmpStr = Me.Rtf
            Debug.Print("tmpStr premod = " & tmpStr)
            Me.Rtf = Me.Rtf.Remove(tStart, tEnd - tStart).Insert(tStart, Doc) 'Put the Doc String back into the main document
            tmpStr = Me.Rtf
            Debug.Print("tmpStr postmod = " & tmpStr)
            'do next 2 lines of code to remove special character and put curser back in correct spot
            tmpStr = Chr(&HA7).ToString
            'subStart = Me.Rtf.Find("Z")
            removeSpecialChar(subStart, curPos + (curRow - 1), selLen)
        End Sub
    
        Public Sub InsertRowBelow()
            Dim ph As String 'Holds the currently selected text while we manipulate things
            Dim Doc As String 'Holds the Rich text code of the Table to parse
            Dim curPos As Integer 'Holds the current location of the caret
            Dim A As String
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim strSubstr As String
            Dim numCols As Integer
            Dim curCol As Integer
            Dim numRows As Integer
            Dim tStart As Integer
            Dim tEnd As Integer
            Dim cStart As Integer
            Dim cEnd As Integer
            Dim curRow As Integer
            Dim colWidth As Integer
            Dim x As Integer
            ph = Me.SelectedRtf
            curPos = Me.SelectionStart
            Doc = getTable(tStart, tEnd)
            numCols = getNumCols(Doc)
            curCol = getCurCol(Doc)
            numRows = getNumRows(Doc)
            curRow = getCurRow(Doc)
            subStart = 0
            cStart = 0
            strSubstr = ""
            Do Until x > 0
                subStart = InStr(subStart + 1, Doc, "\trowd")
                subEnd = InStr(subStart, Doc, "\row") + 3
                strSubstr = Doc.Substring(subStart, subEnd - subStart) 'This isolates the current row
                x = InStr(strSubstr, "\'80")
            Loop 'When finished subStart is where we need to insert the row.
            A = "\trowd\trgaph108\trleft-108\trbrdrl\brdrs\brdrw10 \trbrdrt\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trpaddl108\trpaddr108\trpaddfl3\trpaddfr3"
            For j = 1 To numCols
                cStart = InStr(cStart + 1, strSubstr, "\cellx") + 6
                cEnd = InStr(cStart, strSubstr, "\")
                colWidth = Doc.Substring(cStart, cEnd - cStart)
                A = A & "\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs\cellx" & colWidth
            Next
            A = A & "\pard\intbl\brdrl\brdrs\brdrw10 \brdrt\brdrs\brdrw10 \brdrr\brdrs\brdrw10 \brdrb\brdrs\brdrw10 \sl276\slmult1"
            For j = 1 To numCols
                A = A & "\cell"
            Next
            A = A & "\row"
            Doc = Doc.Insert(subEnd, A) 'insert the row insto the Doc string
            Me.Rtf = Me.Rtf.Remove(tStart, tEnd - tStart).Insert(tStart, Doc) 'Put the Doc String back into the main document
            'do next 2 lines of code to remove special character and put curser back in correct spot
            Me.Rtf = Me.Rtf.Replace("\'80", ph)
            Me.SelectionStart = curPos + (curRow - 1) 'need to add current Row number to maintain original position
        End Sub
    
        Public Sub DeleteRow()
            Dim ph As String 'Holds the currently selected text while we manipulate things
            Dim curPos As Integer 'Holds the current location of the caret
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim x As Integer
            ph = Me.SelectedRtf
            curPos = Me.SelectionStart
            Me.SelectedText = Chr(&H80)
            subStart = 0
            x = InStr(Me.Rtf, "\'80")
            subStart = InStrRev(Me.Rtf, "\trowd", x) - 1
            subEnd = InStr(x, Me.Rtf, "\row") + 3
            Me.Rtf = Me.Rtf.Remove(subStart, subEnd - subStart)
            Me.SelectionStart = curPos
        End Sub
    
        Private Function getNumCols(ByVal doc As String) As Integer
            Dim strSubstr As String
            Dim index As Integer
            Dim index2 As Integer
            Dim index3 As Integer
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim numCols As Integer
            Dim x As Integer
            index = InStr(doc, "\'a7")
            subStart = InStrRev(doc, "\trowd", index)
            subEnd = InStr(index, doc, "\row")
            strSubstr = doc.Substring(subStart, subEnd - subStart) 'This isolates the entire row
            numCols = 0
            index2 = InStr(strSubstr, "\'a7")
            index3 = InStr(strSubstr, "\pard\intbl")
            x = 1
            Do Until x = 0
                x = InStr(x + 1, strSubstr, "\clbrdrl")
                If x > 0 Then numCols = numCols + 1
            Loop
            Return numCols
        End Function
    
        Private Function getCurCol(ByVal doc As String) As Integer
            Dim strSubstr As String
            Dim index As Integer
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim curCol As Integer
            Dim x As Integer
            Dim c As Integer
    
            index = InStr(doc, "\'a7") 'Where the character is in the whole doc
            subStart = InStrRev(doc, "\pard\intbl", index)
            subEnd = InStr(index, doc, "\row")
            strSubstr = doc.Substring(subStart, subEnd - subStart) 'This isolates the part of the row with the \cell tags
            index = InStr(strSubstr, "\'a7") 'Where the character is in the isolated string
            x = 1
            c = 0
            Do Until x = 0
                x = InStr(x + 1, strSubstr, "\cell")
                If x < index And x <> 0 Then c = c + 1
            Loop
            curCol = c + 1
            Return curCol
        End Function
    
        Private Function getNumRows(ByVal doc As String) As Integer
            Dim numRows As Integer
            Dim x As Integer
            numRows = 0
            x = doc.Length
            Do Until x = 0
                If x > 1 Then
                    x = InStrRev(doc, "\trowd", x - 1)
                Else
                    x = 0
                End If
                If x > 0 Then numRows = numRows + 1
            Loop
            Return numRows
        End Function
    
        Private Function getCurRow(ByVal doc As String) As Integer
            Dim x As Integer
            Dim c As Integer
            Dim subStart As Integer
            Dim subEnd As Integer
            Dim strSubstr As String
            c = 0
            x = 0
            subStart = 0
            Do Until x > 0
                subStart = InStr(subStart + 1, doc, "\trowd")
                subEnd = InStr(subStart, doc, "\row")
                strSubstr = doc.Substring(subStart, subEnd - subStart) 'This isolates the current row
                x = InStr(strSubstr, "\'a7")
                c = c + 1
            Loop
            Return c
        End Function
    
        Private Function getTable(ByRef subStart As Integer, ByRef subEnd As Integer) As String
            Dim Doc As String 'Holds the Rich text code of the Document to parse and look for table defs
            Dim curPos As Integer 'Holds the current location of the caret
            Dim strSubstr As String
            Dim parLoc As Integer
            Dim pardLoc As Integer
            Dim selLen As Integer
            Dim charStart As Integer
    
            curPos = Me.SelectionStart
            selLen = Me.SelectionLength
            charStart = addSpecialChar()
            Doc = Me.Rtf
            'Debug.Print("Doc = " & Doc)
            parLoc = charStart
            pardLoc = charStart
            subStart = 0
            Do Until parLoc <> pardLoc
                pardLoc = InStrRev(Doc, "\pard", parLoc - 1)
                parLoc = InStrRev(Doc, "\par", parLoc - 1)
                If parLoc = 0 Then 'This is to prevent problems is the table is at the very top.
                    subStart = InStr(Doc, "\trowd") - 1
                    Exit Do
                End If
            Loop
            If subStart = 0 Then subStart = parLoc + 3 ' This if prevents the subStart from being changed if set above.
    
            parLoc = charStart
            pardLoc = charStart
            Do Until parLoc <> pardLoc
                pardLoc = InStr(parLoc + 1, Doc, "\pard")
                parLoc = InStr(parLoc + 1, Doc, "\par")
            Loop
            subEnd = parLoc
            strSubstr = Doc.Substring(subStart, (subEnd - subStart) - 1)
            removeSpecialChar(charStart, curPos, selLen)
            'Now I need to get the end of the table without the special character
            parLoc = charStart
            pardLoc = charStart
            Do Until parLoc <> pardLoc
                pardLoc = InStr(parLoc + 1, Doc, "\pard")
                parLoc = InStr(parLoc + 1, Doc, "\par")
            Loop
            subEnd = parLoc
            'Debug.Print("subStart = " & subStart)
            'Debug.Print("subEnd = " & subEnd)
            'Debug.Print("strSubstr = " & strSubstr)
            Return strSubstr
        End Function
    
        Public Function isTable() As Boolean
            Dim Doc As String 'Holds the Rich text code of the Document to parse and look for table defs
            Dim curPos As Integer 'Holds the current location of the caret so we can put it back where it was
            Dim strSubstr As String
            Dim index As Integer
            Dim charStart As Integer
            Dim selLen As Integer
            curPos = Me.SelectionStart
            selLen = Me.SelectionLength
            charStart = addSpecialChar() 'Inserts the character and returns it's location.
            Doc = Me.Rtf 'Load the document with the special character into the variable
            index = InStr(Doc, "\'a7") ' Get the location of the character
            strSubstr = Doc.Substring(index) 'Get everything to the right of the character
            index = InStr(strSubstr, "\par") 'Look for the next /par
            strSubstr = strSubstr.Substring(0, index) 'Isolates everything between the special character and the \par
            index = InStr(strSubstr, "\cell") 'Look for the \cell tag if 0 then not a table, anything else and it is.
            removeSpecialChar(charStart, curPos, selLen)
    
            If index = 0 Then 'Return True or False
                Return False
            Else
                Return True
            End If
        End Function
    
        Private Function addSpecialChar() As Integer 'Returns the location of the character
            Dim insStart As Integer
            Dim selLen As Integer
            selLen = Me.SelectionLength
            If selLen = 0 Then
                insStart = Me.SelectionStart
                Me.SelectedText = Chr(&HA7) 'Insert a special character into the document at the current location. "\'80" is the RTF of the Chr.
                'Me.SelectedText = Chr(&H80) 'Insert a special character into the document at the current location. "\'80" is the RTF of the Chr.
            Else
                insStart = Me.SelectionStart + (Me.SelectionLength / 2)
                Me.Select(insStart, 0)
                insStart = Me.SelectionStart
                Me.SelectedText = Chr(&HA7) 'Insert a special character into the document at the current location. "\'80" is the RTF of the Chr.
            End If
            Return insStart
        End Function
    
        Private Sub removeSpecialChar(ByVal charStart As Integer, ByVal selStart As Integer, ByVal selLen As Integer)
            Me.Select(charStart, 1) 'Select the special char
            Me.SelectedText = "" 'remove the special char
            Me.Select(selStart, selLen) 're-highlight the original selection
        End Sub
    
    End Class
    Last edited by Maverickz; Apr 6th, 2021 at 08:17 PM.

  8. #8
    Hyperactive Member
    Join Date
    Sep 2004
    Posts
    477

    Re: RichTextBox - add columns to existing table?

    Finally, I mentioned I was revisiting this project. The following is new code that allosw for resizing the cells horizontally. I haven't implemented vertical resizing yet. Add this into the above custom control and when you mouse over a left or right border the cursor will change and you can resize it.

    NOTE: In the For loop of the GetCells() method, on the "Dim i" line I am adding 108 because that is what I have set for the cell padding in my table (\trgaph108). You should change this to whatever value you use for your cell padding.
    Even better would be to parse the RTF and get this value and add it dynamically.


    Code:
        Private twipX As List(Of Integer) = New List(Of Integer)
        Private tableresize As Boolean = False
        Private doc As String
    
        Private Sub BetterRichTextBox_MouseEnter(sender As Object, e As EventArgs) Handles Me.MouseEnter
            getCells()
        End Sub
    
        Private Sub BetterRichTextBox_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
            If e.Button = MouseButtons.Left And Me.Cursor = Cursors.VSplit Then
                tableresize = True
            End If
        End Sub
    
        Private Sub BetterRichTextBox_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
            For Each twip As Integer In twipX
                If e.X > twip - 2 And e.X < twip + 2 Then
                    Me.Cursor = Cursors.VSplit
                    Exit For
                Else
                    If Me.Cursor = Cursors.VSplit And tableresize = False Then Me.Cursor = Cursors.IBeam
                End If
            Next
        End Sub
        Private Sub BetterRichTextBox_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
            If tableresize Then
                tableresize = False
                Dim t As String = Me.Rtf
                LockWindowUpdate(Form1.Handle.ToInt32) 
                Me.Clear()
                Me.Rtf = t
                LockWindowUpdate(0)
                getCells()
            End If
        End Sub
    
        Private Sub getCells()
            doc = Me.Rtf
            Dim g As Graphics = Me.CreateGraphics
            Dim s As Integer = InStr(doc, "\trowd")
            Dim e As Integer = InStr(doc, "\row")
            Dim tmpStr As String = doc.Substring(s, e - s)
            Dim matches As MatchCollection = Regex.Matches(tmpStr, "\\cellx(\d+)")
            twipX.Clear()
            For Each match As Match In matches
                Dim i As Integer = CInt(match.Value.Substring(6)) + 108
                Dim x As Integer = CInt((CDbl(i) * (1.0 / 1440.0) * g.DpiX)) + 2
                twipX.Add(x)
            Next
        End Sub
    Last edited by Maverickz; Apr 6th, 2021 at 08:25 PM.

  9. #9

    Thread Starter
    Junior Member
    Join Date
    Jan 2021
    Posts
    29

    Re: RichTextBox - add columns to existing table?

    Quote Originally Posted by Maverickz View Post
    OK I said not to use the base RichtextBox, because it doesn't handle a lot of the RTF very well. The good news is every Windows PC already has a much better alternative that you can use: "RICH EDIT" found in msftedit.dll.
    Thanks. I am using VS2019 on .NET 4.7.2 Does it not already use this updated version of rich text box?

  10. #10
    Hyperactive Member
    Join Date
    Sep 2004
    Posts
    477

    Re: RichTextBox - add columns to existing table?

    Quote Originally Posted by mobi12 View Post
    Thanks. I am using VS2019 on .NET 4.7.2 Does it not already use this updated version of rich text box?
    To be honest, I'm not sure. I know the built in tool used to use an older version, but it is possible it has been updated.

    A cursory search didn't turn up anything definitive, but I did find this:

    https://docs.microsoft.com/en-us/win...-edit-controls
    In Microsoft Visual Studio 2005 and later, it is possible to add a rich edit control into a dialog template by dragging the control from the toolbox. However, doing this in the dialog editor does not ensure that the required library will be loaded before the control is created. It is necessary to call the LoadLibrary function to load Riched32.dll, Riched20.dll, or Msftedit.dll before the dialog is created.

    EDIT:

    Doing some more digging, I found this, so it does look like they changed this in .Net 4.7.1. Good to know. So you can ignore that part. The rest of the code should help you on adding and removing columns and rows though. Maybe you can find a better way and share it back. Again that code was written 10+ years ago, so maybe better methods exist.

    https://docs.microsoft.com/en-us/dot...bility/fx-core
    In .NET Framework 4.6.2 and previous versions, the RichTextBox control instantiates the Win32 RichEdit control v3.0, and for applications that target .NET Framework 4.7.1, the RichTextBox control instantiates RichEdit v4.1 (in msftedit.dll). The Switch.System.Windows.Forms.DoNotLoadLatestRichEditControl compatibility switch was introduced to allow applications that target .NET Framework 4.7.1 and later versions to opt out of the new RichEdit v4.1 control and use the old RichEdit v3 control instead.

    In .NET Core and .NET 5.0 and later versions, the Switch.System.Windows.Forms.DoNotLoadLatestRichEditControl switch is not supported. Only new versions of the RichTextBox control are supported.
    Last edited by Maverickz; Apr 7th, 2021 at 09:45 AM.

  11. #11

    Thread Starter
    Junior Member
    Join Date
    Jan 2021
    Posts
    29

    Re: RichTextBox - add columns to existing table?

    The tables in RTB are quite cumbersome to deal with. I am thinking off editing tables inside datagridview and then pasting in RTB. Data Grid View offers easier option to manipulate rows/columns.

  12. #12
    Hyperactive Member
    Join Date
    Sep 2004
    Posts
    477

    Re: RichTextBox - add columns to existing table?

    Quote Originally Posted by mobi12 View Post
    The tables in RTB are quite cumbersome to deal with. I am thinking off editing tables inside datagridview and then pasting in RTB. Data Grid View offers easier option to manipulate rows/columns.
    Using a hidden DGV is pretty clever. I was considering using XML which would allow parsing the table using standard XML tools to add, remove rows, columns, and easily change attributes such as cell shading, border settings, and padding. This would also allow for multiple tables in a single DOM instead of creating multiple DGV.

    The XML would look something something like:

    <?xml version="1.0" encoding="utf-8"?>
    <table>
    <row bordersize=X bordercolor=x etc...>
    <cell attributes=X...>
    TEXT
    </cell>
    <cell attributes=X...>
    TEXT
    </cell>
    </row>
    </table>

    I have stopped at this point and looking at TXTextControl Express (free edition) due to issues with the standard control and not being able to select a single column. Unless I can find a way around this issue, I can't use the standard control. It has built in handling of all of this table stuff, but it's not without it's own issues.

  13. #13

    Thread Starter
    Junior Member
    Join Date
    Jan 2021
    Posts
    29

    Re: RichTextBox - add columns to existing table?

    After lots of trial and errors I finally managed to implement insert/delete row/column in RTF tables.

    I have taken this approach. Convert a table to an array (including rich text formatting). Then add/remove rows/columns in that array and transform updated array back into RTF table.

    Here is the code for this. I have assumed RTB contains only table and no other rich text content.

    Code:
    #Region "Array functions"
        Private Function RtfTableToArray() As String(,)
            'Parse existing table content
            Dim SourceTable(0, 0) As String
            Try
                Dim qqq As String = rtb.Rtf
                qqq = qqq.Replace("\", "¬") 'to avoid problem with \ being escape character
                Dim qq() As String = qqq.Split(vbCrLf) 'causing problem if cell has line breaks
                Dim q As String = ""
                For ii As Integer = 0 To qq.Length - 1
                    Dim line As String = Trim(qq(ii)).ToString
                    'MsgBox(line)
                    If InStr(line, "¬pard¬intbl") > 0 Then q = q & qq(ii)
                Next
                q = q.Replace("¬pard¬intbl", "")
                q = q.Replace("¬sl252¬slmult1", "").Replace("¬f0¬fs22¬lang3082", "")
                q = Regex.Replace(q, "¬brdr(\w+)¬brdr(\w+)¬brdrw(\w+)", "")
                q = Regex.Replace(q, "¬trbrdr(\w+)¬brdr(\w+)¬brdrw(\w+)", "")
                q = Regex.Replace(q, "¬trpaddl(\w+)¬trpaddr(\w+)¬trpaddfl3¬trpaddfr(\w+)", "")
                q = Regex.Replace(q, "¬row¬trowd¬trgaph(\w+)¬trleft(\w+)", "")
                q = q.Replace("¬cell", "|")
                q = q.Replace("¬row", "") 'Table content as string
    
                'Convert existing table into an array
                Dim rows As Integer = q.Split(vbLf).Length - 1
                Dim CellData() As String = q.Split("|")
                Dim cols As Integer = (CellData.Length - 1) / rows
                'MsgBox("row,col = " & vbCrLf & rows & vbCrLf & cols)
                ReDim SourceTable(rows, cols)
                Dim k As Integer = 0
                For i As Integer = 0 To rows - 1
                    For j As Integer = 0 To cols - 1
                        SourceTable(i, j) = CellData(k).Replace("¬", "\")
                        'MsgBox(SourceTable(i, j))
                        k = k + 1
                    Next j
                Next i
            Catch xx As Exception
                MessageBox.Show(xx.Message, "RtfTableToArray error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
            Return SourceTable
        End Function
    
        Private Sub ArrayToRtfTable(ByRef TableData(,) As String, TargetRTB As RichTextBox)
            Try
                Dim rows As Integer = TableData.GetLength(0) - 1
                Dim cols As Integer = TableData.GetLength(1) - 1
                'Now create a new table with this data
                Dim w As New Text.StringBuilder
                w.Append("{\rtf1\ansi\ansicpg1252\deff0\nouicompat\deflang1033{\fonttbl{\f0\fnil\fcharset0 Calibri;}{\f1\fswiss\fprq2\fcharset0 Calibri;}} {\colortbl ;\red255\green255\blue255;\red0\green128\blue128;\red0\green0\blue255;\red255\green0\blue0;} {\*\generator Riched20 10.0.19041}{\*\mmathPr\mdispDef1\mwrapIndent1440 }\viewkind4\uc1")
                Dim x As Integer, y As Integer
                For x = 1 To rows
                    w.Append("\trowd\trgaph108\trleft-108\trbrdrl\brdrs\brdrw10 \trbrdrt\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trpaddl108\trpaddr108\trpaddfl3\trpaddfr3")
                    For y = 1 To cols
                        w.Append("\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs\cellx" & CStr(CInt((((Me.Width / 2) / cols) * 20) * y)))
                    Next
                    w.Append("\pard\intbl\brdrl\brdrs\brdrw10 \brdrt\brdrs\brdrw10 \brdrr\brdrs\brdrw10 \brdrb\brdrs\brdrw10 \sl276\slmult1")
                    For y = 1 To cols
                        w.Append(TableData(x - 1, y - 1) & "\cell")
                    Next
                    w.Append("\row ")
                Next
                w.Append("\pard\f0\fs17}")
                'replace existing RTB content with reconstructed table
                TargetRTB.Rtf = w.ToString
            Catch xx As Exception
                MessageBox.Show(xx.Message, "ArrayToRtfTable error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
        End Sub
    
        Private Function AddColumnToArray(SourceArray(,) As String, NewColumnPos As Integer, mode As String) As String(,)
            'mode = i for insert, d for duplicate
            'add a new empty column after a specific column in an array
            'if 3 is passed, then new column will be 0 1 2 3rd in new array
            Dim rows As Integer = SourceArray.GetLength(0) - 1
            Dim cols As Integer = SourceArray.GetLength(1) - 1
            Dim TargetArray(rows, cols + 1) As String
            Try
                For r As Integer = 0 To rows
                    For c As Integer = 0 To cols
                        If c < NewColumnPos Then
                            TargetArray(r, c) = SourceArray(r, c)
                        ElseIf c = NewColumnPos Then
                            If mode = "i" Then TargetArray(r, c) = "" 'insert blank column
                            If mode = "d" Then TargetArray(r, c) = SourceArray(r, c) 'duplicate column from left
                        ElseIf c > NewColumnPos Then
                            TargetArray(r, c) = SourceArray(r, c - 1)
                        End If
                    Next
                Next
            Catch xx As Exception
                MessageBox.Show(xx.Message, "AddColumnToArray error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
            Return TargetArray
        End Function
    
        Private Function DeleteColumnFromArray(SourceArray(,) As String, ColumnPos As Integer) As String(,)
            'if 3 is passed, then new column will be 0 1 2 3rd in old array
            Dim rows As Integer = SourceArray.GetLength(0) - 1
            Dim cols As Integer = SourceArray.GetLength(1) - 1
            Dim TargetArray(rows, cols - 1) As String
            Try
                For r As Integer = 0 To rows
                    For c As Integer = 0 To cols
                        If c < ColumnPos Then
                            TargetArray(r, c) = SourceArray(r, c)
                        ElseIf c >= ColumnPos Then
                            TargetArray(r, c - 1) = SourceArray(r, c)
                        End If
                    Next
                Next
            Catch xx As Exception
                MessageBox.Show(xx.Message, "DeleteColumnFromArray error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
            Return TargetArray
        End Function
    
        Private Function AddRowToArray(SourceArray(,) As String, NewRowPos As Integer, mode As String) As String(,)
            'mode = i for insert, d for duplicate
            'add a new empty row after a specific row in an array
            'if 3 is passed, then new row will be 0 1 2 3rd in new array
            Dim rows As Integer = SourceArray.GetLength(0) - 1
            Dim cols As Integer = SourceArray.GetLength(1) - 1
            Dim TargetArray(rows + 1, cols) As String
            Try
                For c As Integer = 0 To cols
                    For r As Integer = 0 To rows
                        If r < NewRowPos Then
                            TargetArray(r, c) = SourceArray(r, c)
                        ElseIf r = NewRowPos Then
                            If mode = "i" Then TargetArray(r, c) = ""
                            If mode = "d" Then TargetArray(r, c) = SourceArray(r - 1, c)
                        ElseIf r > NewRowPos Then
                            TargetArray(r, c) = SourceArray(r - 1, c)
                        End If
                    Next
                Next
            Catch xx As Exception
                MessageBox.Show(xx.Message, "AddRowToArray error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
            Return TargetArray
        End Function
    
        Private Function DeleteRowFromArray(SourceArray(,) As String, RowPos As Integer) As String(,)
            'if 3 is passed, then new row will be 0 1 2 3rd in new array
            Dim rows As Integer = SourceArray.GetLength(0) - 1
            Dim cols As Integer = SourceArray.GetLength(1) - 1
            Dim TargetArray(rows - 1, cols) As String
            Try
                For c As Integer = 0 To cols
                    For r As Integer = 0 To rows
                        If r < RowPos Then
                            TargetArray(r, c) = SourceArray(r, c)
                        ElseIf r >= RowPos Then
                            TargetArray(r - 1, c) = SourceArray(r, c)
                        End If
                    Next
                Next
            Catch xx As Exception
                MessageBox.Show(xx.Message, "DeleteRowFromArray error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
            Return TargetArray
        End Function
    #End Region

  14. #14
    Hyperactive Member
    Join Date
    Sep 2004
    Posts
    477

    Re: RichTextBox - add columns to existing table?

    Quote Originally Posted by mobi12 View Post
    After lots of trial and errors I finally managed to implement insert/delete row/column in RTF tables.

    I have taken this approach. Convert a table to an array (including rich text formatting). Then add/remove rows/columns in that array and transform updated array back into RTF table.

    Here is the code for this. I have assumed RTB contains only table and no other rich text content.

    Code:
    #Region "Array functions"
        Private Function RtfTableToArray() As String(,)
            'Parse existing table content
            Dim SourceTable(0, 0) As String
            Try
                Dim qqq As String = rtb.Rtf
                qqq = qqq.Replace("\", "¬") 'to avoid problem with \ being escape character
                Dim qq() As String = qqq.Split(vbCrLf) 'causing problem if cell has line breaks
                Dim q As String = ""
                For ii As Integer = 0 To qq.Length - 1
                    Dim line As String = Trim(qq(ii)).ToString
                    'MsgBox(line)
                    If InStr(line, "¬pard¬intbl") > 0 Then q = q & qq(ii)
                Next
                q = q.Replace("¬pard¬intbl", "")
                q = q.Replace("¬sl252¬slmult1", "").Replace("¬f0¬fs22¬lang3082", "")
                q = Regex.Replace(q, "¬brdr(\w+)¬brdr(\w+)¬brdrw(\w+)", "")
                q = Regex.Replace(q, "¬trbrdr(\w+)¬brdr(\w+)¬brdrw(\w+)", "")
                q = Regex.Replace(q, "¬trpaddl(\w+)¬trpaddr(\w+)¬trpaddfl3¬trpaddfr(\w+)", "")
                q = Regex.Replace(q, "¬row¬trowd¬trgaph(\w+)¬trleft(\w+)", "")
                q = q.Replace("¬cell", "|")
                q = q.Replace("¬row", "") 'Table content as string
    
                'Convert existing table into an array
                Dim rows As Integer = q.Split(vbLf).Length - 1
                Dim CellData() As String = q.Split("|")
                Dim cols As Integer = (CellData.Length - 1) / rows
                'MsgBox("row,col = " & vbCrLf & rows & vbCrLf & cols)
                ReDim SourceTable(rows, cols)
                Dim k As Integer = 0
                For i As Integer = 0 To rows - 1
                    For j As Integer = 0 To cols - 1
                        SourceTable(i, j) = CellData(k).Replace("¬", "\")
                        'MsgBox(SourceTable(i, j))
                        k = k + 1
                    Next j
                Next i
            Catch xx As Exception
                MessageBox.Show(xx.Message, "RtfTableToArray error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
            Return SourceTable
        End Function
    
        Private Sub ArrayToRtfTable(ByRef TableData(,) As String, TargetRTB As RichTextBox)
            Try
                Dim rows As Integer = TableData.GetLength(0) - 1
                Dim cols As Integer = TableData.GetLength(1) - 1
                'Now create a new table with this data
                Dim w As New Text.StringBuilder
                w.Append("{\rtf1\ansi\ansicpg1252\deff0\nouicompat\deflang1033{\fonttbl{\f0\fnil\fcharset0 Calibri;}{\f1\fswiss\fprq2\fcharset0 Calibri;}} {\colortbl ;\red255\green255\blue255;\red0\green128\blue128;\red0\green0\blue255;\red255\green0\blue0;} {\*\generator Riched20 10.0.19041}{\*\mmathPr\mdispDef1\mwrapIndent1440 }\viewkind4\uc1")
                Dim x As Integer, y As Integer
                For x = 1 To rows
                    w.Append("\trowd\trgaph108\trleft-108\trbrdrl\brdrs\brdrw10 \trbrdrt\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trpaddl108\trpaddr108\trpaddfl3\trpaddfr3")
                    For y = 1 To cols
                        w.Append("\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs\cellx" & CStr(CInt((((Me.Width / 2) / cols) * 20) * y)))
                    Next
                    w.Append("\pard\intbl\brdrl\brdrs\brdrw10 \brdrt\brdrs\brdrw10 \brdrr\brdrs\brdrw10 \brdrb\brdrs\brdrw10 \sl276\slmult1")
                    For y = 1 To cols
                        w.Append(TableData(x - 1, y - 1) & "\cell")
                    Next
                    w.Append("\row ")
                Next
                w.Append("\pard\f0\fs17}")
                'replace existing RTB content with reconstructed table
                TargetRTB.Rtf = w.ToString
            Catch xx As Exception
                MessageBox.Show(xx.Message, "ArrayToRtfTable error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
        End Sub
    
        Private Function AddColumnToArray(SourceArray(,) As String, NewColumnPos As Integer, mode As String) As String(,)
            'mode = i for insert, d for duplicate
            'add a new empty column after a specific column in an array
            'if 3 is passed, then new column will be 0 1 2 3rd in new array
            Dim rows As Integer = SourceArray.GetLength(0) - 1
            Dim cols As Integer = SourceArray.GetLength(1) - 1
            Dim TargetArray(rows, cols + 1) As String
            Try
                For r As Integer = 0 To rows
                    For c As Integer = 0 To cols
                        If c < NewColumnPos Then
                            TargetArray(r, c) = SourceArray(r, c)
                        ElseIf c = NewColumnPos Then
                            If mode = "i" Then TargetArray(r, c) = "" 'insert blank column
                            If mode = "d" Then TargetArray(r, c) = SourceArray(r, c) 'duplicate column from left
                        ElseIf c > NewColumnPos Then
                            TargetArray(r, c) = SourceArray(r, c - 1)
                        End If
                    Next
                Next
            Catch xx As Exception
                MessageBox.Show(xx.Message, "AddColumnToArray error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
            Return TargetArray
        End Function
    
        Private Function DeleteColumnFromArray(SourceArray(,) As String, ColumnPos As Integer) As String(,)
            'if 3 is passed, then new column will be 0 1 2 3rd in old array
            Dim rows As Integer = SourceArray.GetLength(0) - 1
            Dim cols As Integer = SourceArray.GetLength(1) - 1
            Dim TargetArray(rows, cols - 1) As String
            Try
                For r As Integer = 0 To rows
                    For c As Integer = 0 To cols
                        If c < ColumnPos Then
                            TargetArray(r, c) = SourceArray(r, c)
                        ElseIf c >= ColumnPos Then
                            TargetArray(r, c - 1) = SourceArray(r, c)
                        End If
                    Next
                Next
            Catch xx As Exception
                MessageBox.Show(xx.Message, "DeleteColumnFromArray error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
            Return TargetArray
        End Function
    
        Private Function AddRowToArray(SourceArray(,) As String, NewRowPos As Integer, mode As String) As String(,)
            'mode = i for insert, d for duplicate
            'add a new empty row after a specific row in an array
            'if 3 is passed, then new row will be 0 1 2 3rd in new array
            Dim rows As Integer = SourceArray.GetLength(0) - 1
            Dim cols As Integer = SourceArray.GetLength(1) - 1
            Dim TargetArray(rows + 1, cols) As String
            Try
                For c As Integer = 0 To cols
                    For r As Integer = 0 To rows
                        If r < NewRowPos Then
                            TargetArray(r, c) = SourceArray(r, c)
                        ElseIf r = NewRowPos Then
                            If mode = "i" Then TargetArray(r, c) = ""
                            If mode = "d" Then TargetArray(r, c) = SourceArray(r - 1, c)
                        ElseIf r > NewRowPos Then
                            TargetArray(r, c) = SourceArray(r - 1, c)
                        End If
                    Next
                Next
            Catch xx As Exception
                MessageBox.Show(xx.Message, "AddRowToArray error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
            Return TargetArray
        End Function
    
        Private Function DeleteRowFromArray(SourceArray(,) As String, RowPos As Integer) As String(,)
            'if 3 is passed, then new row will be 0 1 2 3rd in new array
            Dim rows As Integer = SourceArray.GetLength(0) - 1
            Dim cols As Integer = SourceArray.GetLength(1) - 1
            Dim TargetArray(rows - 1, cols) As String
            Try
                For c As Integer = 0 To cols
                    For r As Integer = 0 To rows
                        If r < RowPos Then
                            TargetArray(r, c) = SourceArray(r, c)
                        ElseIf r >= RowPos Then
                            TargetArray(r - 1, c) = SourceArray(r, c)
                        End If
                    Next
                Next
            Catch xx As Exception
                MessageBox.Show(xx.Message, "DeleteRowFromArray error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
            Return TargetArray
        End Function
    #End Region
    Glad you found something that works for you. Please mark the thread "Resolved".

    Also did you by chance find a way to be able to select a single column of the table (without selecting the entire row)?

  15. #15

    Thread Starter
    Junior Member
    Join Date
    Jan 2021
    Posts
    29

    Re: [RESOLVED] RichTextBox - add columns to existing table?

    I have not found a way to visually select a column. But I think from the table array it would be possible to select a column’s content programmatically and paste somewhere.

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