1<?xml version="1.0" encoding="UTF-8"?> 2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3<script:module xmlns:script="http://openoffice.org/2000/script" script:name="accessibility_XAccessibleComponent" script:language="StarBasic"> 4 5 6'************************************************************************* 7' 8' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. 9' 10' Copyright 2000, 2010 Oracle and/or its affiliates. 11' 12' OpenOffice.org - a multi-platform office productivity suite 13' 14' This file is part of OpenOffice.org. 15' 16' OpenOffice.org is free software: you can redistribute it and/or modify 17' it under the terms of the GNU Lesser General Public License version 3 18' only, as published by the Free Software Foundation. 19' 20' OpenOffice.org is distributed in the hope that it will be useful, 21' but WITHOUT ANY WARRANTY; without even the implied warranty of 22' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23' GNU Lesser General Public License version 3 for more details 24' (a copy is included in the LICENSE file that accompanied this code). 25' 26' You should have received a copy of the GNU Lesser General Public License 27' version 3 along with OpenOffice.org. If not, see 28' <http://www.openoffice.org/license.html> 29' for a copy of the LGPLv3 License. 30' 31'************************************************************************* 32'************************************************************************* 33 34 35 36' Be sure that all variables are dimensioned: 37option explicit 38 39 40 41 42Sub RunTest() 43 44'************************************************************************* 45' INTERFACE: 46' com.sun.star.accessibility.XAccessibleComponent 47'************************************************************************* 48On Error Goto ErrHndl 49 Dim bOK As Boolean 50 51 Test.StartMethod("getBounds()") 52 Dim bounds As new com.sun.star.awt.Rectangle 53 Dim X1,Y1 As Integer 54 bOK = true 55 bounds = oObj.getBounds() 56 X1 = bounds.X+bounds.Width 57 Y1 = bounds.Y+bounds.Height 58 Out.Log("Object's bounding box: ("+bounds.X+","+bounds.Y+","+X1+","+Y1+").") 59 bOK = bOK AND (NOT isNull(bounds)) AND (bounds.X >= 0) AND (bounds.Y >= 0) _ 60 AND (bounds.Width > 0) AND (bounds.Height > 0) 61 Test.MethodTested("getBounds()",bOK) 62 63 Test.StartMethod("contains()") 64 Dim point1 As new com.sun.star.awt.Point 65 Dim point2 As new com.sun.star.awt.Point 66 bOK = true 67 point1.X = bounds.Width + 1 68 point1.Y = bounds.Height + 1 69 point2.X = 0 70 point2.Y = 0 71 bOK = bOK AND (NOT oObj.contains(point1)) AND oObj.contains(point2) 72 Test.MethodTested("contains()",bOK) 73 74 Test.StartMethod("getAccessibleAt()") 75 Dim accAt As Object, oChild As Object 76 Dim i As Integer, childCount As Long, mCount As Integer 77 Dim chBounds As new com.sun.star.awt.Rectangle 78 Dim locRes As Boolean 79 Dim ComponentFound As Boolean 80 Dim visibleFound as Boolean 81 Dim XAccessibleSelection as Boolean 82 83 bOK = true 84 childCount = oObj.getAccessibleChildCount() 85 if (childCount = 0) then 86 Out.Log("There are no children supported by XAccessibleComponent...") 87 else 88 Out.Log("There are "+childCount+" children supported by XAccessibleComponent.") 89 if (childCount > 50) then 90 mCount = 50 91 Out.Log("Checking only first 50 children...") 92 else 93 mCount = childCount 94 End If 95 ComponentFound = false 96 visibleFound = false 97 XAccessibleSelection = hasUNOInterfaces(oObj, "drafts.com.sun.star.accessibility.XAccessibleSelection") 98 for i = 0 to (mCount - 1) 99 oChild = oObj.getAccessibleChild(i) 100 if NOT hasUNOInterfaces(oChild,"drafts.com.sun.star.accessibility.XAccessibleContext") then 101 oChild = oChild.getAccessibleContext() 102 End If 103 if hasUNOInterfaces(oChild,"drafts.com.sun.star.accessibility.XAccessibleComponent") then 104 ComponentFound = TRUE 105 if XAccessibleSelection then 106 if oObj.isAccessibleChildSelected(i) then 107 visibleFound = TRUE 108 End If 109 End If 110 oChild = oChild.getAccessibleContext() 111 chBounds = oChild.getBounds() 112 point1.X = chBounds.X 113 point1.Y = chBounds.Y 114 accAt = oObj.getAccessibleAt(point1) 115 locRes = utils.at_equals(accAt,oChild) 116 Out.log(" getAccessibleAt() with valid points with child " + i + ": " + locRes) 117 bOK = bOK AND locRes 118 point2.X = chBounds.X - 1 119 point2.Y = chBounds.Y - 1 120 accAt = oObj.getAccessibleAt(point2) 121 locRes = NOT utils.at_equals(accAt,oChild) 122 Out.log(" getAccessibleAt() with invalid points with child " + i + ": " + locRes) 123 bOK = bOK AND locRes 124 End If 125 next i 126 if not ComponentFound then 127 Out.Log("Could not find any children which supports XAccessibleComponent!") 128 bOK = TRUE 129 end if 130 if not visibleFound then 131 Out.Log("Could not find any children which is visible!") 132 bOK = TRUE 133 end if 134 End If 135 Test.MethodTested("getAccessibleAt()",bOK) 136 137 Test.StartMethod("getLocation()") 138 bOK = true 139 point1 = oObj.getLocation() 140 bOK = bOK AND (point1.X = bounds.X) AND (point1.Y = bounds.Y) 141 Test.MethodTested("getLocation()",bOK) 142 143 Test.StartMethod("getLocationOnScreen()") 144 Dim accParent As Object 145 bOK = true 146 accParent = getParentComponent() 147 point1 = oObj.getLocationOnScreen() 148 if NOT isNull(accParent) then 149 point2 = accParent.getLocationOnScreen() 150 bOK = bOK AND (point2.X + bounds.X = point1.X) 151 bOK = bOK AND (point2.Y + bounds.Y = point1.Y) 152 else 153 Out.Log("Component's parent is null.") 154 End If 155 Test.MethodTested("getLocationOnScreen()",bOK) 156 157 Test.StartMethod("getSize()") 158 Dim oSize As new com.sun.star.awt.Size 159 bOK = true 160 oSize = oObj.getSize() 161 bOK = bOK AND (oSize.Width = bounds.Width) AND (oSize.Height = bounds.Height) 162 Test.MethodTested("getSize()",bOK) 163 164 Test.StartMethod("grabFocus()") 165 bOK = true 166 oObj.grabFocus() 167 Test.MethodTested("grabFocus()",bOK) 168 169 Test.StartMethod("getForeground()") 170 Dim fColor As Long 171 bOK = true 172 fColor = oObj.getForeground() 173 Out.Log("Foreground color is: "+fColor) 174 Test.MethodTested("getForeground()",bOK) 175 176 Test.StartMethod("getBackground()") 177 Dim bColor As Long 178 bOK = true 179 bColor = oObj.getBackground() 180 Out.Log("Background color is: "+bColor) 181 Test.MethodTested("getBackground()",bOK) 182 183 184 185 186Exit Sub 187ErrHndl: 188 Test.Exception() 189 bOK = false 190 resume next 191End Sub 192 193 194Function getAccessibleChildren() As Variant 195 Dim accCount As Integer, i As Integer, j As Integer 196 Dim accChContext As Object, accCh As Object 197 Dim resArray(50) As Variant 198 Dim emptyArray() As Variant 199 j = 0 200 i = 0 201 if NOT hasUNOInterfaces(oObj,"drafts.com.sun.star.accessibility.XAccessible") then 202 Out.Log("An object does not support XAccessible interface!") 203 Exit Function 204 End If 205 accCount = oObj.getAccessibleChildCount() 206 if (accCount > 50) then accCount = 50 207 while (i < accCount) 208 accCh = oObj.getAccessibleChild(i) 209 accChContext = accCh.getAccessibleContext() 210 if hasUNOInterfaces(accChContext,"drafts.com.sun.star.accessibility.XAccessibleComponent") then 211 resArray(j) = accChContext 212 j = j + 1 213 End If 214 i = i + 1 215 wend 216 if (accCount <> 0) then 217 Dim returnArray(j - 1) As Variant 218 For i = 0 to (j - 1) 219 returnArray(i) = resArray(i) 220 next i 221 getAccessibleChildren() = returnArray() 222 else 223 getAccessibleChildren() = emptyArray() 224 End If 225End Function 226 227Function getParentComponent() As Object 228 Dim accParent As Object 229 Dim accParContext As Object 230 if NOT hasUNOInterfaces(oObj,"drafts.com.sun.star.accessibility.XAccessible") then 231 Out.Log("An object does not support XAccessible interface!") 232 Exit Function 233 End If 234 accParent = oObj.getAccessibleParent() 235 if isNull(accParent) then 236 Out.Log("The component has no accessible parent!") 237 Exit Function 238 End If 239 accParContext = accParent.getAccessibleContext() 240 if NOT hasUNOInterfaces(accParContext,"drafts.com.sun.star.accessibility.XAccessibleComponent") then 241 Out.Log("Accessible parent doesn't support XAccessibleComponent!") 242 Exit Function 243 else 244 getParentComponent() = accParContext 245 End If 246End Function 247</script:module> 248