paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-28 18:42:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

Improves the accessibility support in LCL-Carbon. Starts implementing support for more accessibility support and starts adding accessibility roles for TCustomForm

Browse Source 
git-svn-id: trunk@34695 -
This commit is contained in:
sekelsenmat 2012-01-10 17:33:43 +00:00
parent d44c35bf1c
commit 88b94d106a
3 changed files with 125 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/include/customform.inc
View File

@ -1938,6 +1938,9 @@ begin
if ParentBiDiMode then
BiDiMode := Application.BidiMode;
// Accessibility
SetAccesibilityFields('A window', 'T Form', larWindow);
// the EndFormUpdate is done in AfterConstruction
end;

30
lcl/interfaces/carbon/carbonprivate.pp
View File

@ -710,6 +710,7 @@ end;
procedure TCarbonCustomControl.RegisterEvents;
var
TmpSpec: EventTypeSpec;
AccessibilitySpec: array [0..2] of EventTypeSpec;
begin
inherited RegisterEvents;
@ -722,20 +723,23 @@ begin
end;
// Accessibility
TmpSpec := MakeEventSpec(kEventClassAccessibility, kEventAccessibleGetNamedAttribute);
AccessibilitySpec[0].eventClass := kEventClassAccessibility;
AccessibilitySpec[0].eventKind := kEventAccessibleGetChildAtPoint;
AccessibilitySpec[1].eventClass := kEventClassAccessibility;
AccessibilitySpec[1].eventKind := kEventAccessibleGetFocusedChild;
// kEventAccessibleGetAllAttributeNames
// kEventAccessibleGetAllParameterizedAttributeNames
AccessibilitySpec[2].eventClass := kEventClassAccessibility;
AccessibilitySpec[2].eventKind := kEventAccessibleGetNamedAttribute;
// kEventAccessibleSetNamedAttribute
// kEventAccessibleIsNamedAttributeSettable
// kEventAccessibleGetAllActionNames
// kEventAccessiblePerformNamedAction
// kEventAccessibleGetNamedActionDescription
InstallControlEventHandler(Content,
RegisterEventHandler(@CarbonControl_AccessibleGetNamedAttribute),
1, @TmpSpec, Pointer(Self), nil);
{ kEventAccessibleGetChildAtPoint = 1,
kEventAccessibleGetFocusedChild = 2,
kEventAccessibleGetAllAttributeNames = 21,
kEventAccessibleGetAllParameterizedAttributeNames = 25,
kEventAccessibleGetNamedAttribute = 22,
kEventAccessibleSetNamedAttribute = 23,
kEventAccessibleIsNamedAttributeSettable = 24,
kEventAccessibleGetAllActionNames = 41,
kEventAccessiblePerformNamedAction = 42,
kEventAccessibleGetNamedActionDescription = 44}
RegisterEventHandler(@CarbonControl_Accessibility),
3, @AccessibilitySpec[0], Pointer(Self), nil);
end;
{------------------------------------------------------------------------------

161
lcl/interfaces/carbon/carbonprivatecontrol.inc
View File

@ -126,10 +126,23 @@ begin
end;
{------------------------------------------------------------------------------
Name: CarbonControl_AccessibleGetNamedAttribute
Name: CarbonControl_Accessibility
Accessibility
The named attributes are:
The events for this handler are:
kEventAccessibleGetChildAtPoint
kEventAccessibleGetFocusedChild
kEventAccessibleGetAllAttributeNames
kEventAccessibleGetAllParameterizedAttributeNames
kEventAccessibleGetNamedAttribute
kEventAccessibleSetNamedAttribute
kEventAccessibleIsNamedAttributeSettable
kEventAccessibleGetAllActionNames
kEventAccessiblePerformNamedAction
kEventAccessibleGetNamedActionDescription
For kEventAccessibleGetNamedAttribute the named attributes are:
AXRole
AXRoleDescription
@ -143,78 +156,114 @@ end;
AXSize
AXPosition
------------------------------------------------------------------------------}
function CarbonControl_AccessibleGetNamedAttribute(ANextHandler: EventHandlerCallRef;
function CarbonControl_Accessibility(ANextHandler: EventHandlerCallRef;
AEvent: EventRef;
AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
var
lAXRole, lInputStr, lOutputStr: CFStringRef;
lInputPasStr: string;
lInputMutableArray: CFMutableArrayRef;
lOutputBool: CFBooleanRef;
lLazControl: TControl;
lLazAXRole: TLazAccessibilityRole;
Command: HICommandExtended;
const SName = 'CarbonControl_AccessibleGetNamedAttribute';
EventKind: UInt32;
const SName = 'CarbonControl_Accessibility';
begin
{$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
DebugLn('CarbonControl_AccessibleGetNamedAttribute LCLObject=', DbgSName(AWidget.LCLObject));
DebugLn('CarbonControl_Accessibility LCLObject=', DbgSName(AWidget.LCLObject));
{$ENDIF}
Result := CallNextEventHandler(ANextHandler, AEvent); // Must be called at the event handling start
lLazControl := TControl((AWidget as TCarbonControl).LCLObject);
lLazAXRole := lLazControl.AccessibleRole;
if not OSError(
GetEventParameter(AEvent, kEventParamAccessibleAttributeName,
typeCFStringRef, nil, SizeOf(CFStringRef), nil, @lInputStr),
SName, 'GetEventParameter') then
begin
lInputPasStr := CFStringToStr(lInputStr);
{$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
DebugLn('CarbonControl_AccessibleGetNamedAttribute kEventParamAccessibleAttributeName=' + lInputPasStr);
{$ENDIF}
lLazAXRole := lLazControl.AccessibleRole;
if lInputPasStr = 'AXRole' then
EventKind := GetEventKind(AEvent);
case EventKind of
kEventAccessibleGetAllAttributeNames:
begin
case lLazAXRole of
// kAXApplicationRole
// kAXBrowserRole
larTreeView: lAXRole := CFSTR('AXBrowser'); // alternatively
// kAXButtonRole
// kAXCheckBoxRole
// kAXColumnRole
// kAXDrawerRole
// kAXGrowAreaRole
// kAXImageRole
// kAXMenuButtonRole
// kAXOutlineRole
// kAXPopUpButtonRole
// kAXRadioButtonRole
// kAXRowRole
// kAXSheetRole
// kAXSystemWideRole
// kAXTabGroupRole
// kAXTableRole
// kAXWindowRole
larWindow: lAXRole := CFSTR('AXWindow'); // alternatively
// kAXUnknownRole
else
lAXRole := CFSTR('AXUnknown');
{$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
DebugLn('CarbonControl_Accessibility kEventAccessibleGetAllAttributeNames');
{$ENDIF}
if OSError(
GetEventParameter(AEvent, kEventParamAccessibleAttributeNames,
typeCFMutableArrayRef, nil, SizeOf(CFMutableArrayRef), nil, @lInputMutableArray),
SName, 'GetEventParameter') then Exit;
{$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
DebugLn('CarbonControl_Accessibility kEventAccessibleGetAllAttributeNames After GetEventParameter');
{$ENDIF}
// AXFocused interrests all classes
lOutputStr := CFSTR('AXFocused');
CFArrayAppendValue(lInputMutableArray, lOutputStr);
end; // kEventAccessibleGetAllAttributeNames
kEventAccessibleGetNamedAttribute:
begin
if OSError(
GetEventParameter(AEvent, kEventParamAccessibleAttributeName,
typeCFStringRef, nil, SizeOf(CFStringRef), nil, @lInputStr),
SName, 'GetEventParameter') then Exit;
lInputPasStr := CFStringToStr(lInputStr);
{$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
DebugLn('CarbonControl_Accessibility kEventAccessibleGetNamedAttribute kEventParamAccessibleAttributeName=' + lInputPasStr);
{$ENDIF}
if lInputPasStr = 'AXRole' then
begin
case lLazAXRole of
// kAXApplicationRole
// kAXBrowserRole
larTreeView: lAXRole := CFSTR('AXBrowser'); // alternatively
// kAXButtonRole
// kAXCheckBoxRole
// kAXColumnRole
// kAXDrawerRole
// kAXGrowAreaRole
// kAXImageRole
// kAXMenuButtonRole
// kAXOutlineRole
// kAXPopUpButtonRole
// kAXRadioButtonRole
// kAXRowRole
// kAXSheetRole
// kAXSystemWideRole
// kAXTabGroupRole
// kAXTableRole
// kAXWindowRole
larWindow: lAXRole := CFSTR('AXWindow'); // alternatively
// kAXUnknownRole
else
lAXRole := CFSTR('AXUnknown');
end;
//if OSError(
SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef,
SizeOf(CFStringRef), @lAXRole);//, SName, SSetEvent, SControlAction) then Exit;
end
else if lInputPasStr = 'AXRoleDescription' then
begin
CreateCFString(lLazControl.AccessibleDescription, lOutputStr);
SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef,
SizeOf(CFStringRef), @lOutputStr);
FreeCFString(lOutputStr);
end
else if lInputPasStr = 'AXFocused' then
begin
if not (lLazControl is TWinControl) then Exit;
if TWinControl(lLazControl).Focused then lOutputBool := kCFBooleanTrue
else lOutputBool := kCFBooleanFalse;
SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFBooleanRef,
SizeOf(CFBooleanRef), @lOutputBool);
end;
//if OSError(
SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef,
SizeOf(CFStringRef), @lAXRole);//, SName, SSetEvent, SControlAction) then Exit;
end
else if lInputPasStr = 'AXRoleDescription' then
begin
CreateCFString(lLazControl.AccessibleDescription, lOutputStr);
SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef,
SizeOf(CFStringRef), @lOutputStr);
FreeCFString(lOutputStr);
end;
end;
end; // kEventAccessibleGetNamedAttribute
end; // case EventKind of
end;
{ TCarbonToolBar }