Changeset 1715 for cprs/branches/HealthSevak-CPRS/CPRS-Lib/Hans SpellCheck/skaSpellCheck.pas

Timestamp:

May 17, 2015, 7:29:55 AM (10 years ago)

Author:

healthsevak

Message:

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:

• cprs/branches/HealthSevak-CPRS/CPRS-Lib/Hans SpellCheck/skaSpellCheck.pas (modified) (40 diffs)

cprs/branches/HealthSevak-CPRS/CPRS-Lib/Hans SpellCheck/skaSpellCheck.pas

@@ -17 +17 @@
  * License.
  *
+ *Special Note:
+ * This work has heavily relies upon rather build upon Copyrighted work by
+ * Miha Vrhovnik (http://simail.sf.net, http://xcollect.sf.net)  which is
+ * available at http://sourceforge.net/projects/hunspell/
+ *
  * Alternatively, the content of this file maybe used under the terms of either
  * the GNU General Public License Version 2 or later (the "GPL"), or the GNU
@@ -34 +39 @@
 
 uses
-  Windows, Classes, SysUtils, ComCtrls, StdCtrls, Graphics;
+  Windows, Classes, SysUtils, ComCtrls, StdCtrls, Graphics, Forms, Controls;
 
   const
-    AboutThis = 'A wrapper component developed by Sunil K Arora (digitiger@gmail.com) of HealthSevak using OpenSource HanSpell engine';
+    AboutThis = 'A wrapper component developed by Sunil K Arora '
+      + '(digitiger@gmail.com) of HealthSevak using OpenSource HanSpell engine';
 type
-  TSpellState = (ssNotStarted, ssChecking, ssCancelled, ssCompleted);
+  TSpellState = (ssNoengine, ssInActive, ssReady, ssChecking, ssCancelled,
+                                                                  ssCompleted);
+  TStateChangeEvent = procedure (const Sender : TObject;
+                                          const State : TSpellState) of object;
 
   TskaHunSpellChecker = class(TComponent)
@@ -61 +70 @@
     PREditorWndProc:pointer;
     FHighlightColor: TColor;
-    FShowCompletion: Boolean;
-    FpointerSpellComplete: String;
-    FStatus: TSpellState;
     FUndoList: TStringList;
     FCustDict: TStringList;
@@ -69 +75 @@
     FModified: Boolean;
     FHighlightEdit: TEdit;
-    FbtnClose: TButton;
     FTxtBeforeManualEdit: String;
+
+    FStatus: TSpellState;
+    FOnStart: TNotifyEvent;
+    FOnAbort  : TNotifyEvent;
+    FOnStateChange  : TStateChangeEvent;
+
     function AddCustomWord(aWord: String; isInternal: Boolean = False): Boolean;
                                                             overload; virtual;
@@ -79 +90 @@
     procedure SetActive(const Value: Boolean);
     procedure SetAffixFileName(const Value: string);
-    procedure SetbtnClose(const Value: TButton);
     procedure SetCustomDict(const Value: String);
     procedure SetDictFileName(const Value: string);
@@ -89 +99 @@
     function GetAboutThis: String;
     procedure SaveForUndo(const Ignoring: Boolean=False);
-    procedure ShowBtnClose(const ShowIt: Boolean = True);
+    procedure InformStatusChange;
   public
     constructor Create(AOwner: TComponent); overload; override;
@@ -111 +121 @@
     procedure ManualChangeDone;
     function Open:Boolean; virtual;
+    procedure ReOpen;
     function ReStart: Boolean; virtual;
-
     function Undo: Boolean;
-
-
-    property SpellCheckState: TSpellState read GetStatus default ssNotStarted;
+    property SpellCheckState: TSpellState read GetStatus default ssInActive;
   published
     property About: String read GetAboutThis;
     property Active: Boolean read GetActive write SetActive;
     property AffixFileName: string read FAffixFileName write SetAffixFileName;
-    property btnClose: TButton read FbtnClose write SetbtnClose;
     property CustDictionaryFile: String read FCustom write SetCustomDict;
     property DictionaryFileName:string read FDictFileName write SetDictFileName;
-    property ColorForMisspelled: TColor read FHighlightColor write FHighlightColor default clRed;
+    property ColorForMisspelled: TColor read FHighlightColor
+                                            write FHighlightColor default clRed;
     property MisSpeltWord: TEdit read FHighlightEdit write SetHighLightEdit;
     property IsModified: Boolean read FModified;
-    property ShowCompletionMessage: Boolean read FShowCompletion write FShowCompletion default True;
+    property OnStart : TNotifyEvent read FOnStart write FOnStart;
+    property OnStateChange : TStateChangeEvent read FOnStateChange
+                                                          write FOnStateChange;
+    property OnAbort : TNotifyEvent read FOnAbort write FOnAbort;
     property SourceTextControl: TRichEdit read FSourceEdit write SetSourceEdit;
-    property SpellCheckCompletionMessage: String read FpointerSpellComplete write FpointerSpellComplete; 
-    property SuggestionList: TListbox read FSuggestionList write FSuggestionList;
+    property SuggestionList:TListbox read FSuggestionList write FSuggestionList;
 
   end;
@@ -140 +150 @@
     CaptionForNewWord = 'New Word Suggestion';
     ConfirmAbort = 'Really abort?';
+    ConfirmComplete   = 'If you accept last change than SpellCheck is complete.'
+                        + #13 + '  To review last change click on "Cancel".';
     PromptForNewWord = 'Specify the replacement for current mis-spelt word:';
     DLLNotLoaded = 'Failed to load SpellCheck Engine DLL.';
@@ -145 +157 @@
                           +' Would you want to still use it?   Click NO button '
                           +'to specify better replacement word.';
+
   var
     OldRichEditWndProc: {integer}pointer;
     CurrentMe: TskaHunSpellChecker;
 implementation
-   uses messages, Dialogs, RichEdit, SHFolder, Forms, uHunSpellLib;
+   uses messages, Dialogs, RichEdit, SHFolder,  uHunSpellLib;
 
 procedure Register;
@@ -171 +184 @@
                                                   [mbYes, mbNo],0, mbNo) = 6);
 
