unit SpellCheck.FSpell;
////////////////////////////////////////////////////////////////////////////////
// TfrmSpell can only be used via it's Execute method, or via
// USpellChecker.TSpellChecker.Execute.
////////////////////////////////////////////////////////////////////////////////

interface

uses
  System.Classes,
  System.Actions,
  Vcl.Forms,
  Vcl.Controls,
  Vcl.StdCtrls,
  Vcl.ComCtrls,
  Vcl.ExtCtrls,
  Vcl.ActnList,
  MsSpellCheckLib_TLB,
  SpellCheck.SpellChecker,
  VA508AccessibilityManager;

type
  TfrmSpell = class(TForm)
    pnlMain: TPanel;
    pnlButtons: TPanel;
    pnlSuggest: TPanel;
    pnlNotIn: TPanel;
    lblNotIn: TLabel;
    lblSuggest: TLabel;
    richNotIn: TRichEdit;
    lvSuggest: TListView;
    ActionList: TActionList;
    actIgnore: TAction;
    actAdd: TAction;
    actSkip: TAction;
    actChange: TAction;
    actDelete: TAction;
    actCancel: TAction;
    btnSkip: TButton;
    btnCancel: TButton;
    btnDelete: TButton;
    btnAdd: TButton;
    btnChange: TButton;
    btnIgnore: TButton;
    amgrMain: TVA508AccessibilityManager;
    procedure actIgnoreExecute(Sender: TObject);
    procedure actAddExecute(Sender: TObject);
    procedure actChangeExecute(Sender: TObject);
    procedure actDeleteExecute(Sender: TObject);
    procedure actCancelExecute(Sender: TObject);
    procedure lvSuggestSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure actSkipExecute(Sender: TObject);
    procedure lvSuggestDblClick(Sender: TObject);
  private
    FSpellChecker: TSpellChecker;
    FEnumSpellingError: IEnumSpellingError;
    FSpellingError: TSpellingError;
    FDisplacement: NativeInt;
    FIgnoreList: TStringList;
  protected
    function GetRichEdit: TCustomRichEdit;
    property SpellChecker: TSpellChecker read FSpellChecker write FSpellChecker;
    property Displacement: NativeInt read FDisplacement write FDisplacement;
    property EnumSpellingError: IEnumSpellingError read FEnumSpellingError
      write FEnumSpellingError;
    property SpellingError: TSpellingError read FSpellingError;
    property RichEdit: TCustomRichEdit read GetRichEdit;
    function LoadNextError: Boolean; // This is where everything happens
    procedure UpdateGUI;
    constructor Create; reintroduce; overload;
  public
    constructor Create(AOwner: TComponent); overload; override;
    destructor Destroy; override;
    class function Execute(ASpellChecker: TSpellChecker;
      AComprehensive: Boolean): TModalResult;
  end;

implementation

uses
  System.SysUtils,
  Vcl.Graphics,
  Winapi.RichEdit;

{$R *.dfm}

type
  TCardinalHelper = record helper for Cardinal
    function ToInteger: Integer;
  end;

function TCardinalHelper.ToInteger: Integer;
begin
  if Self > Cardinal(high(Integer)) then
      raise Exception.CreateFmt('%d is not a valid integer value', [Self]);
  Result := Integer(Self);
end;

constructor TfrmSpell.Create;
begin
  inherited Create(nil);
  FIgnoreList := TStringList.Create(dupIgnore, True, False);
end;

constructor TfrmSpell.Create(AOwner: TComponent);
begin
  raise Exception.Create('Do not create this form directly');
end;

destructor TfrmSpell.Destroy;
begin
  FreeAndNil(FIgnoreList);
  FreeAndNil(FSpellingError);
  FEnumSpellingError := nil;
  inherited;
end;

procedure TfrmSpell.UpdateGUI;
var
  ACorrectiveAction: TCorrectiveAction;
begin
  ACorrectiveAction := TCorrectiveAction(SpellingError.CorrectiveAction);
  actSkip.Enabled := True;
  actAdd.Enabled := ACorrectiveAction in [secaSuggestions, secaReplace,
    secaDelete];
  actIgnore.Enabled := ACorrectiveAction in [secaSuggestions, secaReplace,
    secaDelete];
  actDelete.Enabled := ACorrectiveAction in [secaSuggestions, secaReplace,
    secaDelete];
  actChange.Enabled := (ACorrectiveAction in [secaSuggestions, secaReplace]) and
    (lvSuggest.SelCount = 1);
  actCancel.Enabled := True;
end;

function TfrmSpell.LoadNextError: Boolean;
// Go to the next error in FEnumSpellingError and change all the GUI parts
// that need to change. This is where all the magic happens
// If Result = False then no next error was found

  procedure LoadRichNotIn;
  var
    I: Integer;
    AStartIndex, AEndIndex: Integer;
  begin
    richNotIn.Clear;

    AStartIndex := SpellingError.StartIndex;
    for I := 0 to 3 do
        AStartIndex := SpellChecker.FindStartIndex(AStartIndex - 2);
    if AStartIndex < 0 then AStartIndex := 0;

    AEndIndex := SpellingError.StartIndex + SpellingError.Length;
    for I := 0 to 3 do
        AEndIndex := AEndIndex + 2 +
        Length(SpellChecker.FindWord(AEndIndex + 2));

    richNotIn.Text := SpellChecker.FindTextRange(RichEdit, AStartIndex,
      AEndIndex);

    richNotIn.SelStart := SpellingError.StartIndex.ToInteger - AStartIndex;
    richNotIn.SelLength := SpellingError.Length;
    richNotIn.SelAttributes.Style := [TFontStyle.fsBold];
  end;

  procedure LoadLvSuggest;
  var
    ASuggestionList: TStringList;
    S: string;
    AListItem: TListItem;
  begin
    lvSuggest.Clear;
    if SpellingError.CorrectiveAction <> secaDelete then
    begin
      ASuggestionList := TStringList.Create;
      try
        SpellChecker.Suggest(SpellingError.MisspelledWord, ASuggestionList);
        for S in ASuggestionList do
        begin
          AListItem := lvSuggest.Items.Add;
          AListItem.Caption := S;
        end;
      finally
        FreeAndNil(ASuggestionList);
      end;
    end;
  end;

