paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-08 20:47:17 +01:00
Code Issues Packages Projects Releases Wiki Activity

Advances implementing the WS class for TLazAccessibleObject

Browse Source 
git-svn-id: trunk@34713 -
This commit is contained in:
sekelsenmat 2012-01-12 01:29:32 +00:00
parent 61d31cd4c2
commit 034d195ca9
16 changed files with 147 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/controls.pp
View File

@ -2506,6 +2506,7 @@ implementation
uses
WSControls, // circle with base widgetset is allowed
WSLCLClasses,
Forms, // the circle can't be broken without breaking Delphi compatibility
Math; // Math is in RTL and only a few functions are used.

15
lcl/include/control.inc
View File

@ -29,15 +29,19 @@
{ TLazAccessibleObject }
function TLazAccessibleObject.GetHandle: PtrInt;
var
WidgetsetClass: TWSLazAccessibleObjectClass;
begin
// if FHandle = 0 then FHandle := TWSLazAccessibleObject(WidgetsetClass).CreateHandle(Self);
WidgetsetClass := TWSLazAccessibleObjectClass(GetWSLazAccessibleObject());
if (WidgetsetClass <> nil) and (FHandle = 0) then
FHandle := WidgetsetClass.CreateHandle(Self);
Result := FHandle;
end;
class procedure TLazAccessibleObject.WSRegisterClass;
begin
// inherited WSRegisterClass;
// RegisterLazAccessibleObject;
RegisterLazAccessibleObject;
end;
constructor TLazAccessibleObject.Create(AOwner: TControl);
@ -45,12 +49,17 @@ begin
inherited Create;//(AOwner);
OwnerControl := AOwner;
FChildren := TFPList.Create;
WSRegisterClass();
end;
destructor TLazAccessibleObject.Destroy;
var
WidgetsetClass: TWSLazAccessibleObjectClass;
begin
WidgetsetClass := TWSLazAccessibleObjectClass(GetWSLazAccessibleObject());
ClearChildAccessibleObjects();
// if FHandle <> 0 then TWSLazAccessibleObject(WidgetsetClass).DestroyHandle(Self);
if (WidgetsetClass <> nil) and (FHandle <> 0) then
WidgetsetClass.DestroyHandle(Self);
inherited Destroy;
end;

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

@ -322,8 +322,7 @@ begin
lArray := CFArrayCreateMutable(kCFAllocatorDefault, lCount, @kCFTypeArrayCallBacks);
for i := 0 to lCount - 1 do
begin
//lElement := AXUIElementRef(lLazControl.GetAccessibleObject().Handle);
lElement := MacOSAll.AXUIElementCreateSystemWide();
lElement := AXUIElementRef(lLazControl.GetAccessibleObject().Handle);
CFArrayAppendValue(lArray, lElement);
end;

31
lcl/interfaces/carbon/carbonwscontrols.pp
View File

