The following example demonstrates how to create an instance of the
IAccessible interface for the object located at the cursor position by calling the
AccessibleObjectFromPoint API function, and how to navigate though its child objects.
' ########################################################################################
' IAccessible demo.
' ########################################################################################
' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "OLEACC.INC"
%CHILDID_SELF = 0
%IDC_TEXTBOX = 1001
' ========================================================================================
' Structure to store the position
' ========================================================================================
TYPE IAccessibleRect
left AS LONG
top AS LONG
width AS LONG
height AS LONG
END TYPE
' ========================================================================================
' ========================================================================================
' Get object from point
' ========================================================================================
FUNCTION IAccessible_GetObjectFromPoint (BYREF IAR AS IAccessibleRect, BYREF strAccName AS STRING, BYREF strAccValue AS STRING, BYREF strChildren AS STRING) AS LONG
LOCAL hr AS LONG
LOCAL pt AS POINTAPI
LOCAL pIAccessible AS IAccessible
LOCAL varChild AS VARIANT
LOCAL pxLeft AS LONG
LOCAL pyTop AS LONG
LOCAL pcxWidth AS LONG
LOCAL pcyHeight AS LONG
hr = GetCursorPos(pt)
IF hr = 0 THEN EXIT FUNCTION
hr = AccessibleObjectFromPoint(pt, pIAccessible, varChild)
IF hr <> %S_OK THEN EXIT FUNCTION
pIAccessible.accLocation(pxLeft, pyTop, pcxWidth, pcyHeight, varChild)
IF OBJRESULT = %S_OK THEN
IAR.left = pxLeft
IAR.top = pyTop
IAR.width = pcxWidth
IAR.height = pcyHeight
END IF
LOCAL bstrAccName AS STRING
bstrAccName = pIAccessible.accName(varChild)
IF OBJRESULT = %S_OK THEN
' Some versions of the Scintilla control, return the string as ANSI,
' not UNICODE! It also returns the text being edited as the name!
' This is why I'm using IsTextUnicode here; it should not be needed.
IF IsTextUnicode(STRPTR(bstrAccName), LEN(bstrAccName), BYVAL %NULL) THEN
strAccName = ACODE$(bstrAccName)
ELSE
strAccName = bstrAccName
END IF
END IF
LOCAL bstrAccValue AS STRING
bstrAccValue = pIAccessible.accValue(varChild)
IF OBJRESULT = %S_OK THEN
IF IsTextUnicode(STRPTR(bstrAccValue), LEN(bstrAccValue), BYVAL %NULL) THEN
strAccValue = ACODE$(bstrAccValue)
ELSE
strAccValue = strAccValue
END IF
END IF
' Navigate children objects to retrieve its names
LOCAL varStart AS VARIANT
varStart = %CHILDID_SELF AS LONG
varChild = pIAccessible.accNavigate(%NAVDIR_FIRSTCHILD, varStart)
DO
IF OBJRESULT <> %S_OK OR VARIANTVT(varChild) = %VT_EMPTY THEN EXIT DO
bstrAccName = pIAccessible.accName(varChild)
strChildren += "Child " & FORMAT$(VARIANT#(varChild))
strChildren += " = " & ACODE$(bstrAccName) & $CRLF
varStart = varChild
varChild = pIAccessible.accNavigate(%NAVDIR_NEXT, varStart)
LOOP
' Release the interface
pIAccessible = NOTHING
FUNCTION = %TRUE
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main dialog callback
' ========================================================================================
CALLBACK FUNCTION DlgProc() AS LONG
STATIC hTimer AS LONG
LOCAL hr AS LONG
LOCAL IAR AS IAccessibleRect
LOCAL strAccName AS STRING
LOCAL strAccValue AS STRING
LOCAL strOutput AS STRING
LOCAL strChildren AS STRING
SELECT CASE CBMSG
CASE %WM_INITDIALOG
SetWindowPos CBHNDL, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NOSIZE OR %SWP_NOMOVE
hTimer = SetTimer(CBHNDL, 123, 200, 0)
CASE %WM_TIMER
hr = IAccessible_GetObjectFromPoint(IAR, strAccName, strAccValue, strChildren)
strOutput = "x = " & FORMAT$(IAR.left) & " y = " & FORMAT$(IAR.top) & " Width = " & FORMAT$(IAR.width) & " Height = " & FORMAT$(IAR.height) & $CRLF
strOutput += "Name = " & strAccName & $CRLF & "Value = " & strAccValue & $CRLF
strOutput += strChildren
CONTROL SET TEXT CBHNDL, %IDC_TEXTBOX, strOutput
CASE %WM_DESTROY
KillTimer CBHNDL, hTimer
SetWindowPos CBHNDL, %HWND_NOTOPMOST, 0, 0, 0, 0, %SWP_NOSIZE OR %SWP_NOMOVE
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE %IDCANCEL
IF CBCTLMSG = %BN_CLICKED THEN DIALOG END CBHNDL, 0
END SELECT
END SELECT
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG
LOCAL hDlg AS DWORD
DIALOG NEW 0, "IAccessible Demo",,, 350, 150, %WS_CAPTION OR %WS_SYSMENU, 0 TO hDlg
CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX, "", 4, 4, 340, 140,%ES_MULTILINE OR %ES_WANTRETURN OR %WS_VSCROLL, %WS_EX_CLIENTEDGE
DIALOG SHOW MODAL hDlg CALL DlgProc
END FUNCTION
' ========================================================================================
A reference guide, adapted to the PowerBASIC syntax, is available in my web site: http://www.jose.it-berater.org/oleacc/iframe/index.htm