diff --git a/lcl/controls.pp b/lcl/controls.pp index 26e56270c1..ac21ca34a6 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -930,6 +930,7 @@ type function GetHandle: PtrInt; function GetPosition: TPoint; function GetSize: TSize; + procedure SetHandle(AValue: PtrInt); procedure SetPosition(AValue: TPoint); procedure SetSize(AValue: TSize); protected @@ -945,6 +946,8 @@ type SecondaryHandle: PtrInt; // Available for Widgetsets to use constructor Create(AOwner: TControl); virtual; destructor Destroy; override; + function HandleAllocated: Boolean; + procedure InitializeHandle; virtual; procedure SetAccessibleDescription(const ADescription: TCaption); procedure SetAccessibleValue(const AValue: TCaption); procedure SetAccessibleRole(const ARole: TLazAccessibilityRole); @@ -963,7 +966,7 @@ type property AccessibleRole: TLazAccessibilityRole read FAccessibleRole write SetAccessibleRole; property Position: TPoint read GetPosition write SetPosition; property Size: TSize read GetSize write SetSize; - property Handle: PtrInt read GetHandle write FHandle; + property Handle: PtrInt read GetHandle write SetHandle; end; {* Note on TControl.Caption diff --git a/lcl/include/control.inc b/lcl/include/control.inc index c0e7b654af..928f4801b0 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -34,7 +34,10 @@ var begin WidgetsetClass := TWSLazAccessibleObjectClass(GetWSLazAccessibleObject()); if (WidgetsetClass <> nil) and (FHandle = 0) then + begin FHandle := WidgetsetClass.CreateHandle(Self); + InitializeHandle(); + end; Result := FHandle; end; @@ -58,6 +61,13 @@ begin Result := FSize; end; +procedure TLazAccessibleObject.SetHandle(AValue: PtrInt); +begin + if AValue = FHandle then Exit; + FHandle := AValue; + InitializeHandle(); +end; + procedure TLazAccessibleObject.SetPosition(AValue: TPoint); var WidgetsetClass: TWSLazAccessibleObjectClass; @@ -104,6 +114,21 @@ begin inherited Destroy; end; +function TLazAccessibleObject.HandleAllocated: Boolean; +begin + Result := FHandle <> 0; +end; + +procedure TLazAccessibleObject.InitializeHandle; +var + WidgetsetClass: TWSLazAccessibleObjectClass; +begin + WidgetsetClass := TWSLazAccessibleObjectClass(GetWSLazAccessibleObject()); + WidgetsetClass.SetAccessibleDescription(Self, FAccessibleDescription); + WidgetsetClass.SetAccessibleValue(Self, FAccessibleValue); + WidgetsetClass.SetAccessibleRole(Self, FAccessibleRole); +end; + procedure TLazAccessibleObject.SetAccessibleDescription(const ADescription: TCaption); var WidgetsetClass: TWSLazAccessibleObjectClass; diff --git a/lcl/interfaces/carbon/carbonedits.pp b/lcl/interfaces/carbon/carbonedits.pp index b3657c9f7b..a604b171a8 100644 --- a/lcl/interfaces/carbon/carbonedits.pp +++ b/lcl/interfaces/carbon/carbonedits.pp @@ -1760,10 +1760,193 @@ begin end; end; +function CarbonMemoBorder_Accessibility(ANextHandler: EventHandlerCallRef; + AEvent: EventRef; + AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF} +var + // Inputs + lAXRole, lInputStr: CFStringRef; + lIsMemoControl: Boolean; + lInputAXObject, lInputMemoAXObject: AXUIElementRef; + lInputID64: UInt64; + lInputAccessibleObject: TLazAccessibleObject; + lInputPasStr: string; + lInputMutableArray: CFMutableArrayRef; + lInputHIPoint: HIPoint; + lInputPoint: TPoint; + // Outputs + lOutputStr: CFStringRef; + lOutputBool: Boolean; + lOutputInt: SInt64; + lOutputNum: CFNumberRef; + lOutputValue: AXValueRef; + lOutputPoint: CGPoint; + lOutputSize: CGSize; + // + lLazControl: TControl; + lLazAXRole: TLazAccessibilityRole; + lCurAccessibleObject: TLazAccessibleObject; + Command: HICommandExtended; + EventKind: UInt32; + // array + lArray: CFMutableArrayRef; + lElement, lElement2: AXUIElementRef; + lCount: Integer; + i: Integer; + lAccessibleObj: TLazAccessibleObject; + lHandle: PtrInt; + lSelection: TLazAccessibleObject; +const SName = 'CarbonMemoBorder_Accessibility'; +begin + {.$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)} + DebugLn('CarbonMemoBorder_Accessibility LCLObject=', DbgSName(AWidget.LCLObject)); + {.$ENDIF} + + Result := CallNextEventHandler(ANextHandler, AEvent); // Must be called at the event handling start + + lLazControl := TControl((AWidget as TCarbonControl).LCLObject); + if lLazControl = nil then Exit; + + GetEventParameter(AEvent, kEventParamAccessibleObject, + typeCFTypeRef, nil, SizeOf(AXUIElementRef), nil, @lInputAXObject); + + // Check if this is an event to a child accessible object + AXUIElementGetIdentifier(lInputAXObject, lInputID64); + lInputAccessibleObject := lLazControl.GetAccessibleObject(); + lInputMemoAXObject := AXUIElementRef(lInputAccessibleObject.Handle); + lIsMemoControl := lInputMemoAXObject = lInputAXObject; + lLazAXRole := lInputAccessibleObject.AccessibleRole; + + EventKind := GetEventKind(AEvent); + case EventKind of + kEventAccessibleGetFocusedChild: + begin + {.$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)} + DebugLn('CarbonMemoBorder_Accessibility kEventAccessibleGetFocusedChild ' + + 'lInputAXObject=%x lChildAX=%x', [PtrInt(lInputAXObject), PtrInt(lInputMemoAXObject)]); + {.$ENDIF} + + {if lIsMemoControl then + SetEventParameter(AEvent, kEventParamAccessibleChild, typeCFTypeRef, + SizeOf(AXUIElementRef), nil) + else} + SetEventParameter(AEvent, kEventParamAccessibleChild, typeCFTypeRef, + SizeOf(AXUIElementRef), @lInputMemoAXObject); + Result := noErr; + end; + kEventAccessibleGetAllAttributeNames: + begin + {.$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)} + DebugLn('CarbonMemoBorder_Accessibility kEventAccessibleGetAllAttributeNames'); + {.$ENDIF} + + GetEventParameter(AEvent, kEventParamAccessibleAttributeNames, + typeCFMutableArrayRef, nil, SizeOf(CFMutableArrayRef), nil, @lInputMutableArray); + + {for i := 0 to CFArrayGetCount(lInputMutableArray) - 1 do + begin + lOutputStr := CFArrayGetValueAtIndex(lInputMutableArray, i); + WriteLn(' '+CFStringToStr(lOutputStr)); + end;} + +// lOutputStr := CFSTR('AXRole'); +// CFArrayAppendValue(lInputMutableArray, lOutputStr); + end; // kEventAccessibleGetAllAttributeNames + kEventAccessibleGetNamedAttribute: + begin + GetEventParameter(AEvent, kEventParamAccessibleAttributeName, + typeCFStringRef, nil, SizeOf(CFStringRef), nil, @lInputStr); + + lInputPasStr := CFStringToStr(lInputStr); + + {.$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)} + DebugLn('CarbonMemoBorder_Accessibility kEventAccessibleGetNamedAttribute kEventParamAccessibleAttributeName=' + lInputPasStr); + {.$ENDIF} + + // AXRole overrides TCustomControl and TCustomWindow values +(* if lInputPasStr = 'AXRole' then + begin + lAXRole := CFSTR('AXGroup'); + //if OSError( + SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef, + SizeOf(CFStringRef), @lAXRole); + + Result := noErr; + Exit; + end;*) + // Specially only AXRoleDescription is allowed to override non-TCustomControl values + if lInputPasStr = 'AXRoleDescription' then + begin + //if lInputAccessibleObject.AccessibleDescription = '' then Exit; + CreateCFString('memoborder', lOutputStr); + SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef, + SizeOf(CFStringRef), @lOutputStr); + FreeCFString(lOutputStr); + Result := noErr; + Exit; + end; +(* else if lInputPasStr = 'AXValue' then + begin + if not (lLazControl is TCustomControl) then Exit; + if lLazControl is TCustomForm then Exit; + if (lInputID64 = 0) then Exit; + CreateCFString(lInputAccessibleObject.AccessibleValue, lOutputStr); + SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef, + SizeOf(CFStringRef), @lOutputStr); + FreeCFString(lOutputStr); + Result := noErr; + end + else if (lInputPasStr = 'AXNumberOfCharacters') then + begin + if not (lLazControl is TCustomControl) then Exit; + if lLazControl is TCustomForm then Exit; + lOutputInt := UTF8Length(lInputAccessibleObject.AccessibleValue); + lOutputNum := CFNumberCreate(nil, kCFNumberSInt64Type, @lOutputInt); + SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFNumberRef, + SizeOf(lOutputNum), @lOutputNum); + CFRelease(lOutputNum); + Result := noErr; + end;*) + end; // kEventAccessibleGetNamedAttribute +(* kEventAccessibleIsNamedAttributeSettable: + begin + if OSError( + GetEventParameter(AEvent, kEventParamAccessibleAttributeName, + typeCFStringRef, nil, SizeOf(CFStringRef), nil, @lInputStr), + SName, 'GetEventParameter') then Exit; + + lInputPasStr := CFStringToStr(lInputStr); + + if (lInputPasStr = 'AXFocused') then + begin + lOutputBool := TCustomControl(lLazControl).TabStop; + SetEventParameter(AEvent, kEventParamAccessibleAttributeSettable, typeBoolean, + SizeOf(Boolean), @lOutputBool); + Result := noErr; + Exit; + end; + // For all other attributes simply default for not settable + if (lInputPasStr = 'AXStringForRange') or + (lInputPasStr = 'AXNumberOfCharacters') or (lInputPasStr = 'AXChildren') or + (lInputPasStr = 'AXSelectedChildren') or (lInputPasStr = 'AXVisibleChildren') or + (lInputPasStr = 'AXPosition') or (lInputPasStr = 'AXSize') or + (lInputPasStr = 'AXParent') or (lInputPasStr = 'AXTopLevelUIElement') or + (lInputPasStr = 'AXWindow') or (lInputPasStr = 'AXOrientation') or + (lInputPasStr = 'AXValue') or (lInputPasStr = 'AXEnabled') then + begin + lOutputBool := False; + SetEventParameter(AEvent, kEventParamAccessibleAttributeSettable, typeBoolean, + SizeOf(Boolean), @lOutputBool); + Result := noErr; + end; + end; // kEventAccessibleIsNamedAttributeSettable*) + end; // case EventKind of +end; procedure TCarbonMemo.RegisterEvents; var TmpSpec: EventTypeSpec; + AccessibilitySpec: array [0..3] of EventTypeSpec; begin inherited RegisterEvents; @@ -1778,6 +1961,28 @@ begin InstallControlEventHandler(FBorder, RegisterEventHandler(@CarbonMemoBorder_Draw), 1, @TmpSpec, Pointer(Self), nil); + + // Accessibility + //AccessibilitySpec[0].eventClass := kEventClassAccessibility; + //AccessibilitySpec[0].eventKind := kEventAccessibleGetChildAtPoint; + AccessibilitySpec[0].eventClass := kEventClassAccessibility; + AccessibilitySpec[0].eventKind := kEventAccessibleGetFocusedChild; + AccessibilitySpec[1].eventClass := kEventClassAccessibility; + AccessibilitySpec[1].eventKind := kEventAccessibleGetAllAttributeNames; + {AccessibilitySpec[3].eventClass := kEventClassAccessibility; + AccessibilitySpec[3].eventKind := kEventAccessibleGetAllParameterizedAttributeNames;} + AccessibilitySpec[2].eventClass := kEventClassAccessibility; + AccessibilitySpec[2].eventKind := kEventAccessibleGetNamedAttribute; + // kEventAccessibleSetNamedAttribute + AccessibilitySpec[3].eventClass := kEventClassAccessibility; + AccessibilitySpec[3].eventKind := kEventAccessibleIsNamedAttributeSettable; + // kEventAccessibleGetAllActionNames + // kEventAccessiblePerformNamedAction + // kEventAccessibleGetNamedActionDescription + + InstallControlEventHandler(FBorder, + RegisterEventHandler(@CarbonMemoBorder_Accessibility), + 4, @AccessibilitySpec[0], Pointer(Self), nil); end; end; diff --git a/lcl/interfaces/carbon/carbonprivatecontrol.inc b/lcl/interfaces/carbon/carbonprivatecontrol.inc index 7d2ccee490..38dc29ed32 100644 --- a/lcl/interfaces/carbon/carbonprivatecontrol.inc +++ b/lcl/interfaces/carbon/carbonprivatecontrol.inc @@ -223,7 +223,14 @@ begin AXUIElementGetIdentifier(lInputAXObject, lInputID64); if (lLazControl is TCustomControl) and (lInputID64 <> 0) then lInputAccessibleObject := TLazAccessibleObject(PtrInt(lInputID64)) - else lInputAccessibleObject := lLazControl.GetAccessibleObject(); + else + begin + lInputAccessibleObject := lLazControl.GetAccessibleObject(); + + {// Store the AX Handle + if not lInputAccessibleObject.HandleAllocated then + lInputAccessibleObject.Handle := PtrInt(lInputAXObject);} + end; lLazAXRole := lInputAccessibleObject.AccessibleRole; EventKind := GetEventKind(AEvent);