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' Licensed to the Apache Software Foundation (ASF) under one 9' or more contributor license agreements. See the NOTICE file 10' distributed with this work for additional information 11' regarding copyright ownership. The ASF licenses this file 12' to you under the Apache License, Version 2.0 (the 13' "License"); you may not use this file except in compliance 14' with the License. You may obtain a copy of the License at 15' 16' http://www.apache.org/licenses/LICENSE-2.0 17' 18' Unless required by applicable law or agreed to in writing, 19' software distributed under the License is distributed on an 20' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 21' KIND, either express or implied. See the License for the 22' specific language governing permissions and limitations 23' under the License. 24' 25'************************************************************************* 26 27 28 29 30 31' Be sure that all variables are dimensioned: 32option explicit 33 34 35 36 37Sub RunTest() 38 39'************************************************************************* 40' INTERFACE: 41' com.sun.star.accessibility.XAccessibleComponent 42'************************************************************************* 43On Error Goto ErrHndl 44 Dim bOK As Boolean 45 46 Test.StartMethod("getBounds()") 47 Dim bounds As new com.sun.star.awt.Rectangle 48 Dim X1,Y1 As Integer 49 bOK = true 50 bounds = oObj.getBounds() 51 X1 = bounds.X+bounds.Width 52 Y1 = bounds.Y+bounds.Height 53 Out.Log("Object's bounding box: ("+bounds.X+","+bounds.Y+","+X1+","+Y1+").") 54 bOK = bOK AND (NOT isNull(bounds)) AND (bounds.X >= 0) AND (bounds.Y >= 0) _ 55 AND (bounds.Width > 0) AND (bounds.Height > 0) 56 Test.MethodTested("getBounds()",bOK) 57 58 Test.StartMethod("contains()") 59 Dim point1 As new com.sun.star.awt.Point 60 Dim point2 As new com.sun.star.awt.Point 61 bOK = true 62 point1.X = bounds.Width + 1 63 point1.Y = bounds.Height + 1 64 point2.X = 0 65 point2.Y = 0 66 bOK = bOK AND (NOT oObj.contains(point1)) AND oObj.contains(point2) 67 Test.MethodTested("contains()",bOK) 68 69 Test.StartMethod("getAccessibleAt()") 70 Dim accAt As Object, oChild As Object 71 Dim i As Integer, childCount As Long, mCount As Integer 72 Dim chBounds As new com.sun.star.awt.Rectangle 73 Dim locRes As Boolean 74 Dim ComponentFound As Boolean 75 Dim visibleFound as Boolean 76 Dim XAccessibleSelection as Boolean 77 78 bOK = true 79 childCount = oObj.getAccessibleChildCount() 80 if (childCount = 0) then 81 Out.Log("There are no children supported by XAccessibleComponent...") 82 else 83 Out.Log("There are "+childCount+" children supported by XAccessibleComponent.") 84 if (childCount > 50) then 85 mCount = 50 86 Out.Log("Checking only first 50 children...") 87 else 88 mCount = childCount 89 End If 90 ComponentFound = false 91 visibleFound = false 92 XAccessibleSelection = hasUNOInterfaces(oObj, "drafts.com.sun.star.accessibility.XAccessibleSelection") 93 for i = 0 to (mCount - 1) 94 oChild = oObj.getAccessibleChild(i) 95 if NOT hasUNOInterfaces(oChild,"drafts.com.sun.star.accessibility.XAccessibleContext") then 96 oChild = oChild.getAccessibleContext() 97 End If 98 if hasUNOInterfaces(oChild,"drafts.com.sun.star.accessibility.XAccessibleComponent") then 99 ComponentFound = TRUE 100 if XAccessibleSelection then 101 if oObj.isAccessibleChildSelected(i) then 102 visibleFound = TRUE 103 End If 104 End If 105 oChild = oChild.getAccessibleContext() 106 chBounds = oChild.getBounds() 107 point1.X = chBounds.X 108 point1.Y = chBounds.Y 109 accAt = oObj.getAccessibleAt(point1) 110 locRes = utils.at_equals(accAt,oChild) 111 Out.log(" getAccessibleAt() with valid points with child " + i + ": " + locRes) 112 bOK = bOK AND locRes 113 point2.X = chBounds.X - 1 114 point2.Y = chBounds.Y - 1 115 accAt = oObj.getAccessibleAt(point2) 116 locRes = NOT utils.at_equals(accAt,oChild) 117 Out.log(" getAccessibleAt() with invalid points with child " + i + ": " + locRes) 118 bOK = bOK AND locRes 119 End If 120 next i 121 if not ComponentFound then 122 Out.Log("Could not find any children which supports XAccessibleComponent!") 123 bOK = TRUE 124 end if 125 if not visibleFound then 126 Out.Log("Could not find any children which is visible!") 127 bOK = TRUE 128 end if 129 End If 130 Test.MethodTested("getAccessibleAt()",bOK) 131 132 Test.StartMethod("getLocation()") 133 bOK = true 134 point1 = oObj.getLocation() 135 bOK = bOK AND (point1.X = bounds.X) AND (point1.Y = bounds.Y) 136 Test.MethodTested("getLocation()",bOK) 137 138 Test.StartMethod("getLocationOnScreen()") 139 Dim accParent As Object 140 bOK = true 141 accParent = getParentComponent() 142 point1 = oObj.getLocationOnScreen() 143 if NOT isNull(accParent) then 144 point2 = accParent.getLocationOnScreen() 145 bOK = bOK AND (point2.X + bounds.X = point1.X) 146 bOK = bOK AND (point2.Y + bounds.Y = point1.Y) 147 else 148 Out.Log("Component's parent is null.") 149 End If 150 Test.MethodTested("getLocationOnScreen()",bOK) 151 152 Test.StartMethod("getSize()") 153 Dim oSize As new com.sun.star.awt.Size 154 bOK = true 155 oSize = oObj.getSize() 156 bOK = bOK AND (oSize.Width = bounds.Width) AND (oSize.Height = bounds.Height) 157 Test.MethodTested("getSize()",bOK) 158 159 Test.StartMethod("grabFocus()") 160 bOK = true 161 oObj.grabFocus() 162 Test.MethodTested("grabFocus()",bOK) 163 164 Test.StartMethod("getForeground()") 165 Dim fColor As Long 166 bOK = true 167 fColor = oObj.getForeground() 168 Out.Log("Foreground color is: "+fColor) 169 Test.MethodTested("getForeground()",bOK) 170 171 Test.StartMethod("getBackground()") 172 Dim bColor As Long 173 bOK = true 174 bColor = oObj.getBackground() 175 Out.Log("Background color is: "+bColor) 176 Test.MethodTested("getBackground()",bOK) 177 178 179 180 181Exit Sub 182ErrHndl: 183 Test.Exception() 184 bOK = false 185 resume next 186End Sub 187 188 189Function getAccessibleChildren() As Variant 190 Dim accCount As Integer, i As Integer, j As Integer 191 Dim accChContext As Object, accCh As Object 192 Dim resArray(50) As Variant 193 Dim emptyArray() As Variant 194 j = 0 195 i = 0 196 if NOT hasUNOInterfaces(oObj,"drafts.com.sun.star.accessibility.XAccessible") then 197 Out.Log("An object does not support XAccessible interface!") 198 Exit Function 199 End If 200 accCount = oObj.getAccessibleChildCount() 201 if (accCount > 50) then accCount = 50 202 while (i < accCount) 203 accCh = oObj.getAccessibleChild(i) 204 accChContext = accCh.getAccessibleContext() 205 if hasUNOInterfaces(accChContext,"drafts.com.sun.star.accessibility.XAccessibleComponent") then 206 resArray(j) = accChContext 207 j = j + 1 208 End If 209 i = i + 1 210 wend 211 if (accCount <> 0) then 212 Dim returnArray(j - 1) As Variant 213 For i = 0 to (j - 1) 214 returnArray(i) = resArray(i) 215 next i 216 getAccessibleChildren() = returnArray() 217 else 218 getAccessibleChildren() = emptyArray() 219 End If 220End Function 221 222Function getParentComponent() As Object 223 Dim accParent As Object 224 Dim accParContext As Object 225 if NOT hasUNOInterfaces(oObj,"drafts.com.sun.star.accessibility.XAccessible") then 226 Out.Log("An object does not support XAccessible interface!") 227 Exit Function 228 End If 229 accParent = oObj.getAccessibleParent() 230 if isNull(accParent) then 231 Out.Log("The component has no accessible parent!") 232 Exit Function 233 End If 234 accParContext = accParent.getAccessibleContext() 235 if NOT hasUNOInterfaces(accParContext,"drafts.com.sun.star.accessibility.XAccessibleComponent") then 236 Out.Log("Accessible parent doesn't support XAccessibleComponent!") 237 Exit Function 238 else 239 getParentComponent() = accParContext 240 End If 241End Function 242</script:module> 243