source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fHunSpell.pas@ 1723

unit fHunSpell;
(* ***************************** BEGIN LICENSE BLOCK **********************
 *
 * Copyright (C) 2015
 * Sunil Kumar Arora (digitiger@gmail.com        sunil@healthsevak.com)
 * All Rights Reserved.
 * Version: MPL 1.1/GPL 2.0/LGPL 2.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * 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
 * Lesser General Public License Version 2.1 or later (the "LGPL"), in which
 * case the provisions of the GPL or the LGPL are applicable instead of those
 * above. If you wish to allow use of your version of this file only under the
 * terms of either the GPL or the LGPL, and not to allow others to use your
 * version of this file under the terms of the MPL, indicate your division by
 * deleting the provisions above and replace them with the notice and other
 * provisions required by the GPL or LGPL. If you do not delete the provisions
 * above, a recipient may use your version of this file under the terms of any
 * one of the MPL, the GPL or the LGPL.
 *
 * *********************** END LICENSE BLOCK *********************************)

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, RichEdit, Buttons, ExtCtrls, ShellAPI, 
  skaSpellCheck,
  VA508AccessibilityManager, fBase508Form;

type
  TfrmHunSpell = class(TfrmBase508Form)
    lblDictionary: TLabel;
    btnClose: TButton;
    OpenDialog1: TOpenDialog;
    SpellCheck1: TskaHunSpellChecker;
    edtDictionary: TEdit;
    btnSelectDict: TBitBtn;
    lblOpenMedURL: TLabel;
    lblDictionariesURL: TLabel;
    RichEdit1: TRichEdit;
    pnlMisSpelled: TPanel;
    Label1: TLabel;
    lstSuggestions: TListBox;
    Label4: TLabel;
    edtMisSpelt: TEdit;
    btnReplaceWith: TButton;
    btnChangeAll: TButton;
    btnChange: TButton;
    btnAddToDictionary: TButton;
    btnIgnoreAll: TButton;
    btnIgnoreOnce: TButton;
    btnAbort: TButton;
    btnAbout: TButton;
    pnlAbout: TPanel;
    Button1: TButton;
    btnUndo: TButton;
    cbIgnoreAllCaps: TCheckBox;
    cbIgnoreDigit: TCheckBox;
    btnRestat: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnIgnoreOnceClick(Sender: TObject);
    procedure btnIgnoreAllClick(Sender: TObject);
    procedure btnChangeClick(Sender: TObject);
    procedure btnChangeAllClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure btnSelectDictClick(Sender: TObject);
    procedure edtDictionaryEnter(Sender: TObject);
    procedure btnReplaceWithClick(Sender: TObject);
    procedure btnAddToDictionaryClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnAbortClick(Sender: TObject);
    procedure lblOpenMedURLClick(Sender: TObject);
    procedure btnAboutClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure btnUndoClick(Sender: TObject);
    procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lstSuggestionsDblClick(Sender: TObject);
    procedure SpellCheck1StateChange(const Sender: TObject;
      const State: TSpellState);
    procedure SpellCheck1Abort(Sender: TObject);
    procedure SpellCheck1Start(Sender: TObject);
    procedure cbIgnoreAllCapsClick(Sender: TObject);
    procedure cbIgnoreDigitClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnRestatClick(Sender: TObject);
  private
    { Private declarations }
    NoEngineOpted: Boolean;
    FSourceControl: TCustomMemo;
    procedure GoToURL(const aURL: String);
    procedure UpdateGUI;
  public
    { Public declarations }
    Showhighlight:boolean;
    highlightcolor:TColor;
    HighLightList:TStringlist;
    OldRichEditWndProc: {integer}pointer;
    PRichEditWndProc:pointer;
    class function DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult; static;
  end;

  Resourcestring
    TX_AFF_NOT_FOUND      = 'Correspong AFF file named not found!'
                          + #13
                          + '  Specify dictionary file whose *.aff is also '
                          + 'present in same directory.' ;
    TX_DIC_FILE_NOT_FOUND = 'Dictionary File for SpellCheck Engine not found!';
    TX_SPELL_COMPLETE     = 'Spell Check Complete';
    TX_SPELL_CANCELLED    = 'Spell Check Aborted'
                          + #13
                          + 'No Changes applied to the original text!';

 Const
   DefaultDicFile =  'dict\en-US-OpenMedSpel.dic';

 var
  frmHunSpell: TfrmHunSpell;
  
