From 61d31cd4c20dc6baddfe7efb3bf274bfc59b9a9d Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Wed, 11 Jan 2012 18:36:30 +0000 Subject: [PATCH] Various improvements and attempts at creating a WS implementation for TLazAccessibleObject git-svn-id: trunk@34712 - --- lcl/comctrls.pp | 12 +--- lcl/controls.pp | 14 +++-- lcl/include/control.inc | 38 ++++++++++-- lcl/include/treeview.inc | 46 ++++++--------- .../carbon/carbonprivatecontrol.inc | 16 ++--- lcl/widgetset/wscontrols.pp | 59 +++++++++++++++---- 6 files changed, 114 insertions(+), 71 deletions(-) diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index 9d18f9620a..ed1ebab7a3 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -2654,14 +2654,6 @@ type tvimAsPrevSibling ); - { TTreeViewAccessibleObject } - - TTreeViewAccessibleObject = class(TLazAccessibleObject) - public - function GetSelectedChildAccessibleObject: TLazAccessibleObject; override; - function GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; override; - end; - TCustomTreeView = class(TCustomControl) private FBackgroundColor: TColor; @@ -2860,7 +2852,9 @@ type procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS; procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS; procedure Resize; override; - function CreateAccessibleObject: TLazAccessibleObject; override; + // Accessibility + function GetSelectedChildAccessibleObject: TLazAccessibleObject; override; + function GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; override; protected property AutoExpand: Boolean read GetAutoExpand write SetAutoExpand default False; property BorderStyle default bsSingle; diff --git a/lcl/controls.pp b/lcl/controls.pp index 13fc4e3340..328999f2df 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -895,17 +895,20 @@ type { TLazAccessibleObject } TLazAccessibleObject = class + private + FHandle: PtrInt; + function GetHandle: PtrInt; protected FChildren: TFPList; // of TLazAccessibleObject + class procedure WSRegisterClass; virtual;//override; public AccessibleDescription: TCaption; AccessibleName: TCaption; AccessibleRole: TLazAccessibilityRole; - ParentControl: TControl; + OwnerControl: TControl; Parent: TLazAccessibleObject; DataObject: TObject; // Availble to be used to connect to an object - Handle: PtrInt; - constructor Create; virtual; + constructor Create(AOwner: TControl); virtual; destructor Destroy; override; function AddChildAccessibleObject: TLazAccessibleObject; virtual; procedure ClearChildAccessibleObjects; @@ -915,6 +918,7 @@ type function GetChildAccessibleObjectsCount: Integer; function GetSelectedChildAccessibleObject: TLazAccessibleObject; virtual; function GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; virtual; + property Handle: PtrInt read GetHandle; end; {* Note on TControl.Caption @@ -934,7 +938,6 @@ type TControl = class(TLCLComponent) private - FAccessibleObject: TLazAccessibleObject; FActionLink: TControlActionLink; FAlign: TAlign; FAnchors: TAnchors; @@ -1092,6 +1095,7 @@ type procedure SetTop(Value: Integer); procedure SetWidth(Value: Integer); protected + FAccessibleObject: TLazAccessibleObject; FControlState: TControlState; FCursor: TCursor; class procedure WSRegisterClass; override; @@ -1346,6 +1350,8 @@ type procedure SetAccesibilityFields(const ADescription, AName: string; const ARole: TLazAccessibilityRole); function GetAccessibleObject: TLazAccessibleObject; function CreateAccessibleObject: TLazAccessibleObject; virtual; + function GetSelectedChildAccessibleObject: TLazAccessibleObject; virtual; + function GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; virtual; public // size procedure AdjustSize; virtual;// smart calling DoAutoSize diff --git a/lcl/include/control.inc b/lcl/include/control.inc index c906373151..5536cd114c 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -28,15 +28,29 @@ { TLazAccessibleObject } -constructor TLazAccessibleObject.Create; +function TLazAccessibleObject.GetHandle: PtrInt; begin - inherited Create; +// if FHandle = 0 then FHandle := TWSLazAccessibleObject(WidgetsetClass).CreateHandle(Self); + Result := FHandle; +end; + +class procedure TLazAccessibleObject.WSRegisterClass; +begin +// inherited WSRegisterClass; +// RegisterLazAccessibleObject; +end; + +constructor TLazAccessibleObject.Create(AOwner: TControl); +begin + inherited Create;//(AOwner); + OwnerControl := AOwner; FChildren := TFPList.Create; end; destructor TLazAccessibleObject.Destroy; begin ClearChildAccessibleObjects(); +// if FHandle <> 0 then TWSLazAccessibleObject(WidgetsetClass).DestroyHandle(Self); inherited Destroy; end; @@ -44,9 +58,8 @@ function TLazAccessibleObject.AddChildAccessibleObject: TLazAccessibleObject; begin Result := nil; if FChildren = nil then Exit; - Result := TLazAccessibleObject.Create; + Result := TLazAccessibleObject.Create(OwnerControl); Result.Parent := Self; - Result.ParentControl := Self.ParentControl; FChildren.Add(Result); //DebugLn('[TControl.AddChildAccessibleObject] Name=%s', [Name]); end; @@ -101,11 +114,15 @@ end; function TLazAccessibleObject.GetSelectedChildAccessibleObject: TLazAccessibleObject; begin Result := nil; + if OwnerControl = nil then Exit; + Result := OwnerControl.GetSelectedChildAccessibleObject(); end; function TLazAccessibleObject.GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; begin Result := nil; + if OwnerControl = nil then Exit; + Result := OwnerControl.GetChildAccessibleObjectAtPos(APos); end; {------------------------------------------------------------------------------ @@ -1502,8 +1519,17 @@ end; function TControl.CreateAccessibleObject: TLazAccessibleObject; begin - Result := TLazAccessibleObject.Create; - Result.ParentControl := Self; + Result := TLazAccessibleObject.Create(Self); +end; + +function TControl.GetSelectedChildAccessibleObject: TLazAccessibleObject; +begin + Result := nil; +end; + +function TControl.GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; +begin + Result := nil; end; {------------------------------------------------------------------------------ diff --git a/lcl/include/treeview.inc b/lcl/include/treeview.inc index 83cb04707c..3bc5bf1580 100644 --- a/lcl/include/treeview.inc +++ b/lcl/include/treeview.inc @@ -31,32 +31,6 @@ { 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; @@ -5347,10 +5321,24 @@ begin inherited Resize; end; -function TCustomTreeView.CreateAccessibleObject: TLazAccessibleObject; +function TCustomTreeView.GetSelectedChildAccessibleObject: TLazAccessibleObject; +var + lNode: TTreeNode; begin - Result := TTreeViewAccessibleObject.Create; - Result.ParentControl := Self; + Result := nil; + lNode := GetSelection(); + if lNode = nil then Exit; + Result := FAccessibleObject.GetChildAccessibleObjectWithDataObject(lNode); +end; + +function TCustomTreeView.GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; +var + lNode: TTreeNode; +begin + Result := nil; + lNode := GetNodeAt(APos.X, APos.Y); + if lNode = nil then Exit; + Result := FAccessibleObject.GetChildAccessibleObjectWithDataObject(lNode); end; procedure TCustomTreeView.InternalSelectionChanged; diff --git a/lcl/interfaces/carbon/carbonprivatecontrol.inc b/lcl/interfaces/carbon/carbonprivatecontrol.inc index a00f516990..4184b884a4 100644 --- a/lcl/interfaces/carbon/carbonprivatecontrol.inc +++ b/lcl/interfaces/carbon/carbonprivatecontrol.inc @@ -176,6 +176,7 @@ var lCount: Integer; i: Integer; lAccessibleObj: TLazAccessibleObject; + lHandle: PtrInt; const SName = 'CarbonControl_Accessibility'; begin {$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)} @@ -207,8 +208,9 @@ begin if lAccessibleObj = nil then Exit; lAccessibleObj := lAccessibleObj.GetChildAccessibleObjectAtPos(lInputPoint); if (lAccessibleObj = nil) or (lAccessibleObj.Handle = 0) then Exit; + lHandle := lAccessibleObj.Handle; SetEventParameter(AEvent, kEventParamAccessibleChild, typeCFTypeRef, - SizeOf(AXUIElementRef), @lAccessibleObj.Handle); + SizeOf(AXUIElementRef), @lHandle); end; kEventAccessibleGetAllAttributeNames: begin @@ -320,17 +322,9 @@ begin lArray := CFArrayCreateMutable(kCFAllocatorDefault, lCount, @kCFTypeArrayCallBacks); for i := 0 to lCount - 1 do begin - if lLazControl.GetAccessibleObject().Handle <> 0 then - begin - lElement := AXUIElementRef(lLazControl.GetAccessibleObject().Handle) - end - else - begin - lElement := MacOSAll.AXUIElementCreateSystemWide(); - lLazControl.GetAccessibleObject().Handle := PtrInt(lElement); - end; + //lElement := AXUIElementRef(lLazControl.GetAccessibleObject().Handle); + lElement := MacOSAll.AXUIElementCreateSystemWide(); CFArrayAppendValue(lArray, lElement); - //CFRelease(lElement); end; SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFTypeRef, diff --git a/lcl/widgetset/wscontrols.pp b/lcl/widgetset/wscontrols.pp index 81eb21ae1d..57c4fa4ab1 100644 --- a/lcl/widgetset/wscontrols.pp +++ b/lcl/widgetset/wscontrols.pp @@ -67,6 +67,17 @@ type TWSDragImageListClass = class of TWSDragImageList; + { TWSLazAccessibleObject } + +{ TWSLazAccessibleObject = class(TWSLCLComponent) + published + class procedure SetFields(const AObject: TLazAccessibleObject; const ADescription, AName: string; const ARole: TLazAccessibilityRole); virtual; + class function CreateHandle(const AObject: TLazAccessibleObject): HWND; virtual; + class procedure DestroyHandle(const AObject: TLazAccessibleObject); virtual; + end;} + //lElement := MacOSAll.AXUIElementCreateSystemWide(); + //CFRelease(lElement); + { TWSControl } TWSControl = class(TWSLCLComponent) @@ -76,7 +87,6 @@ type class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; virtual; class procedure ConstraintWidth(const AControl: TControl; const AConstraints: TObject; var aWidth: integer); virtual; class procedure ConstraintHeight(const AControl: TControl; const AConstraints: TObject; var aHeight: integer); virtual; - //class procedure LazAccessibility_SetFields(const AControl: TControl; const ADescription, AName: string; const ARole: TLazAccessibilityRole); virtual; end; TWSControlClass = class of TWSControl; @@ -144,14 +154,35 @@ type published end; - procedure RegisterDragImageList; - procedure RegisterControl; - procedure RegisterWinControl; - procedure RegisterGraphicControl; - procedure RegisterCustomControl; +procedure RegisterDragImageList; +//procedure RegisterLazAccessibleObject; +procedure RegisterControl; +procedure RegisterWinControl; +procedure RegisterGraphicControl; +procedure RegisterCustomControl; implementation +{ TWSLazAccessibleObject } + +(*class procedure TWSLazAccessibleObject.SetFields( + const AObject: TLazAccessibleObject; const ADescription, AName: string; + const ARole: TLazAccessibilityRole); +begin + +end; + +class function TWSLazAccessibleObject.CreateHandle( + const AObject: TLazAccessibleObject): HWND; +begin + Result := 0; +end; + +class procedure TWSLazAccessibleObject.DestroyHandle( + const AObject: TLazAccessibleObject); +begin + +end;*) { TWSControl } @@ -181,12 +212,6 @@ begin end; -{class procedure TWSControl.LazAccessibility_SetFields(const AControl: TControl; - const ADescription, AName: string; const ARole: TLazAccessibilityRole); -begin - -end;} - { TWSWinControl } class procedure TWSWinControl.AdaptBounds(const AWinControl: TWinControl; @@ -384,6 +409,16 @@ begin Done := True; end; +{procedure RegisterLazAccessibleObject; +const + Done: Boolean = False; +begin + if Done then exit; + if not WSRegisterControl then + RegisterWSComponent(TLazAccessibleObject, TWSLazAccessibleObject); + Done := True; +end;} + procedure RegisterControl; const Done: Boolean = False;