jvspellchecker.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvSpellChecker.PAS, released on 2003-08-19.

The Initial Developer of the Original Code is Peter Th鰎nqvist [peter3 at sourceforge dot net]
Portions created by Peter Th鰎nqvist are Copyright (C) 2003 Peter Th鰎nqvist.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
- Items in the UserDictionary are not added to the internal WordTable/SoundexTable when
  you add a new item (i.e call UserDictionary.Add). This is mostly for performance.
  UserDictionary entries are loaded into the dictionary table in BuildTables, so to get
  them added make sure UserDictionary is filled before setting the Dictionary property.
-----------------------------------------------------------------------------}
// $Id: JvSpellChecker.pas,v 1.18 2005/02/17 10:20:53 marquardt Exp $

unit JvSpellChecker;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, Classes, Windows, Controls, Messages,
  JvSpellIntf, JvComponent;

type
  TJvSpellChecker = class(TJvComponent)
  private
    FSpellChecker: IJvSpellChecker;
    procedure SetText(const Value: string);
    function GetText: string;
    function GetDictionary: TFileName;
    function GetUserDictionary: TStrings;
    procedure SetDictionary(const Value: TFileName);
    procedure SetUserDictionary(const Value: TStrings);
    function GetSpellChecker: IJvSpellChecker;
    function GetDelimiters: TSysCharSet;
    procedure SetDelimiters(const Value: TSysCharSet);
    function GetIgnores: TStrings;
    procedure SetIgnores(const Value: TStrings);
    function GetCanIgnore: TJvSpellCheckIgnoreEvent;
    procedure SetCanIgnore(const Value: TJvSpellCheckIgnoreEvent);
  public
    // reference to the actual spell check implementation
    property SpellChecker: IJvSpellChecker read GetSpellChecker;
    property Delimiters: TSysCharSet read GetDelimiters write SetDelimiters;
  published
    // Surface interface properties to make it a bit easier to work with this component
    property Text: string read GetText write SetText;
    property Dictionary: TFileName read GetDictionary write SetDictionary;
    property UserDictionary: TStrings read GetUserDictionary write SetUserDictionary;
    property Ignores: TStrings read GetIgnores write SetIgnores;
    property OnCanIgnore: TJvSpellCheckIgnoreEvent read GetCanIgnore write SetCanIgnore;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvSpellChecker.pas,v $';
    Revision: '$Revision: 1.18 $';
    Date: '$Date: 2005/02/17 10:20:53 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  JclStrings, // StrAddRef, StrDecRef
  JvTypes, JvResources;