-  if Result then
-    FStatus := ssCancelled;
-
-  ShowBtnClose;
-end;
-
-function TskaHunSpellChecker.AddCustomWord(aWord: String; isInternal: Boolean = False): Boolean;
+  if Result and (FUndoList.Count > 0) then
+  begin
+       SourceTextControl.Text := FUndoList[0];
+       FUndoList.Clear;
+       FUndoList.Add(SourceTextControl.Text);
+  end;
+   FIgnore.Clear;
+   FStatus := ssCancelled;
+   SourceTextControl.Invalidate;
+   if Assigned(OnAbort) then
+     OnAbort(Self);
+end;
+
+function TskaHunSpellChecker.AddCustomWord(aWord: String;
+                                        isInternal: Boolean = False): Boolean;
 begin
   Result := False;
-  if (trim(aWord) = '') or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
-     
-
-  Result := False;
-  if (not Active) then Exit;
+  if (not active) or (trim(aWord) = '') or (SpellCheckState <> ssChecking)
+    or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
+  begin
+    Result := False;
+    exit;
+  end;
   uHunSpellLib.hunspell_put_word(FpointerHunLib, PAnsiChar(AnsiString(aWord)));
   Result := True;
@@ -191 +213 @@
 procedure TskaHunSpellChecker.ChangeAll;
 begin
-  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
+  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl))
+                                         or (not assigned(SuggestionList)) then
      exit;
   SaveForUndo;
@@ -214 +237 @@
 end;
 
+procedure TskaHunSpellChecker.ReOpen;
+begin
+  Close;
+  Open;
+end;
+
 procedure TskaHunSpellChecker.ReplaceCurrentWordWith(const aNewWord: String);
 var
@@ -221 +250 @@
 begin
   full := SourceTextControl.Lines[CurrentLine];
-  prefix := copy(CurrentText, 2, WordPos-2);    //remember there is one extra space at the start of the line prefixed while populating this variable
+{remember there is one extra space at the start of the line prefixed while
+ populating this variable}
+  prefix := copy(CurrentText, 2, WordPos-2);
   Suffix :=  copy(CurrentText, WordPos+WordLength,
                            length(CurrentText));
   SaveForUndo;
+  FModified := True;
   SourceTextControl.Lines[CurrentLine] :=prefix + aNewWord + suffix;
   WaitForUser := False;
@@ -238 +270 @@
   Initialize;
   WaitForUser := False;
