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

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

Added few options to SpellChecker which persists beyond current session
File size: 27.1 KB
Line 
1unit skaSpellCheck;
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 *Special Note:
20 * This work has heavily relies upon rather build upon Copyrighted work by
21 * Miha Vrhovnik (http://simail.sf.net, http://xcollect.sf.net) which is
22 * available at http://sourceforge.net/projects/hunspell/
23 *
24 * Alternatively, the content of this file maybe used under the terms of either
25 * the GNU General Public License Version 2 or later (the "GPL"), or the GNU
26 * Lesser General Public License Version 2.1 or later (the "LGPL"), in which
27 * case the provisions of the GPL or the LGPL are applicable instead of those
28 * above. If you wish to allow use of your version of this file only under the
29 * terms of either the GPL or the LGPL, and not to allow others to use your
30 * version of this file under the terms of the MPL, indicate your division by
31 * deleting the provisions above and replace them with the notice and other
32 * provisions required by the GPL or LGPL. If you do not delete the provisions
33 * above, a recipient may use your version of this file under the terms of any
34 * one of the MPL, the GPL or the LGPL.
35 *
36 * *********************** END LICENSE BLOCK *********************************)
37
38interface
39
40uses
41 Windows, Classes, SysUtils, ComCtrls, StdCtrls, Graphics, Forms, Controls;
42
43 const
44 AboutThis = 'A wrapper component developed by Sunil K Arora '
45 + '(digitiger@gmail.com) of HealthSevak using OpenSource HanSpell engine';
46type
47 TSpellState = (ssNoengine, ssInActive, ssReady, ssChecking, ssCancelled,
48 ssCompleted);
49 TStateChangeEvent = procedure (const Sender : TObject;
50 const State : TSpellState) of object;
51
52 TskaHunSpellChecker = class(TComponent)
53 private
54 FActiveOrLoaded: Boolean;
55 FpointerHunLib: Pointer;
56 FSourceEdit: TRichEdit;
57 FSuggestionList: TListbox;
58
59 FAffixFileName: string;
60 FDictFileName: string;
61 CurrentWord: String;
62 CurrentText: String;
63 FoundAt: Integer;
64 PosOfFirstCharInCurrentLine: integer;
65 CurrentLine: Integer;
66 FIgnore: TStringList;
67 WaitForUser: Boolean;
68 WordLength:integer;
69 WordPos: Integer;
70 PREditorWndProc:pointer;
71 FHighlightColor: TColor;
72 FUndoList: TStringList;
73 FCustDict: TStringList;
74 FCustom: String;
75 FModified: Boolean;
76 FHighlightEdit: TEdit;
77 FTxtBeforeManualEdit: String;
78
79 FStatus: TSpellState;
80 FOnStart: TNotifyEvent;
81 FOnAbort : TNotifyEvent;
82 FOnStateChange : TStateChangeEvent;
83 FIgnoreWordWdigits: boolean;
84 FIgnoreCaps: boolean;
85
86 function AddCustomWord(aWord: String; isInternal: Boolean = False): Boolean;
87 overload; virtual;
88 Function CurrentWordDetail(WithPosition: Boolean= True): String;
89 function GetActive: Boolean;
90 procedure GetOptions;
91 function GetStatus: TSpellState;
92 procedure Initialize;
93 procedure SetActive(const Value: Boolean);
94 procedure SetAffixFileName(const Value: string);
95 procedure SetCustomDict(const Value: String);
96 procedure SetDictFileName(const Value: string);
97 procedure SetHighLightEdit(const Value: TEdit);
98 procedure SetOptions;
99 procedure SetSourceEdit(const Value: TRichEdit);
100 Function ShowMisSpelledWord:boolean;
101 procedure Loaded; override;
102 procedure ReplaceCurrentWordWith(const aNewWord: String);
103 function GetAboutThis: String;
104 procedure SaveForUndo(const Ignoring: Boolean=False);
105 procedure InformStatusChange;
106 procedure SetIgnoreCaps(const Value: boolean);
107 procedure SetIgnoreWordWdigits(const Value: boolean);
108 public
109 constructor Create(AOwner: TComponent); overload; override;
110 constructor Create(AOwner: TComponent; SourceTextRichEdit: TRichedit;
111 SuggestList: TListbox); ReIntroduce; overload;
112 destructor Destroy; override;
113
114 function AbortSpellCheck(Verbose: Boolean = True):Boolean;
115 function AddCustomWord: Boolean; overload; virtual;
116 procedure Change;
117 procedure ChangeAll;
118 procedure CheckSpelling;
119 procedure Close; virtual;
120 procedure CorrectWithMyWord;
121 procedure GetSuggestions(const aMisSpeltWord: string;
122 const SuggestionList: TStrings); dynamic;
123 procedure IgnoreAll;
124 procedure IgnoreOnce;
125 function IsMisspelled(const AWord: string): Boolean; dynamic;
126 procedure ManualChangeStart;
127 procedure ManualChangeDone;
128 function Open:Boolean; virtual;
129 procedure ReOpen;
130 function ReStart: Boolean; virtual;
131 function Undo: Boolean;
132 property SpellCheckState: TSpellState read GetStatus default ssInActive;
133 published
134 property About: String read GetAboutThis;
135 property Active: Boolean read GetActive write SetActive;
136 property AffixFileName: string read FAffixFileName write SetAffixFileName;
137 property IgnoreAllCaps: boolean read FIgnoreCaps write SetIgnoreCaps default true;
138 property IgnoreWordWithDigits:boolean read FIgnoreWordWdigits write SetIgnoreWordWdigits default true;
139 property CustDictionaryFile: String read FCustom write SetCustomDict;
140 property DictionaryFileName:string read FDictFileName write SetDictFileName;
141 property ColorForMisspelled: TColor read FHighlightColor
142 write FHighlightColor default clRed;
143 property MisSpeltWord: TEdit read FHighlightEdit write SetHighLightEdit;
144 property IsModified: Boolean read FModified;
145 property OnStart : TNotifyEvent read FOnStart write FOnStart;
146 property OnStateChange : TStateChangeEvent read FOnStateChange
147 write FOnStateChange;
148 property OnAbort : TNotifyEvent read FOnAbort write FOnAbort;
149 property SourceTextControl: TRichEdit read FSourceEdit write SetSourceEdit;
150 property SuggestionList:TListbox read FSuggestionList write FSuggestionList;
151
152 end;
153
154 procedure Register;
155
156 Const
157 CompletionMessage = 'Spell Check Complete.';
158 CaptionForNewWord = 'New Word Suggestion';
159 ConfirmAbort = 'Really abort?';
160 ConfirmComplete = 'If you accept last change than SpellCheck is complete.'
161 + #13 + ' To review last change click on "Cancel".';
162 PromptForNewWord = 'Specify the replacement for current mis-spelt word:';
163 DLLNotLoaded = 'Failed to load SpellCheck Engine DLL.';
164 MisSpeltReplacement = 'The new word specified by you "%s" looks mis-spelt!'
165 +' Would you want to still use it? Click NO button '
166 +'to specify better replacement word.';
167
168 var
169 OldRichEditWndProc: {integer}pointer;
170 CurrentMe: TskaHunSpellChecker;
171implementation
172 uses messages, Dialogs, RichEdit, SHFolder, uHunSpellLib, Registry;
173
174procedure Register;
175begin
176 RegisterComponentsProc('SkA Utility', [TskaHunSpellChecker]);
177end;
178
179{ TskaHunSpellChecker }
180
181function TskaHunSpellChecker.AbortSpellCheck(Verbose: Boolean = True): Boolean;
182begin
183 if FStatus <> ssChecking then
184 begin
185 FStatus := ssCancelled;
186 Close;
187 exit;
188 end;
189
190 Result := (not isModified) or
191 (not Verbose) or (MessageDlg(ConfirmAbort, mtConfirmation,
192 [mbYes, mbNo],0, mbNo) = 6);
193
194 if Result then
195 begin
196 if FUndoList.Count > 0 then
197 SourceTextControl.Text := FUndoList[0];
198 FUndoList.Clear;
199 FUndoList.Add(SourceTextControl.Text);
200 FIgnore.Clear;
201 FStatus := ssCancelled;
202 SourceTextControl.Invalidate;
203 if Assigned(OnAbort) then
204 OnAbort(Self);
205 end;
206end;
207
208function TskaHunSpellChecker.AddCustomWord(aWord: String;
209 isInternal: Boolean = False): Boolean;
210begin
211 Result := False;
212 if (not active) or (trim(aWord) = '') or (SpellCheckState <> ssChecking)
213 or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
214 begin
215 Result := False;
216 exit;
217 end;
218 uHunSpellLib.hunspell_put_word(FpointerHunLib, PAnsiChar(AnsiString(aWord)));
219 Result := True;
220end;
221
222procedure TskaHunSpellChecker.ChangeAll;
223begin
224 if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl))
225 or (not assigned(SuggestionList)) then
226 exit;
227 SaveForUndo;
228 SourceTextControl.Text := StringReplace(SourceTextControl.Text,
229 CurrentWord, SuggestionList.Items[SuggestionList.ItemIndex],
230 [rfReplaceAll,rfIgnoreCase]);
231 WaitForUser := False;
232 FModified := True;
233 SourceTextControl.Invalidate;
234
235end;
236
237function TskaHunSpellChecker.AddCustomWord: Boolean;
238begin
239 Result := AddCustomWord(CurrentWord, False);
240 FCustdict.Add(CurrentWord);
241 WaitForUser := False;
242 AbortSpellCheck(False);
243 Initialize;
244 CheckSpelling;
245 ShowMisSpelledWord;
246end;
247
248procedure TskaHunSpellChecker.ReOpen;
249begin
250 Close;
251 Open;
252end;
253
254procedure TskaHunSpellChecker.ReplaceCurrentWordWith(const aNewWord: String);
255var
256 full: String;
257 prefix: string;
258 suffix: string;
259begin
260 full := SourceTextControl.Lines[CurrentLine];
261{remember there is one extra space at the start of the line prefixed while
262 populating this variable}
263 prefix := copy(CurrentText, 2, WordPos-2);
264 Suffix := copy(CurrentText, WordPos+WordLength,
265 length(CurrentText));
266 SaveForUndo;
267 FModified := True;
268 SourceTextControl.Lines[CurrentLine] :=prefix + aNewWord + suffix;
269 WaitForUser := False;
270 FStatus := ssChecking;
271 FModified := True;
272 SourceTextControl.Invalidate;
273end;
274
275function TskaHunSpellChecker.ReStart: Boolean;
276begin
277 Close;
278 Result := Open;
279 Initialize;
280 WaitForUser := False;
281 if FStatus <> ssChecking then
282 begin
283 FStatus := ssChecking;
284 InformStatusChange;
285 end;
286 SourceTextControl.Invalidate;
287 Result := not WaitForUser;
288end;
289
290procedure TskaHunSpellChecker.Change;
291
292begin
293 if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl))
294 or (not assigned(SuggestionList)) then
295 exit;
296 ReplaceCurrentWordWith(SuggestionList.Items[SuggestionList.ItemIndex]);
297end;
298
299procedure TskaHunSpellChecker.CheckSpelling;
300begin
301 if (SpellCheckState = ssChecking) or (not assigned(SourceTextControl))
302 or (trim(SourceTextControl.Text)= '') or (not assigned(SuggestionList)) then
303 exit;
304
305 Initialize;
306 FUndoList.Clear;
307 FUndoList.Add(SourceTextControl.Text);
308 FIgnore.Clear;
309 WaitForUser := False;
310 FStatus := ssChecking;
311 if Assigned(OnStart) then
312 OnStart(Self);
313 SourceTextControl.Invalidate;
314end;
315
316procedure TskaHunSpellChecker.Close;
317begin
318 if not Active then Exit;
319 uHunSpellLib.hunspell_uninitialize(FpointerHunLib);
320 FpointerHunLib := nil;
321 FStatus := ssInActive;
322 InformStatusChange;
323end;
324
325
326procedure TskaHunSpellChecker.CorrectWithMyWord;
327var
328 NewWord: String;
329 GotIt: Boolean;
330begin
331 if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl))
332 or (not assigned(SuggestionList)) then
333 exit;
334
335 if SuggestionList.Count > 0 then
336 NewWord := SuggestionList.Items[0]
337 else
338 NewWord := CurrentWord;
339
340 GotIt := False;
341 while not GotIt do
342 begin
343 if not InputQuery(CaptionForNewWord, PromptForNewWord, NewWord) then
344 exit;
345
346 GotIt := (not IsMisspelled(NewWord))
347 or (MessageDlg(Format(MisSpeltReplacement,[NewWord]),
348 mtWarning, [mbYes, mbNo],0, mbNo) =6) ;
349 end;
350
351 if IsMisspelled(NewWord) then
352 AddCustomWord(NewWord, True);
353
354 ReplaceCurrentWordWith(NewWord);
355end;
356
357constructor TskaHunSpellChecker.Create(AOwner: TComponent);
358begin
359 inherited;
360 ColorForMisspelled := clRed;
361
362 CurrentMe := Self;
363 FIgnore := TStringList.Create;
364 FCustDict := TStringList.Create;
365
366 if (trim(CustDictionaryFile)<>'') and (FileExists(CustDictionaryFile)) then
367 try
368 FCustDict.LoadFromFile(CustDictionaryFile);
369 except
370 end;
371
372 FUndoList := TStringList.Create;
373
374 if csDesigning in componentState then
375 begin
376 IgnoreAllCaps := True;
377 IgnoreWordWithDigits := True;
378 end
379 else
380 GetOptions;
381
382 FStatus := ssInActive;
383 WaitForUser := False;
384 WordPos := 0;
385end;
386
387constructor TskaHunSpellChecker.Create(AOwner: TComponent;
388 SourceTextRichEdit: TRichedit; SuggestList: TListbox);
389begin
390 create(AOwner);
391 SourceTextControl := SourceTextRichEdit;
392 SuggestionList := SuggestList;
393end;
394
395function TskaHunSpellChecker.CurrentWordDetail(WithPosition: Boolean): String;
396begin
397 Result := '$$' + CurrentWord + '$$';
398 if WithPosition then
399 Result :='$$' + IntToStr(CurrentLine) + '$$' + IntToStr(FoundAt+1) + Result;
400end;
401
402destructor TskaHunSpellChecker.Destroy;
403begin
404 Close;
405 FIgnore.clear;
406 FreeAndNil(FIgnore);
407 FreeAndNil(FUndoList);
408 if not (csDesigning in ComponentState) then
409 try
410 if FCustDict.Count > 0 then
411 try
412 FCustDict.SaveToFile(CustDictionaryFile);
413 except
414 end;
415 SetOptions;
416 finally
417 FCustDict.Free;
418 end;
419 inherited;
420end;
421
422function TskaHunSpellChecker.GetAboutThis: String;
423begin
424 Result := AboutThis;
425end;
426
427function TskaHunSpellChecker.GetActive: Boolean;
428begin
429 Result := (FpointerHunLib <> nil);
430end;
431
432procedure TskaHunSpellChecker.GetOptions;
433var
434reg:TRegistry;
435begin
436 reg:=TRegistry.Create;
437 try
438 reg.RootKey := HKEY_CURRENT_USER;
439
440 //first get the dicationary file name
441 Reg.OpenKey('\software\'+ ChangeFileExt(Application.ExeName,'') + '\skaHunSpellCheckOptions',True);
442 if reg.ValueExists('DicFileName') then
443 DictionaryFileName:=Reg.readString('DicFileName')
444 else
445 Reg.WriteString('DicFileName',DictionaryFileName);
446
447 //IgnoreAllCaps ?
448 if reg.ValueExists('IgnoreAllCaps') then
449 IgnoreAllCaps:=Reg.readBool('IgnoreAllCaps')
450 else
451 Reg.WriteBool('IgnoreAllCaps',IgnoreAllCaps);
452
453
454 //IgnoreWordsWithDigits ?
455 if reg.ValueExists('IgnoreWordWithDigits') then
456 IgnoreWordWithDigits:=Reg.readBool('IgnoreWordWithDigits')
457 else
458 Reg.WriteBool('IgnoreWordWithDigits',IgnoreWordWithDigits);
459
460 finally
461 Reg.Free;
462 end;
463
464end;
465
466function TskaHunSpellChecker.GetStatus: TSpellState;
467begin
468 Result := FStatus;
469end;
470
471procedure TskaHunSpellChecker.GetSuggestions(const aMisSpeltWord: string;
472 const SuggestionList: TStrings);
473var
474 i: Integer;
475 pMisSpelt: PAnsiChar;
476 suggestions: PPAnsiChar;
477 Results: PPAnsiChar;
478 Count: Integer;
479begin
480 if (not Active) or (not Assigned(SuggestionList)) then
481 exit;
482
483 pMisSpelt := PAnsiChar(AnsiString(aMisSpeltWord));
484
485 if not uHunSpellLib.hunspell_spell(FpointerHunLib, pMisSpelt) then
486 uHunSpellLib.hunspell_suggest_auto(FpointerHunLib, pMisSpelt, suggestions);
487 begin
488 Count :=uHunSpellLib.hunspell_suggest(FpointerHunLib,pMisSpelt,suggestions);
489 Results := suggestions;
490 for i := 1 to Count do
491 begin
492 SuggestionList.Add(Results^);
493 Inc(Integer(Results), SizeOf(Pointer));
494 end;
495 uHunSpellLib.hunspell_suggest_free(FpointerHunLib, suggestions, Count);
496 end;
497end;
498
499function TskaHunSpellChecker.ShowMisSpelledWord: boolean;
500var
501 I , l :integer;
502 CharPosion:integer;
503 FirstVisibleLine, LastVisibleLine:integer;
504
505 hndl: hwnd;
506 dcForHndl: THandle;
507 visrect:Trect;
508 vispoint:TPoint;
509 procedure ShowMisSpelletWord;
510 begin
511 if Assigned(FHighlightEdit) then
512 begin
513 FHighlightEdit.Font.Color := ColorForMisspelled;
514 FHighlightEdit.Text := CurrentWord;
515 FHighlightEdit.Show;
516 end ;
517
518 if ((PosOfFirstCharInCurrentLine + FoundAt) < 1) then
519 exit;
520
521 SendMessage (SourceTextControl.Handle, EM_POSFROMCHAR, integer(@VisPoint),
522 PosOfFirstCharInCurrentLine + FoundAt-1);
523 SetTextColor(dcForHndl, ColorForMisspelled);
524 TextOut(dcForHndl, VisPoint.x, VisPoint.y, pchar(CurrentWord), WordLength);
525 end;
526
527 function WordIsIgnorable: Boolean;
528 var
529 i: Integer;
530 begin
531 if IgnoreAllCaps then
532 begin
533 Result := True;
534 for i := 1 to WordLength do
535 begin
536 Result := Result and (ord(CurrentWord[i]) in [65..90]);
537 end;
538 if Result then
539 exit;
540 end;
541
542
543
544 if IgnoreWordWithDigits then
545 begin
546 Result := False;
547 for i := 1 to WordLength do
548 begin
549 Result := Result or (ord(CurrentWord[i]) in [48..57]);
550 if Result then
551 break;
552 end;
553 end;
554 end;
555begin
556 Result := False;
557 if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl))
558 or (not assigned(SuggestionList)) then
559 exit;
560
561 hndl:=SourceTextControl.Handle;
562
563 result:= SendMessage (hndl, EM_GETRECT, 0, integer(@visrect))=0;
564
565 dcForHndl := getdc(hndl);
566
567 if result then
568 begin
569 // VisPoint := visrect.BottomRight;
570 vispoint.Y := visrect.Bottom;
571 vispoint.X := visrect.Right;
572 CharPosion := SendMessage (hndl, EM_CHARFROMPOS, 0, integer(@VisPoint));
573 LASTVISIBLELINE := SendMessage (hndl, EM_LINEFROMCHAR, CharPosion, 0);
574 FIRSTVISIBLELINE := SendMessage (hndl, EM_GETFIRSTVISIBLELINE, 0, 0);
575
576 SetBkMode (dcForHndl, TRANSPARENT);
577 SelectObject(dcForHndl, SourceTextControl.font.Handle);
578 i := 0;
579
580 if WaitForUser then
581 begin
582 ShowMisSpelletWord;
583 exit;
584 end;
585
586 For l := 0 to SourceTextControl.Lines.Count -1 do
587 begin
588 {$R-}
589 CurrentLine := l;
590 if trim(SourceTextControl.Lines[CurrentLine]) = '' then
591 continue;
592
593 CurrentText := ' ' + SourceTextControl.Lines[CurrentLine];
594 PosOfFirstCharInCurrentLine := SendMessage (SourceTextControl.Handle,
595 EM_LINEINDEX, CurrentLine, 0);
596 i := 0;
597
598 While i <= LENgth(CurrentText) do
599 begin
600 FoundAt := i -1;
601 if Assigned(FHighlightEdit) then
602 FHighlightEdit.Hide;
603
604
605 //SuggestionList.Clear;
606 {Any character except these will count as a word delimiter}
607 While CurrentText[i] in ['A'..'Z','a'..'z','0'..'9'] do inc(i);
608
609 WordLength := i- FoundAt -1;
610 WordPos := i-WordLength;
611 CurrentWord := copy(CurrentText, WordPos, WordLength);
612 // if WordIsCorrect then
613 if (((FIgnore.IndexOf(CurrentWordDetail(True))< 0) //SingelIgnore
614 and (FIgnore.IndexOf(CurrentWordDetail(False))< 0) //IgnoreAll
615 and (IsMisspelled(CurrentWord))))
616 and (not WordIsIgnorable) then
617
618 begin
619 GetSuggestions(CurrentWord, SuggestionList.Items);
620 if SuggestionList.Count > 0 then
621 SuggestionList.ItemIndex := 0;
622 ShowMisSpelletWord;
623 if CurrentLine > LastVisibleLine then
624 SendMessage(SourceTextControl.Handle, EM_LINESCROLL, 0,
625 (CurrentLine - lastvisibleLine)+5);
626 WaitForUser := True;
627 exit;
628 End
629 else
630 SuggestionList.Clear;
631 inc(i);
632 end;
633 end;
634 if (CurrentLine >= SourceTextControl.Lines.Count-1)
635 and (i >= length(CurrentText) +1) then
636 begin
637 if (not FModified)
638 or (MessageDlg(ConfirmComplete,mtConfirmation,[mbOK, mbCancel],0)=mrOk)
639 then
640 begin
641 FStatus := ssCompleted;
642 InformStatusChange;
643 end
644 else
645 Undo;
646 end;
647 {$R+}
648 end;
649 ReleaseDC(SourceTextControl.Handle, dcForHndl);
650
651End;
652
653function TskaHunSpellChecker.Undo: Boolean;
654var
655 tmpStr: String;
656 tmpCount: Integer;
657 SrcText: String;
658begin
659 if FUndoList.Count > 1 then
660 try
661 tmpStr := FUndoList.Strings[FUndoList.Count-1];
662 if (AnsiPos('$$',tmpStr)=1) and (copy(tmpStr,length(tmpStr)-1,2) = '$$')then
663 //if last action was ignoring word then just remove it from ignore list
664 begin
665 tmpCount := strtoInt(StringReplace(tmpStr,'$$','',[rfReplaceAll]));
666 while FIgnore.Count > tmpCount do
667 FIgnore.Delete(FIgnore.Count -1);
668 end
669 else
670 SourceTextControl.Text := tmpStr;
671
672 Result := True;
673 FUndoList.Delete(FUndoList.Count-1);
674 ReStart;
675 except
676 Result := False;
677 end;
678end;
679
680procedure TskaHunSpellChecker.IgnoreAll;
681begin
682 if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl))
683 or (not assigned(SuggestionList)) then
684 exit;
685
686 SaveForUndo(True);
687 FIgnore.Add(CurrentWordDetail(False)) ;
688 WaitForUser := False;
689 SourceTextControl.Invalidate;
690end;
691
692procedure TskaHunSpellChecker.IgnoreOnce;
693begin
694 if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl))
695 or (not assigned(SuggestionList)) then
696 exit;
697
698 if trim(CurrentWord) <> '' then
699 begin
700 SaveForUndo(True);
701 FIgnore.Add(CurrentWordDetail(True)) ;
702 end;
703 WaitForUser := False;
704 SourceTextControl.Invalidate;
705end;
706
707procedure TskaHunSpellChecker.InformStatusChange;
708begin
709 if Assigned(OnStateChange) then
710 OnStateChange(Self, FStatus);
711end;
712
713procedure TskaHunSpellChecker.Initialize;
714begin
715 CurrentWord := '';
716 WordLength := 0;
717 FoundAt := -1;
718 CurrentLine := 0;
719 WordPos := 0;
720 SuggestionList.Clear;
721end;
722
723function TskaHunSpellChecker.IsMisspelled(const AWord: string): Boolean;
724begin
725 if (not Active) then
726 Result := True
727 else
728 Result := not uHunSpellLib.hunspell_spell(FpointerHunLib,
729 PAnsiChar(AnsiString(AWord)));
730end;
731
732procedure TskaHunSpellChecker.Loaded;
733begin
734 inherited;
735 SetActive(FActiveOrLoaded);
736end;
737
738procedure TskaHunSpellChecker.ManualChangeDone;
739begin
740 if trim(FTxtBeforeManualEdit) = '' then
741 exit;
742 FUndoList.Add(FTxtBeforeManualEdit);
743 ReStart;
744end;
745
746procedure TskaHunSpellChecker.ManualChangeStart;
747begin
748 FTxtBeforeManualEdit := FSourceEdit.Text;
749end;
750
751function TskaHunSpellChecker.Open: Boolean;
752var
753 CurrentLine: integer;
754 function GetSpecialFolderPath(folder : integer) : string;
755 var
756 path: array [0..MAX_PATH] of char;
757 begin
758 if SUCCEEDED(SHGetFolderPath(0,folder,0,0,@path[0])) then
759 Result := path
760 else
761 Result := '';
762 end;
763begin
764 Result := True;
765 if Active then Exit;
766 Result := False;
767 FpointerHunLib := Nil;
768 if not uHunSpellLib.LoadLibHunspell('') then
769 begin
770 MessageDlg(DLLNotLoaded, mtError, [mbOK],0);
771 Exit;
772 end;
773 FpointerHunLib := uHunSpellLib.hunspell_initialize(
774 PAnsiChar(AnsiString(FAffixFileName)),
775 PAnsiChar(AnsiString(FDictFileName)));
776 Result := Assigned(FpointerHunLib);
777
778 if Result then
779 begin
780 FStatus := ssReady;
781 InformStatusChange;
782 end;
783 if trim(CustDictionaryFile) = '' then
784 CustDictionaryFile := IncludeTrailingPathDelimiter(
785 GetSpecialFolderPath(CSIDL_PERSONAL)) + 'CustomDictionary.txt';
786 if (Result) and (assigned(FCustDict)) then
787 for CurrentLine := 0 to FCustDict.Count - 1 do
788 AddCustomWord(FCustDict[CurrentLine], True);
789end;
790
791procedure TskaHunSpellChecker.SaveForUndo(const Ignoring: Boolean = False);
792begin
793 if Ignoring then
794 FUndoList.Add('$$'+ IntToStr(FIgnore.Count)+'$$')
795 else
796 FUndoList.Add(SourceTextControl.Text);
797end;
798
799procedure TskaHunSpellChecker.SetActive(const Value: Boolean);
800begin
801 if (csDesigning in ComponentState) or (csLoading in ComponentState) then
802 FActiveOrLoaded := Value
803 else
804 if Value then
805 FActiveOrLoaded := Open
806 else
807 Close;
808end;
809
810procedure TskaHunSpellChecker.SetAffixFileName(const Value: string);
811begin
812 Close;
813 FAffixFileName := Value;
814 if (trim(DictionaryFileName) = '') and (trim(value)<>'') then
815 DictionaryFileName := ChangeFileExt(value, '.dic');
816end;
817
818procedure TskaHunSpellChecker.SetCustomDict(const Value: String);
819begin
820 FCustom := Value;
821 if (not (csDesigning in componentState))
822 and (FileExists(Value)) and assigned(FCustDict) then
823 begin
824 FCustDict.Clear;
825 FCustDict.LoadFromFile(Value);
826 end;
827end;
828
829procedure TskaHunSpellChecker.SetDictFileName(const Value: string);
830begin
831 Close;
832 FDictFileName := Value;
833 if (trim(AffixFileName) = '') and (trim(value)<>'') then
834 AffixFileName := ChangeFileExt(value, '.aff');
835end;
836
837procedure TskaHunSpellChecker.SetHighLightEdit(const Value: TEdit);
838begin
839 if FHighlightEdit = Value then
840 exit;
841
842 FHighlightEdit := Value;
843
844 if Active then
845 FHighlightEdit.Text := CurrentWord;
846
847
848end;
849
850procedure TskaHunSpellChecker.SetIgnoreCaps(const Value: boolean);
851begin
852 if (FIgnoreCaps = Value) then
853 exit;
854
855 FIgnoreCaps := Value;
856 if SpellCheckState = ssChecking then
857 ReStart;
858end;
859
860procedure TskaHunSpellChecker.SetIgnoreWordWdigits(const Value: boolean);
861begin
862 if (FIgnoreWordWdigits = Value) then
863 exit;
864
865 FIgnoreWordWdigits := Value;
866 if SpellCheckState = ssChecking then
867 ReStart;
868
869end;
870
871procedure TskaHunSpellChecker.SetOptions;
872var
873reg:TRegistry;
874begin
875 reg:=TRegistry.Create;
876 try
877 reg.RootKey := HKEY_CURRENT_USER;
878
879
880 Reg.OpenKey('\software\'+ ChangeFileExt(Application.ExeName,'') + '\skaHunSpellCheckOptions',True);
881
882 //first save the dicationary file name
883 Reg.WriteString('DicFileName',DictionaryFileName);
884
885 //IgnoreAllCaps ?
886 Reg.WriteBool('IgnoreAllCaps',IgnoreAllCaps);
887
888
889 //IgnoreWordsWithDigits ?
890 Reg.WriteBool('IgnoreWordWithDigits',IgnoreWordWithDigits);
891
892 finally
893 Reg.Free;
894 end;
895end;
896
897Function RichEditWndProc(handle:HWnd;uMsg,wParam,lParam:longint):longint stdcall;
898begin
899 Result := CallWindowProc(OldRichEditWndProc, handle, uMsg, wParam, lParam);
900 if (uMsg=WM_PAINT) and assigned(CurrentMe) then
901 CurrentMe.ShowMisSpelledWord;
902End;
903
904procedure TskaHunSpellChecker.SetSourceEdit(const Value: TRichEdit);
905begin
906 if FSourceEdit = Value then
907 exit;
908
909 FSourceEdit := Value;
910
911 if csDesigning in ComponentState then
912 exit;
913
914 PREditorWndProc:=@RichEditWndProc;
915 //raise the limit of text which could be inserted into this Richedit
916 Value.perform(EM_EXLIMITTEXT, 0, 65535*32);
917 OldRichEditWndProc := pointer(SetWindowLong(Value.handle, GWL_WNDPROC,
918 longint(@RichEditWndProc)));
919end;
920
921end.
Note: See TracBrowser for help on using the repository browser.