Advances implementing accessible children for TTreeView, specially in Carbon. Not yet fully working

git-svn-id: trunk@34709 -

lcl/comctrls.pp

@@ -2654,6 +2654,14 @@ type
     tvimAsPrevSibling
   );
 
+  { TTreeViewAccessibleObject }
+
+  TTreeViewAccessibleObject = class(TLazAccessibleObject)
+  public
+    function GetSelectedChildAccessibleObject: TLazAccessibleObject; override;
+    function GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; override;
+  end;
+
   TCustomTreeView = class(TCustomControl)
   private
     FBackgroundColor: TColor;
@@ -2852,6 +2860,7 @@ type
     procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
     procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
     procedure Resize; override;
+    function CreateAccessibleObject: TLazAccessibleObject; override;
   protected
     property AutoExpand: Boolean read GetAutoExpand write SetAutoExpand default False;
     property BorderStyle default bsSingle;

lcl/controls.pp

@@ -904,12 +904,14 @@ type
     ParentControl: TControl;
     Parent: TLazAccessibleObject;
     DataObject: TObject; // Availble to be used to connect to an object
+    Handle: PtrInt;
     constructor Create; virtual;
     destructor Destroy; override;
     function AddChildAccessibleObject: TLazAccessibleObject; virtual;
     procedure ClearChildAccessibleObjects;
     procedure RemoveChildAccessibleObject(AObject: TLazAccessibleObject);
     function GetChildAccessibleObject(AIndex: Integer): TLazAccessibleObject;
+    function GetChildAccessibleObjectWithDataObject(ADataObject: TObject): TLazAccessibleObject;
     function GetChildAccessibleObjectsCount: Integer;
     function GetSelectedChildAccessibleObject: TLazAccessibleObject; virtual;
     function GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; virtual;

lcl/include/control.inc

@@ -42,6 +42,7 @@ end;
 
 function TLazAccessibleObject.AddChildAccessibleObject: TLazAccessibleObject;
 begin
+  Result := nil;
   if FChildren = nil then Exit;
   Result := TLazAccessibleObject.Create;
   Result.Parent := Self;
@@ -70,12 +71,29 @@ end;
 
 function TLazAccessibleObject.GetChildAccessibleObject(AIndex: Integer): TLazAccessibleObject;
 begin
+  Result := nil;
   if FChildren = nil then Exit;
   Result := TLazAccessibleObject(FChildren.Items[AIndex]);
 end;
 
+function TLazAccessibleObject.GetChildAccessibleObjectWithDataObject(
+  ADataObject: TObject): TLazAccessibleObject;
+var
+  i: Integer;
+  lCurObject: TLazAccessibleObject;
+begin
+  Result := nil;
+  if FChildren = nil then Exit;
+  for i := 0 to FChildren.Count - 1 do
+  begin
+    lCurObject := TLazAccessibleObject(FChildren.Items[i]);
+    if lCurObject.DataObject = ADataObject then Exit(lCurObject);
+  end;
+end;
+
 function TLazAccessibleObject.GetChildAccessibleObjectsCount: Integer;
 begin
+  Result := 0;
   if FChildren = nil then Exit;
   Result := FChildren.Count;
 end;

lcl/include/treeview.inc

@@ -29,6 +29,34 @@
 
 { $DEFINE TREEVIEW_DEBUG}
 
+{ TTreeViewAccessibleObject }
+
+function TTreeViewAccessibleObject.GetSelectedChildAccessibleObject: TLazAccessibleObject;
+var
+  lTreeView: TCustomTreeView;
+  lNode: TTreeNode;
+begin
+  Result := inherited GetSelectedChildAccessibleObject();
+  if (Result <> nil) or (ParentControl = nil) then Exit;
+  lTreeView := TCustomTreeView(ParentControl);
+  lNode := lTreeView.GetSelection();
+  if lNode = nil then Exit;
+  Result := GetChildAccessibleObjectWithDataObject(lNode);
+end;
+
+function TTreeViewAccessibleObject.GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject;
+var
+  lTreeView: TCustomTreeView;
+  lNode: TTreeNode;
+begin
+  Result := inherited GetChildAccessibleObjectAtPos(APos);
+  if (Result <> nil) or (ParentControl = nil) then Exit;
+  lTreeView := TCustomTreeView(ParentControl);
+  lNode := lTreeView.GetNodeAt(APos.X, APos.Y);
+  if lNode = nil then Exit;
+  Result := GetChildAccessibleObjectWithDataObject(lNode);
+end;
+
 const
   TTreeNodeWithPointerStreamVersion : word = 1;
   TTreeNodeStreamVersion : word = 2;