var
  ASpellingError: ISpellingError;
  I: Integer;
begin
  FreeAndNil(FSpellingError);
  Result := True;
  try
    if not Assigned(FEnumSpellingError) then Exit(False);
    repeat
      ASpellingError := SpellChecker.NextError(FEnumSpellingError);
      if not Assigned(ASpellingError) then Exit(False);
      FreeAndNil(FSpellingError);
      FSpellingError := TSpellingError.Create(RichEdit, ASpellingError,
        FDisplacement);
    until not FIgnoreList.Find(FSpellingError.MisspelledWord, I);
    LoadRichNotIn;
    LoadLvSuggest;
    UpdateGUI;
  finally
    if not Result then ModalResult := mrOK;
  end;
end;

procedure TfrmSpell.actAddExecute(Sender: TObject);
begin
  SpellChecker.Add(SpellingError.MisspelledWord);
  LoadNextError;
end;

procedure TfrmSpell.actCancelExecute(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TfrmSpell.actChangeExecute(Sender: TObject);
var
  ANewWord: string;
begin
  ANewWord := lvSuggest.Selected.Caption;
  SpellChecker.Replace(SpellingError.StartIndex, SpellingError.Length,
    ANewWord);
  // FDisplacement keeps track of the change in number of characters when we
  // replace a word with one of a different length
  FDisplacement := FDisplacement + Length(ANewWord) -
    SpellingError.Length.ToInteger;
  LoadNextError;
end;

procedure TfrmSpell.actDeleteExecute(Sender: TObject);
begin
  SpellChecker.Replace(SpellingError.StartIndex, SpellingError.Length, '');
  Dec(FDisplacement, SpellingError.Length);
  // The change in number of characters
  LoadNextError;
end;

procedure TfrmSpell.actIgnoreExecute(Sender: TObject);
begin
  SpellChecker.Ignore(SpellingError.MisspelledWord);
  FIgnoreList.Add(SpellingError.MisspelledWord);
  LoadNextError;
end;

procedure TfrmSpell.actSkipExecute(Sender: TObject);
begin
  LoadNextError;
end;

function TfrmSpell.GetRichEdit: TCustomRichEdit;
begin
  Result := SpellChecker.RichEdit;
end;

procedure TfrmSpell.lvSuggestDblClick(Sender: TObject);
begin
  actChange.Execute;
end;

procedure TfrmSpell.lvSuggestSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  UpdateGUI;
end;

class function TfrmSpell.Execute(ASpellChecker: TSpellChecker;
  AComprehensive: Boolean): TModalResult;
var
  AFrmSpell: TfrmSpell;
  AEnumSpellingError: IEnumSpellingError;
  ADisplacement: NativeInt;
  AOldMask, AOldSelStart, AOldSelLength, AEndIndex: Integer;
begin
  AOldMask := ASpellChecker.RichEdit.Perform(EM_SETEVENTMASK, 0, 0);
  try
    AOldSelLength := ASpellChecker.RichEdit.SelLength;
    try
      AOldSelStart := ASpellChecker.RichEdit.SelStart;
      try
        // Replace, as otherwise the character # in the spellingError is off
        // for each subsequent line
        if ASpellChecker.RichEdit.SelLength <= 0 then
        begin
          // Spell check all text
          AEnumSpellingError := ASpellChecker.CheckSpelling
            (string(ASpellChecker.RichEdit.Text).Replace(#13#10, #13),
            AComprehensive);
          ADisplacement := 0;
        end else begin
          // Spell check selected text
          ADisplacement := ASpellChecker.FindStartIndex
            (ASpellChecker.RichEdit.SelStart);
          AEndIndex := ASpellChecker.FindEndIndex
            (ASpellChecker.RichEdit.SelStart +
            ASpellChecker.RichEdit.SelLength);
          AEnumSpellingError := ASpellChecker.CheckSpelling
            (ASpellChecker.FindTextRange(ADisplacement, AEndIndex)
            .Replace(#13#10, #13), AComprehensive);
        end;
        AFrmSpell := Create;
        try
          AFrmSpell.SpellChecker := ASpellChecker;
          AFrmSpell.Displacement := ADisplacement;
          AFrmSpell.EnumSpellingError := AEnumSpellingError;
          if not AFrmSpell.LoadNextError then
          begin
            Result := mrOK;
          end else begin
            Result := AFrmSpell.ShowModal;
            if AOldSelLength > 0 then
                AOldSelLength := AOldSelLength + AFrmSpell.Displacement -
                AOldSelStart;
          end;
        finally
          FreeAndNil(AFrmSpell);
        end;
      finally
        ASpellChecker.RichEdit.SelStart := AOldSelStart;
      end;
    finally
      ASpellChecker.RichEdit.SelLength := AOldSelLength;
    end;
  finally
    ASpellChecker.RichEdit.Perform(EM_SETEVENTMASK, 0, AOldMask);
  end;
end;

end.