implementation
{$R *.DFM}

  uses uSpell, VAUtils;

class function TfrmHunSpell.DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult;
var
  frm: TfrmHunSpell;
begin
  Result := mrCancel;
  frm:= TfrmHunSpell.create(Application);
  try
    frm.RichEdit1.Text:= AnEditControl.Text;
    frm.FSourceControl := AnEditControl;
    Result := frm.ShowModal;
  finally
    frm.Free;
  end;
end;

 {************ HighLight ***********888}
 procedure TfrmHunSpell.FormShow(Sender: TObject);
begin
 if SpellCheck1.SpellCheckState = ssReady then
   SpellCheck1.CheckSpelling;
 try
   if lstSuggestions.Count > 0 then
     btnChange.SetFocus;
 except
 end;
end;

procedure TfrmHunSpell.GoToURL(const aURL: String);
begin
if length(trim(aURL)) > 4 then
  ShellExecute(Handle, 'open', PChar(aURL), '', '', SW_NORMAL);
end;

procedure TfrmHunSpell.lblOpenMedURLClick(Sender: TObject);
begin
  inherited;
  GoToURL(TLabel(sender).Caption);
end;

procedure TfrmHunSpell.lstSuggestionsDblClick(Sender: TObject);
begin
  inherited;
  btnChangeClick(sender);
end;

procedure TfrmHunSpell.RichEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if SpellCheck1.SpellCheckState = ssChecking then
    SpellCheck1.ManualChangeStart;
end;

procedure TfrmHunSpell.RichEdit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if SpellCheck1.SpellCheckState in [ssCancelled, ssCompleted] then
   SpellCheck1.Reopen;

 if SpellCheck1.SpellCheckState = ssChecking then
    SpellCheck1.ManualChangeDone;
end;

procedure TfrmHunSpell.SpellCheck1Abort(Sender: TObject);
begin
  inherited;
  UpdateGUI;
end;

procedure TfrmHunSpell.SpellCheck1Start(Sender: TObject);
begin
  inherited;
  UpdateGUI;
end;

procedure TfrmHunSpell.SpellCheck1StateChange(const Sender: TObject;
  const State: TSpellState);
begin
  inherited;
  if State = ssCompleted then
    ShowMessage(TX_SPELL_COMPLETE);
  UpdateGUI;
end;

procedure TfrmHunSpell.UpdateGUI;
var
  Checking: Boolean;
begin
  if  csDestroying in componentstate then
     exit;
  Checking := SpellCheck1.SpellCheckState = ssChecking;
  pnlMisSpelled.Visible := Checking;
  pnlMisSpelled.Enabled := Checking;
  btnClose.Visible := not Checking;
end;

{************* FormCreate **********}
procedure TfrmHunSpell.btnAboutClick(Sender: TObject);
begin
  inherited;
  pnlAbout.Show;
  pnlAbout.BringToFront;
end;

procedure TfrmHunSpell.btnAddToDictionaryClick(Sender: TObject);
begin
  SpellCheck1.AddCustomWord;
end;

procedure TfrmHunSpell.btnReplaceWithClick(Sender: TObject);
begin
   SpellCheck1.CorrectWithMyWord;
end;

procedure TfrmHunSpell.btnRestatClick(Sender: TObject);
begin
  inherited;
  if SpellCheck1.SpellCheckState = ssChecking then
    SpellCheck1.ReStart
  else
    SpellCheck1.CheckSpelling;
end;

procedure TfrmHunSpell.btnAbortClick(Sender: TObject);
begin
//popup 508 compliant confirmation/warning box if isModified
  if SpellCheck1.AbortSpellCheck(True) then
  begin
     Close;
     ModalResult := mrCancel;
  end;
end;

procedure TfrmHunSpell.btnChangeAllClick(Sender: TObject);
begin
  SpellCheck1.ChangeAll;
end;

procedure TfrmHunSpell.btnChangeClick(Sender: TObject);
begin
  SpellCheck1.Change;
end;

procedure TfrmHunSpell.btnCloseClick(Sender: TObject);
begin
  close;
end;

procedure TfrmHunSpell.btnIgnoreAllClick(Sender: TObject);
begin
  SpellCheck1.IgnoreAll;
end;

procedure TfrmHunSpell.btnIgnoreOnceClick(Sender: TObject);
begin
  SpellCheck1.IgnoreOnce;
end;

procedure TfrmHunSpell.btnSelectDictClick(Sender: TObject);
var
  aff: String;
