-
Apr 5th, 2021, 03:12 AM
#1
Thread Starter
Junior Member
[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
-
Apr 5th, 2021, 09:08 AM
#2
Re: RichTextBox - add columns to existing table?
-
Apr 5th, 2021, 11:48 AM
#3
Thread Starter
Junior Member
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.
-
Apr 5th, 2021, 01:17 PM
#4
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.
-
Apr 6th, 2021, 02:13 AM
#5
Thread Starter
Junior Member
Re: RichTextBox - add columns to existing table?
Originally Posted by wes4dbt
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
-
Apr 6th, 2021, 07:29 PM
#6
Hyperactive Member
Re: RichTextBox - add columns to existing table?
Originally Posted by mobi12
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
-
Apr 6th, 2021, 07:40 PM
#7
Hyperactive Member
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.
-
Apr 6th, 2021, 07:51 PM
#8
Hyperactive Member
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.
-
Apr 7th, 2021, 02:17 AM
#9
Thread Starter
Junior Member
Re: RichTextBox - add columns to existing table?
Originally Posted by Maverickz
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?
-
Apr 7th, 2021, 09:36 AM
#10
Hyperactive Member
Re: RichTextBox - add columns to existing table?
Originally Posted by mobi12
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.
-
Apr 8th, 2021, 02:42 AM
#11
Thread Starter
Junior Member
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.
-
Apr 8th, 2021, 09:21 AM
#12
Hyperactive Member
Re: RichTextBox - add columns to existing table?
Originally Posted by mobi12
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.
-
Apr 15th, 2021, 05:37 AM
#13
Thread Starter
Junior Member
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
-
Apr 15th, 2021, 02:54 PM
#14
Hyperactive Member
Re: RichTextBox - add columns to existing table?
Originally Posted by mobi12
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)?
-
Apr 15th, 2021, 05:44 PM
#15
Thread Starter
Junior Member
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|