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

Various improvements and attempts at creating a WS implementation for TLazAccessibleObject

Browse Source 
git-svn-id: trunk@34712 -
This commit is contained in:
sekelsenmat 2012-01-11 18:36:30 +00:00
parent eae537252c
commit 61d31cd4c2
6 changed files with 114 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lcl/comctrls.pp
View File

@ -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;

14
lcl/controls.pp
View File

@ -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

38
lcl/include/control.inc
View File

@ -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;
{------------------------------------------------------------------------------

46
lcl/include/treeview.inc
View File

@ -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;

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

@ -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,

59
lcl/widgetset/wscontrols.pp
View File

@ -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;