Retrieving the styled text in saved DBKit.TextArea inputs.

General
1

The goal is to store and retrieve records that include user styled text documents.

(using SQLite)

Following the example in Quickly building a database client app for the desktop with DBKit, a DBKit.TextArea was added. The text area was decorated (after clicking the Edit button) with bold, underline, color, etc… using the contextual menu and then saved using the Done button. When the record is again selected in the listbox, only plain text appears. The styling has been lost.

Does the DBKit.TextArea not keep its styling when saved?

Thanks - KC

2

After some reading and testing it seems that handling RTFData can be too slow for a user interface. In a large (300K) text document getting RTFData to Styled Text took about 1 minute. (using macOS15.1, M1, Xojo 4.1)

DTTextArea1.StyledText.Text = DTTextArea2.StyledText.RTFData ’ takes about 60 seconds

I copied the code example in the Xojo docs to explore MEMORYBOLCK for gaining some speed and found no advantage at first. Some documents were taking up to 3 minutes.

Var mb As MemoryBlock
MB = glbl.TextAreaToMemB(DTTextArea2.StyledText)  ' takes about 2 seconds
DTTextArea1.StyledText = glbl.TextAreaFromMemB(MB)   ' still took about 60 seconds

(code for these is shown below)

However, changing
sr.FontName = mb.CString(pos)
sr.Text = mb.CString(pos+stFontLen)
to
sr.FontName = mb.CString(pos).DefineEncoding(Encodings.ASCII)
sr.Text = mb.CString(pos+stFontLen).DefineEncoding(Encodings.ASCII)
in TextAreaFromMemB made the speed very acceptable.

Using UTF8 made the tabs and carriage returns appear as odd characters.
Using UTF16 was slow.
Using ASCII was fast and the resulting text looked like it was supposed to.

This leads to some questions.
Is there a better approach in general to saving and retrieving user styled docs?
Could Xojo’s built in method benefit from using ASCII encoding? Not sure if that can be set.

Thanks - KC

'  TextAreaToMemB
'  Input: sta As StyledText

Var sr As StyleRun
Var i, Count As Integer
Var textLen, fontLen As Integer
Var staticInfo, curLength,startLength As Integer 
Var mb As MemoryBlock

mb=New MemoryBlock(0)

' We already know that a style run takes up a certain amount of space
' 3 bytes for the booleans, 4 for size and 4 for color (when size is integer32)
' bold italic underline textcolor fontsize fontnamelength textlength - fontName and text appear next
staticInfo = 1 + 1 + 1 + 4 + 4 + 4 + 4

Count = sta.StyleRunCount ' Get the number of styles
curLength=0  ' of mb

For i = 0 To Count - 1 ' get the MemoryBox size so it can be set once
  startLength=curLength
  sr = sta.StyleRun(i)
  textLen = sr.Text.Length + 1  ' +1 sets the null byte
  fontLen = sr.FontName.Length + 1
  curLength=curLength+staticInfo + fontLen + textLen+1
  
Next
mb.size=curLength

curLength=0  ' start over so the values can be set
For i = 0 To Count - 1 ' get the StyleRuns
  startLength=curLength
  sr = sta.StyleRun(i)
  textLen = sr.Text.Length + 1  ' +1 sets the null byte
  fontLen = sr.FontName.Length + 1
  curLength=curLength+staticInfo + fontLen + textLen+1
  
  ' Stuff the style run content and style info into a memory block
  mb.BooleanValue(startLength+0) = sr.Bold
  mb.BooleanValue(startLength+1) = sr.Italic
  mb.BooleanValue(startLength+2) = sr.Underline
  mb.ColorValue(startLength+3, 32) = sr.TextColor
  mb.Int32Value(startLength+7) = sr.FontSize
   
  mb.Int32Value(startLength+11) = fontLen
  mb.Int32Value(startLength+15) = textLen
  mb.CString(startLength+19) = sr.FontName
  mb.CString(startLength+19+fontLen) = sr.Text 
 Next

Return mb

'  TextAreaFromMemB
'  Input: mb As MemoryBlock created by TextAreaToMemB

Var sta As StyledText
Var pos, staticInfo As Integer
Var sr As StyleRun
Var  stFontLen, stTextLen As Integer   

staticInfo = 1 + 1 + 1 + 4 + 4 + 4 + 4' bold italic underline textcolor fontsize fontnamelength textlength  - fontName and text appear next
pos = 0
sta = New StyledText
While pos < mb.Size 
  sr = New StyleRun
  sr.Bold = mb.BooleanValue(pos+0) 
  sr.Italic = mb.BooleanValue(pos+1)
  sr.Underline = mb.BooleanValue(pos+2)
  sr.TextColor = mb.ColorValue(pos+3, 32)
  sr.FontSize = mb.Long(pos+7)
  stFontLen = mb.Long(pos+11)
  stTextLen = mb.Long(pos+15)
  
  pos = pos + 19 ' fontName starts here 
  sr.FontName = mb.CString(pos).DefineEncoding(Encodings.ASCII) 
  sr.Text = mb.CString(pos+stFontLen).DefineEncoding(Encodings.ASCII)
  
  sta.AddStyleRun(sr)
  
  pos = pos+stFontLen+stTextLen+1
  
