source: cprs/trunk/CPRS-Chart/uAccessibleTreeNode.pas@ 776

Last change on this file since 776 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76

File size: 8.1 KB
Line 
1unit uAccessibleTreeNode;
2
3interface
4
5uses
6 ComObj, ActiveX, CPRSChart_TLB, StdVcl, ORCtrls, Accessibility_TLB;
7
8type
9 TChildType = (ctInvalid, ctNoChild, ctChild);
10
11 TAccessibleTreeNode = class(TAutoObject, IAccessibleTreeNode, IAccessible)
12 private
13 FDefaultObject: IAccessible;
14 FDefaultObjectLoaded: boolean;
15 FControl: TORTreeNode;
16 function GetDefaultObject: IAccessible;
17 protected
18 function accHitTest(xLeft, yTop: Integer): OleVariant; safecall;
19 function accNavigate(navDir: Integer; varStart: OleVariant): OleVariant;
20 safecall;
21 function Get_accChild(varChild: OleVariant): IDispatch; safecall;
22 function Get_accChildCount: Integer; safecall;
23 function Get_accDefaultAction(varChild: OleVariant): WideString; safecall;
24 function Get_accDescription(varChild: OleVariant): WideString; safecall;
25 function Get_accFocus: OleVariant; safecall;
26 function Get_accHelp(varChild: OleVariant): WideString; safecall;
27 function Get_accHelpTopic(out pszHelpFile: WideString;
28 varChild: OleVariant): Integer; safecall;
29 function Get_accKeyboardShortcut(varChild: OleVariant): WideString;
30 safecall;
31 function Get_accName(varChild: OleVariant): WideString; safecall;
32 function Get_accParent: IDispatch; safecall;
33 function Get_accRole(varChild: OleVariant): OleVariant; safecall;
34 function Get_accSelection: OleVariant; safecall;
35 function Get_accState(varChild: OleVariant): OleVariant; safecall;
36 function Get_accValue(varChild: OleVariant): WideString; safecall;
37 procedure accDoDefaultAction(varChild: OleVariant); safecall;
38 procedure accLocation(out pxLeft, pyTop, pcxWidth, pcyHeight: Integer;
39 varChild: OleVariant); safecall;
40 procedure accSelect(flagsSelect: Integer; varChild: OleVariant); safecall;
41 procedure Set_accName(varChild: OleVariant; const pszName: WideString);
42 safecall;
43 procedure Set_accValue(varChild: OleVariant; const pszValue: WideString);
44 safecall;
45 public
46 property Control: TORTreeNode read FControl write FControl;
47 property DefaultObject: IAccessible read GetDefaultObject write FDefaultObject;
48 function ChildType( varChild: OleVariant): TChildType;
49 class procedure WrapControl( Control: TORTreeNode);
50 class procedure UnwrapControl( Control: TORTreeNode);
51 end;
52
53implementation
54
55uses uComServ, uAccessAPI, Windows, SysUtils, Variants;
56
57var
58 UserIsRestricted: boolean = False;
59
60function TAccessibleTreeNode.accHitTest(xLeft, yTop: Integer): OleVariant;
61begin
62 result := Null;
63 if Assigned(DefaultObject) then
64 result := DefaultObject.accHitTest(xLeft,yTop);
65end;
66
67function TAccessibleTreeNode.accNavigate(navDir: Integer;
68 varStart: OleVariant): OleVariant;
69begin
70 result := Null;
71 if Assigned(DefaultObject) then
72 result := DefaultObject.accNavigate(navDir, varStart);
73end;
74
75function TAccessibleTreeNode.Get_accChild(varChild: OleVariant): IDispatch;
76begin
77 result := nil;
78 if Assigned(DefaultObject) then
79 result := DefaultObject.Get_accChild(varChild);
80end;
81
82function TAccessibleTreeNode.Get_accChildCount: Integer;
83begin
84 result := 0;
85 if Assigned(DefaultObject) then
86 result := DefaultObject.Get_accChildCount;
87end;
88
89function TAccessibleTreeNode.Get_accDefaultAction(
90 varChild: OleVariant): WideString;
91begin
92 result := '';
93 if Assigned(DefaultObject) then
94 result := DefaultObject.Get_accDefaultAction(varChild);
95end;
96
97function TAccessibleTreeNode.Get_accDescription(
98 varChild: OleVariant): WideString;
99begin
100 result := '';
101 if Assigned(DefaultObject) then
102 result := DefaultObject.Get_accDescription(varChild);
103end;
104
105function TAccessibleTreeNode.Get_accFocus: OleVariant;
106begin
107 result := NULL;
108 if Assigned(DefaultObject) then
109 result := DefaultObject.Get_accFocus;
110end;
111
112function TAccessibleTreeNode.Get_accHelp(varChild: OleVariant): WideString;
113begin
114 result := '';
115 if Assigned(DefaultObject) then
116 result := DefaultObject.Get_accHelp(varChild);
117end;
118
119function TAccessibleTreeNode.Get_accHelpTopic(out pszHelpFile: WideString;
120 varChild: OleVariant): Integer;
121begin
122 result := 0;
123 if Assigned(DefaultObject) then
124 result := DefaultObject.Get_accHelpTopic(pszHelpFile, varChild);
125end;
126
127function TAccessibleTreeNode.Get_accKeyboardShortcut(
128 varChild: OleVariant): WideString;
129begin
130 result := '';
131 if Assigned(DefaultObject) then
132 result := DefaultObject.Get_accKeyboardShortcut(varChild);
133end;
134
135function TAccessibleTreeNode.Get_accName(varChild: OleVariant): WideString;
136begin
137 if ChildType(varChild) = ctNoChild then
138 begin
139 result := '';
140 if Assigned(FControl) then
141 result := FControl.Caption;
142 end
143 else if Assigned(DefaultObject) then
144 result := DefaultObject.Get_accName(varChild);
145end;
146
147function TAccessibleTreeNode.Get_accParent: IDispatch;
148begin
149 result := nil;
150 if Assigned(DefaultObject) then
151 result := DefaultObject.Get_accParent;
152end;
153
154function TAccessibleTreeNode.Get_accRole(varChild: OleVariant): OleVariant;
155begin
156 result := NULL;
157 if Assigned(DefaultObject) then
158 result := DefaultObject.Get_accRole(varChild);
159end;
160
161function TAccessibleTreeNode.Get_accSelection: OleVariant;
162begin
163 result := NULL;
164 if Assigned(DefaultObject) then
165 result := DefaultObject.Get_accSelection;
166end;
167
168function TAccessibleTreeNode.Get_accState(varChild: OleVariant): OleVariant;
169begin
170 result := NULL;
171 if Assigned(DefaultObject) then
172 result := DefaultObject.Get_accState(varChild);
173end;
174
175function TAccessibleTreeNode.Get_accValue(varChild: OleVariant): WideString;
176begin
177 result := '';
178 if Assigned(DefaultObject) then
179 result := DefaultObject.Get_accValue(varChild);
180end;
181
182procedure TAccessibleTreeNode.accDoDefaultAction(varChild: OleVariant);
183begin
184 if Assigned(DefaultObject) then
185 DefaultObject.accDoDefaultAction(varChild);
186end;
187
188procedure TAccessibleTreeNode.accLocation(out pxLeft, pyTop, pcxWidth,
189 pcyHeight: Integer; varChild: OleVariant);
190begin
191 if Assigned(DefaultObject) then
192 DefaultObject.accLocation(pxLeft,pyTop,pcxWidth,pcyHeight,VarChild);
193end;
194
195procedure TAccessibleTreeNode.accSelect(flagsSelect: Integer;
196 varChild: OleVariant);
197begin
198 if Assigned(DefaultObject) then
199 DefaultObject.accSelect(flagsSelect, varChild);
200end;
201
202procedure TAccessibleTreeNode.Set_accName(varChild: OleVariant;
203 const pszName: WideString);
204begin
205 if Assigned(DefaultObject) then
206 DefaultObject.Set_accName(varChild, pszName);
207end;
208
209procedure TAccessibleTreeNode.Set_accValue(varChild: OleVariant;
210 const pszValue: WideString);
211begin
212 if Assigned(DefaultObject) then
213 DefaultObject.Set_accValue(varChild, pszValue);
214end;
215
216function TAccessibleTreeNode.GetDefaultObject: IAccessible;
217begin
218 if Assigned(FControl) and not FDefaultObjectLoaded then begin
219 FDefaultObject := uAccessAPI.GetDefaultObject(FControl);
220 FDefaultObjectLoaded := True;
221 end;
222 Result := FDefaultObject;
223end;
224
225function TAccessibleTreeNode.ChildType(varChild: OleVariant): TChildType;
226begin
227 if (VarType(varChild) <> varInteger) then
228 result := ctInvalid
229 else if varChild = CHILDID_SELF then
230 result := ctNoChild
231 else
232 result := ctChild;
233end;
234
235class procedure TAccessibleTreeNode.WrapControl(Control: TORTreeNode);
236var
237 AccessibleTreeNode: TAccessibleTreeNode;
238 {Using Accessible here is probably just interface reference count paranoia}
239 Accessible: IAccessible;
240begin
241 if not UserIsRestricted then
242 begin
243 AccessibleTreeNode := TAccessibleTreeNode.Create;
244 Accessible := AccessibleTreeNode;
245 AccessibleTreeNode.Control := Control;
246 Control.MakeAccessible(Accessible);
247 end;
248end;
249
250class procedure TAccessibleTreeNode.UnwrapControl(Control: TORTreeNode);
251begin
252 if not UserIsRestricted then
253 Control.MakeAccessible(nil);
254end;
255
256initialization
257 try
258 TAutoObjectFactory.Create(ComServer, TAccessibleTreeNode, Class_AccessibleTreeNode,
259 ciMultiInstance, tmApartment);
260 except
261 {Let the poor restricted users pass!}
262 UserIsRestricted := True;
263 end;
264
265end.
Note: See TracBrowser for help on using the repository browser.