Fixes accessibility for TMemo in LCL-Carbon

git-svn-id: trunk@35094 -
This commit is contained in:
sekelsenmat 2012-02-02 20:17:58 +00:00
parent 5c9cd1a9ed
commit fb1ea909c4
2 changed files with 65 additions and 2 deletions

View File

@ -25,6 +25,60 @@
{ TCarbonWidgetSet }
{
This event handler will fix the focus indication in AXApplication for
standard controls where it gets it wrong. Necessary to support accessibility
for TMemo / TEdit for example
}
function AppAccessibilityEventHandler(inHandlerCallRef: EventHandlerCallRef;
inEvent: EventRef;
inUserData: Pointer): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
var
lAXRole, lInputStr: CFStringRef;
lInputAXObject: AXUIElementRef;
EventKind: UInt32;
lInputPasStr: string;
lElement, lElement2: AXUIElementRef;
lAXArray: CFMutableArrayRef;
begin
Result := CallNextEventHandler(inHandlerCallRef, inEvent);
GetEventParameter(inEvent, kEventParamAccessibleObject,
typeCFTypeRef, nil, SizeOf(AXUIElementRef), nil, @lInputAXObject);
EventKind := GetEventKind(inEvent);
case EventKind of
kEventAccessibleGetNamedAttribute:
begin
GetEventParameter(inEvent, kEventParamAccessibleAttributeName,
typeCFStringRef, nil, SizeOf(CFStringRef), nil, @lInputStr);
lInputPasStr := CFStringToStr(lInputStr);
if lInputPasStr = 'AXFocusedUIElement' then
begin
// First interfere only if the element returned is in our black list
// for example: memo border
GetEventParameter(inEvent, kEventParamAccessibleAttributeValue,
typeCFTypeRef, nil, SizeOf(AXUIElementRef), nil, @lElement);
AXUIElementCopyAttributeValue(lElement, CFSTR('AXRoleDescription'), lAXRole);
lInputPasStr := CFStringToStr(lAXRole);
if lInputPasStr = 'memoborder' then
begin
AXUIElementCopyAttributeValue(lElement, CFSTR('AXChildren'), lAXArray);
lElement2 := CFArrayGetValueAtIndex(lAXArray, 0);
SetEventParameter(inEvent, kEventParamAccessibleAttributeValue, typeCFTypeRef,
SizeOf(AXUIElementRef), @lElement2);
Result := noErr;
Exit;
end;
end;
end; // kEventAccessibleGetNamedAttribute
end; // case EventKind of
end;
{
The only drawback to making your own event loop dispatching calls in the main
application thread is that you won't get the standard application event handler
@ -442,8 +496,8 @@ procedure TCarbonWidgetSet.AppRun(const ALoop: TApplicationMainLoop);
var
DummyEvent: EventRef;
EventSpec: EventTypeSpec;
EventLoopUPP: EventHandlerUPP;
EventLoopHandler: EventHandlerRef;
EventLoopUPP, AccessibilityUPP: EventHandlerUPP;
EventLoopHandler, AccessibilityHandle: EventHandlerRef;
begin
{$IFDEF VerboseObject}
DebugLn('TCarbonWidgetSet.AppRun');
@ -451,6 +505,11 @@ begin
FAppLoop:=ALoop;
DummyEvent := nil;
// Accessibility for AXApplication
AccessibilityUPP := NewEventHandlerUPP(EventHandlerProcPtr(Pointer(@AppAccessibilityEventHandler)));
EventSpec := MakeEventSpec(kEventClassAccessibility, kEventAccessibleGetNamedAttribute);
InstallApplicationEventHandler(AccessibilityUPP, 1, @EventSpec, Self, @AccessibilityHandle);
// Create a UPP for EventLoopEventHandler and QuitEventHandler
EventLoopUPP := NewEventHandlerUPP(EventHandlerProcPtr(

View File

@ -169,6 +169,10 @@ end;
http://developer.apple.com/library/mac/#documentation/UserExperience/Reference/Accessibility_RoleAttribute_Ref/Attributes.html
List of routines to handle a AXUIElementRef:
http://developer.apple.com/library/mac/#documentation/Accessibility/Reference/AccessibilityLowlevel/AXUIElement_h/CompositePage.html
------------------------------------------------------------------------------}
function CarbonControl_Accessibility(ANextHandler: EventHandlerCallRef;
AEvent: EventRef;