From 46e5cbf514c9e21172c6fb1abb2086a637b42202 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Thu, 19 Jan 2012 08:09:12 +0000 Subject: [PATCH] Finally figured out how to properly create child non-windowed accessible objects in Carbon! Renames AccessibleName to the more useful AccessibleValue information. However it still doesnt work properly because the non-windowed accessible objects require a already created HIView so we need to figure out the proper place to do this after the HIView is created for TTreeView git-svn-id: trunk@34788 - --- lcl/controls.pp | 14 +-- lcl/include/control.inc | 39 ++++++--- lcl/include/treeview.inc | 12 +-- .../carbon/carbonprivatecontrol.inc | 20 ++++- lcl/interfaces/carbon/carbonwscontrols.pp | 85 +++++++++++++++++-- lcl/widgetset/wscontrols.pp | 4 +- 6 files changed, 142 insertions(+), 32 deletions(-) diff --git a/lcl/controls.pp b/lcl/controls.pp index d1257b46d2..87f6ea6495 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -935,17 +935,19 @@ type public // Primary information AccessibleDescription: TCaption; - AccessibleName: TCaption; // currently unused + AccessibleValue: TCaption; AccessibleRole: TLazAccessibilityRole; // Secondary information for notifications SelectedText: string; // OwnerControl: TControl; Parent: TLazAccessibleObject; - DataObject: TObject; // Availble to be used to connect to an object + DataObject: TObject; // Available to be used to connect to an object SecondaryHandle: PtrInt; // Available for Widgetsets to use constructor Create(AOwner: TControl); virtual; destructor Destroy; override; + procedure SetAccesibilityFields(const ADescription, AValue: string; const ARole: TLazAccessibilityRole); + function FindOwnerWinControl: TWinControl; function AddChildAccessibleObject: TLazAccessibleObject; virtual; procedure ClearChildAccessibleObjects; procedure RemoveChildAccessibleObject(AObject: TLazAccessibleObject); @@ -1074,7 +1076,7 @@ type function CaptureMouseButtonsIsStored: boolean; procedure DoActionChange(Sender: TObject); function GetAccessibleDescription: TCaption; - function GetAccessibleName: TCaption; + function GetAccessibleValue: TCaption; function GetAccessibleRole: TLazAccessibilityRole; function GetAutoSizingAll: Boolean; function GetAnchorSide(Kind: TAnchorKind): TAnchorSide; @@ -1104,7 +1106,7 @@ type Shift: TShiftState); procedure DoMouseUp(var Message: TLMMouse; Button: TMouseButton); procedure SetAccessibleDescription(AValue: TCaption); - procedure SetAccessibleName(AValue: TCaption); + procedure SetAccessibleValue(AValue: TCaption); procedure SetAccessibleRole(AValue: TLazAccessibilityRole); procedure SetAnchorSide(Kind: TAnchorKind; AValue: TAnchorSide); procedure SetBorderSpacing(const AValue: TControlBorderSpacing); @@ -1384,7 +1386,7 @@ type DropControl: TControl; ControlSide: TAlign): Boolean; function Dragging: Boolean; // accessibility - procedure SetAccesibilityFields(const ADescription, AName: string; const ARole: TLazAccessibilityRole); + procedure SetAccesibilityFields(const ADescription, AValue: string; const ARole: TLazAccessibilityRole); function GetAccessibleObject: TLazAccessibleObject; function CreateAccessibleObject: TLazAccessibleObject; virtual; function GetSelectedChildAccessibleObject: TLazAccessibleObject; virtual; @@ -1514,7 +1516,7 @@ type public // standard properties, which should be supported by all descendants property AccessibleDescription: TCaption read GetAccessibleDescription write SetAccessibleDescription; - property AccessibleName: TCaption read GetAccessibleName write SetAccessibleName; + property AccessibleValue: TCaption read GetAccessibleValue write SetAccessibleValue; property AccessibleRole: TLazAccessibilityRole read GetAccessibleRole write SetAccessibleRole; property Action: TBasicAction read GetAction write SetAction; property Align: TAlign read FAlign write SetAlign default alNone; diff --git a/lcl/include/control.inc b/lcl/include/control.inc index ce8a945360..9126160604 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -64,6 +64,26 @@ begin inherited Destroy; end; +procedure TLazAccessibleObject.SetAccesibilityFields(const ADescription, + AValue: string; const ARole: TLazAccessibilityRole); +var + WidgetsetClass: TWSLazAccessibleObjectClass; +begin + AccessibleDescription := ADescription; + AccessibleValue := AValue; + AccessibleRole := ARole; + WidgetsetClass := TWSLazAccessibleObjectClass(GetWSLazAccessibleObject()); + WidgetsetClass.SetFields(Self, ADescription, AValue, ARole); +end; + +function TLazAccessibleObject.FindOwnerWinControl: TWinControl; +begin + Result := nil; + if (OwnerControl <> nil) and (OwnerControl is TWinControl) then Exit(OwnerControl as TWinControl); + if Self.Parent = nil then Exit; + Result := Self.Parent.FindOwnerWinControl(); +end; + function TLazAccessibleObject.AddChildAccessibleObject: TLazAccessibleObject; begin Result := nil; @@ -1458,19 +1478,19 @@ end; procedure TControl.SetAccessibleDescription(AValue: TCaption); begin if FAccessibleObject.AccessibleDescription=AValue then Exit; - SetAccesibilityFields(AValue, FAccessibleObject.AccessibleName, FAccessibleObject.AccessibleRole); + SetAccesibilityFields(AValue, FAccessibleObject.AccessibleValue, FAccessibleObject.AccessibleRole); end; -procedure TControl.SetAccessibleName(AValue: TCaption); +procedure TControl.SetAccessibleValue(AValue: TCaption); begin - if FAccessibleObject.AccessibleName=AValue then Exit; + if FAccessibleObject.AccessibleValue=AValue then Exit; SetAccesibilityFields(FAccessibleObject.AccessibleDescription, AValue, FAccessibleObject.AccessibleRole); end; procedure TControl.SetAccessibleRole(AValue: TLazAccessibilityRole); begin if FAccessibleObject.AccessibleRole=AValue then Exit; - SetAccesibilityFields(FAccessibleObject.AccessibleDescription, FAccessibleObject.AccessibleName, AValue); + SetAccesibilityFields(FAccessibleObject.AccessibleDescription, FAccessibleObject.AccessibleValue, AValue); end; {------------------------------------------------------------------------------ @@ -1523,12 +1543,9 @@ begin end; // accessibility -procedure TControl.SetAccesibilityFields(const ADescription, AName: string; const ARole: TLazAccessibilityRole); +procedure TControl.SetAccesibilityFields(const ADescription, AValue: string; const ARole: TLazAccessibilityRole); begin - FAccessibleObject.AccessibleDescription := ADescription; - FAccessibleObject.AccessibleName := AName; - FAccessibleObject.AccessibleRole := ARole; - //TWSControl(WidgetSetClass).LazAccessibility_SetFields(Self, ADescription, AName, ARole); + FAccessibleObject.SetAccesibilityFields(ADescription, AValue, ARole); end; function TControl.GetAccessibleObject: TLazAccessibleObject; @@ -1717,9 +1734,9 @@ begin Result := FAccessibleObject.AccessibleDescription; end; -function TControl.GetAccessibleName: TCaption; +function TControl.GetAccessibleValue: TCaption; begin - Result := FAccessibleObject.AccessibleName; + Result := FAccessibleObject.AccessibleValue; end; function TControl.GetAccessibleRole: TLazAccessibilityRole; diff --git a/lcl/include/treeview.inc b/lcl/include/treeview.inc index 3111df46ff..17553adf13 100644 --- a/lcl/include/treeview.inc +++ b/lcl/include/treeview.inc @@ -1995,8 +1995,8 @@ begin Owner.Invalidate; end; FSelection.Clear; - //if (FOwner <> nil) then - // FOwner.GetAccessibleObject().ClearChildAccessibleObjects(); + if (FOwner <> nil) then + FOwner.GetAccessibleObject().ClearChildAccessibleObjects(); EndUpdate; end; @@ -2225,13 +2225,13 @@ begin if (FUpdateCount=0) and (Owner<>nil) then Owner.Invalidate; ok:=true; - {if ok and (Owner<>nil) then + if ok and (Owner<>nil) then begin lAccessibleObject := FOwner.GetAccessibleObject().AddChildAccessibleObject(); lAccessibleObject.AccessibleDescription := S; lAccessibleObject.AccessibleRole := larTreeItem; lAccessibleObject.DataObject := Result; - end;} + end; finally // this construction creates nicer exception output if not ok then @@ -3032,7 +3032,7 @@ begin FTreeLineColor := clWindowFrame; FTreeLinePenStyle := psPattern; FExpandSignColor := clWindowFrame; - SetAccesibilityFields('A tree of items', 'T Tree View', larTreeView); + SetAccesibilityFields('A tree of items', '', larTreeView); end; destructor TCustomTreeView.Destroy; @@ -4290,6 +4290,8 @@ begin lSelection := Self.Selected; if lSelection = nil then lAccessibleObject.SelectedText := '' else lAccessibleObject.SelectedText := lSelection.Text; + lAccessibleObject.SetAccesibilityFields(lAccessibleObject.AccessibleDescription, + lSelection.Text, lAccessibleObject.AccessibleRole); lAccessibleObject.SendNotification(lanSelectedTextChanged); if Assigned(OnSelectionChanged) then OnSelectionChanged(Self); diff --git a/lcl/interfaces/carbon/carbonprivatecontrol.inc b/lcl/interfaces/carbon/carbonprivatecontrol.inc index 72ecb25831..a29171e627 100644 --- a/lcl/interfaces/carbon/carbonprivatecontrol.inc +++ b/lcl/interfaces/carbon/carbonprivatecontrol.inc @@ -233,12 +233,19 @@ begin lOutputStr := CFSTR('AXFocused'); CFArrayAppendValue(lInputMutableArray, lOutputStr); end; + // AXChildren lCount := lLazControl.GetAccessibleObject().GetChildAccessibleObjectsCount; if lCount > 0 then begin lOutputStr := CFSTR('AXChildren'); CFArrayAppendValue(lInputMutableArray, lOutputStr); end; +{ // AXValue + if lLazControl.GetAccessibleObject().AccessibleValue <> '' then + begin + lOutputStr := CFSTR('AXValue'); + CFArrayAppendValue(lInputMutableArray, lOutputStr); + end;} end; // kEventAccessibleGetAllAttributeNames kEventAccessibleGetNamedAttribute: begin @@ -262,7 +269,7 @@ begin // kAXApplicationRole // There is nothing in the LCL for this role, it comes automatically in the application hierarchy // kAXBrowserRole - larTreeView: lAXRole := CFSTR('AXList');//Browser'); + larTreeView: lAXRole := CFSTR('AXList');//AXBrowser'); // kAXButtonRole larButton, larButtonDropDown: lAXRole := CFSTR('AXButton'); // kAXCheckBoxRole @@ -299,6 +306,14 @@ begin SizeOf(CFStringRef), @lOutputStr); FreeCFString(lOutputStr); end +{ else if lInputPasStr = 'AXValue' then + begin + if lLazControl.AccessibleValue = '' then Exit; + CreateCFString(lLazControl.AccessibleValue, lOutputStr); + SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef, + SizeOf(CFStringRef), @lOutputStr); + FreeCFString(lOutputStr); + end} //if (CFStringCompare(lInputStr, kAXFocusedAttribute, 0) = kCFCompareEqualTo) then else if lInputPasStr = 'AXFocused' then begin @@ -323,7 +338,8 @@ begin for i := 0 to lCount - 1 do begin lElement := AXUIElementRef(lLazControl.GetAccessibleObject().Handle); - CFArrayAppendValue(lArray, lElement); + if lElement <> nil then + CFArrayAppendValue(lArray, lElement); end; SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFTypeRef, diff --git a/lcl/interfaces/carbon/carbonwscontrols.pp b/lcl/interfaces/carbon/carbonwscontrols.pp index 85d0e0b28a..76fd2af820 100644 --- a/lcl/interfaces/carbon/carbonwscontrols.pp +++ b/lcl/interfaces/carbon/carbonwscontrols.pp @@ -51,11 +51,13 @@ type { TCarbonWSLazAccessibleObject } TCarbonWSLazAccessibleObject = class(TWSLazAccessibleObject) + private + class procedure GetCarbonAXIdentifiers(const AObject: TLazAccessibleObject; out AHIObject: HIObjectRef; out AID64: UInt64); public - // No need to implement SetFields in Carbon since Carbon requests the info - //class procedure SetFields(const AObject: TLazAccessibleObject; const ADescription, AName: string; const ARole: TLazAccessibilityRole); virtual; + class procedure SetFields(const AObject: TLazAccessibleObject; const ADescription, AValue: string; const ARole: TLazAccessibilityRole); override; class function CreateHandle(const AObject: TLazAccessibleObject): HWND; override; class procedure DestroyHandle(const AObject: TLazAccessibleObject); override; + class procedure SendNotification(const AObject: TLazAccessibleObject; ANotification: TLazAccessibilityNotification); override; end; { TCarbonWSControl } @@ -119,15 +121,65 @@ uses { TCarbonWSLazAccessibleObject } +class procedure TCarbonWSLazAccessibleObject.GetCarbonAXIdentifiers( + const AObject: TLazAccessibleObject; out AHIObject: HIObjectRef; out + AID64: UInt64); +var + lControlHandle: TCarbonControl; + lWinControl: TWinControl; +begin + AHIObject := nil; + AID64 := 0; + lWinControl := AObject.FindOwnerWinControl(); + if lWinControl = nil then Exit; + // 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 + begin + lControlHandle := TCarbonControl(TWinControl(AObject.OwnerControl).Handle); + AHIObject := lControlHandle.Widget; + AID64 := 0; + end + else + begin + lControlHandle := TCarbonControl(lWinControl.Handle); + // If this is an internal sub-element, then simply represent it with the + // memory address of the object + AID64 := UInt64(PtrInt(AObject)); + AHIObject := lControlHandle.Widget; + end; +end; + +class procedure TCarbonWSLazAccessibleObject.SetFields( + const AObject: TLazAccessibleObject; const ADescription, AValue: string; + const ARole: TLazAccessibilityRole); +var + lElement: AXUIElementRef; + lHIObject: HIObjectRef; + lID64: UInt64; + lValueStr: CFStringRef; +begin + GetCarbonAXIdentifiers(AObject, lHIObject, lID64); + if lHIObject = nil then Exit; + + CreateCFString(AValue, lValueStr); + HIObjectSetAuxiliaryAccessibilityAttribute(lHIObject, lID64, CFStr('AXValue'), lValueStr); + FreeCFString(lValueStr); +end; + class function TCarbonWSLazAccessibleObject.CreateHandle( const AObject: TLazAccessibleObject): HWND; var lElement: AXUIElementRef; + lHIObject: HIObjectRef; + lID64: UInt64; begin -{ lObject := HIObjectCreate(); - AObject.SecondaryHandle := PtrInt(lObject); AXUIElementCreateWithHIObjectAndIdentifier} - lElement := MacOSAll.AXUIElementCreateSystemWide(); - Result := HWND(lElement); + Result := 0; + GetCarbonAXIdentifiers(AObject, lHIObject, lID64); + if lHIObject = nil then Exit; + + lElement := AXUIElementCreateWithHIObjectAndIdentifier(lHIObject, lID64); end; class procedure TCarbonWSLazAccessibleObject.DestroyHandle( @@ -140,6 +192,27 @@ begin CFRelease(lElement); end; +class procedure TCarbonWSLazAccessibleObject.SendNotification( + const AObject: TLazAccessibleObject; + ANotification: TLazAccessibilityNotification); +var + lNotification: CFStringRef; + lHIObject: HIObjectRef; + lID64: UInt64; +begin + GetCarbonAXIdentifiers(AObject, lHIObject, lID64); + if lHIObject = nil then Exit; + + case ANotification of + lanSelectedTextChanged: lNotification := CFSTR('AXValueChanged'); + lanValueChanged: lNotification := CFSTR('AXValueChanged'); + else + Exit; + end; + + AXNotificationHIObjectNotify(lNotification, lHIObject, lID64); +end; + { TCarbonWSWinControl } {------------------------------------------------------------------------------ diff --git a/lcl/widgetset/wscontrols.pp b/lcl/widgetset/wscontrols.pp index d54943cc3b..a8a67472c1 100644 --- a/lcl/widgetset/wscontrols.pp +++ b/lcl/widgetset/wscontrols.pp @@ -71,7 +71,7 @@ type TWSLazAccessibleObject = class(TWSObject) public - class procedure SetFields(const AObject: TLazAccessibleObject; const ADescription, AName: string; const ARole: TLazAccessibilityRole); virtual; + class procedure SetFields(const AObject: TLazAccessibleObject; const ADescription, AValue: string; const ARole: TLazAccessibilityRole); virtual; class function CreateHandle(const AObject: TLazAccessibleObject): HWND; virtual; class procedure DestroyHandle(const AObject: TLazAccessibleObject); virtual; class procedure SendNotification(const AObject: TLazAccessibleObject; ANotification: TLazAccessibilityNotification); virtual; @@ -166,7 +166,7 @@ implementation { TWSLazAccessibleObject } class procedure TWSLazAccessibleObject.SetFields( - const AObject: TLazAccessibleObject; const ADescription, AName: string; + const AObject: TLazAccessibleObject; const ADescription, AValue: string; const ARole: TLazAccessibilityRole); begin