paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 04:19:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

Implements AccessibleValue for TTreeView items even when reading from the lfm. Improves the Carbon accessibility code for lists

Browse Source 
git-svn-id: trunk@34830 -
This commit is contained in:
sekelsenmat 2012-01-21 08:37:45 +00:00
parent bd8a968767
commit ec6c831a3b
6 changed files with 146 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/controls.pp
View File

@ -959,7 +959,7 @@ type
property AccessibleDescription: TCaption read FAccessibleDescription write SetAccessibleDescription;
property AccessibleValue: TCaption read FAccessibleValue write SetAccessibleValue;
property AccessibleRole: TLazAccessibilityRole read FAccessibleRole write SetAccessibleRole;
property Handle: PtrInt read GetHandle;
property Handle: PtrInt read GetHandle write FHandle;
end;
{* Note on TControl.Caption

21
lcl/include/treeview.inc
View File

@ -29,8 +29,6 @@
{ $DEFINE TREEVIEW_DEBUG}
{ TTreeViewAccessibleObject }
const
TTreeNodeWithPointerStreamVersion : word = 1;
TTreeNodeStreamVersion : word = 2;
@ -398,6 +396,8 @@ begin
end;
procedure TTreeNode.SetText(const S: string);
var
lSelfAX: TLazAccessibleObject;
begin
if S=FText then exit;
FText := S;
@ -409,6 +409,10 @@ begin
else TreeView.AlphaSort;
end;
Update;
// Update accessibility information
lSelfAX := TreeView.GetAccessibleObject.GetChildAccessibleObjectWithDataObject(Self);
if lSelfAX <> nil then
lSelfAX.AccessibleValue := S;
end;
procedure TTreeNode.SetData(AValue: Pointer);
@ -1740,6 +1744,7 @@ var
OldInfo: TOldTreeNodeInfo;
Info: TTreeNodeInfo;
Node: TTreeNode;
lSelfAX: TLazAccessibleObject;
begin
if Owner<>nil then Owner.ClearCache;
if StreamVersion=TTreeNodeWithPointerStreamVersion then
@ -1768,7 +1773,16 @@ begin
SetLength(FText,Info.TextLen);
end;
if FText<>'' then
begin
Stream.Read(FText[1],length(FText));
// Update accessibility information
if TreeView<>nil then
begin
lSelfAX := TreeView.GetAccessibleObject.GetChildAccessibleObjectWithDataObject(Self);
if lSelfAX <> nil then
lSelfAX.AccessibleValue := FText;
end;
end;
if Owner<>nil then begin
for I := 0 to ItemCount - 1 do begin
Node:=Owner.AddChild(Self, '');
@ -2228,7 +2242,8 @@ begin
if ok and (Owner<>nil) then
begin
lAccessibleObject := FOwner.GetAccessibleObject().AddChildAccessibleObject();
lAccessibleObject.AccessibleDescription := S;
lAccessibleObject.AccessibleDescription := 'Item';
lAccessibleObject.AccessibleValue := S;
lAccessibleObject.AccessibleRole := larTreeItem;
lAccessibleObject.DataObject := Result;
end;

4
lcl/interfaces/carbon/carbondefines.inc
View File

@ -24,6 +24,10 @@
{$define CarbonUseCocoa}
{$endif}
{$ifndef VER2_2}{$ifndef VER2_4}{$ifndef CarbonDontUseCocoa}
{$define CarbonUseCocoaAll}
{$endif}{$endif}{$endif}
// Show debug info when tracing:
{off $define DebugBitmaps}

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

@ -29,10 +29,13 @@ interface
{$I carbondefines.inc}
uses
// rtl+ftl
// rtl+ftl
Types, Classes, SysUtils, Math, Contnrs,
// carbon bindings
// carbon bindings
MacOSAll,
{$ifdef CarbonUseCocoaAll}
CocoaAll,
{$endif}
// widgetset
WSControls, WSLCLClasses, WSProc,
// LCL Carbon

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

@ -165,12 +165,17 @@ end;
http://developer.apple.com/library/mac/#documentation/Accessibility/Reference/AccessibilityCarbonRef/Reference/reference.html
Documentation explaining in details which attributes are required for each Role:
http://developer.apple.com/library/mac/#documentation/UserExperience/Reference/Accessibility_RoleAttribute_Ref/Attributes.html
------------------------------------------------------------------------------}
function CarbonControl_Accessibility(ANextHandler: EventHandlerCallRef;
AEvent: EventRef;
AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
var
lAXRole, lInputStr, lOutputStr: CFStringRef;
// Inputs
lAXRole, lInputStr: CFStringRef;
lInputAXObject: AXUIElementRef;
lInputID64: UInt64;
lInputAccessibleObject: TLazAccessibleObject;
@ -178,9 +183,12 @@ var
lInputMutableArray: CFMutableArrayRef;
lInputHIPoint: HIPoint;
lInputPoint: TPoint;
// Outputs
lOutputStr: CFStringRef;
lOutputBool: Boolean;
lOutputInt: SInt64;
lOutputNum: CFNumberRef;
//
lLazControl: TControl;
lLazAXRole: TLazAccessibilityRole;
Command: HICommandExtended;
@ -192,6 +200,7 @@ var
i: Integer;
lAccessibleObj: TLazAccessibleObject;
lHandle: PtrInt;
lSelection: TLazAccessibleObject;
const SName = 'CarbonControl_Accessibility';
begin
{$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
@ -209,15 +218,9 @@ begin
// Check if this is an event to a child accessible object
AXUIElementGetIdentifier(lInputAXObject, lInputID64);
if (lLazControl is TCustomControl) and (lInputID64 <> 0) then
begin
lInputAccessibleObject := TLazAccessibleObject(PtrInt(lInputID64));
lLazAXRole := lLazControl.AccessibleRole;
end
else
begin
lInputAccessibleObject := lLazControl.GetAccessibleObject();
lLazAXRole := lLazControl.AccessibleRole;
end;
lInputAccessibleObject := TLazAccessibleObject(PtrInt(lInputID64))
else lInputAccessibleObject := lLazControl.GetAccessibleObject();
lLazAXRole := lInputAccessibleObject.AccessibleRole;
EventKind := GetEventKind(AEvent);
case EventKind of
@ -234,9 +237,8 @@ begin
// specified point, in the form of an AXUIElementRef.
lInputPoint := Types.Point(Round(lInputHIPoint.x), Round(lInputHIPoint.y));
lInputPoint := TWinControl(lLazControl).ScreenToClient(lInputPoint);
lAccessibleObj := lLazControl.GetAccessibleObject();
if lAccessibleObj = nil then Exit;
lAccessibleObj := lAccessibleObj.GetChildAccessibleObjectAtPos(lInputPoint);
if lInputAccessibleObject = nil then Exit;
lAccessibleObj := lInputAccessibleObject.GetChildAccessibleObjectAtPos(lInputPoint);
if (lAccessibleObj = nil) or (lAccessibleObj.Handle = 0) then Exit;
lHandle := lAccessibleObj.Handle;
SetEventParameter(AEvent, kEventParamAccessibleChild, typeCFTypeRef,
@ -266,7 +268,7 @@ begin
CFArrayAppendValue(lInputMutableArray, lOutputStr);
end;
// AXChildren
lCount := lLazControl.GetAccessibleObject().GetChildAccessibleObjectsCount;
lCount := lInputAccessibleObject.GetChildAccessibleObjectsCount;
if lCount > 0 then
begin
lOutputStr := CFSTR('AXChildren');
@ -280,6 +282,24 @@ begin
lOutputStr := CFSTR('AXNumberOfCharacters');
CFArrayAppendValue(lInputMutableArray, lOutputStr);
end;
// Now elements for each role
// AXList
if (lLazControl is TCustomControl) and
(lLazAXRole in [larListBox, larTreeView]) then
begin
lOutputStr := CFSTR('AXOrientation');
CFArrayAppendValue(lInputMutableArray, lOutputStr);
lOutputStr := CFSTR('AXSelectedChildren');
CFArrayAppendValue(lInputMutableArray, lOutputStr);
lOutputStr := CFSTR('AXVisibleChildren');
CFArrayAppendValue(lInputMutableArray, lOutputStr);
end;
// Basic elements for non-windowed accessible objects
if (lLazControl is TCustomControl) and (lInputID64 <> 0) then
begin
lOutputStr := CFSTR('AXValue');
CFArrayAppendValue(lInputMutableArray, lOutputStr);
end;
end; // kEventAccessibleGetAllAttributeNames
kEventAccessibleGetAllParameterizedAttributeNames:
begin
@ -321,12 +341,14 @@ begin
lInputPasStr := CFStringToStr(lInputStr);
{$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
DebugLn('CarbonControl_Accessibility kEventAccessibleGetNamedAttribute kEventParamAccessibleAttributeName=' + lInputPasStr);
{$ENDIF}
// AXRole overrides TCustomControl and TCustomWindow values
if lInputPasStr = 'AXRole' then
begin
if (lLazControl is TWinControl) and (not (lLazControl is TCustomForm))
and (not (lLazControl is TCustomControl)) then Exit;
if not (lLazControl is TCustomControl) then Exit;
case lLazAXRole of
larAnimation: lAXRole := CFSTR('AXImage');
larButton: lAXRole := CFSTR('AXButton');
@ -366,36 +388,31 @@ begin
Result := noErr;
Exit;
end;
end
// Specially only AXRoleDescription is allowed to override non-TCustomControl values
if lInputPasStr = 'AXRoleDescription' then
else if lInputPasStr = 'AXRoleDescription' then
begin
if lLazControl.AccessibleDescription = '' then Exit;
CreateCFString(lLazControl.AccessibleDescription, lOutputStr);
if lInputAccessibleObject.AccessibleDescription = '' then Exit;
CreateCFString(lInputAccessibleObject.AccessibleDescription, lOutputStr);
SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef,
SizeOf(CFStringRef), @lOutputStr);
FreeCFString(lOutputStr);
Result := noErr;
Exit;
end;
if not (lLazControl is TCustomControl) then Exit;
{$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
DebugLn('CarbonControl_Accessibility kEventAccessibleGetNamedAttribute kEventParamAccessibleAttributeName=' + lInputPasStr);
{$ENDIF}
{ else if lInputPasStr = 'AXValue' then
end
else if lInputPasStr = 'AXValue' then
begin
if lLazControl.AccessibleValue = '' then Exit;
CreateCFString(lLazControl.AccessibleValue, lOutputStr);
if not (lLazControl is TCustomControl) then Exit;
if (lInputID64 = 0) then Exit;
CreateCFString(lInputAccessibleObject.AccessibleValue, lOutputStr);
SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef,
SizeOf(CFStringRef), @lOutputStr);
FreeCFString(lOutputStr);
end}
if (lInputPasStr = 'AXNumberOfCharacters') then
end
else if (lInputPasStr = 'AXNumberOfCharacters') then
begin
lOutputInt := UTF8Length(lLazControl.AccessibleValue);
if not (lLazControl is TCustomControl) then Exit;
lOutputInt := UTF8Length(lInputAccessibleObject.AccessibleValue);
lOutputNum := CFNumberCreate(nil, kCFNumberSInt64Type, @lOutputInt);
SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFNumberRef,
SizeOf(lOutputNum), @lOutputNum);
@ -405,25 +422,25 @@ begin
//
// Parameterized attributes
//
else if (lLazControl is TCustomControl) and (lInputPasStr = 'AXStringForRange') then
else if (lInputPasStr = 'AXStringForRange') then
begin
if lLazControl.AccessibleValue = '' then Exit;
CreateCFString(lLazControl.AccessibleValue, lOutputStr);
if not (lLazControl is TCustomControl) then Exit;
if lInputAccessibleObject.AccessibleValue = '' then Exit;
CreateCFString(lInputAccessibleObject.AccessibleValue, lOutputStr);
SetEventParameter(AEvent, kEventParamAccessibleAttributeParameter, typeCFStringRef,
SizeOf(CFStringRef), @lOutputStr);
FreeCFString(lOutputStr);
Result := noErr;
end
else if (lLazControl is TCustomControl) and
((lInputPasStr = 'AXAttributedStringForRange') or
else if (lInputPasStr = 'AXAttributedStringForRange') or
(lInputPasStr = 'AXBoundsForRange') or
(lInputPasStr = 'AXRangeForIndex') or
(lInputPasStr = 'AXRangeForLine') or
(lInputPasStr = 'AXRangeForPosition') or
(lInputPasStr = 'AXRTFForRange') or
(lInputPasStr = 'AXStyleRangeForIndex')
) then
(lInputPasStr = 'AXStyleRangeForIndex') then
begin
if not (lLazControl is TCustomControl) then Exit;
SetEventParameter(AEvent, kEventParamAccessibleAttributeParameter, typeCFTypeRef,
0, nil);
Result := noErr;
@ -431,6 +448,7 @@ begin
//if (CFStringCompare(lInputStr, kAXFocusedAttribute, 0) = kCFCompareEqualTo) then
else if lInputPasStr = 'AXFocused' then
begin
//if not (lLazControl is TCustomControl) then Exit;
if not (lLazControl is TWinControl) then lOutputBool := False
else if TWinControl(lLazControl).Focused then lOutputBool := True
else lOutputBool := False;
@ -444,24 +462,61 @@ begin
Result := noErr;
end
else if (CFStringCompare(lInputStr, CFSTR('AXChildren'), 0) = kCFCompareEqualTo) then // kAXChildrenAttribute
//else if (CFStringCompare(lInputStr, CFSTR('AXChildren'), 0) = kCFCompareEqualTo) then // kAXChildrenAttribute
else if (lInputPasStr = 'AXChildren') or (lInputPasStr = 'AXVisibleChildren')
or (lInputPasStr = 'AXSelectedChildren') then
begin
if not (lLazControl is TCustomControl) then Exit;
// Create and return an array of AXUIElements describing the children of this view.
lCount := lLazControl.GetAccessibleObject().GetChildAccessibleObjectsCount;
lArray := CFArrayCreateMutable(kCFAllocatorDefault, lCount, @kCFTypeArrayCallBacks);
for i := 0 to lCount - 1 do
if (lInputPasStr = 'AXSelectedChildren') then
begin
lElement := AXUIElementRef(lLazControl.GetAccessibleObject().Handle);
if lElement <> nil then
CFArrayAppendValue(lArray, lElement);
lSelection := lInputAccessibleObject.GetSelectedChildAccessibleObject();
if lSelection = nil then
lArray := CFArrayCreateMutable(kCFAllocatorDefault, 0, @kCFTypeArrayCallBacks)
else
begin
lArray := CFArrayCreateMutable(kCFAllocatorDefault, 1, @kCFTypeArrayCallBacks);
lElement := AXUIElementRef(lSelection.Handle);
if lElement <> nil then
CFArrayAppendValue(lArray, lElement);
end;
end
else
begin
lCount := lInputAccessibleObject.GetChildAccessibleObjectsCount;
lArray := CFArrayCreateMutable(kCFAllocatorDefault, lCount, @kCFTypeArrayCallBacks);
for i := 0 to lCount - 1 do
begin
lElement := AXUIElementRef(lInputAccessibleObject.Handle);
if lElement <> nil then
CFArrayAppendValue(lArray, lElement);
end;
end;
SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFTypeRef,
SizeOf(lArray), @lArray);
CFRelease(lArray);
Result := noErr;
end
else if lInputPasStr = 'AXOrientation' then
begin
if not (lLazControl is TCustomControl) then Exit;
{$ifdef CarbonUseCocoaAll}
SetEventParameter(AEvent, kEventParamAccessibleAttributeParameter, typeCFStringRef,
SizeOf(CFStringRef), @NSAccessibilityHorizontalOrientationValue);
Result := noErr;
{$endif}
end
else if lInputPasStr = 'AXParent' then
begin
if lInputID64 = 0 then Exit;
if not (lLazControl is TCustomControl) then Exit;
if lInputAccessibleObject.Parent = nil then Exit;
lElement := AXUIElementRef(lInputAccessibleObject.Parent.Handle);
SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFTypeRef,
SizeOf(AXUIElementRef), @lElement);
Result := noErr;
end;
end; // kEventAccessibleGetNamedAttribute
kEventAccessibleIsNamedAttributeSettable:
@ -475,18 +530,22 @@ begin
lInputPasStr := CFStringToStr(lInputStr);
{ // Now elements for each role
// AXStaticText
if lLazAXRole in [larClock, larLabel, larListItem, larTreeItem] then
begin}
if (lInputPasStr = 'AXFocused') or (lInputPasStr = 'AXStringForRange') or
(lInputPasStr = 'AXNumberOfCharacters') then
if (lInputPasStr = 'AXFocused') then
begin
lOutputBool := TCustomControl(lLazControl).TabStop;
SetEventParameter(AEvent, kEventParamAccessibleAttributeSettable, typeBoolean,
SizeOf(Boolean), @lOutputBool);
Result := noErr;
end
else if (lInputPasStr = 'AXStringForRange') or
(lInputPasStr = 'AXNumberOfCharacters') or (lInputPasStr = 'AXChildren') or
(lInputPasStr = 'AXSelectedChildren') or (lInputPasStr = 'AXVisibleChildren') then
begin
lOutputBool := False;
SetEventParameter(AEvent, kEventParamAccessibleAttributeSettable, typeBoolean,
SizeOf(Boolean), @lOutputBool);
Result := noErr;
end
end;
end; // kEventAccessibleIsNamedAttributeSettable
end; // case EventKind of
end;

4
lcl/interfaces/carbon/carbonwscontrols.pp
View File

@ -136,7 +136,8 @@ begin
// Requesting a handle allocation here might be too soon and crash, so cancel the whole action
if not lWinControl.HandleAllocated then Exit;
if (AObject.OwnerControl <> nil) and (AObject.OwnerControl is TWinControl) then
if (AObject.OwnerControl <> nil) and (AObject.OwnerControl is TWinControl) and
(AObject.OwnerControl.GetAccessibleObject() = AObject) then
begin
lControlHandle := TCarbonControl(TWinControl(AObject.OwnerControl).Handle);
AHIObject := lControlHandle.Widget;
@ -164,6 +165,7 @@ begin
if lHIObject = nil then Exit;
lElement := AXUIElementCreateWithHIObjectAndIdentifier(lHIObject, lID64);
Result := HWND(lElement);
end;
class procedure TCarbonWSLazAccessibleObject.DestroyHandle(