// NOTE: hash table and soundex lookup code originally from Julian Bucknall's
// "Algorithms Alfresco" column in The Delphi Magazine, Issue 52, December 1999
// Used with permission
const
  WordTableSize = 10007; {a prime}
  SoundexTableSize = 26 * 7 * 7 * 7; {the exact number of Soundexes}
  cDelimiters: TSysCharSet = [#0..#32, '.', ',', '<', '>', '=', '!', '?', ':', ';', '"', '''', '(', ')', '[', ']', '{', '}', '+', '|'];

type
  TSoundex = string[4];
  // default implementation of the IJvSpellChecker interface. To provide a new implementation,
  // assign a function to the CreateSpellChecker function variable in JvSpellIntf that returns an
  // instance of your implementation. For more info, see InternalSpellChecker in this unit.
  TJvDefaultSpellChecker = class(TInterfacedObject, IInterface, IJvSpellChecker)
  private
    FText: string;
    FCurrentWord: string;
    FPosition: Integer;
    FDictionary: string;
    FSuggestions: TStringList;
    FUserDictionary: TStringList;
    FIgnores: TStringList;
    FWordTable: TList;
    FSoundexTable: TList;
    FDelimiters: TSysCharSet;
    FOnCanIgnore: TJvSpellCheckIgnoreEvent;
    { IJvSpellChecker }
    procedure SetDictionary(const Value: string);
    function GetDictionary: string;
    function GetUserDictionary: TStrings;
    procedure SetUserDictionary(const Value: TStrings);
    function GetSuggestions: TStrings;
    function GetText: string;
    procedure SetText(const Value: string);
    function GetIgnores: TStrings;
    procedure SetIgnores(const Value: TStrings);
    function GetDelimiters: TSysCharSet;
    procedure SetDelimiters(const Value: TSysCharSet);
    function GetCanIgnore: TJvSpellCheckIgnoreEvent;
    procedure SetCanIgnore(const Value: TJvSpellCheckIgnoreEvent);
  protected
    procedure BuildTables; virtual;
    procedure ClearTables; virtual;
    function GetCurrentWord: string; virtual;
    procedure GetWordSuggestions(const Value: string; AStrings: TStrings); virtual;
    procedure AddSoundex(ASoundex: TSoundex; Value: string); virtual;
    procedure AddWord(Value: string); virtual;
    function WordExists(const Value: string): Boolean; virtual;
    function CanIgnore(const Value: string): Boolean; virtual;
    { IJvSpellChecker }
    function Next(out StartIndex, WordLength: Integer): WordBool; virtual;
    procedure Seek(Position: Integer); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    property Delimiters: TSysCharSet read GetDelimiters write SetDelimiters;
    property Suggestions: TStrings read GetSuggestions;
    property Dictionary: string read GetDictionary write SetDictionary;
    property UserDictionary: TStrings read GetUserDictionary write SetUserDictionary;
    property Text: string read GetText write SetText;
    property Ignores: TStrings read GetIgnores write SetIgnores;
    property OnCanIgnore: TJvSpellCheckIgnoreEvent read GetCanIgnore write SetCanIgnore;
  end;

function InternalCreateSpellChecker: IJvSpellChecker;
begin
  // create our implementation of the spell checker interface
  Result := TJvDefaultSpellChecker.Create;
end;

function Soundex(const Value: string): TSoundex;
const
  Encode: array ['A'..'Z'] of Char =
   ('0', '1', '2', '3', '0', '1', '2', '/', '0', '2', '2',
    '4', '5', '5', '0', '1', '2', '6', '2', '3', '0', '1',
    '/', '2', '0', '2');
var
  Ch: Char;
  Code, OldCode: Char;
  SxInx: Integer;
  I: Integer;
begin
  Result := 'A000';
  if Value = '' then
    Exit;
//    raise Exception.Create('Soundex: input string is empty');
  Ch := UpCase(Value[1]);
  if not ('A' <= Ch) and (Ch <= 'Z') then
    Ch := 'A';
//    raise Exception.Create('Soundex: unknown character in input string');
  Result[1] := Ch;
  Code := Encode[Ch];
  OldCode := Code;
  SxInx := 2;
  for I := 2 to Length(Value) do
  begin
    if (Code <> '/') then
      OldCode := Code;
    Ch := UpCase(Value[I]);
    if not ('A' <= Ch) and (Ch <= 'Z') then
      Code := '0'
    else
      Code := Encode[Ch];
    if (Code <> OldCode) and (Code > '0') then
    begin
      Result[SxInx] := Code;
      Inc(SxInx);
      if SxInx > 4 then
        Break;
    end;
  end;
end;

function ELFHash(const S: string): Integer;
var
  G, I: Integer;
begin
  Result := 0;
  for I := 1 to Length(S) do
  begin
    Result := (Result shl 4) + Ord(S[I]);
    G := Result and Longint($F0000000);
    if G <> 0 then
      Result := Result xor (G shr 24);
    Result := Result and (not G);
  end;
end;

function SoundexHash(const S: TSoundex): Integer;
begin
  Result :=
    ((Ord(S[1]) - Ord('A')) * 343) +
    ((Ord(S[2]) - Ord('0')) * 49) +
    ((Ord(S[3]) - Ord('0')) * 7) +
    (Ord(S[4]) - Ord('0'));
end;

function GetNextWord(var S: PAnsiChar; out Word: AnsiString; Delimiters: TSysCharSet): Boolean;
var
  Start: PAnsiChar;
begin
  Word := '';
  Result := (S = nil);
  if Result then
    Exit;
  Start := nil;
  while True do
  begin
    if S^ = #0 then
    begin
      Word := Start;
      Result := Start <> nil;
      Exit;
    end
    else
    if S^ in Delimiters then
    begin
      if Start <> nil then
      begin
        SetString(Word, Start, S - Start);
        Exit;
      end
      else
        while (S^ in Delimiters) and (S^ <> #0) do
          Inc(S);
    end
    else
    begin
      if Start = nil then
        Start := S;
      Inc(S);
    end;
  end;
end;

//=== { TJvDefaultSpellChecker } =============================================

constructor TJvDefaultSpellChecker.Create;
begin
  inherited Create;
  FDelimiters := cDelimiters;
  FSuggestions := TStringList.Create;
  FUserDictionary := TStringList.Create;
  FUserDictionary.Sorted := True;
  FIgnores := TStringList.Create;
  FIgnores.Sorted := True;

  FWordTable := TList.Create;
  FWordTable.Count := WordTableSize;
  FSoundexTable := TList.Create;
  FSoundexTable.Count := SoundexTableSize;
end;

destructor TJvDefaultSpellChecker.Destroy;
begin
  ClearTables;
  FreeAndNil(FSuggestions);
  FreeAndNil(FUserDictionary);
  FreeAndNil(FWordTable);
  FreeAndNil(FSoundexTable);
  FreeAndNil(FIgnores);
  inherited Destroy;
end;

procedure TJvDefaultSpellChecker.AddSoundex(ASoundex: TSoundex; Value: string);
var
  Hash: Integer;
begin
  Hash := SoundexHash(ASoundex) mod SoundexTableSize;
  if FSoundexTable[Hash] = nil then
    FSoundexTable[Hash] := TList.Create;
  TList(FSoundexTable[Hash]).Add(Pointer(Value));
end;

procedure TJvDefaultSpellChecker.AddWord(Value: string);
var
  Hash: Integer;
begin
  Hash := ELFHash(Value) mod WordTableSize;
  if FWordTable[Hash] = nil then
    FWordTable[Hash] := TList.Create;
  TList(FWordTable[Hash]).Add(Pointer(Value));
end;

procedure TJvDefaultSpellChecker.BuildTables;
var
  AFile: TextFile;
  Value: string;
  LastValue: string;
  SoundexVal: TSoundex;
  I: Integer;
  N: Integer;
begin
  ClearTables;
  if FileExists(Dictionary) then
  begin
    System.AssignFile(AFile, Dictionary);
    System.Reset(AFile);