'************************************************************************* ' ' Licensed to the Apache Software Foundation (ASF) under one ' or more contributor license agreements. See the NOTICE file ' distributed with this work for additional information ' regarding copyright ownership. The ASF licenses this file ' to you under the Apache License, Version 2.0 (the ' "License"); you may not use this file except in compliance ' with the License. You may obtain a copy of the License at ' ' http://www.apache.org/licenses/LICENSE-2.0 ' ' Unless required by applicable law or agreed to in writing, ' software distributed under the License is distributed on an ' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY ' KIND, either express or implied. See the License for the ' specific language governing permissions and limitations ' under the License. ' '************************************************************************* ' Be sure that all variables are dimensioned: option explicit Sub RunTest() '************************************************************************* ' INTERFACE: ' com.sun.star.accessibility.XAccessibleComponent '************************************************************************* On Error Goto ErrHndl Dim bOK As Boolean Test.StartMethod("getBounds()") Dim bounds As new com.sun.star.awt.Rectangle Dim X1,Y1 As Integer bOK = true bounds = oObj.getBounds() X1 = bounds.X+bounds.Width Y1 = bounds.Y+bounds.Height Out.Log("Object's bounding box: ("+bounds.X+","+bounds.Y+","+X1+","+Y1+").") bOK = bOK AND (NOT isNull(bounds)) AND (bounds.X >= 0) AND (bounds.Y >= 0) _ AND (bounds.Width > 0) AND (bounds.Height > 0) Test.MethodTested("getBounds()",bOK) Test.StartMethod("contains()") Dim point1 As new com.sun.star.awt.Point Dim point2 As new com.sun.star.awt.Point bOK = true point1.X = bounds.Width + 1 point1.Y = bounds.Height + 1 point2.X = 0 point2.Y = 0 bOK = bOK AND (NOT oObj.contains(point1)) AND oObj.contains(point2) Test.MethodTested("contains()",bOK) Test.StartMethod("getAccessibleAt()") Dim accAt As Object, oChild As Object Dim i As Integer, childCount As Long, mCount As Integer Dim chBounds As new com.sun.star.awt.Rectangle Dim locRes As Boolean Dim ComponentFound As Boolean Dim visibleFound as Boolean Dim XAccessibleSelection as Boolean bOK = true childCount = oObj.getAccessibleChildCount() if (childCount = 0) then Out.Log("There are no children supported by XAccessibleComponent...") else Out.Log("There are "+childCount+" children supported by XAccessibleComponent.") if (childCount > 50) then mCount = 50 Out.Log("Checking only first 50 children...") else mCount = childCount End If ComponentFound = false visibleFound = false XAccessibleSelection = hasUNOInterfaces(oObj, "drafts.com.sun.star.accessibility.XAccessibleSelection") for i = 0 to (mCount - 1) oChild = oObj.getAccessibleChild(i) if NOT hasUNOInterfaces(oChild,"drafts.com.sun.star.accessibility.XAccessibleContext") then oChild = oChild.getAccessibleContext() End If if hasUNOInterfaces(oChild,"drafts.com.sun.star.accessibility.XAccessibleComponent") then ComponentFound = TRUE if XAccessibleSelection then if oObj.isAccessibleChildSelected(i) then visibleFound = TRUE End If End If oChild = oChild.getAccessibleContext() chBounds = oChild.getBounds() point1.X = chBounds.X point1.Y = chBounds.Y accAt = oObj.getAccessibleAt(point1) locRes = utils.at_equals(accAt,oChild) Out.log(" getAccessibleAt() with valid points with child " + i + ": " + locRes) bOK = bOK AND locRes point2.X = chBounds.X - 1 point2.Y = chBounds.Y - 1 accAt = oObj.getAccessibleAt(point2) locRes = NOT utils.at_equals(accAt,oChild) Out.log(" getAccessibleAt() with invalid points with child " + i + ": " + locRes) bOK = bOK AND locRes End If next i if not ComponentFound then Out.Log("Could not find any children which supports XAccessibleComponent!") bOK = TRUE end if if not visibleFound then Out.Log("Could not find any children which is visible!") bOK = TRUE end if End If Test.MethodTested("getAccessibleAt()",bOK) Test.StartMethod("getLocation()") bOK = true point1 = oObj.getLocation() bOK = bOK AND (point1.X = bounds.X) AND (point1.Y = bounds.Y) Test.MethodTested("getLocation()",bOK) Test.StartMethod("getLocationOnScreen()") Dim accParent As Object bOK = true accParent = getParentComponent() point1 = oObj.getLocationOnScreen() if NOT isNull(accParent) then point2 = accParent.getLocationOnScreen() bOK = bOK AND (point2.X + bounds.X = point1.X) bOK = bOK AND (point2.Y + bounds.Y = point1.Y) else Out.Log("Component's parent is null.") End If Test.MethodTested("getLocationOnScreen()",bOK) Test.StartMethod("getSize()") Dim oSize As new com.sun.star.awt.Size bOK = true oSize = oObj.getSize() bOK = bOK AND (oSize.Width = bounds.Width) AND (oSize.Height = bounds.Height) Test.MethodTested("getSize()",bOK) Test.StartMethod("grabFocus()") bOK = true oObj.grabFocus() Test.MethodTested("grabFocus()",bOK) Test.StartMethod("getForeground()") Dim fColor As Long bOK = true fColor = oObj.getForeground() Out.Log("Foreground color is: "+fColor) Test.MethodTested("getForeground()",bOK) Test.StartMethod("getBackground()") Dim bColor As Long bOK = true bColor = oObj.getBackground() Out.Log("Background color is: "+bColor) Test.MethodTested("getBackground()",bOK) Exit Sub ErrHndl: Test.Exception() bOK = false resume next End Sub Function getAccessibleChildren() As Variant Dim accCount As Integer, i As Integer, j As Integer Dim accChContext As Object, accCh As Object Dim resArray(50) As Variant Dim emptyArray() As Variant j = 0 i = 0 if NOT hasUNOInterfaces(oObj,"drafts.com.sun.star.accessibility.XAccessible") then Out.Log("An object does not support XAccessible interface!") Exit Function End If accCount = oObj.getAccessibleChildCount() if (accCount > 50) then accCount = 50 while (i < accCount) accCh = oObj.getAccessibleChild(i) accChContext = accCh.getAccessibleContext() if hasUNOInterfaces(accChContext,"drafts.com.sun.star.accessibility.XAccessibleComponent") then resArray(j) = accChContext j = j + 1 End If i = i + 1 wend if (accCount <> 0) then Dim returnArray(j - 1) As Variant For i = 0 to (j - 1) returnArray(i) = resArray(i) next i getAccessibleChildren() = returnArray() else getAccessibleChildren() = emptyArray() End If End Function Function getParentComponent() As Object Dim accParent As Object Dim accParContext As Object if NOT hasUNOInterfaces(oObj,"drafts.com.sun.star.accessibility.XAccessible") then Out.Log("An object does not support XAccessible interface!") Exit Function End If accParent = oObj.getAccessibleParent() if isNull(accParent) then Out.Log("The component has no accessible parent!") Exit Function End If accParContext = accParent.getAccessibleContext() if NOT hasUNOInterfaces(accParContext,"drafts.com.sun.star.accessibility.XAccessibleComponent") then Out.Log("Accessible parent doesn't support XAccessibleComponent!") Exit Function else getParentComponent() = accParContext End If End Function