begin
  if OpenDialog1.Execute then
  begin
    if SpellCheck1.DictionaryFileName = OpenDialog1.FileName then
      exit;

    aff := ChangeFileExt(OpenDialog1.FileName, '.aff');
    if not FileExists(aff) then
    begin
      ShowMessage(TX_AFF_NOT_FOUND);
      OpenDialog1.FileName := '';
      btnSelectDictClick(self);
    end
    else
    begin
      if SpellCheck1.SpellCheckState = ssChecking then
        SpellCheck1.AbortSpellCheck(False);
      edtDictionary.Text := OpenDialog1.FileName;
      SpellCheck1.DictionaryFileName := edtDictionary.Text;
      SpellCheck1.AffixFileName := aff;
      SpellCheck1.Open;
    end;
  end;
end;

procedure TfrmHunSpell.btnUndoClick(Sender: TObject);
begin
  inherited;
  SpellCheck1.Undo;
end;

procedure TfrmHunSpell.Button1Click(Sender: TObject);
begin
  inherited;
  pnlAbout.hide;
end;

procedure TfrmHunSpell.cbIgnoreAllCapsClick(Sender: TObject);
begin
  inherited;
  if SpellCheck1.IgnoreAllCaps <> cbIgnoreAllCaps.Checked then
    SpellCheck1.IgnoreAllCaps := cbIgnoreAllCaps.Checked;
end;

procedure TfrmHunSpell.cbIgnoreDigitClick(Sender: TObject);
begin
  inherited;
  if SpellCheck1.IgnoreWordWithDigits <> cbIgnoreDigit.Checked then
    SpellCheck1.IgnoreWordWithDigits := cbIgnoreDigit.Checked;
end;

procedure TfrmHunSpell.edtDictionaryEnter(Sender: TObject);
begin
  btnSelectDict.SetFocus;
end;

procedure TfrmHunSpell.FormActivate(Sender: TObject);
begin
  if ( not SpellCheck1.Active) and (not NoEngineOpted) then
  begin
     btnSelectDictClick(self);
     NoEngineOpted := True;
  end;
  if cbIgnoreAllCaps.Checked <> SpellCheck1.IgnoreAllCaps then
    cbIgnoreAllCaps.Checked := SpellCheck1.IgnoreAllCaps;

  if cbIgnoreDigit.Checked <> SpellCheck1.IgnoreWordWithDigits then
    cbIgnoreDigit.Checked := SpellCheck1.IgnoreWordWithDigits;
end;

procedure TfrmHunSpell.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if SpellCheck1.SpellCheckState = ssCompleted then
  begin
   // ShowMsg(TX_SPELL_COMPLETE, TShow508MessageIcon(1), smbOK) ;
    if Assigned(FSourceControl) then
      FSourceControl.Text := RichEdit1.Text;
  end;
  {else
  ShowMsg(TX_SPELL_CANCELLED + CRLF + TX_NO_CORRECTIONS,
                                              TShow508MessageIcon(1), smbOK) ;}
end;

procedure TfrmHunSpell.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  inherited;

  CanClose := (SpellCheck1.SpellCheckState <> ssChecking)
               or (SpellCheck1.AbortSpellCheck(True));
  if CanClose then
     ModalResult := mrCancel;
end;

procedure TfrmHunSpell.FormCreate(Sender: TObject);
var
  dicFile: String;
  function affFile: String;
  begin
    Result := ChangeFileExt(dicFile, '.aff');
  end;
begin
  if (SpellCheck1.DictionaryFileName <>  '') then
      dicFile := SpellCheck1.DictionaryFileName
  else
      dicFile := ExtractFilePath(Application.ExeName)+ DefaultDicFile;

  if (FileExists(dicFile)) and (FileExists(affFile)) then
  begin
      SpellCheck1.AffixFileName := affFile;
      edtDictionary.Text := SpellCheck1.DictionaryFileName;
  end
  else
    edtDictionary.Text := TX_Dic_File_Not_Found;

  if edtDictionary.Text = TX_Dic_File_Not_Found then
    btnSelectDictClick(self);
  SpellCheck1.SourceTextControl := RichEdit1;
  SpellCheck1.SuggestionList := lstSuggestions;
  SpellCheck1.MisSpeltWord := edtMisSpelt;
  SpellCheck1.Active :=  (SpellCheck1.DictionaryFileName <>  '')
                                                      and FileExists(dicFile);
end;



end.