source: cprs/branches/tmg-cprs/CPRS-Chart/uAccessibleTreeNode.pas@ 1620

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

Initial upload of TMG-CPRS 1.0.26.69

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