-  FStatus := ssChecking;
+  if FStatus <> ssChecking then
+  begin
+    FStatus := ssChecking;
+    InformStatusChange;
+  end;
   SourceTextControl.Invalidate;
   Result := not WaitForUser;
@@ -246 +282 @@
 
 begin
-  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
+  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl))
+                                          or (not assigned(SuggestionList)) then
      exit;
   ReplaceCurrentWordWith(SuggestionList.Items[SuggestionList.ItemIndex]);
@@ -253 +290 @@
 procedure TskaHunSpellChecker.CheckSpelling;
 begin
- if (SpellCheckState = ssChecking) or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
+ if (SpellCheckState = ssChecking) or (not assigned(SourceTextControl))
+    or (trim(SourceTextControl.Text)= '') or (not assigned(SuggestionList)) then
      exit;
 
  Initialize;
  FUndoList.Clear;
+  FUndoList.Add(SourceTextControl.Text);
+ FIgnore.Clear;
  WaitForUser := False;
  FStatus := ssChecking;
+ if Assigned(OnStart) then
+   OnStart(Self);
  SourceTextControl.Invalidate;
- //SourceTextControl.Invalidate;
- ShowBtnClose(False);
 end;
 
@@ -268 +308 @@
 begin
   if not Active then Exit;
-  uHunSpellLib.hunspell_uninitialize(FpointerHunLib);
+    uHunSpellLib.hunspell_uninitialize(FpointerHunLib);
   FpointerHunLib := nil;
+  FStatus := ssInActive;
+  InformStatusChange;
 end;
 
@@ -278 +320 @@
   GotIt: Boolean;
 begin
-  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
+  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl))
+                                        or (not assigned(SuggestionList)) then
      exit;
 
@@ -304 +347 @@
 
 constructor TskaHunSpellChecker.Create(AOwner: TComponent);
-    function GetSpecialFolderPath(folder : integer) : string;
-      var
-        path: array [0..MAX_PATH] of char;
-    begin
-      if SUCCEEDED(SHGetFolderPath(0,folder,0,0,@path[0])) then
-        Result := path
-      else
-        Result := '';
-    end;
 begin
   inherited;
-
    ColorForMisspelled := clRed;
-   ShowCompletionMessage := True;
-   SpellCheckCompletionMessage := CompletionMessage;
-
-
 
    CurrentMe := Self;
@@ -326 +355 @@
    FCustDict := TStringList.Create;
 
-   CustDictionaryFile := IncludeTrailingPathDelimiter(GetSpecialFolderPath(CSIDL_PERSONAL)) + 'CustomDictionary.txt';
-   if FileExists(CustDictionaryFile) then
+   if (trim(CustDictionaryFile)<>'') and (FileExists(CustDictionaryFile)) then
     try
       FCustDict.LoadFromFile(CustDictionaryFile);
@@ -335 +363 @@
    FUndoList := TStringList.Create;
 
-   FStatus := ssNotStarted;
+   FStatus := ssInActive;
    WaitForUser := False;
    WordPos := 0;
@@ -406 +434 @@
     uHunSpellLib.hunspell_suggest_auto(FpointerHunLib, pMisSpelt, suggestions);
   begin
-    Count := uHunSpellLib.hunspell_suggest(FpointerHunLib, pMisSpelt, suggestions);
+    Count :=uHunSpellLib.hunspell_suggest(FpointerHunLib,pMisSpelt,suggestions);
     Results := suggestions;
     for i := 1 to Count do
@@ -415 +443 @@
     uHunSpellLib.hunspell_suggest_free(FpointerHunLib, suggestions, Count);
   end; 
-end;
-
-procedure TskaHunSpellChecker.ShowBtnClose(const ShowIt: Boolean);
-begin
-  if Assigned(btnClose) then
-  begin
-   btnClose.Enabled := ShowIt;
-   btnClose.Visible := ShowIt;
-   if ShowIt then
-   begin
-     btnClose.BringToFront;
-     btnClose.SetFocus;
-   end;
-  end;
 end;
 
@@ -453 +467 @@
         exit;
 
-     SendMessage (SourceTextControl.Handle, EM_POSFROMCHAR, integer(@VisPoint), PosOfFirstCharInCurrentLine + FoundAt-1);
+     SendMessage (SourceTextControl.Handle, EM_POSFROMCHAR, integer(@VisPoint),
+                                      PosOfFirstCharInCurrentLine + FoundAt-1);
      SetTextColor(dcForHndl, ColorForMisspelled);
