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

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

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