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

Last change on this file since 1751 was 1725, checked in by healthsevak, 10 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.