-     TextOut(dcForHndl,  VisPoint.x,  VisPoint.y,  pchar(CurrentWord), WordLength);
+     TextOut(dcForHndl, VisPoint.x, VisPoint.y, pchar(CurrentWord), WordLength);
    end;
 begin
@@ -474 +489 @@
     vispoint.Y := visrect.Bottom;
     vispoint.X := visrect.Right;
-    CharPosion       := SendMessage (hndl, EM_CHARFROMPOS, 0, integer(@VisPoint));
-    LASTVISIBLELINE  := SendMessage (hndl, EM_LINEFROMCHAR, CharPosion, 0);
+    CharPosion := SendMessage (hndl, EM_CHARFROMPOS, 0, integer(@VisPoint));
+    LASTVISIBLELINE := SendMessage (hndl, EM_LINEFROMCHAR, CharPosion, 0);
     FIRSTVISIBLELINE := SendMessage (hndl, EM_GETFIRSTVISIBLELINE, 0, 0);
 
@@ -496 +511 @@
 
       CurrentText := ' ' + SourceTextControl.Lines[CurrentLine];
-      PosOfFirstCharInCurrentLine := SendMessage (SourceTextControl.Handle, EM_LINEINDEX, CurrentLine, 0);
+      PosOfFirstCharInCurrentLine := SendMessage (SourceTextControl.Handle,
+                                                  EM_LINEINDEX, CurrentLine, 0);
       i := 0;
 
@@ -522 +538 @@
           ShowMisSpelletWord;
           if CurrentLine > LastVisibleLine then
-            SendMessage(SourceTextControl.Handle, EM_LINESCROLL, 0, (CurrentLine - lastvisibleLine)+5);
+            SendMessage(SourceTextControl.Handle, EM_LINESCROLL, 0,
+                                            (CurrentLine - lastvisibleLine)+5);
           WaitForUser := True;
           exit;
@@ -531 +548 @@
       end;
     end;
-    if (CurrentLine >= SourceTextControl.Lines.Count-1) and (i >= length(CurrentText) +1) then
+    if (CurrentLine >= SourceTextControl.Lines.Count-1)
+                                          and (i >= length(CurrentText) +1) then
     begin
-      FStatus := ssCompleted;
-      if ShowCompletionMessage then
-        ShowMessage(CompletionMessage);
-      ShowBtnClose;
+      if (not FModified)
+         or (MessageDlg(ConfirmComplete,mtConfirmation,[mbOK, mbCancel],0)=mrOk)
+         then
+      begin
+        FStatus := ssCompleted;
+        InformStatusChange;
+      end
+      else
+        Undo;
     end;
     {$R+}
@@ -548 +571 @@
   tmpStr: String;
   tmpCount: Integer;
-begin
-  if FUndoList.Count > 0 then
+  SrcText: String;
+begin
+  if FUndoList.Count > 1 then
   try
     tmpStr := FUndoList.Strings[FUndoList.Count-1];
-   { showmessage(inttostr(AnsiPos('$$',tmpStr)) + #13 + inttostr(length(tmpstr)) + #13 +
-                                        copy(tmpStr,length(tmpStr)-2,2));  }
     if (AnsiPos('$$',tmpStr)=1) and (copy(tmpStr,length(tmpStr)-1,2) = '$$')then
+    //if last action was ignoring word then just remove it from ignore list
     begin
       tmpCount := strtoInt(StringReplace(tmpStr,'$$','',[rfReplaceAll]));
@@ -573 +596 @@
 procedure TskaHunSpellChecker.IgnoreAll;
 begin
-  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
+  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl))
+                                        or (not assigned(SuggestionList)) then
      exit;
+
   SaveForUndo(True);
   FIgnore.Add(CurrentWordDetail(False)) ;
@@ -583 +608 @@
 procedure TskaHunSpellChecker.IgnoreOnce;
 begin
-  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
+  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl))
+                                          or (not assigned(SuggestionList)) then
      exit;
+
   if trim(CurrentWord) <> '' then
   begin
@@ -592 +619 @@
   WaitForUser := False;
   SourceTextControl.Invalidate;
+end;
+
+procedure TskaHunSpellChecker.InformStatusChange;
+begin
+  if Assigned(OnStateChange) then
+    OnStateChange(Self, FStatus);
 end;
 