@@ -5319,6 +5347,12 @@ begin
   inherited Resize;
 end;
 
+function TCustomTreeView.CreateAccessibleObject: TLazAccessibleObject;
+begin
+  Result := TTreeViewAccessibleObject.Create;
+  Result.ParentControl := Self;
+end;
+
 procedure TCustomTreeView.InternalSelectionChanged;
 begin
   if FSelectionChangeEventLock > 0 then

lcl/interfaces/carbon/carbonprivatecontrol.inc

@@ -163,6 +163,8 @@ var
   lAXRole, lInputStr, lOutputStr: CFStringRef;
   lInputPasStr: string;
   lInputMutableArray: CFMutableArrayRef;
+  lInputHIPoint: HIPoint;
+  lInputPoint: TPoint;
   lOutputBool: Boolean;
   lLazControl: TControl;
   lLazAXRole: TLazAccessibilityRole;
@@ -173,6 +175,7 @@ var
   lElement: AXUIElementRef;
   lCount: Integer;
   i: Integer;
+  lAccessibleObj: TLazAccessibleObject;
 const SName = 'CarbonControl_Accessibility';
 begin
   {$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
@@ -186,6 +189,27 @@ begin
 
   EventKind := GetEventKind(AEvent);
   case EventKind of
+    kEventAccessibleGetChildAtPoint:
+    begin
+      if lLazControl = nil then Exit;
+      if (lLazControl is TWinControl) and (not (lLazControl is TCustomControl)) then Exit;
+
+      // The location in global coordinates.
+      GetEventParameter(AEvent, kEventParamMouseLocation,
+        typeHIPoint, nil, SizeOf(HIPoint), nil, @lInputHIPoint);
+
+      // <-- kEventParamAccessibleChild (out, typeCFTypeRef)
+      // On exit, contains the child of the accessible object at the
+      // 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 (lAccessibleObj = nil) or (lAccessibleObj.Handle = 0) then Exit;
+      SetEventParameter(AEvent, kEventParamAccessibleChild, typeCFTypeRef,
+        SizeOf(AXUIElementRef), @lAccessibleObj.Handle);
+    end;
     kEventAccessibleGetAllAttributeNames:
     begin
       {$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
@@ -293,12 +317,20 @@ begin
       begin
         // Create and return an array of AXUIElements describing the children of this view.
         lCount := lLazControl.GetAccessibleObject().GetChildAccessibleObjectsCount;
-        lArray := CFArrayCreateMutable( kCFAllocatorDefault, lCount, @kCFTypeArrayCallBacks);
+        lArray := CFArrayCreateMutable(kCFAllocatorDefault, lCount, @kCFTypeArrayCallBacks);
         for i := 0 to lCount - 1 do
         begin
-          lElement := MacOSAll.AXUIElementCreateSystemWide();
+          if lLazControl.GetAccessibleObject().Handle <> 0 then
+          begin
+            lElement := AXUIElementRef(lLazControl.GetAccessibleObject().Handle)
+          end
+          else
+          begin
+            lElement := MacOSAll.AXUIElementCreateSystemWide();
+            lLazControl.GetAccessibleObject().Handle := PtrInt(lElement);
+          end;
           CFArrayAppendValue(lArray, lElement);
-          CFRelease(lElement);
+          //CFRelease(lElement);
         end;
 
         SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFTypeRef,