https://bugs.documentfoundation.org/show_bug.cgi?id=170929
--- Comment #5 from Roland Baudin <[email protected]> --- OK, thanks to https://bugs.documentfoundation.org/show_bug.cgi?id=170796#c9 I was able to fix my macro that tests if the visible cursor is within a text box. The code is below (works in version 26.2 and previous). Note that in Windows and Mac OS, when the text box itself is selected (the visible cursor is not within the text box) the macro does not return the correct answer, while in Linux it works reliably. For sure, we need a simpler way... ' Based on the following posts on the Openoffice forum ' https://forum.openoffice.org/en/forum/viewtopic.php?t=101034 ' https://forum.openoffice.org/en/forum/viewtopic.php?t=81353 ' The following bug report is also useful ' https://bugs.documentfoundation.org/show_bug.cgi?id=170796 Sub IsCursorInTextBox Dim oDoc As Variant Dim oController As Variant oDoc = ThisComponent oDocCtrl = oDoc.getCurrentController() ' Writer or Calc document (transferable is only supported in Writer or Calc) If oDoc.SupportsService("com.sun.star.text.TextDocument") Then Dim Transferable as Variant Transferable = oDocCtrl.getTransferable() Dim DataFlavor as new com.sun.star.datatransfer.DataFlavor DataFlavor.mimetype = "text/plain;charset=utf-16" If Not Transferable.isDataFlavorSupported(DataFlavor) Then msgbox "Writer => Cursor is NOT in a text box" else msgbox "Writer => Cursor is in a tex box" End If ' Other document type (Impress or Draw) ' Use a method based on the accessible context tree Else ' Get list of commands Dim oList as Variant GlobalScope.BasicLibraries.LoadLibrary("Tools") oList = GetRegistryKeyContent("org.openoffice.Office.UI.GenericCommands") ' Get localized context label of Insert Symbol command (remove tilde character if present) Dim contextLabel as String contextLabel = RemoveTilde( oList.getByName("UserInterface").getByName("Commands").getByName(".uno:InsertSymbol").ContextLabel ) ' Obtain accessible context Dim oAccessibleContext as Variant, oWindow as Variant oWindow = oDocCtrl.getFrame().getComponentWindow() ' API has changed from LibreOffice 26.2 If Val( GetAppVersion() ) >= 26.2 Then oAccessibleContext = FindAccessibleRoot(oWindow.getProperty("XAccessible")) Else oAccessibleContext = oWindow.getAccessibleContext().getAccessibleParent().getAccessibleContext() End If ' Recursive function that traverses the accessible context tree Dim inTextBox as Boolean inTextBox = MenuItemStatus(oAccessibleContext, contextLabel) If inTextBox = FALSE Then msgbox "Impress or Draw => Cursor is NOT in a text box" Else msgbox "Impress or Draw => Cursor is in a text box" End If End If End Sub ' Recursive function used by IsCursorInTextBox Function MenuItemStatus(oAccessibleContext as Variant, contextLabel as String) as Boolean Dim oChild as Variant, oChildAccessibleContext as Variant Dim i as Integer, n as Integer ' Initialize result MenuItemStatus = TRUE ' Loop on childs n = oAccessibleContext.AccessibleChildCount For i = 0 to n - 1 ' Child and its accessible context On Error GoTo EndFunc oChild = oAccessibleContext.getAccessibleChild(i) oChildAccessibleContext = oChild.getAccessibleContext() ' Recurse if there is still childs If oChildAccessibleContext.AccessibleChildCount > 0 Then ' End recursion if menu item found If MenuItemStatus(oChildAccessibleContext, contextLabel) = FALSE Then MenuItemStatus = FALSE Exit For End If End If ' Restrict to menu items If oChildAccessibleContext.getAccessibleRole() = com.sun.star.accessibility.AccessibleRole.MENU_ITEM Then If oChildAccessibleContext.getAccessibleName() = contextLabel Then ' Check state Dim val as Integer val = oChildAccessibleContext.AccessibleStateSet And com.sun.star.accessibility.AccessibleStateType.ENABLED If val = 0 Then MenuItemStatus = FALSE Exit For End If End If End If Next i EndFunc: End Function ' Hierarchically search AccessibleContext up to root object ' Input oAccContext Object (supports AccessibleContext service) ' Used by IsCursorInTextBox ' Author? Function FindAccessibleRoot(ByVal oAccContext) As Object Dim oAccParent as Variant, i As Long oAccParent = oAccContext.AccessibleParent Do While True FindAccessibleRoot = oAccParent i = i + 1 oAccParent = oAccParent.AccessibleContext.AccessibleParent If oAccParent Is Nothing Or i > 100 Then Exit Do End If Loop End Function ' Remove tilde characters in String ' Used by IsCursorInTextBox Function RemoveTilde( ByVal str as String ) as String Dim result as String Dim c as String Dim i as Integer result = "" For i = 1 To Len( str ) c = Mid( str, i, 1 ) If c <> "~" Then result = result & c Next RemoveTilde = result End Function -- You are receiving this mail because: You are the assignee for the bug.
