source: cprs/trunk/VA/VA508Accessibility/JAWS/fVA508HiddenJawsMainWindow.pas@ 1339

Last change on this file since 1339 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

File size: 7.0 KB
Line 
1unit fVA508HiddenJawsMainWindow;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, Contnrs, ExtCtrls, ComObj, VA508AccessibilityConst, AppEvnts;
8
9type
10 TfrmVA508HiddenJawsMainWindow = class(TForm)
11 ReloadTimer: TTimer;
12 CloseINIFilesTimer: TTimer;
13 procedure FormCreate(Sender: TObject);
14 procedure FormDestroy(Sender: TObject);
15 procedure ReloadTimerTimer(Sender: TObject);
16 procedure CloseINIFilesTimerTimer(Sender: TObject);
17 private
18 FRootCaption: string;
19 FPostWindow: HWnd;
20 FCloseFilesEvent: TNotifyEvent;
21 FData: string;
22 FVariables: string;
23 FDataWindowPool: TList;
24 FDataWindows: TObjectList;
25 FComponentDataCallBackProc: TComponentDataRequestProc;
26 FConfigChangePending: boolean;
27 FConfigReloadProc: TConfigReloadProc;
28 procedure ConverAccelChars(var text: string);
29 protected
30 procedure WndProc(var Msg: TMessage); override;
31 public
32 procedure ConfigReloadNeeded;
33 procedure WriteData(VarName, Value: string);
34 procedure PostData;
35 procedure ResetINITimer(Event: TNotifyEvent);
36 property ConfigReloadProc: TConfigReloadProc read FConfigReloadProc write FConfigReloadProc;
37 property ComponentDataCallBackProc: TComponentDataRequestProc read FComponentDataCallBackProc write FComponentDataCallBackProc;
38 property ConfigChangePending: boolean read FConfigChangePending write FConfigChangePending;
39 end;
40
41var
42 frmVA508HiddenJawsMainWindow: TfrmVA508HiddenJawsMainWindow;
43
44implementation
45
46uses JAWSCommon, fVA508HiddenJawsDataWindow, VAUtils;
47
48{$R *.dfm}
49
50procedure TfrmVA508HiddenJawsMainWindow.CloseINIFilesTimerTimer(
51 Sender: TObject);
52begin
53 CloseINIFilesTimer.Enabled := FALSE;
54 if assigned(FCloseFilesEvent) then
55 FCloseFilesEvent(Sender);
56end;
57
58procedure TfrmVA508HiddenJawsMainWindow.ConfigReloadNeeded;
59begin
60 ReloadTimer.Enabled := FALSE;
61 ReloadTimer.Enabled := TRUE;
62 FConfigChangePending := TRUE;
63end;
64
65// MSAA messes up strings with & chars
66procedure TfrmVA508HiddenJawsMainWindow.ConverAccelChars(var text: string);
67var
68 i: integer;
69 convert: boolean;
70begin
71 repeat
72 i := pos('&', text);
73 if i > 0 then
74 begin
75 convert := (i = length(text));
76 if not convert then
77 convert := not (text[i+1] in ['A'..'Z','a'..'z','0'..'9']);
78 delete(text,i,1);
79 if convert then
80 insert(' and ', text, i);
81 end;
82 until i = 0;
83end;
84
85procedure TfrmVA508HiddenJawsMainWindow.FormCreate(Sender: TObject);
86begin
87 ErrorCheckClassName(Self, DLL_MAIN_WINDOW_CLASS);
88 FRootCaption := DLL_WINDOW_TITLE;
89 Caption := FRootCaption;
90 FDataWindowPool := TList.Create;
91 FDataWindows := TObjectList.Create;
92end;
93
94procedure TfrmVA508HiddenJawsMainWindow.FormDestroy(Sender: TObject);
95begin
96 FreeAndNil(FDataWindowPool);
97 FreeAndNil(FDataWindows);
98end;
99
100procedure TfrmVA508HiddenJawsMainWindow.ReloadTimerTimer(Sender: TObject);
101begin
102 ReloadTimer.Enabled := FALSE;
103 if assigned(FConfigReloadProc) then
104 FConfigReloadProc;
105 FConfigChangePending := FALSE;
106end;
107
108procedure TfrmVA508HiddenJawsMainWindow.ResetINITimer(Event: TNotifyEvent);
109begin
110 FCloseFilesEvent := Event;
111 CloseINIFilesTimer.Enabled := FALSE;
112 CloseINIFilesTimer.Enabled := TRUE;
113end;
114
115// data is in 2 strings
116// list of variable names
117// list of data
118procedure TfrmVA508HiddenJawsMainWindow.WriteData(VarName, Value: string);
119var
120 offset, len: integer;
121begin
122 ConverAccelChars(Value);
123 len := length(Value);
124 if len > 0 then
125 begin
126 offset := length(FData);
127 FData := FData + Value;
128 end
129 else
130 offset := 0;
131 FVariables := FVariables + DLL_WINDOW_DELIM + VarName + DLL_WINDOW_OFFSET +
132 IntToStr(offset) + DLL_WINDOW_LENGTH + IntToStr(len);
133end;
134
135// output
136// caption:[next window handle]:varlen:var=offset,length:var=offset,len:data
137// varlen = from first to last :
138
139procedure TfrmVA508HiddenJawsMainWindow.PostData;
140var
141 DataWindow, LastWindow: TfrmVA508HiddenJawsDataWindow;
142 Data, Output, RootOutput: string;
143 Done, UpdateLastWindow: boolean;
144 DataLen, Len, HandleIdx, AllowedChars, StartIndex: integer;
145
146 procedure GetDataWindow;
147 var
148 idx: integer;
149 begin
150 if assigned(DataWindow) then
151 LastWindow := DataWindow;
152 if FDataWindowPool.Count > 0 then
153 begin
154 idx := FDataWindowPool.Count-1;
155 DataWindow := TfrmVA508HiddenJawsDataWindow(FDataWindowPool[idx]);
156 FDataWindowPool.Delete(idx);
157 end
158 else
159 begin
160 DataWindow := TfrmVA508HiddenJawsDataWindow.Create(Self);
161 FDataWindows.Add(DataWindow);
162 DataWindow.HandleNeeded;
163 Application.ProcessMessages;
164 end;
165 if FPostWindow = 0 then
166 FPostWindow := DataWindow.Handle;
167 end;
168
169begin
170 LastWindow := nil;
171 DataWindow := nil;
172 FVariables := FVariables + DLL_WINDOW_DELIM;
173 Len := length(FVariables);
174 Data := IntToStr(Len) + FVariables + FData;
175 DataLen := length(Data) + 1;
176// Format = header : next window handle : data
177 RootOutput := FRootCaption + DLL_WINDOW_DELIM + DLL_WINDOW_DELIM;
178 HandleIdx := length(RootOutput);
179 AllowedChars := DLL_CAPTION_LIMIT - Length(RootOutput);
180 StartIndex := 1;
181 UpdateLastWindow := FALSE;
182 repeat
183 Done := TRUE;
184 GetDataWindow;
185 if UpdateLastWindow then
186 begin
187 Output := LastWindow.Caption;
188 insert(IntToStr(DataWindow.handle), Output, HandleIdx);
189 LastWindow.Caption := Output;
190 UpdateLastWindow := FALSE;
191 end;
192 Len := DataLen - StartIndex;
193 Output := RootOutput + copy(Data, StartIndex, AllowedChars);
194 DataWindow.Caption := Output;
195 if Len > AllowedChars then
196 begin
197 UpdateLastWindow := TRUE;
198 Done := FALSE;
199 inc(startIndex, AllowedChars);
200 end;
201 until Done;
202end;
203
204procedure TfrmVA508HiddenJawsMainWindow.WndProc(var Msg: TMessage);
205var
206 i: integer;
207 data: string;
208begin
209 if Msg.Msg = MessageID then
210 begin
211 Msg.Result := 1;
212 data := caption;
213 try
214 // make sure Delphi has finished creating the form. If we dont, JAWS can detect the
215 // window before Delphi has finished creating it - resulting in an access violation
216 if assigned(Self) then
217 begin
218 try
219 if assigned(FComponentDataCallBackProc) then
220 begin
221 FPostWindow := 0;
222 FData := '';
223 FVariables := '';
224 FDataWindowPool.Assign(FDataWindows);
225 try
226 FComponentDataCallBackProc(Msg.WParam, Msg.LParam);
227 except
228 end;
229 // clean up unused windows
230 for i := 0 to FDataWindowPool.Count - 1 do
231 TfrmVA508HiddenJawsDataWindow(FDataWindowPool[i]).Caption := '';
232 SendReturnValue(Handle, FPostWindow);
233 end;
234 except
235 end;
236 end;
237 finally
238 if data = caption then
239 begin
240 SendReturnValue(Handle, 0);
241 end;
242 end;
243 end
244 else
245 inherited WndProc(Msg);
246end;
247
248end.
Note: See TracBrowser for help on using the repository browser.