@@ -609 +642 @@
     Result := True
   else
-    Result := not uHunSpellLib.hunspell_spell(FpointerHunLib, PAnsiChar(AnsiString(AWord)));
+    Result := not uHunSpellLib.hunspell_spell(FpointerHunLib,
+                                                PAnsiChar(AnsiString(AWord)));
 end;
 
@@ -634 +668 @@
 var
   CurrentLine: integer;
+  function GetSpecialFolderPath(folder : integer) : string;
+      var
+        path: array [0..MAX_PATH] of char;
+    begin
+      if SUCCEEDED(SHGetFolderPath(0,folder,0,0,@path[0])) then
+        Result := path
+      else
+        Result := '';
+    end;
 begin
   Result := True;
@@ -644 +687 @@
      Exit;
   end;
-  FpointerHunLib := uHunSpellLib.hunspell_initialize(PAnsiChar(AnsiString(FAffixFileName)), PAnsiChar(AnsiString(FDictFileName)));
+  FpointerHunLib := uHunSpellLib.hunspell_initialize(
+                                        PAnsiChar(AnsiString(FAffixFileName)),
+                                        PAnsiChar(AnsiString(FDictFileName)));
   Result := Assigned(FpointerHunLib);
 
+  if Result then
+  begin
+    FStatus := ssReady;
+    InformStatusChange;
+  end;
+  if trim(CustDictionaryFile) = '' then
+    CustDictionaryFile := IncludeTrailingPathDelimiter(
+                GetSpecialFolderPath(CSIDL_PERSONAL)) + 'CustomDictionary.txt';
   if (Result) and (assigned(FCustDict)) then
      for CurrentLine := 0 to FCustDict.Count - 1 do
@@ -675 +728 @@
   Close;
   FAffixFileName := Value;
-end;
-
-procedure TskaHunSpellChecker.SetbtnClose(const Value: TButton);
-begin
-  if btnClose = Value then
-     exit;
-  FbtnClose := Value;
-  FbtnClose.ModalResult := 1; //mrOK
+  if (trim(DictionaryFileName) = '') and (trim(value)<>'') then
+    DictionaryFileName := ChangeFileExt(value, '.dic');
 end;
 
@@ -688 +735 @@
 begin
   FCustom := Value;
-  if not (csDesigning in componentState) then
-    if Active and (FileExists(Value)) then
-      FCustDict.LoadFromFile(Value);
+  if (not (csDesigning in componentState))
+                          and (FileExists(Value)) and assigned(FCustDict) then
+  begin
+    FCustDict.Clear;
+    FCustDict.LoadFromFile(Value);
+  end;
 end;
 
@@ -697 +747 @@
   Close;
   FDictFileName := Value;
+  if (trim(AffixFileName) = '') and (trim(value)<>'') then
+    AffixFileName := ChangeFileExt(value, '.aff');
 end;
 
@@ -712 +764 @@
 end;
 
-Function RichEditWndProc (handle:HWnd;uMsg,wParam,lParam:longint): longint stdcall;
-begin
-      Result := CallWindowProc(OldRichEditWndProc, handle, uMsg, wParam, lParam);
-      if (uMsg=WM_PAINT) and assigned(CurrentMe) then CurrentMe.ShowMisSpelledWord;
+Function RichEditWndProc(handle:HWnd;uMsg,wParam,lParam:longint):longint stdcall;
+begin
+  Result := CallWindowProc(OldRichEditWndProc, handle, uMsg, wParam, lParam);
+   if (uMsg=WM_PAINT) and assigned(CurrentMe) then
+     CurrentMe.ShowMisSpelledWord;
 End;
 
@@ -729 +782 @@
 
   PREditorWndProc:=@RichEditWndProc;
-  Value.perform(EM_EXLIMITTEXT, 0, 65535*32); //raise the limit of text which could be inserted into this Richedit
-  OldRichEditWndProc := pointer(SetWindowLong(Value.handle, GWL_WNDPROC, longint(@RichEditWndProc)));
-
+  //raise the limit of text which could be inserted into this Richedit
+  Value.perform(EM_EXLIMITTEXT, 0, 65535*32);
+  OldRichEditWndProc := pointer(SetWindowLong(Value.handle, GWL_WNDPROC,
+                                                    longint(@RichEditWndProc)));
 end;