[Solved] Modify character properties within Writer selection

[pansmanse]

In a Writer Basic macro, I am trying to decrease/increase the font size of every character within the selection. This subroutine works well, but operates over the whole document, not just the selection. Can I limit the range to the selected text?

Code: Select all

Sub FontDown
rem Increase the font of each character in selection by 1.
Dim CharHeight As Long, oSel as Object, oTC as Object
Dim oParEnum as Object, oPar as Object, oSecEnum as Object, oSec as Object
Dim oVC as Object, oText As Object

  oText = ThisComponent.Text
  oSel = ThisComponent.CurrentSelection.getByIndex(0) 'get the current selection
  oTC = oText.createTextCursorByRange(oSel)           ' and span it with a cursor

rem Scan the cursor range for chunks of given text size.
rem (Doesn't work - affects the whole document)

  oParEnum = oTC.Text.createEnumeration()
    Do While oParEnum.hasMoreElements()
      oPar = oParEnum.nextElement()
    
      If oPar.supportsService("com.sun.star.text.Paragraph") Then
        oSecEnum = oPar.createEnumeration()
        Do While oSecEnum.hasMoreElements()
          oSec = oSecEnum.nextElement()
          If oSec.TextPortionType = "Text" Then
            CharHeight = oSec.CharHeight
            oSec.CharHeight = CharHeight - 1
          End If
        Loop
      End If

    Loop

End Sub

[B Marcelly]

Hi,
Here is a simpler solution:

Code: Select all

sub Main
  FontUpDown(+4)
end sub


Sub FontUpDown(incrValue As integer)
Dim visibleCursor As Object, thisText As Object, myCursor As Object

visibleCursor = ThisComponent.CurrentController.ViewCursor
thisText = visibleCursor.Text
myCursor = thisText.createTextCursorByRange(visibleCursor.Start)

Do While thisText.compareRegionEnds(myCursor, visibleCursor) > 0
  if not myCursor.goRight(1, True)  then Exit Sub
  myCursor.CharHeight =  myCursor.CharHeight + incrValue
  myCursor.collapseToEnd
Loop
End Sub

[pansmanse]

Thank you, Bernard.

I have tried a solution very like this (although yours is neater!).

However working with characters individually is very slow. Working with text portions could be very much faster. But as far as I can see, text protions have to be enumerated across paragraphs, and are niether a property of the selection nor of the cursor.

[B Marcelly]

What is slow is screen updating. This variant changes 5 pages full of text in 7 seconds.

Code: Select all

Sub FontUpDown(incrValue As integer)
Dim visibleCursor As Object, thisText As Object, myCursor As Object

visibleCursor = ThisComponent.CurrentController.ViewCursor
thisText = visibleCursor.Text
myCursor = thisText.createTextCursorByRange(visibleCursor.Start)

ThisComponent.lockControllers
Do While thisText.compareRegionEnds(myCursor, visibleCursor) > 0
  if not myCursor.goRight(1, True)  then Exit Sub
  myCursor.CharHeight =  myCursor.CharHeight + incrValue
  myCursor.collapseToEnd
Loop
ThisComponent.unlockControllers
End Sub

I tried to work by blocks of same CharHeight, it is not quicker.

Of course, if your text used styles, a change of char size would have been easily done without macros.

[pansmanse]

Yes, that is brilliant, thank you B Marcelly.
I could suggest a small variation: the Do loop should test at the end, not the beginning, so that where there is no selection, the single character at the viewcursor is changed. Thus we have:

Sub FontUpDown(incrValue As integer)
Dim visibleCursor As Object, thisText As Object, myCursor As Object

visibleCursor = ThisComponent.CurrentController.ViewCursor
thisText = visibleCursor.Text
myCursor = thisText.createTextCursorByRange(visibleCursor.Start)

ThisComponent.lockControllers
Do
if not myCursor.goRight(1, True) then Exit Sub
myCursor.CharHeight = myCursor.CharHeight + incrValue
myCursor.collapseToEnd
Loop While thisText.compareRegionEnds(myCursor, visibleCursor) > 0
ThisComponent.unlockControllers
End Sub

Again, thanks to you both.