@ -48,6 +48,16 @@ type
published
end;
{ TCarbonWSLazAccessibleObject }
TCarbonWSLazAccessibleObject = class(TWSLazAccessibleObject)
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 function CreateHandle(const AObject: TLazAccessibleObject): HWND; override;
class procedure DestroyHandle(const AObject: TLazAccessibleObject); override;
end;
{ TCarbonWSControl }
TCarbonWSControl = class(TWSControl)
@ -107,6 +117,27 @@ implementation
uses
CarbonProc;
{ TCarbonWSLazAccessibleObject }
class function TCarbonWSLazAccessibleObject.CreateHandle(
const AObject: TLazAccessibleObject): HWND;
var
lElement: AXUIElementRef;
begin
lElement := MacOSAll.AXUIElementCreateSystemWide();
Result := HWND(lElement);
end;
class procedure TCarbonWSLazAccessibleObject.DestroyHandle(
const AObject: TLazAccessibleObject);
var
lElement: AXUIElementRef;
begin
if AObject.Handle = 0 then Exit;
lElement := AXUIElementRef(AObject.Handle);
CFRelease(lElement);
end;
{ TCarbonWSWinControl }
{------------------------------------------------------------------------------

7
lcl/interfaces/carbon/carbonwsfactory.pas
View File

@ -17,6 +17,7 @@ uses
function RegisterCustomImageList: Boolean;
// controls
function RegisterDragImageList: Boolean;
function RegisterLazAccessibleObject: Boolean;
function RegisterControl: Boolean;
function RegisterWinControl: Boolean;
function RegisterGraphicControl: Boolean;
@ -115,6 +116,12 @@ begin
Result := False;
end;
function RegisterLazAccessibleObject: Boolean; alias : 'WSRegisterLazAccessibleObject';
begin
RegisterWSLazAccessibleObject(TCarbonWSLazAccessibleObject);
Result := True;
end;
function RegisterControl: Boolean; alias : 'WSRegisterControl';
begin
Result := False;

8
lcl/interfaces/cocoa/cocoawsfactory.pas
View File

@ -20,6 +20,7 @@ uses
function RegisterCustomImageList: Boolean;
// controls
function RegisterDragImageList: Boolean;
function RegisterLazAccessibleObject: Boolean;
function RegisterControl: Boolean;
function RegisterWinControl: Boolean;
function RegisterGraphicControl: Boolean;
@ -120,6 +121,13 @@ begin
Result := False;
end;
function RegisterLazAccessibleObject: Boolean; alias : 'WSRegisterLazAccessibleObject';
begin
// RegisterWSLazAccessibleObject(TGtk2WSLazAccessibleObject);
// Result := True;
Result := False;
end;
function RegisterControl: Boolean; alias : 'WSRegisterControl';
begin
Result := False;

8
lcl/interfaces/customdrawn/customdrawnwsfactory.pas
View File

@ -12,6 +12,7 @@ uses
function RegisterCustomImageList: Boolean;
// controls
function RegisterDragImageList: Boolean;
function RegisterLazAccessibleObject: Boolean;
function RegisterControl: Boolean;
function RegisterWinControl: Boolean;
function RegisterGraphicControl: Boolean;
@ -127,6 +128,13 @@ begin
Result := False;
end;
function RegisterLazAccessibleObject: Boolean; alias : 'WSRegisterLazAccessibleObject';
begin
// RegisterWSLazAccessibleObject(TGtk2WSLazAccessibleObject);
// Result := True;
Result := False;
end;
function RegisterControl: Boolean; alias : 'WSRegisterControl';
begin
Result := False;

8
lcl/interfaces/fpgui/fpguiwsfactory.pas
View File

@ -12,6 +12,7 @@ uses
function RegisterCustomImageList: Boolean;
// controls
function RegisterDragImageList: Boolean;
function RegisterLazAccessibleObject: Boolean;
function RegisterControl: Boolean;
function RegisterWinControl: Boolean;
function RegisterGraphicControl: Boolean;
@ -120,6 +121,13 @@ begin
Result := False;
end;
function RegisterLazAccessibleObject: Boolean; alias : 'WSRegisterLazAccessibleObject';
begin
// RegisterWSLazAccessibleObject(TGtk2WSLazAccessibleObject);
// Result := True;
Result := False;
end;
function RegisterControl: Boolean; alias : 'WSRegisterControl';
begin
RegisterWSComponent(TControl, TFpGuiWSControl);

8
lcl/interfaces/gtk2/gtk2wsfactory.pas
View File

@ -13,6 +13,7 @@ uses
function RegisterCustomImageList: Boolean;
// controls
function RegisterDragImageList: Boolean;
function RegisterLazAccessibleObject: Boolean;
function RegisterControl: Boolean;
function RegisterWinControl: Boolean;
function RegisterGraphicControl: Boolean;
@ -132,6 +133,13 @@ begin
Result := True;
end;
function RegisterLazAccessibleObject: Boolean; alias : 'WSRegisterLazAccessibleObject';
begin
// RegisterWSLazAccessibleObject(TGtk2WSLazAccessibleObject);
// Result := True;
Result := False;
end;
function RegisterControl: Boolean; alias : 'WSRegisterControl';
begin
// RegisterWSComponent(TControl, TGtk2WSControl);

6
lcl/interfaces/nogui/noguiwsfactory.pas
View File

@ -11,6 +11,7 @@ uses
function RegisterCustomImageList: Boolean;
// controls
function RegisterDragImageList: Boolean;
function RegisterLazAccessibleObject: Boolean;
function RegisterControl: Boolean;
function RegisterWinControl: Boolean;
function RegisterGraphicControl: Boolean;
@ -109,6 +110,11 @@ begin
Result := False;
end;
function RegisterLazAccessibleObject: Boolean; alias : 'WSRegisterLazAccessibleObject';
begin
Result := False;
end;
function RegisterControl: Boolean; alias : 'WSRegisterControl';
begin
Result := False;

8
lcl/interfaces/qt/qtwsfactory.pas
View File

@ -12,6 +12,7 @@ uses
function RegisterCustomImageList: Boolean;
// controls
function RegisterDragImageList: Boolean;
function RegisterLazAccessibleObject: Boolean;
function RegisterControl: Boolean;
function RegisterWinControl: Boolean;
function RegisterGraphicControl: Boolean;
@ -126,6 +127,13 @@ begin
Result := True;
end;
function RegisterLazAccessibleObject: Boolean; alias : 'WSRegisterLazAccessibleObject';
begin
// RegisterWSLazAccessibleObject(TGtk2WSLazAccessibleObject);
// Result := True;
Result := False;
end;
function RegisterControl: Boolean; alias : 'WSRegisterControl';
begin
Result := False;

8
lcl/interfaces/win32/win32wsfactory.pas
View File

@ -12,6 +12,7 @@ uses
function RegisterCustomImageList: Boolean;
// controls
function RegisterDragImageList: Boolean;
function RegisterLazAccessibleObject: Boolean;
function RegisterControl: Boolean;
function RegisterWinControl: Boolean;
function RegisterGraphicControl: Boolean;
@ -128,6 +129,13 @@ begin
Result := True;
end;
function RegisterLazAccessibleObject: Boolean; alias : 'WSRegisterLazAccessibleObject';
begin
// RegisterWSLazAccessibleObject(TGtk2WSLazAccessibleObject);
// Result := True;
Result := False;
end;
function RegisterControl: Boolean; alias : 'WSRegisterControl';
begin
RegisterWSComponent(TControl, TWin32WSControl);

8
lcl/interfaces/wince/wincewsfactory.pas
View File

@ -12,6 +12,7 @@ uses
function RegisterCustomImageList: Boolean;
// controls
function RegisterDragImageList: Boolean;
function RegisterLazAccessibleObject: Boolean;
function RegisterControl: Boolean;
function RegisterWinControl: Boolean;
function RegisterGraphicControl: Boolean;
@ -127,6 +128,13 @@ begin
Result := True;
end;
function RegisterLazAccessibleObject: Boolean; alias : 'WSRegisterLazAccessibleObject';
begin
// RegisterWSLazAccessibleObject(TGtk2WSLazAccessibleObject);
// Result := True;
Result := False;
end;
function RegisterControl: Boolean; alias : 'WSRegisterControl';
begin
Result := False;

23
lcl/widgetset/wscontrols.pp
View File

@ -69,14 +69,13 @@ type
{ TWSLazAccessibleObject }
{ TWSLazAccessibleObject = class(TWSLCLComponent)
published
TWSLazAccessibleObject = class(TWSObject)
public
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);
end;
TWSLazAccessibleObjectClass = class of TWSLazAccessibleObject;
{ TWSControl }
@ -155,7 +154,7 @@ type
end;
procedure RegisterDragImageList;
//procedure RegisterLazAccessibleObject;
procedure RegisterLazAccessibleObject;
procedure RegisterControl;
procedure RegisterWinControl;
procedure RegisterGraphicControl;
@ -165,7 +164,7 @@ implementation
{ TWSLazAccessibleObject }
(*class procedure TWSLazAccessibleObject.SetFields(
class procedure TWSLazAccessibleObject.SetFields(
const AObject: TLazAccessibleObject; const ADescription, AName: string;
const ARole: TLazAccessibilityRole);
begin
@ -182,7 +181,7 @@ class procedure TWSLazAccessibleObject.DestroyHandle(
const AObject: TLazAccessibleObject);
begin
end;*)
end;
{ TWSControl }
@ -409,15 +408,15 @@ begin
Done := True;
end;
{procedure RegisterLazAccessibleObject;
procedure RegisterLazAccessibleObject;
const
Done: Boolean = False;
begin
if Done then exit;
if not WSRegisterControl then
RegisterWSComponent(TLazAccessibleObject, TWSLazAccessibleObject);
if not WSRegisterLazAccessibleObject then
RegisterWSLazAccessibleObject(TWSLazAccessibleObject);
Done := True;
end;}
end;
procedure RegisterControl;
const

1
lcl/widgetset/wsfactory.pas
View File

@ -8,6 +8,7 @@ interface
function WSRegisterCustomImageList: Boolean; external name 'WSRegisterCustomImageList';
// controls
function WSRegisterDragImageList: Boolean; external name 'WSRegisterDragImageList';
function WSRegisterLazAccessibleObject: Boolean; external name 'WSRegisterLazAccessibleObject';
function WSRegisterControl: Boolean; external name 'WSRegisterControl';
function WSRegisterWinControl: Boolean; external name 'WSRegisterWinControl';
function WSRegisterGraphicControl: Boolean; external name 'WSRegisterGraphicControl';

21
lcl/widgetset/wslclclasses.pp
View File

@ -56,6 +56,13 @@ type
end;
TWSPrivateClass = class of TWSPrivate;
{ For non-TComponent WS objects }
TWSObject = class(TObject)
public
end;
TWSObjectClass = class of TWSObject;
{ TWSLCLComponent }
{$M+}
@ -79,6 +86,9 @@ function FindWSComponentClass(const AComponent: TComponentClass): TWSLCLComponen
procedure RegisterWSComponent(const AComponent: TComponentClass;
const AWSComponent: TWSLCLComponentClass;
const AWSPrivate: TWSPrivateClass = nil);
// Only for non-TComponent based objects
function GetWSLazAccessibleObject: TWSObjectClass;
procedure RegisterWSLazAccessibleObject(const AWSObject: TWSObjectClass);
implementation
@ -116,6 +126,7 @@ const
var
MComponentIndex: TStringList;
MWSRegisterIndex: TStringList;
WSLazAccessibleObjectClass: TWSObjectClass;
function FindWSComponentClass(
const AComponent: TComponentClass): TWSLCLComponentClass;
@ -422,6 +433,16 @@ begin
UpdateChildren(Node, OldPrivate);
end;
function GetWSLazAccessibleObject: TWSObjectClass;
begin
Result := WSLazAccessibleObjectClass;
end;
procedure RegisterWSLazAccessibleObject(const AWSObject: TWSObjectClass);
begin
WSLazAccessibleObjectClass := AWSObject;
end;
{ TWSLCLComponent }