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

Last change on this file since 1717 was 1715, checked in by healthsevak, 10 years ago

Modified the library to make it more generic from Delphi community point of view before sharing with original author/custodian of HunSpell library at sourceforge

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