1 | unit fHunSpell;
|
---|
2 | (* ***************************** BEGIN LICENSE BLOCK **********************
|
---|
3 | *
|
---|
4 | * Copyright (C) 2015
|
---|
5 | * Sunil Kumar Arora (digitiger@gmail.com sunil@healthsevak.com)
|
---|
6 | * All Rights Reserved.
|
---|
7 | * Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
---|
8 | *
|
---|
9 | * The contents of this file are subject to the Mozilla Public License Version
|
---|
10 | * 1.1 (the "License"); you may not use this file except in compliance with
|
---|
11 | * the License. You may obtain a copy of the License at
|
---|
12 | * http://www.mozilla.org/MPL/
|
---|
13 | *
|
---|
14 | * Software distributed under the License is distributed on an "AS IS" basis,
|
---|
15 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
---|
16 | * for the specific language governing rights and limitations under the
|
---|
17 | * License.
|
---|
18 | *
|
---|
19 | * Alternatively, the content of this file maybe used under the terms of either
|
---|
20 | * the GNU General Public License Version 2 or later (the "GPL"), or the GNU
|
---|
21 | * Lesser General Public License Version 2.1 or later (the "LGPL"), in which
|
---|
22 | * case the provisions of the GPL or the LGPL are applicable instead of those
|
---|
23 | * above. If you wish to allow use of your version of this file only under the
|
---|
24 | * terms of either the GPL or the LGPL, and not to allow others to use your
|
---|
25 | * version of this file under the terms of the MPL, indicate your division by
|
---|
26 | * deleting the provisions above and replace them with the notice and other
|
---|
27 | * provisions required by the GPL or LGPL. If you do not delete the provisions
|
---|
28 | * above, a recipient may use your version of this file under the terms of any
|
---|
29 | * one of the MPL, the GPL or the LGPL.
|
---|
30 | *
|
---|
31 | * *********************** END LICENSE BLOCK *********************************)
|
---|
32 |
|
---|
33 | interface
|
---|
34 |
|
---|
35 | uses
|
---|
36 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
37 | StdCtrls, ComCtrls, RichEdit, Buttons, ExtCtrls, ShellAPI,
|
---|
38 | skaSpellCheck,
|
---|
39 | VA508AccessibilityManager, fBase508Form;
|
---|
40 |
|
---|
41 | type
|
---|
42 | TfrmHunSpell = class(TfrmBase508Form)
|
---|
43 | lblDictionary: TLabel;
|
---|
44 | btnClose: TButton;
|
---|
45 | OpenDialog1: TOpenDialog;
|
---|
46 | SpellCheck1: TskaHunSpellChecker;
|
---|
47 | edtDictionary: TEdit;
|
---|
48 | btnSelectDict: TBitBtn;
|
---|
49 | lblOpenMedURL: TLabel;
|
---|
50 | lblDictionariesURL: TLabel;
|
---|
51 | RichEdit1: TRichEdit;
|
---|
52 | pnlMisSpelled: TPanel;
|
---|
53 | Label1: TLabel;
|
---|
54 | lstSuggestions: TListBox;
|
---|
55 | Label4: TLabel;
|
---|
56 | edtMisSpelt: TEdit;
|
---|
57 | btnReplaceWith: TButton;
|
---|
58 | btnChangeAll: TButton;
|
---|
59 | btnChange: TButton;
|
---|
60 | btnAddToDictionary: TButton;
|
---|
61 | btnIgnoreAll: TButton;
|
---|
62 | btnIgnoreOnce: TButton;
|
---|
63 | btnAbort: TButton;
|
---|
64 | btnAbout: TButton;
|
---|
65 | pnlAbout: TPanel;
|
---|
66 | Button1: TButton;
|
---|
67 | btnUndo: TButton;
|
---|
68 | cbIgnoreAllCaps: TCheckBox;
|
---|
69 | cbIgnoreDigit: TCheckBox;
|
---|
70 | procedure FormCreate(Sender: TObject);
|
---|
71 | procedure btnIgnoreOnceClick(Sender: TObject);
|
---|
72 | procedure btnIgnoreAllClick(Sender: TObject);
|
---|
73 | procedure btnChangeClick(Sender: TObject);
|
---|
74 | procedure btnChangeAllClick(Sender: TObject);
|
---|
75 | procedure btnCloseClick(Sender: TObject);
|
---|
76 | procedure FormActivate(Sender: TObject);
|
---|
77 | procedure btnSelectDictClick(Sender: TObject);
|
---|
78 | procedure edtDictionaryEnter(Sender: TObject);
|
---|
79 | procedure btnReplaceWithClick(Sender: TObject);
|
---|
80 | procedure btnAddToDictionaryClick(Sender: TObject);
|
---|
81 | procedure FormShow(Sender: TObject);
|
---|
82 | procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
83 | procedure btnAbortClick(Sender: TObject);
|
---|
84 | procedure lblOpenMedURLClick(Sender: TObject);
|
---|
85 | procedure btnAboutClick(Sender: TObject);
|
---|
86 | procedure Button1Click(Sender: TObject);
|
---|
87 | procedure btnUndoClick(Sender: TObject);
|
---|
88 | procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
|
---|
89 | Shift: TShiftState);
|
---|
90 | procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
|
---|
91 | Shift: TShiftState);
|
---|
92 | procedure lstSuggestionsDblClick(Sender: TObject);
|
---|
93 | procedure SpellCheck1StateChange(const Sender: TObject;
|
---|
94 | const State: TSpellState);
|
---|
95 | procedure SpellCheck1Abort(Sender: TObject);
|
---|
96 | procedure SpellCheck1Start(Sender: TObject);
|
---|
97 | procedure cbIgnoreAllCapsClick(Sender: TObject);
|
---|
98 | procedure cbIgnoreDigitClick(Sender: TObject);
|
---|
99 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
---|
100 | private
|
---|
101 | { Private declarations }
|
---|
102 | NoEngineOpted: Boolean;
|
---|
103 | FSourceControl: TCustomMemo;
|
---|
104 | procedure GoToURL(const aURL: String);
|
---|
105 | procedure UpdateGUI;
|
---|
106 | public
|
---|
107 | { Public declarations }
|
---|
108 | Showhighlight:boolean;
|
---|
109 | highlightcolor:TColor;
|
---|
110 | HighLightList:TStringlist;
|
---|
111 | OldRichEditWndProc: {integer}pointer;
|
---|
112 | PRichEditWndProc:pointer;
|
---|
113 | class function DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult; static;
|
---|
114 | end;
|
---|
115 |
|
---|
116 | Resourcestring
|
---|
117 | TX_AFF_NOT_FOUND = 'Correspong AFF file named not found!'
|
---|
118 | + #13
|
---|
119 | + ' Specify dictionary file whose *.aff is also '
|
---|
120 | + 'present in same directory.' ;
|
---|
121 | TX_DIC_FILE_NOT_FOUND = 'Dictionary File for SpellCheck Engine not found!';
|
---|
122 | TX_SPELL_COMPLETE = 'Spell Check Complete';
|
---|
123 | TX_SPELL_CANCELLED = 'Spell Check Aborted'
|
---|
124 | + #13
|
---|
125 | + 'No Changes applied to the original text!';
|
---|
126 |
|
---|
127 | Const
|
---|
128 | DefaultDicFile = 'dict\en-US-OpenMedSpel.dic';
|
---|
129 |
|
---|
130 | var
|
---|
131 | frmHunSpell: TfrmHunSpell;
|
---|
132 |
|
---|
133 | implementation
|
---|
134 | {$R *.DFM}
|
---|
135 |
|
---|
136 | uses uSpell, VAUtils;
|
---|
137 |
|
---|
138 | class function TfrmHunSpell.DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult;
|
---|
139 | var
|
---|
140 | frm: TfrmHunSpell;
|
---|
141 | begin
|
---|
142 | Result := mrCancel;
|
---|
143 | frm:= TfrmHunSpell.create(Application);
|
---|
144 | try
|
---|
145 | frm.RichEdit1.Text:= AnEditControl.Text;
|
---|
146 | frm.FSourceControl := AnEditControl;
|
---|
147 | Result := frm.ShowModal;
|
---|
148 | finally
|
---|
149 | frm.Free;
|
---|
150 | end;
|
---|
151 | end;
|
---|
152 |
|
---|
153 | {************ HighLight ***********888}
|
---|
154 | procedure TfrmHunSpell.FormShow(Sender: TObject);
|
---|
155 | begin
|
---|
156 | if SpellCheck1.SpellCheckState = ssReady then
|
---|
157 | SpellCheck1.CheckSpelling;
|
---|
158 | try
|
---|
159 | if lstSuggestions.Count > 0 then
|
---|
160 | btnChange.SetFocus;
|
---|
161 | except
|
---|
162 | end;
|
---|
163 | end;
|
---|
164 |
|
---|
165 | procedure TfrmHunSpell.GoToURL(const aURL: String);
|
---|
166 | begin
|
---|
167 | if length(trim(aURL)) > 4 then
|
---|
168 | ShellExecute(Handle, 'open', PChar(aURL), '', '', SW_NORMAL);
|
---|
169 | end;
|
---|
170 |
|
---|
171 | procedure TfrmHunSpell.lblOpenMedURLClick(Sender: TObject);
|
---|
172 | begin
|
---|
173 | inherited;
|
---|
174 | GoToURL(TLabel(sender).Caption);
|
---|
175 | end;
|
---|
176 |
|
---|
177 | procedure TfrmHunSpell.lstSuggestionsDblClick(Sender: TObject);
|
---|
178 | begin
|
---|
179 | inherited;
|
---|
180 | btnChangeClick(sender);
|
---|
181 | end;
|
---|
182 |
|
---|
183 | procedure TfrmHunSpell.RichEdit1KeyDown(Sender: TObject; var Key: Word;
|
---|
184 | Shift: TShiftState);
|
---|
185 | begin
|
---|
186 | inherited;
|
---|
187 | if SpellCheck1.SpellCheckState = ssChecking then
|
---|
188 | SpellCheck1.ManualChangeStart;
|
---|
189 | end;
|
---|
190 |
|
---|
191 | procedure TfrmHunSpell.RichEdit1KeyUp(Sender: TObject; var Key: Word;
|
---|
192 | Shift: TShiftState);
|
---|
193 | begin
|
---|
194 | inherited;
|
---|
195 | if SpellCheck1.SpellCheckState in [ssCancelled, ssCompleted] then
|
---|
196 | SpellCheck1.Reopen;
|
---|
197 |
|
---|
198 | if SpellCheck1.SpellCheckState = ssChecking then
|
---|
199 | SpellCheck1.ManualChangeDone;
|
---|
200 | end;
|
---|
201 |
|
---|
202 | procedure TfrmHunSpell.SpellCheck1Abort(Sender: TObject);
|
---|
203 | begin
|
---|
204 | inherited;
|
---|
205 | UpdateGUI;
|
---|
206 | end;
|
---|
207 |
|
---|
208 | procedure TfrmHunSpell.SpellCheck1Start(Sender: TObject);
|
---|
209 | begin
|
---|
210 | inherited;
|
---|
211 | UpdateGUI;
|
---|
212 | end;
|
---|
213 |
|
---|
214 | procedure TfrmHunSpell.SpellCheck1StateChange(const Sender: TObject;
|
---|
215 | const State: TSpellState);
|
---|
216 | begin
|
---|
217 | inherited;
|
---|
218 | if State = ssCompleted then
|
---|
219 | ShowMessage(TX_SPELL_COMPLETE);
|
---|
220 | UpdateGUI;
|
---|
221 | end;
|
---|
222 |
|
---|
223 | procedure TfrmHunSpell.UpdateGUI;
|
---|
224 | var
|
---|
225 | Checking: Boolean;
|
---|
226 | begin
|
---|
227 | if csDestroying in componentstate then
|
---|
228 | exit;
|
---|
229 | Checking := SpellCheck1.SpellCheckState = ssChecking;
|
---|
230 | pnlMisSpelled.Visible := Checking;
|
---|
231 | pnlMisSpelled.Enabled := Checking;
|
---|
232 | btnClose.Visible := not Checking;
|
---|
233 | end;
|
---|
234 |
|
---|
235 | {************* FormCreate **********}
|
---|
236 | procedure TfrmHunSpell.btnAboutClick(Sender: TObject);
|
---|
237 | begin
|
---|
238 | inherited;
|
---|
239 | pnlAbout.Show;
|
---|
240 | pnlAbout.BringToFront;
|
---|
241 | end;
|
---|
242 |
|
---|
243 | procedure TfrmHunSpell.btnAddToDictionaryClick(Sender: TObject);
|
---|
244 | begin
|
---|
245 | SpellCheck1.AddCustomWord;
|
---|
246 | end;
|
---|
247 |
|
---|
248 | procedure TfrmHunSpell.btnReplaceWithClick(Sender: TObject);
|
---|
249 | begin
|
---|
250 | SpellCheck1.CorrectWithMyWord;
|
---|
251 | end;
|
---|
252 |
|
---|
253 | procedure TfrmHunSpell.btnAbortClick(Sender: TObject);
|
---|
254 | begin
|
---|
255 | //popup 508 compliant confirmation/warning box if isModified
|
---|
256 | if SpellCheck1.AbortSpellCheck(True) then
|
---|
257 | begin
|
---|
258 | Close;
|
---|
259 | ModalResult := mrCancel;
|
---|
260 | end;
|
---|
261 | end;
|
---|
262 |
|
---|
263 | procedure TfrmHunSpell.btnChangeAllClick(Sender: TObject);
|
---|
264 | begin
|
---|
265 | SpellCheck1.ChangeAll;
|
---|
266 | end;
|
---|
267 |
|
---|
268 | procedure TfrmHunSpell.btnChangeClick(Sender: TObject);
|
---|
269 | begin
|
---|
270 | SpellCheck1.Change;
|
---|
271 | end;
|
---|
272 |
|
---|
273 | procedure TfrmHunSpell.btnCloseClick(Sender: TObject);
|
---|
274 | begin
|
---|
275 | close;
|
---|
276 | end;
|
---|
277 |
|
---|
278 | procedure TfrmHunSpell.btnIgnoreAllClick(Sender: TObject);
|
---|
279 | begin
|
---|
280 | SpellCheck1.IgnoreAll;
|
---|
281 | end;
|
---|
282 |
|
---|
283 | procedure TfrmHunSpell.btnIgnoreOnceClick(Sender: TObject);
|
---|
284 | begin
|
---|
285 | SpellCheck1.IgnoreOnce;
|
---|
286 | end;
|
---|
287 |
|
---|
288 | procedure TfrmHunSpell.btnSelectDictClick(Sender: TObject);
|
---|
289 | var
|
---|
290 | aff: String;
|
---|
291 | begin
|
---|
292 | if OpenDialog1.Execute then
|
---|
293 | begin
|
---|
294 | if SpellCheck1.DictionaryFileName = OpenDialog1.FileName then
|
---|
295 | exit;
|
---|
296 |
|
---|
297 | aff := ChangeFileExt(OpenDialog1.FileName, '.aff');
|
---|
298 | if not FileExists(aff) then
|
---|
299 | begin
|
---|
300 | ShowMessage(TX_AFF_NOT_FOUND);
|
---|
301 | OpenDialog1.FileName := '';
|
---|
302 | btnSelectDictClick(self);
|
---|
303 | end
|
---|
304 | else
|
---|
305 | begin
|
---|
306 | if SpellCheck1.SpellCheckState = ssChecking then
|
---|
307 | SpellCheck1.AbortSpellCheck(False);
|
---|
308 | edtDictionary.Text := OpenDialog1.FileName;
|
---|
309 | SpellCheck1.DictionaryFileName := edtDictionary.Text;
|
---|
310 | SpellCheck1.AffixFileName := aff;
|
---|
311 | SpellCheck1.Open;
|
---|
312 | end;
|
---|
313 | end;
|
---|
314 | end;
|
---|
315 |
|
---|
316 | procedure TfrmHunSpell.btnUndoClick(Sender: TObject);
|
---|
317 | begin
|
---|
318 | inherited;
|
---|
319 | SpellCheck1.Undo;
|
---|
320 | end;
|
---|
321 |
|
---|
322 | procedure TfrmHunSpell.Button1Click(Sender: TObject);
|
---|
323 | begin
|
---|
324 | inherited;
|
---|
325 | pnlAbout.hide;
|
---|
326 | end;
|
---|
327 |
|
---|
328 | procedure TfrmHunSpell.cbIgnoreAllCapsClick(Sender: TObject);
|
---|
329 | begin
|
---|
330 | inherited;
|
---|
331 | if SpellCheck1.IgnoreAllCaps <> cbIgnoreAllCaps.Checked then
|
---|
332 | SpellCheck1.IgnoreAllCaps := cbIgnoreAllCaps.Checked;
|
---|
333 | end;
|
---|
334 |
|
---|
335 | procedure TfrmHunSpell.cbIgnoreDigitClick(Sender: TObject);
|
---|
336 | begin
|
---|
337 | inherited;
|
---|
338 | if SpellCheck1.IgnoreWordWithDigits <> cbIgnoreDigit.Checked then
|
---|
339 | SpellCheck1.IgnoreWordWithDigits := cbIgnoreDigit.Checked;
|
---|
340 | end;
|
---|
341 |
|
---|
342 | procedure TfrmHunSpell.edtDictionaryEnter(Sender: TObject);
|
---|
343 | begin
|
---|
344 | btnSelectDict.SetFocus;
|
---|
345 | end;
|
---|
346 |
|
---|
347 | procedure TfrmHunSpell.FormActivate(Sender: TObject);
|
---|
348 | begin
|
---|
349 | if ( not SpellCheck1.Active) and (not NoEngineOpted) then
|
---|
350 | begin
|
---|
351 | btnSelectDictClick(self);
|
---|
352 | NoEngineOpted := True;
|
---|
353 | end;
|
---|
354 | if cbIgnoreAllCaps.Checked <> SpellCheck1.IgnoreAllCaps then
|
---|
355 | cbIgnoreAllCaps.Checked := SpellCheck1.IgnoreAllCaps;
|
---|
356 |
|
---|
357 | if cbIgnoreDigit.Checked <> SpellCheck1.IgnoreWordWithDigits then
|
---|
358 | cbIgnoreDigit.Checked := SpellCheck1.IgnoreWordWithDigits;
|
---|
359 | end;
|
---|
360 |
|
---|
361 | procedure TfrmHunSpell.FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
362 | begin
|
---|
363 | if SpellCheck1.SpellCheckState = ssCompleted then
|
---|
364 | begin
|
---|
365 | ShowMsg(TX_SPELL_COMPLETE, TShow508MessageIcon(1), smbOK) ;
|
---|
366 | if Assigned(FSourceControl) then
|
---|
367 | FSourceControl.Text := RichEdit1.Text;
|
---|
368 | end;
|
---|
369 | {else
|
---|
370 | ShowMsg(TX_SPELL_CANCELLED + CRLF + TX_NO_CORRECTIONS,
|
---|
371 | TShow508MessageIcon(1), smbOK) ;}
|
---|
372 | end;
|
---|
373 |
|
---|
374 | procedure TfrmHunSpell.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
---|
375 | begin
|
---|
376 | inherited;
|
---|
377 |
|
---|
378 | CanClose := (SpellCheck1.SpellCheckState <> ssChecking)
|
---|
379 | or (SpellCheck1.AbortSpellCheck(True));
|
---|
380 | if CanClose then
|
---|
381 | ModalResult := mrCancel;
|
---|
382 | end;
|
---|
383 |
|
---|
384 | procedure TfrmHunSpell.FormCreate(Sender: TObject);
|
---|
385 | var
|
---|
386 | dicFile: String;
|
---|
387 | function affFile: String;
|
---|
388 | begin
|
---|
389 | Result := ChangeFileExt(dicFile, '.aff');
|
---|
390 | end;
|
---|
391 | begin
|
---|
392 | if (SpellCheck1.DictionaryFileName <> '') then
|
---|
393 | dicFile := SpellCheck1.DictionaryFileName
|
---|
394 | else
|
---|
395 | dicFile := ExtractFilePath(Application.ExeName)+ DefaultDicFile;
|
---|
396 |
|
---|
397 | if (FileExists(dicFile)) and (FileExists(affFile)) then
|
---|
398 | begin
|
---|
399 | SpellCheck1.AffixFileName := affFile;
|
---|
400 | edtDictionary.Text := SpellCheck1.DictionaryFileName;
|
---|
401 | end
|
---|
402 | else
|
---|
403 | edtDictionary.Text := TX_Dic_File_Not_Found;
|
---|
404 |
|
---|
405 | if edtDictionary.Text = TX_Dic_File_Not_Found then
|
---|
406 | btnSelectDictClick(self);
|
---|
407 | SpellCheck1.SourceTextControl := RichEdit1;
|
---|
408 | SpellCheck1.SuggestionList := lstSuggestions;
|
---|
409 | SpellCheck1.MisSpeltWord := edtMisSpelt;
|
---|
410 | SpellCheck1.Active := (SpellCheck1.DictionaryFileName <> '')
|
---|
411 | and FileExists(dicFile);
|
---|
412 | end;
|
---|
413 |
|
---|
414 |
|
---|
415 |
|
---|
416 | end.
|
---|