source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fHunSpell.pas@ 1722

Last change on this file since 1722 was 1719, checked in by healthsevak, 10 years ago

Added few options to SpellChecker which persists beyond current session
File size: 12.2 KB
Line 
1unit 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
33interface
34
35uses
36 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
37 StdCtrls, ComCtrls, RichEdit, Buttons, ExtCtrls, ShellAPI,
38 skaSpellCheck,
39 VA508AccessibilityManager, fBase508Form;
40
41type
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
133implementation
134{$R *.DFM}
135
136 uses uSpell, VAUtils;
137
138class function TfrmHunSpell.DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult;
139var
140 frm: TfrmHunSpell;
141begin
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;
151end;
152
153 {************ HighLight ***********888}
154 procedure TfrmHunSpell.FormShow(Sender: TObject);
155begin
156 if SpellCheck1.SpellCheckState = ssReady then
157 SpellCheck1.CheckSpelling;
158 try
159 if lstSuggestions.Count > 0 then
160 btnChange.SetFocus;
161 except
162 end;
163end;
164
165procedure TfrmHunSpell.GoToURL(const aURL: String);
166begin
167if length(trim(aURL)) > 4 then
168 ShellExecute(Handle, 'open', PChar(aURL), '', '', SW_NORMAL);
169end;
170
171procedure TfrmHunSpell.lblOpenMedURLClick(Sender: TObject);
172begin
173 inherited;
174 GoToURL(TLabel(sender).Caption);
175end;
176
177procedure TfrmHunSpell.lstSuggestionsDblClick(Sender: TObject);
178begin
179 inherited;
180 btnChangeClick(sender);
181end;
182
183procedure TfrmHunSpell.RichEdit1KeyDown(Sender: TObject; var Key: Word;
184 Shift: TShiftState);
185begin
186 inherited;
187 if SpellCheck1.SpellCheckState = ssChecking then
188 SpellCheck1.ManualChangeStart;
189end;
190
191procedure TfrmHunSpell.RichEdit1KeyUp(Sender: TObject; var Key: Word;
192 Shift: TShiftState);
193begin
194 inherited;
195 if SpellCheck1.SpellCheckState in [ssCancelled, ssCompleted] then
196 SpellCheck1.Reopen;
197
198 if SpellCheck1.SpellCheckState = ssChecking then
199 SpellCheck1.ManualChangeDone;
200end;
201
202procedure TfrmHunSpell.SpellCheck1Abort(Sender: TObject);
203begin
204 inherited;
205 UpdateGUI;
206end;
207
208procedure TfrmHunSpell.SpellCheck1Start(Sender: TObject);
209begin
210 inherited;
211 UpdateGUI;
212end;
213
214procedure TfrmHunSpell.SpellCheck1StateChange(const Sender: TObject;
215 const State: TSpellState);
216begin
217 inherited;
218 if State = ssCompleted then
219 ShowMessage(TX_SPELL_COMPLETE);
220 UpdateGUI;
221end;
222
223procedure TfrmHunSpell.UpdateGUI;
224var
225 Checking: Boolean;
226begin
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;
233end;
234
235{************* FormCreate **********}
236procedure TfrmHunSpell.btnAboutClick(Sender: TObject);
237begin
238 inherited;
239 pnlAbout.Show;
240 pnlAbout.BringToFront;
241end;
242
243procedure TfrmHunSpell.btnAddToDictionaryClick(Sender: TObject);
244begin
245 SpellCheck1.AddCustomWord;
246end;
247
248procedure TfrmHunSpell.btnReplaceWithClick(Sender: TObject);
249begin
250 SpellCheck1.CorrectWithMyWord;
251end;
252
253procedure TfrmHunSpell.btnAbortClick(Sender: TObject);
254begin
255//popup 508 compliant confirmation/warning box if isModified
256 if SpellCheck1.AbortSpellCheck(True) then
257 begin
258 Close;
259 ModalResult := mrCancel;
260 end;
261end;
262
263procedure TfrmHunSpell.btnChangeAllClick(Sender: TObject);
264begin
265 SpellCheck1.ChangeAll;
266end;
267
268procedure TfrmHunSpell.btnChangeClick(Sender: TObject);
269begin
270 SpellCheck1.Change;
271end;
272
273procedure TfrmHunSpell.btnCloseClick(Sender: TObject);
274begin
275 close;
276end;
277
278procedure TfrmHunSpell.btnIgnoreAllClick(Sender: TObject);
279begin
280 SpellCheck1.IgnoreAll;
281end;
282
283procedure TfrmHunSpell.btnIgnoreOnceClick(Sender: TObject);
284begin
285 SpellCheck1.IgnoreOnce;
286end;
287
288procedure TfrmHunSpell.btnSelectDictClick(Sender: TObject);
289var
290 aff: String;
291begin
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;
314end;
315
316procedure TfrmHunSpell.btnUndoClick(Sender: TObject);
317begin
318 inherited;
319 SpellCheck1.Undo;
320end;
321
322procedure TfrmHunSpell.Button1Click(Sender: TObject);
323begin
324 inherited;
325 pnlAbout.hide;
326end;
327
328procedure TfrmHunSpell.cbIgnoreAllCapsClick(Sender: TObject);
329begin
330 inherited;
331 if SpellCheck1.IgnoreAllCaps <> cbIgnoreAllCaps.Checked then
332 SpellCheck1.IgnoreAllCaps := cbIgnoreAllCaps.Checked;
333end;
334
335procedure TfrmHunSpell.cbIgnoreDigitClick(Sender: TObject);
336begin
337 inherited;
338 if SpellCheck1.IgnoreWordWithDigits <> cbIgnoreDigit.Checked then
339 SpellCheck1.IgnoreWordWithDigits := cbIgnoreDigit.Checked;
340end;
341
342procedure TfrmHunSpell.edtDictionaryEnter(Sender: TObject);
343begin
344 btnSelectDict.SetFocus;
345end;
346
347procedure TfrmHunSpell.FormActivate(Sender: TObject);
348begin
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;
359end;
360
361procedure TfrmHunSpell.FormClose(Sender: TObject; var Action: TCloseAction);
362begin
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) ;}
372end;
373
374procedure TfrmHunSpell.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
375begin
376 inherited;
377
378 CanClose := (SpellCheck1.SpellCheckState <> ssChecking)
379 or (SpellCheck1.AbortSpellCheck(True));
380 if CanClose then
381 ModalResult := mrCancel;
382end;
383
384procedure TfrmHunSpell.FormCreate(Sender: TObject);
385var
386 dicFile: String;
387 function affFile: String;
388 begin
389 Result := ChangeFileExt(dicFile, '.aff');
390 end;
391begin
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);
412end;
413
414
415
416end.
Note: See TracBrowser for help on using the repository browser.