source: cprs/branches/tmg-cprs/CPRS-Chart/uAccessibleTreeView.pas@ 893

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

Initial upload of TMG-CPRS 1.0.26.69

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