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

Last change on this file was 1726, checked in by healthsevak, 9 years ago

Cleaned little bit of glitches and added the About dialog and have recompiled the executable once again
File size: 13.7 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, jpeg;
40
41type
42 TfrmHunSpell = class(TfrmBase508Form)
43 btnClose: TButton;
44 OpenDialog1: TOpenDialog;
45 SpellCheck1: TskaHunSpellChecker;
46 edtDictionary: TEdit;
47 btnSelectDict: TBitBtn;
48 RichEdit1: TRichEdit;
49 pnlMisSpelled: TPanel;
50 Label1: TLabel;
51 lstSuggestions: TListBox;
52 Label4: TLabel;
53 edtMisSpelt: TEdit;
54 btnReplaceWith: TButton;
55 btnChangeAll: TButton;
56 btnChange: TButton;
57 btnAddToDictionary: TButton;
58 btnIgnoreAll: TButton;
59 btnIgnoreOnce: TButton;
60 btnAbort: TButton;
61 btnAbout: TButton;
62 pnlAbout: TPanel;
63 Button1: TButton;
64 btnUndo: TButton;
65 cbIgnoreAllCaps: TCheckBox;
66 cbIgnoreDigit: TCheckBox;
67 btnRestat: TButton;
68 cbHyphenatedWord: TCheckBox;
69 StaticText1: TStaticText;
70 StaticText2: TStaticText;
71 StaticText3: TStaticText;
72 Label2: TLabel;
73 StaticText4: TStaticText;
74 Label3: TLabel;
75 StaticText5: TStaticText;
76 StaticText6: TStaticText;
77 Image1: TImage;
78 lblDictionariesURL: TLabel;
79 lblDictionary: TLabel;
80 lblOpenMedURL: TLabel;
81 Label5: TLabel;
82 Label6: TLabel;
83 procedure FormCreate(Sender: TObject);
84 procedure btnIgnoreOnceClick(Sender: TObject);
85 procedure btnIgnoreAllClick(Sender: TObject);
86 procedure btnChangeClick(Sender: TObject);
87 procedure btnChangeAllClick(Sender: TObject);
88 procedure btnCloseClick(Sender: TObject);
89 procedure FormActivate(Sender: TObject);
90 procedure btnSelectDictClick(Sender: TObject);
91 procedure edtDictionaryEnter(Sender: TObject);
92 procedure btnReplaceWithClick(Sender: TObject);
93 procedure btnAddToDictionaryClick(Sender: TObject);
94 procedure FormShow(Sender: TObject);
95 procedure FormClose(Sender: TObject; var Action: TCloseAction);
96 procedure btnAbortClick(Sender: TObject);
97 procedure lblOpenMedURLClick(Sender: TObject);
98 procedure btnAboutClick(Sender: TObject);
99 procedure Button1Click(Sender: TObject);
100 procedure btnUndoClick(Sender: TObject);
101 procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
102 Shift: TShiftState);
103 procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
104 Shift: TShiftState);
105 procedure lstSuggestionsDblClick(Sender: TObject);
106 procedure SpellCheck1StateChange(const Sender: TObject;
107 const State: TSpellState);
108 procedure SpellCheck1Abort(Sender: TObject);
109 procedure SpellCheck1Start(Sender: TObject);
110 procedure cbIgnoreAllCapsClick(Sender: TObject);
111 procedure cbIgnoreDigitClick(Sender: TObject);
112 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
113 procedure btnRestatClick(Sender: TObject);
114 procedure cbHyphenatedWordClick(Sender: TObject);
115 procedure Image1Click(Sender: TObject);
116 procedure Label6Click(Sender: TObject);
117 private
118 { Private declarations }
119 NoEngineOpted: Boolean;
120 FSourceControl: TCustomMemo;
121 procedure GoToURL(const aURL: String);
122 procedure UpdateGUI;
123 public
124 { Public declarations }
125 Showhighlight:boolean;
126 highlightcolor:TColor;
127 HighLightList:TStringlist;
128 OldRichEditWndProc: {integer}pointer;
129 PRichEditWndProc:pointer;
130 class function DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult; static;
131 end;
132
133 Resourcestring
134 TX_AFF_NOT_FOUND = 'Correspong AFF file named not found!'
135 + #13
136 + ' Specify dictionary file whose *.aff is also '
137 + 'present in same directory.' ;
138 TX_DIC_FILE_NOT_FOUND = 'Dictionary File for SpellCheck Engine not found!';
139 TX_SPELL_COMPLETE = 'Spell Check Complete';
140 TX_SPELL_CANCELLED = 'Spell Check Aborted'
141 + #13
142 + 'No Changes applied to the original text!';
143
144 Const
145 DefaultDicFile = 'dict\en-US-OpenMedSpel.dic';
146
147 var
148 frmHunSpell: TfrmHunSpell;
149
150implementation
151{$R *.DFM}
152
153 uses uSpell, VAUtils;
154
155class function TfrmHunSpell.DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult;
156var
157 frm: TfrmHunSpell;
158begin
159 Result := mrCancel;
160 frm:= TfrmHunSpell.create(Application);
161 try
162 frm.RichEdit1.Text:= AnEditControl.Text;
163 frm.FSourceControl := AnEditControl;
164 Result := frm.ShowModal;
165 finally
166 frm.Free;
167 end;
168end;
169
170 {************ HighLight ***********888}
171 procedure TfrmHunSpell.FormShow(Sender: TObject);
172begin
173 if SpellCheck1.SpellCheckState = ssReady then
174 SpellCheck1.CheckSpelling;
175 try
176 if lstSuggestions.Count > 0 then
177 btnChange.SetFocus;
178 except
179 end;
180end;
181
182procedure TfrmHunSpell.GoToURL(const aURL: String);
183begin
184if length(trim(aURL)) > 4 then
185 ShellExecute(Handle, 'open', PChar(aURL), '', '', SW_NORMAL);
186end;
187
188procedure TfrmHunSpell.Image1Click(Sender: TObject);
189begin
190 inherited;
191 GoToURL('http://www.healthsevak.com');
192end;
193
194procedure TfrmHunSpell.Label6Click(Sender: TObject);
195begin
196 inherited;
197 GoToURL('mailto: digitiger@gmail.com');
198end;
199
200procedure TfrmHunSpell.lblOpenMedURLClick(Sender: TObject);
201begin
202 inherited;
203 GoToURL(TLabel(sender).Caption);
204end;
205
206procedure TfrmHunSpell.lstSuggestionsDblClick(Sender: TObject);
207begin
208 inherited;
209 btnChangeClick(sender);
210end;
211
212procedure TfrmHunSpell.RichEdit1KeyDown(Sender: TObject; var Key: Word;
213 Shift: TShiftState);
214begin
215 inherited;
216 if SpellCheck1.SpellCheckState = ssChecking then
217 SpellCheck1.ManualChangeStart;
218end;
219
220procedure TfrmHunSpell.RichEdit1KeyUp(Sender: TObject; var Key: Word;
221 Shift: TShiftState);
222begin
223 inherited;
224 if SpellCheck1.SpellCheckState in [ssCancelled, ssCompleted] then
225 SpellCheck1.Reopen;
226
227 if SpellCheck1.SpellCheckState = ssChecking then
228 SpellCheck1.ManualChangeDone;
229end;
230
231procedure TfrmHunSpell.SpellCheck1Abort(Sender: TObject);
232begin
233 inherited;
234 UpdateGUI;
235end;
236
237procedure TfrmHunSpell.SpellCheck1Start(Sender: TObject);
238begin
239 inherited;
240 UpdateGUI;
241end;
242
243procedure TfrmHunSpell.SpellCheck1StateChange(const Sender: TObject;
244 const State: TSpellState);
245begin
246 inherited;
247 if State = ssCompleted then
248 ShowMessage(TX_SPELL_COMPLETE);
249 UpdateGUI;
250end;
251
252procedure TfrmHunSpell.UpdateGUI;
253var
254 Checking: Boolean;
255begin
256 if csDestroying in componentstate then
257 exit;
258 Checking := SpellCheck1.SpellCheckState = ssChecking;
259 pnlMisSpelled.Visible := Checking;
260 pnlMisSpelled.Enabled := Checking;
261 btnClose.Visible := not Checking;
262end;
263
264{************* FormCreate **********}
265procedure TfrmHunSpell.btnAboutClick(Sender: TObject);
266begin
267 inherited;
268 pnlAbout.Show;
269 pnlAbout.BringToFront;
270end;
271
272procedure TfrmHunSpell.btnAddToDictionaryClick(Sender: TObject);
273begin
274 SpellCheck1.AddCustomWord;
275end;
276
277procedure TfrmHunSpell.btnReplaceWithClick(Sender: TObject);
278begin
279 SpellCheck1.CorrectWithMyWord;
280end;
281
282procedure TfrmHunSpell.btnRestatClick(Sender: TObject);
283begin
284 inherited;
285 if SpellCheck1.SpellCheckState = ssChecking then
286 SpellCheck1.ReStart
287 else
288 SpellCheck1.CheckSpelling;
289end;
290
291procedure TfrmHunSpell.btnAbortClick(Sender: TObject);
292begin
293//popup 508 compliant confirmation/warning box if isModified
294 if SpellCheck1.AbortSpellCheck(True) then
295 begin
296 Close;
297 ModalResult := mrCancel;
298 end;
299end;
300
301procedure TfrmHunSpell.btnChangeAllClick(Sender: TObject);
302begin
303 SpellCheck1.ChangeAll;
304end;
305
306procedure TfrmHunSpell.btnChangeClick(Sender: TObject);
307begin
308 SpellCheck1.Change;
309end;
310
311procedure TfrmHunSpell.btnCloseClick(Sender: TObject);
312begin
313 close;
314end;
315
316procedure TfrmHunSpell.btnIgnoreAllClick(Sender: TObject);
317begin
318 SpellCheck1.IgnoreAll;
319end;
320
321procedure TfrmHunSpell.btnIgnoreOnceClick(Sender: TObject);
322begin
323 SpellCheck1.IgnoreOnce;
324end;
325
326procedure TfrmHunSpell.btnSelectDictClick(Sender: TObject);
327var
328 aff: String;
329begin
330 if OpenDialog1.Execute then
331 begin
332 if SpellCheck1.DictionaryFileName = OpenDialog1.FileName then
333 exit;
334
335 aff := ChangeFileExt(OpenDialog1.FileName, '.aff');
336 if not FileExists(aff) then
337 begin
338 ShowMessage(TX_AFF_NOT_FOUND);
339 OpenDialog1.FileName := '';
340 btnSelectDictClick(self);
341 end
342 else
343 begin
344 if SpellCheck1.SpellCheckState = ssChecking then
345 SpellCheck1.AbortSpellCheck(False);
346 edtDictionary.Text := OpenDialog1.FileName;
347 SpellCheck1.DictionaryFileName := edtDictionary.Text;
348 SpellCheck1.AffixFileName := aff;
349 SpellCheck1.Open;
350 end;
351 end;
352end;
353
354procedure TfrmHunSpell.btnUndoClick(Sender: TObject);
355begin
356 inherited;
357 SpellCheck1.Undo;
358end;
359
360procedure TfrmHunSpell.Button1Click(Sender: TObject);
361begin
362 inherited;
363 pnlAbout.hide;
364end;
365
366procedure TfrmHunSpell.cbHyphenatedWordClick(Sender: TObject);
367begin
368 inherited;
369 if SpellCheck1.HyphenatedWords <> cbHyphenatedWord.Checked then
370 SpellCheck1.HyphenatedWords := cbHyphenatedWord.Checked;
371
372 if SpellCheck1.SpellCheckState = ssChecking then
373 SpellCheck1.ReStart;
374end;
375
376procedure TfrmHunSpell.cbIgnoreAllCapsClick(Sender: TObject);
377begin
378 inherited;
379 if SpellCheck1.IgnoreAllCaps <> cbIgnoreAllCaps.Checked then
380 SpellCheck1.IgnoreAllCaps := cbIgnoreAllCaps.Checked;
381
382 if SpellCheck1.SpellCheckState = ssChecking then
383 SpellCheck1.ReStart;
384end;
385
386procedure TfrmHunSpell.cbIgnoreDigitClick(Sender: TObject);
387begin
388 inherited;
389 if SpellCheck1.IgnoreWordWithDigits <> cbIgnoreDigit.Checked then
390 SpellCheck1.IgnoreWordWithDigits := cbIgnoreDigit.Checked;
391
392 if SpellCheck1.SpellCheckState = ssChecking then
393 SpellCheck1.ReStart;
394end;
395
396procedure TfrmHunSpell.edtDictionaryEnter(Sender: TObject);
397begin
398 btnSelectDict.SetFocus;
399end;
400
401procedure TfrmHunSpell.FormActivate(Sender: TObject);
402begin
403 if ( not SpellCheck1.Active) and (not NoEngineOpted) then
404 begin
405 btnSelectDictClick(self);
406 NoEngineOpted := True;
407 end;
408 if cbIgnoreAllCaps.Checked <> SpellCheck1.IgnoreAllCaps then
409 cbIgnoreAllCaps.Checked := SpellCheck1.IgnoreAllCaps;
410
411 if cbIgnoreDigit.Checked <> SpellCheck1.IgnoreWordWithDigits then
412 cbIgnoreDigit.Checked := SpellCheck1.IgnoreWordWithDigits;
413
414 if cbHyphenatedWord.Checked <> SpellCheck1.HyphenatedWords then
415 cbHyphenatedWord.Checked := SpellCheck1.HyphenatedWords;
416end;
417
418procedure TfrmHunSpell.FormClose(Sender: TObject; var Action: TCloseAction);
419begin
420 if SpellCheck1.SpellCheckState = ssCompleted then
421 begin
422 // ShowMsg(TX_SPELL_COMPLETE, TShow508MessageIcon(1), smbOK) ;
423 if Assigned(FSourceControl) then
424 FSourceControl.Text := RichEdit1.Text;
425 end;
426 {else
427 ShowMsg(TX_SPELL_CANCELLED + CRLF + TX_NO_CORRECTIONS,
428 TShow508MessageIcon(1), smbOK) ;}
429end;
430
431procedure TfrmHunSpell.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
432begin
433 inherited;
434
435 CanClose := (SpellCheck1.SpellCheckState <> ssChecking)
436 or (SpellCheck1.AbortSpellCheck(True));
437 if CanClose then
438 ModalResult := mrCancel;
439end;
440
441procedure TfrmHunSpell.FormCreate(Sender: TObject);
442var
443 dicFile: String;
444 function affFile: String;
445 begin
446 Result := ChangeFileExt(dicFile, '.aff');
447 end;
448begin
449 if (SpellCheck1.DictionaryFileName <> '') then
450 dicFile := SpellCheck1.DictionaryFileName
451 else
452 dicFile := ExtractFilePath(Application.ExeName)+ DefaultDicFile;
453
454 if (FileExists(dicFile)) and (FileExists(affFile)) then
455 begin
456 SpellCheck1.AffixFileName := affFile;
457 edtDictionary.Text := SpellCheck1.DictionaryFileName;
458 end
459 else
460 edtDictionary.Text := TX_Dic_File_Not_Found;
461
462 if edtDictionary.Text = TX_Dic_File_Not_Found then
463 btnSelectDictClick(self);
464 SpellCheck1.SourceTextControl := RichEdit1;
465 SpellCheck1.SuggestionList := lstSuggestions;
466 SpellCheck1.MisSpeltWord := edtMisSpelt;
467 SpellCheck1.Active := (SpellCheck1.DictionaryFileName <> '')
468 and FileExists(dicFile);
469end;
470
471
472
473end.
Note: See TracBrowser for help on using the repository browser.