Wend

Return sta
3

Revised: After more testing it looks like ASCII and the other encodings used so far affect the characters that will be displayed, so not a good solution for all keyboard characters.

4

Also replace “Length” with “Bytes”

textLen = sr.Text.Bytes + 1 ’ +1 sets the null byte
fontLen = sr.FontName.Bytes + 1

6

This seems to be a workable solution to loading and unloading StyledText in a form by using StyleRuns.
It uses UTF-8, which is the only way that seems to preserve all characters.
Using UTF-8 slowed creating a StyledText (3 minutes to display a large complex styled text area) until a change from

myStyledText = TextAreaFromRString(mySavedStyleRuns)
to
TextAreaFromRString(myStyledText, mySavedStyleRuns) makes the process very quick.
Also switched to using string rather than memoryblock, which feels more flexible and unexpectedly benchmarked almost twice as fast.

updated withmore efficient code:

=============================================

// Sample call to copy one TextArea to another
Var myCodedStyleRuns As String
myCodedStyleRuns=TextAreaToRString(TA1.StyledText)
TA2.Text=""
TextAreaFromRString(TA2.StyledText, myCodedStyleRuns)

=============================================

// TextAreaToRString - 2025.01
// Input: sta As StyledText, outString As String (pass "" To avoid appending)
// Build a string representing the StyleRuns of a StyledText

Var sr As StyleRun
Var i, Count As Integer  
Var thisval As String = ""
Var delim As String = Chr(3)
Var repeatF As String = Chr(5)
Var lastTextColor As String = ""
Var lastFontName As String = ""


Count = sta.StyleRunCount ' Get the number of styles
 
Var runs() As String
runs.add("V1")  ' leave space for a header or version

For i = 0 To Count - 1 ' send the StyleRuns to the array with some "compression" attempts
  sr = sta.StyleRun(i) 
  runs.add(sr.Bold.ToString.Left(1))  // just store T or F
  runs.add(sr.Italic.ToString.Left(1))
  runs.add(sr.Underline.ToString.Left(1))
  
  thisVal = sr.TextColor.ToString 
  If thisval = lastTextColor Then  // store repeatF if the last used Color is the same
    thisval=repeatF
  Else
    lastTextColor=thisval
  End If
  runs.add(thisval)
  
  runs.add(sr.FontSize.ToString(Locale.Current, "####"))
  
  thisVal = sr.FontName   
  If thisval = lastFontName Then  // store repeatF if the last used Font is the same
    thisval=repeatF
  Else
    lastFontName=thisval
  End If
  runs.add(thisval)
  
  runs.add(sr.Text)
  
 Next

Return String.FromArray(runs,delim) '  pack into a string

=============================================

//  TextAreaFromRString - 2025.01
//  Input: sta As StyledText, inString As string from the TextAreaToRString method
//  Build a StyledText from a string of StyleRuns

Var sr As StyleRun 
Var runs() As String
Var thisColorVal, thisFontNameVal As String = ""

Var delim As String = Chr(3)
Var repeatF As String = Chr(5)
Var lastTextColor As Color
Var lastFontName As String = ""

If inString <> "" Then
  runs = inString.ToArray(delim) 
  If runs(0)="V1" Then
    Var startF As Integer = 1 
    Var currentOffset As Integer = 0
    sr = New StyleRun  // moving this outside the loop speeds up x10
    For i As Integer = 0 To runs.LastIndex-1 Step 7
      currentOffset = startF + i
      sr.Bold = (runs(currentOffset+0)="T")
      sr.Italic = (runs(currentOffset+1)="T")
      sr.Underline = (runs(currentOffset+2)="T")
      
      thisColorVal= runs(currentOffset+3)  // decide whether to use the last value
      If thisColorVal <> repeatF Then  
        lastTextColor=Color.FromString(thisColorVal)
      End If 
      sr.TextColor = lastTextColor
      
      sr.FontSize = runs(currentOffset+4).ToInteger
      
      thisFontNameVal= runs(currentOffset+5)  // decide whether to use the last value
      If thisFontNameVal <> repeatF Then 
        lastFontName=thisFontNameVal
      End If 
      sr.FontName = lastFontName
      
      sr.Text = runs(currentOffset+6).DefineEncoding(Encodings.UTF8) 
      
      sta.AddStyleRun(sr)
      
    Next
   End If
End If