source: cprs/branches/HealthSevak-CPRS/CPRS-Lib/Hans SpellCheck/Demo/fHunSpell.pas@ 1718

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

Added few options to SpellChecker which persists beyond current session
File size: 12.0 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
40type
41 TfrmHunSpell = class(TForm)
42 lblDictionary: TLabel;
43 btnClose: TButton;
44 OpenDialog1: TOpenDialog;
45 SpellCheck1: TskaHunSpellChecker;
46 edtDictionary: TEdit;
47 btnSelectDict: TBitBtn;
48 lblDictionariesURL: TLabel;
49 RichEdit1: TRichEdit;
50 btnStart: TButton;
51 pnlMisSpelled: TPanel;
52 Label1: TLabel;
53 Label4: TLabel;
54 lstSuggestions: TListBox;
55 edtMisSpeltWordForExtraHint: TEdit; //required for screenreaders which are MOSTLY colour blind
56 btnReplaceWith: TButton;
57 btnChangeAll: TButton;
58 btnChange: TButton;
59 btnAddToDictionary: TButton;
60 btnIgnoreAll: TButton;
61 btnIgnoreOnce: TButton;
62 btnAbort: TButton;
63 btnUndo: TButton;
64 cbIgnoreAllCaps: TCheckBox;
65 cbIgnoreDigit: TCheckBox;
66 procedure FormCreate(Sender: TObject);
67 procedure btnIgnoreOnceClick(Sender: TObject);
68 procedure btnIgnoreAllClick(Sender: TObject);
69 procedure btnChangeClick(Sender: TObject);
70 procedure btnChangeAllClick(Sender: TObject);
71 procedure btnCloseClick(Sender: TObject);
72 procedure FormActivate(Sender: TObject);
73 procedure btnSelectDictClick(Sender: TObject);
74 procedure edtDictionaryEnter(Sender: TObject);
75 procedure btnReplaceWithClick(Sender: TObject);
76 procedure btnAddToDictionaryClick(Sender: TObject);
77 procedure FormClose(Sender: TObject; var Action: TCloseAction);
78 procedure btnAbortClick(Sender: TObject);
79 procedure btnStartClick(Sender: TObject);
80 procedure btnUndoClick(Sender: TObject);
81 procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
82 Shift: TShiftState);
83 procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
84 Shift: TShiftState);
85 procedure UpdateGUI;
86 procedure SpellCheck1Abort(Sender: TObject);
87 procedure SpellCheck1Start(Sender: TObject);
88 procedure SpellCheck1StateChange(const Sender: TObject;
89 const State: TSpellState);
90 procedure lblDictionariesURLClick(Sender: TObject);
91 procedure lstSuggestionsDblClick(Sender: TObject);
92 procedure cbIgnoreAllCapsClick(Sender: TObject);
93 procedure cbIgnoreDigitClick(Sender: TObject);
94 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
95 private
96 { Private declarations }
97 NoEngineOpted: Boolean;
98 FSourceControl: TCustomMemo;
99 procedure GoToURL(const aURL: String);
100 public
101 { Public declarations }
102 Showhighlight:boolean;
103 highlightcolor:TColor;
104 HighLightList:TStringlist;
105 OldRichEditWndProc: {integer}pointer;
106 PRichEditWndProc:pointer;
107 class function DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult;
108 static;
109 end;
110
111 Resourcestring
112 TX_AFF_NOT_FOUND = 'Correspong AFF file named not found!'
113 + #13
114 + ' Specify dictionary file whose *.aff is also '
115 + 'present in same directory.' ;
116 TX_DIC_FILE_NOT_FOUND = 'Dictionary File for SpellCheck Engine not found!';
117 TX_SPELL_COMPLETE = 'Spell Check Complete';
118 TX_SPELL_CANCELLED = 'Spell Check Aborted'
119 + #13
120 + 'No Changes applied to the original text!';
121
122 Const
123 DefaultDicFile = 'dict\en_GB.dic';// 'dict\en-US-OpenMedSpel.dic';
124 var
125 frmHunSpell: TfrmHunSpell;
126
127implementation
128{$R *.DFM}
129
130
131class function TfrmHunSpell.DoHunSpellCheck(AnEditControl: TCustomMemo):
132 TModalResult;
133{This function could be invoked from some other form by using this as modalform
134without creating the instance of this form in advance}
135var
136 frm: TfrmHunSpell;
137begin
138 Result := mrCancel;
139 frm:= TfrmHunSpell.create(Application);
140 try
141 frm.RichEdit1.Text:= AnEditControl.Text;
142 frm.FSourceControl := AnEditControl;
143 Result := frm.ShowModal;
144 finally
145 frm.Free;
146 end;
147end;
148
149 {************ HighLight ***********888}
150 procedure TfrmHunSpell.GoToURL(const aURL: String);
151begin
152if length(trim(aURL)) > 4 then
153 ShellExecute(Handle, 'open', PChar(aURL), '', '', SW_NORMAL);
154end;
155
156procedure TfrmHunSpell.lblDictionariesURLClick(Sender: TObject);
157begin
158 GoToURL(TLabel(sender).Caption);
159end;
160
161procedure TfrmHunSpell.lstSuggestionsDblClick(Sender: TObject);
162begin
163if lstSuggestions.ItemIndex >= 0 then
164 btnChangeClick(Self);
165end;
166
167procedure TfrmHunSpell.RichEdit1KeyDown(Sender: TObject; var Key: Word;
168 Shift: TShiftState);
169begin
170 if SpellCheck1.SpellCheckState = ssChecking then
171 SpellCheck1.ManualChangeStart;
172end;
173
174procedure TfrmHunSpell.RichEdit1KeyUp(Sender: TObject; var Key: Word;
175 Shift: TShiftState);
176begin
177 if SpellCheck1.SpellCheckState in [ssCancelled, ssCompleted] then
178 SpellCheck1.Reopen;
179
180 if SpellCheck1.SpellCheckState = ssChecking then
181 SpellCheck1.ManualChangeDone;
182end;
183
184procedure TfrmHunSpell.SpellCheck1Abort(Sender: TObject);
185begin
186 UpdateGUI;
187end;
188
189procedure TfrmHunSpell.SpellCheck1Start(Sender: TObject);
190begin
191 UpdateGUI;
192end;
193
194procedure TfrmHunSpell.SpellCheck1StateChange(const Sender: TObject;
195 const State: TSpellState);
196begin
197 if State = ssCompleted then
198 ShowMessage(TX_SPELL_COMPLETE);
199 UpdateGUI;
200end;
201
202procedure TfrmHunSpell.UpdateGUI;
203var
204 Checking: Boolean;
205begin
206 if csDestroying in componentstate then
207 exit;
208 btnStart.Enabled := (SpellCheck1.SpellCheckState in [ssReady, ssCancelled])
209 and (trim(RichEdit1.Text) <> '');
210
211 Checking := SpellCheck1.SpellCheckState = ssChecking;
212 pnlMisSpelled.Visible := Checking;
213 pnlMisSpelled.Enabled := Checking;
214 btnClose.Visible := not Checking;
215end;
216
217{************* FormCreate **********}
218procedure TfrmHunSpell.btnStartClick(Sender: TObject);
219begin
220 if SpellCheck1.SpellCheckState <> ssChecking then
221 SpellCheck1.CheckSpelling;
222
223 UpdateGUI;
224 if (lstSuggestions.Count > 0) and btnChange.Visible and btnChange.Enabled then
225 btnChange.SetFocus;
226end;
227
228procedure TfrmHunSpell.btnAddToDictionaryClick(Sender: TObject);
229begin
230 SpellCheck1.AddCustomWord;
231end;
232
233procedure TfrmHunSpell.btnReplaceWithClick(Sender: TObject);
234begin
235 SpellCheck1.CorrectWithMyWord;
236end;
237
238procedure TfrmHunSpell.btnAbortClick(Sender: TObject);
239begin
240 if SpellCheck1.AbortSpellCheck(False) then
241 UpdateGUI;
242end;
243
244procedure TfrmHunSpell.btnChangeAllClick(Sender: TObject);
245begin
246 SpellCheck1.ChangeAll;
247end;
248
249procedure TfrmHunSpell.btnChangeClick(Sender: TObject);
250begin
251 SpellCheck1.Change;
252end;
253
254procedure TfrmHunSpell.btnCloseClick(Sender: TObject);
255begin
256 close;
257end;
258
259procedure TfrmHunSpell.btnIgnoreAllClick(Sender: TObject);
260begin
261 SpellCheck1.IgnoreAll;
262end;
263
264procedure TfrmHunSpell.btnIgnoreOnceClick(Sender: TObject);
265begin
266 SpellCheck1.IgnoreOnce;
267end;
268
269procedure TfrmHunSpell.btnSelectDictClick(Sender: TObject);
270var
271 aff: String;
272begin
273 if OpenDialog1.Execute then
274 begin
275 if SpellCheck1.DictionaryFileName = OpenDialog1.FileName then
276 exit;
277
278 aff := ChangeFileExt(OpenDialog1.FileName, '.aff');
279 if not FileExists(aff) then
280 begin
281 ShowMessage(TX_AFF_NOT_FOUND);
282 OpenDialog1.FileName := '';
283 btnSelectDictClick(self);
284 end
285 else
286 begin
287 if SpellCheck1.SpellCheckState = ssChecking then
288 SpellCheck1.AbortSpellCheck(False);
289 edtDictionary.Text := OpenDialog1.FileName;
290 SpellCheck1.DictionaryFileName := edtDictionary.Text;
291 SpellCheck1.AffixFileName := aff;
292 SpellCheck1.Open;
293 end;
294 end;
295end;
296
297procedure TfrmHunSpell.btnUndoClick(Sender: TObject);
298begin
299 inherited;
300 SpellCheck1.Undo;
301end;
302
303procedure TfrmHunSpell.cbIgnoreAllCapsClick(Sender: TObject);
304begin
305 if SpellCheck1.IgnoreAllCaps <> cbIgnoreAllCaps.Checked then
306 SpellCheck1.IgnoreAllCaps := cbIgnoreAllCaps.Checked;
307end;
308
309procedure TfrmHunSpell.cbIgnoreDigitClick(Sender: TObject);
310begin
311 if SpellCheck1.IgnoreWordWithDigits <> cbIgnoreDigit.Checked then
312 SpellCheck1.IgnoreWordWithDigits := cbIgnoreDigit.Checked;
313end;
314
315procedure TfrmHunSpell.edtDictionaryEnter(Sender: TObject);
316begin
317 btnSelectDict.SetFocus;
318end;
319
320procedure TfrmHunSpell.FormActivate(Sender: TObject);
321begin
322 if ( not SpellCheck1.Active) and (not NoEngineOpted) then
323 begin
324 btnSelectDictClick(self);
325 NoEngineOpted := True;
326 end;
327
328 if cbIgnoreAllCaps.Checked <> SpellCheck1.IgnoreAllCaps then
329 cbIgnoreAllCaps.Checked := SpellCheck1.IgnoreAllCaps;
330
331 if cbIgnoreDigit.Checked <> SpellCheck1.IgnoreWordWithDigits then
332 cbIgnoreDigit.Checked := SpellCheck1.IgnoreWordWithDigits;
333end;
334
335procedure TfrmHunSpell.FormClose(Sender: TObject; var Action: TCloseAction);
336begin
337 { if SpellCheck1.SpellCheckState = ssCompleted then
338 begin
339 ShowMessage(TX_SPELL_COMPLETE) ;
340 if Assigned(FSourceControl) then
341 FSourceControl.Text := RichEdit1.Text;
342 end
343 else
344 ShowMessage(TX_SPELL_CANCELLED) ; }
345end;
346
347procedure TfrmHunSpell.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
348begin
349 CanClose := (SpellCheck1.SpellCheckState <> ssChecking)
350 or (SpellCheck1.AbortSpellCheck(True));
351 if CanClose then
352 ModalResult := mrCancel;
353end;
354
355procedure TfrmHunSpell.FormCreate(Sender: TObject);
356var
357 dicFile: String;
358 function affFile: String;
359 begin
360 Result := ChangeFileExt(dicFile, '.aff');
361 end;
362begin
363 if (SpellCheck1.DictionaryFileName <> '') then
364 dicFile := SpellCheck1.DictionaryFileName
365 else
366 dicFile := ExtractFilePath(Application.ExeName)+ DefaultDicFile;
367
368 if (FileExists(dicFile)) and (FileExists(affFile)) then
369 begin
370 SpellCheck1.AffixFileName := affFile;
371 edtDictionary.Text := SpellCheck1.DictionaryFileName;
372 end
373 else
374 edtDictionary.Text := TX_Dic_File_Not_Found;
375
376 if edtDictionary.Text = TX_Dic_File_Not_Found then
377 btnSelectDictClick(self);
378 // SpellCheck1.SourceTextControl := RichEdit1;
379 // SpellCheck1.SuggestionList := lstSuggestions;
380 //SpellCheck1.MisSpeltWord := Edit2;
381 SpellCheck1.Active := (SpellCheck1.DictionaryFileName <> '')
382 and FileExists(dicFile);
383 UpdateGUI;
384end;
385
386
387
388end.
389
Note: See TracBrowser for help on using the repository browser.