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 37' Be sure that all variables are dimensioned: 38option explicit 39 40 41 42 43Sub RunTest() 44 45'************************************************************************* 46' INTERFACE: 47' com.sun.star.accessibility.XAccessibleComponent 48'************************************************************************* 49On Error Goto ErrHndl 50 Dim bOK As Boolean 51 52 Test.StartMethod("getBounds()") 53 Dim bounds As new com.sun.star.awt.Rectangle 54 Dim X1,Y1 As Integer 55 bOK = true 56 bounds = oObj.getBounds() 57 X1 = bounds.X+bounds.Width 58 Y1 = bounds.Y+bounds.Height 59 Out.Log("Object's bounding box: ("+bounds.X+","+bounds.Y+","+X1+","+Y1+").") 60 bOK = bOK AND (NOT isNull(bounds)) AND (bounds.X >= 0) AND (bounds.Y >= 0) _ 61 AND (bounds.Width > 0) AND (bounds.Height > 0) 62 Test.MethodTested("getBounds()",bOK) 63 64 Test.StartMethod("contains()") 65 Dim point1 As new com.sun.star.awt.Point 66 Dim point2 As new com.sun.star.awt.Point 67 bOK = true 68 point1.X = bounds.Width + 1 69 point1.Y = bounds.Height + 1 70 point2.X = 0 71 point2.Y = 0 72 bOK = bOK AND (NOT oObj.contains(point1)) AND oObj.contains(point2) 73 Test.MethodTested("contains()",bOK) 74 75 Test.StartMethod("getAccessibleAt()") 76 Dim accAt As Object, oChild As Object 77 Dim i As Integer, childCount As Long, mCount As Integer 78 Dim chBounds As new com.sun.star.awt.Rectangle 79 Dim locRes As Boolean 80 Dim ComponentFound As Boolean 81 Dim visibleFound as Boolean 82 Dim XAccessibleSelection as Boolean 83 84 bOK = true 85 childCount = oObj.getAccessibleChildCount() 86 if (childCount = 0) then 87 Out.Log("There are no children supported by XAccessibleComponent...") 88 else 89 Out.Log("There are "+childCount+" children supported by XAccessibleComponent.") 90 if (childCount > 50) then 91 mCount = 50 92 Out.Log("Checking only first 50 children...") 93 else 94 mCount = childCount 95 End If 96 ComponentFound = false 97 visibleFound = false 98 XAccessibleSelection = hasUNOInterfaces(oObj, "drafts.com.sun.star.accessibility.XAccessibleSelection") 99 for i = 0 to (mCount - 1) 100 oChild = oObj.getAccessibleChild(i) 101 if NOT hasUNOInterfaces(oChild,"drafts.com.sun.star.accessibility.XAccessibleContext") then 102 oChild = oChild.getAccessibleContext() 103 End If 104 if hasUNOInterfaces(oChild,"drafts.com.sun.star.accessibility.XAccessibleComponent") then 105 ComponentFound = TRUE 106 if XAccessibleSelection then 107 if oObj.isAccessibleChildSelected(i) then 108 visibleFound = TRUE 109 End If 110 End If 111 oChild = oChild.getAccessibleContext() 112 chBounds = oChild.getBounds() 113 point1.X = chBounds.X 114 point1.Y = chBounds.Y 115 accAt = oObj.getAccessibleAt(point1) 116 locRes = utils.at_equals(accAt,oChild) 117 Out.log(" getAccessibleAt() with valid points with child " + i + ": " + locRes) 118 bOK = bOK AND locRes 119 point2.X = chBounds.X - 1 120 point2.Y = chBounds.Y - 1 121 accAt = oObj.getAccessibleAt(point2) 122 locRes = NOT utils.at_equals(accAt,oChild) 123 Out.log(" getAccessibleAt() with invalid points with child " + i + ": " + locRes) 124 bOK = bOK AND locRes 125 End If 126 next i 127 if not ComponentFound then 128 Out.Log("Could not find any children which supports XAccessibleComponent!") 129 bOK = TRUE 130 end if 131 if not visibleFound then 132 Out.Log("Could not find any children which is visible!") 133 bOK = TRUE 134 end if 135 End If 136 Test.MethodTested("getAccessibleAt()",bOK) 137 138 Test.StartMethod("getLocation()") 139 bOK = true 140 point1 = oObj.getLocation() 141 bOK = bOK AND (point1.X = bounds.X) AND (point1.Y = bounds.Y) 142 Test.MethodTested("getLocation()",bOK) 143 144 Test.StartMethod("getLocationOnScreen()") 145 Dim accParent As Object 146 bOK = true 147 accParent = getParentComponent() 148 point1 = oObj.getLocationOnScreen() 149 if NOT isNull(accParent) then 150 point2 = accParent.getLocationOnScreen() 151 bOK = bOK AND (point2.X + bounds.X = point1.X) 152 bOK = bOK AND (point2.Y + bounds.Y = point1.Y) 153 else 154 Out.Log("Component's parent is null.") 155 End If 156 Test.MethodTested("getLocationOnScreen()",bOK) 157 158 Test.StartMethod("getSize()") 159 Dim oSize As new com.sun.star.awt.Size 160 bOK = true 161 oSize = oObj.getSize() 162 bOK = bOK AND (oSize.Width = bounds.Width) AND (oSize.Height = bounds.Height) 163 Test.MethodTested("getSize()",bOK) 164 165 Test.StartMethod("grabFocus()") 166 bOK = true 167 oObj.grabFocus() 168 Test.MethodTested("grabFocus()",bOK) 169 170 Test.StartMethod("getForeground()") 171 Dim fColor As Long 172 bOK = true 173 fColor = oObj.getForeground() 174 Out.Log("Foreground color is: "+fColor) 175 Test.MethodTested("getForeground()",bOK) 176 177 Test.StartMethod("getBackground()") 178 Dim bColor As Long 179 bOK = true 180 bColor = oObj.getBackground() 181 Out.Log("Background color is: "+bColor) 182 Test.MethodTested("getBackground()",bOK) 183 184 185 186 187Exit Sub 188ErrHndl: 189 Test.Exception() 190 bOK = false 191 resume next 192End Sub 193 194 195Function getAccessibleChildren() As Variant 196 Dim accCount As Integer, i As Integer, j As Integer 197 Dim accChContext As Object, accCh As Object 198 Dim resArray(50) As Variant 199 Dim emptyArray() As Variant 200 j = 0 201 i = 0 202 if NOT hasUNOInterfaces(oObj,"drafts.com.sun.star.accessibility.XAccessible") then 203 Out.Log("An object does not support XAccessible interface!") 204 Exit Function 205 End If 206 accCount = oObj.getAccessibleChildCount() 207 if (accCount > 50) then accCount = 50 208 while (i < accCount) 209 accCh = oObj.getAccessibleChild(i) 210 accChContext = accCh.getAccessibleContext() 211 if hasUNOInterfaces(accChContext,"drafts.com.sun.star.accessibility.XAccessibleComponent") then 212 resArray(j) = accChContext 213 j = j + 1 214 End If 215 i = i + 1 216 wend 217 if (accCount <> 0) then 218 Dim returnArray(j - 1) As Variant 219 For i = 0 to (j - 1) 220 returnArray(i) = resArray(i) 221 next i 222 getAccessibleChildren() = returnArray() 223 else 224 getAccessibleChildren() = emptyArray() 225 End If 226End Function 227 228Function getParentComponent() As Object 229 Dim accParent As Object 230 Dim accParContext As Object 231 if NOT hasUNOInterfaces(oObj,"drafts.com.sun.star.accessibility.XAccessible") then 232 Out.Log("An object does not support XAccessible interface!") 233 Exit Function 234 End If 235 accParent = oObj.getAccessibleParent() 236 if isNull(accParent) then 237 Out.Log("The component has no accessible parent!") 238 Exit Function 239 End If 240 accParContext = accParent.getAccessibleContext() 241 if NOT hasUNOInterfaces(accParContext,"drafts.com.sun.star.accessibility.XAccessibleComponent") then 242 Out.Log("Accessible parent doesn't support XAccessibleComponent!") 243 Exit Function 244 else 245 getParentComponent() = accParContext 246 End If 247End Function 248</script:module> 249