unit MSSPeller;

{
  non visual Spell Checker, used Microsoft Common Speller API (CSAPI), for Unicode Delphi 2009, 2010
  Vitaly Khozhainov, www.foxbase.ru
  based on LS Speller (Luzius Schneider)
}

interface

uses
  Windows, Messages, SysUtils, Graphics, Controls, Forms, Dialogs,
  ComCtrls, RichEdit, StdCtrls, Math, Classes, IniFiles, Registry;

  // CSAPI

const

  chSpaceSpell = #$20;
  chTabSpell = #$09;

  chLParenSpell = #$28;
  chRParenSpell = #$29;
  chLBracketSpell = #$7B;
  chRBracketSpell = #$7D;
  chLBraceSpell = #$5B;
  chRBraceSpell = #$5D;
  chLessThanSpell = #$3C;
  chGreaterThanSpell = #$3E;
  chForwardSlashSpell = #$2F;

  sidSA = 1;
  sidHM = 2;
  sidML = 3;
  sidLS = 4;
  sidCT = 5;
  sidHS = 6;
  sidMO = 7;
  sidTI = 8;
  sidKF = 9;
  sidPI = 10;
  sidGS = 11;
  sidRA = 12;
  sidIN = 13;

  lidAmerican       = $0409;
  lidAustralian     = $0c09;
  lidBritish        = $0809;
  lidCatalan        = $0403;
  lidDanish         = $0406;
  lidDutch          = $0413;
  lidFinnish        = $040b;
  lidFrench         = $040c;
  lidFrenchCanadian = $0c0c;
  lidGerman         = $0407;
  lidItalian        = $0410;
  lidNorskBokmal    = $0414;
  lidNorskNynorsk   = $0814;
  lidPortBrazil     = $0416;
  lidPortIberian    = $0816;
  lidSpanish        = $040a;
  lidSwedish        = $041d;
  lidRussian        = $0419;
  lidCzech          = $0405;
  lidHungarian      = $040e;
  lidPolish         = $0415;

  lidUnknown        = $FFFF;

  udrChangeOnce = $FFFC;
  udrChangeAlways = $FFFD;
  udrIgnoreAlways = $FFFE;

  ChangeOnceProp = udrChangeOnce;
  ChangeAlwaysProp = udrChangeAlways;
  IgnoreAlwaysProp = udrIgnoreAlways;

  fscisWildCardSupport = $0001;
  fscisMultiDictSupport = $0002;
  fscishyphenationSupport = $0004;
  scisNull = $0000;

  sccVerifyWord = 1;
  sccVerifyBuffer = 2;
  sccSuggest = 3;
  sccSuggestMore = 4;
  sccHyphInfo = 5;
  sccWildCard = 6;
  sccAnagram = 7;

  fssIsContinued = $0001;
  fssStartsSentence = $0002;
  fssIsEditedChange = $0004;
  fssNoStateInfo = $0000;

  scrsNoErrors                    = 0;
  scrsUnknownInputWord            = 1;
  scrsReturningChangeAlways       = 2;
  scrsReturningChangeOnce         = 3;
  scrsInvalidHyphenation          = 4;
  scrsErrorCapitalization         = 5;
  scrsWordConsideredAbbreviation  = 6;
  scrsHyphChangesSpelling         = 7;
  scrsNoMoreSuggestions           = 8;
  scrsMoreInfoThanBufferCouldHold = 9;
  scrsNoSentenceStartCap          =10;
  scrsRepeatWord                  =11;
  scrsExtraSpaces                 =12;
  scrsMissingSpace                =13;
  scrsInitialNumeral	        	  =14;

  secNoErrors = 0;
  secOOM = 1;
  secModuleError = 2;
  secIOErrorMdr = 3;
  secIOErrorUdr = 4;

  secModuleAlreadyBusy     =(128 shl 8);
  secInvalidID             =(129 shl 8);
  secInvalidWsc            =(130 shl 8);
  secInvalidMdr            =(131 shl 8);
  secInvalidUdr            =(132 shl 8);
  secInvalidSCC            =(133 shl 8);
  secInvalidMainDict       =(134 shl 8);
  secOperNotMatchedUserDict=(135 shl 8);
  secFileReadError         =(136 shl 8);
  secFileWriteError        =(137 shl 8);
  secFileCreateError       =(138 shl 8);
  secFileShareError        =(139 shl 8);
  secModuleNotTerminated   =(140 shl 8);
  secUserDictFull          =(141 shl 8);
  secInvalidUdrEntry       =(142 shl 8);
  secUdrEntryTooLong       =(143 shl 8);
  secMdrCountExceeded      =(144 shl 8);
  secUdrCountExceeded      =(145 shl 8);
  secFileOpenError         =(146 shl 8);
  secFileTooLargeError	   =(147 shl 8);
  secUdrReadOnly           =(148 shl 8);

  soSuggestFromUserDict  = $0001;
  soIgnoreAllCaps        = $0002;
  soIgnoreMixedDigits    = $0004;
  soIgnoreRomanNumerals  = $0008;
  soFindUncappedSentences= $0010;
  soFindMissingSpaces    = $0020;
  soFindRepeatWord       = $0040;
  soFindExtraSpaces      = $0080;
  soFindSpacesBeforePunc = $0100;
  soFindSpacesAfterPunc  = $0200;
  soRateSuggestions      = $0400;
  soFindInitialNumerals	 = $0800;
  soReportUDHits         = $1000;
  soQuickSuggest         = $2000;
  soUseAllOpenUdr        = $4000;
  soSwapMdr              = $8000;
  soSglStepSugg         = $10000;
  soLangMode            = $F0000000;
  soHebrewFullScript          = $00000000;
  soHebrewPartialScript       = $10000000;
  soHebrewMixedScript         = $20000000;
  soHebrewMixedAuthorizedScript = $30000000;
  soFrenchDialectDefault      = $00000000;
  soFrenchUnaccentedUppercase = $10000000;
  soFrenchAccentedUppercase   = $20000000;
  soRussianDialectDefault     = $00000000;
  soRussianIE                 = $10000000;
  soRussianIO                 = $20000000;

  sdcDumpRCAll   = 200;
  sdcDumpRCIgnore= 201;
  sdcDumpRCOnce  = 202;
  sdcDumpRCAlways= 203;
  sdcDumpUdrAll  = 300;
  sdcDumpUdr1    = 301;
  sdcDumpUdr2    = 302;
  sdcDumpUdr3    = 303;
  sdcDumpUdr4    = 304;
  sdcDumpMdrAll  = 400;
  sdcDumpMdr1    = 401;

type

  TMDR = Cardinal;
  TUDR = Cardinal;
  TSCCC = Word;
  TSPLID = Cardinal;
  TSCIS = Word;
  TSCRS = Word;
  TLID = Word;

  TWSC = packed record
    bIgnore,
    bHyphenHard,
    bHyphenSoft,
    bHyphenNonBreaking,
    bEmDash,
    bEnDash,
    bEllipsis: Char;
    rgLineBreak: array[0..1]of Char;
    rgParaBreak: array[0..1]of Char;
  end;

  TSEC = Word;

  TSIB = packed record
    cch: Word;
    cMdr,
    cUdr: Word;
    wSpellState: Word;
    lrgch: PChar;
    lrgMdr: ^TMDR;
    lrgUdr: ^TUDR;
  end;

  PSIB = ^TSIB;

  TSRB = packed record
    ichError: Word;
    cchError: Word;
    scrs: TSCRS;
    csz: Word;
    cchMac: Word;
    cch: Word;
    lrgsz: PChar;
    lrgbRating: ^Byte;
    cbRate: Word;
  end;

  PSRB= ^TSRB;

  TMDRS = packed record
    mdr: TMDR;
    lid: TLID;
    udrExc: TUDR;
  end;

  PMDRS = ^TMDRS;

  TLPSPATH = PChar;

  TSpellVerFunc = function (var Ver, IdEngine, SpellType: Word): TSEC; cdecl;
  TSpellInitFunc = function (var Sid: TSPLID; var Wsc: TWSC): TSEC; cdecl;
  TSpellOptionsFunc = function (splid: TSPLID; SpellOptions: Integer): TSEC; cdecl;
  TSpellCheckFunc = function (splid: TSPLID; Scc: TSCCC; var Sib: TSIB;
                              var Srb: TSRB): TSEC; cdecl;
  TSpellTerminateFunc = function(splid: TSPLID; Force: Boolean): TSEC; cdecl;
  TSpellVerifyMdrFunc = function(PathMdr: PChar; LidExpected: TLID; var Lid: TLID): TSEC; cdecl;
  TSpellOpenMdrFunc = function(splid: TSPLID; PathMain, PathExc: PChar; CreateUdrExc,
                           Cache: Boolean; lidExpected: TLID; var Mdrs: TMDRS): TSEC; cdecl;
  TSpellOpenUdrFunc = function(splid: TSPLID; PathUdr: PChar; CreateUdr: Boolean;
                               udrPropType: Word; var Udr: TUDR; var ReadOnly: Boolean): TSEC; cdecl;
  TSpellAddUdrFunc = function(splid: TSPLID; udr: TUDR; Add: PChar): TSEC; cdecl;
  TSpellAddChangeUdrFunc = function(splid: TSPLID; udr: TUDR; Add, Change: PChar): TSEC; cdecl;
  TSpellDelUdrFunc = function(splid: TSPLID; udr: TUDR; Del: PChar): TSEC; cdecl;
  TSpellClearUdrFunc = function(splid: TSPLID; udr: TUDR): TSEC; cdecl;
  TSpellGetSizeUdrFunc = function(splid: TSPLID; udr: TUDR; var Words): TSEC; cdecl;
  TSpellGetListUdrFunc = function(splid: TSPLID; udr: TUDR; Start: Word; var Srb: TSRB): TSEC; cdecl;
  TSpellCloseMdrFunc = function(splif: TSPLID; var Mdrs: TMDRS): TSEC; cdecl;
  TSpellCloseUdrFunc = function(splid: TSPLID; udr: TUDR; Force: Boolean): TSEC; cdecl;
  THCsapiResInit = function(FileName: PChar; vRef: SmallInt; dirId: Integer): THandle; cdecl;
  TCsapiResTermProc = procedure; cdecl;
  TCsapiResFlushProc = procedure; cdecl;


  // Spellers types

  TLanguage = 0..$FFFF;

  TLangOption = (loLocalized, loEnglish, loNative, loAbbrev);

  ESpellError = class(Exception);

  TSpellOption = (spoSuggestFromUserDict, spoIgnoreAllCaps, spoIgnoreMixedDigits,
                  spoIgnoreRomanNumerals, spoFindUncappedSentences,
                  spoFindMissingSpaces, spoFindRepeatWord, spoFindExtraSpaces,
                  spoFindSpacesBeforePunc, spoFindSpacesAfterPunc, spoRateSuggestions,
                  spoFindInitialNumerals);

  TSpellOptions = set of TSpellOption;

  TSpellReturnCode = (srNoErrors, srUnknownInputWord, srReturningChangeAlways,
                      srReturningChangeOnce, srInvalidHyphenation,
                      srErrorCapitalization, srWordConsideredAbbreviation,
                      srHyphChangesSpelling, srNoMoreSuggestions,
                      srMoreInfoThanBufferCouldHold, srNoSentenceStartCap,
                      srRepeatWord, srExtraSpaces, srMissingSpace,
                      srInitialNumeral);


  TCSAPISpeller = class
    FLanguage: TLanguage;
    FNotActive: Boolean;
    SpellInstance: THandle;
    DLLName: String;
    LexName: AnsiString;
    DefaultUserDict: AnsiString;
    UserDict: AnsiString;
    UnkWord: String;
    FOptions: TSpellOptions;
    SpellVer: TSpellVerFunc;
    SpellInit: TSpellInitFunc;
    SpellOptions: TSpellOptionsFunc;
    SpellCheck: TSpellCheckFunc;
    SpellTerminate: TSpellTerminateFunc;
    SpellVerifyMdr: TSpellVerifyMdrFunc;
    SpellOpenMdr: TSpellOpenMdrFunc;
    SpellOpenUdr: TSpellOpenUdrFunc;
    SpellAddUdr: TSpellAddUdrFunc;
    SpellAddChangeUdr: TSpellAddChangeUdrFunc;
    SpellDelUdr: TSpellDelUdrFunc;
    SpellClearUdr: TSpellClearUdrFunc;
    SpellGetSizeUdr: TSpellGetSizeUdrFunc;
    SpellGetListUdr: TSpellGetListUdrFunc;
    SpellCloseMdr: TSpellCloseMdrFunc;
    SpellCloseUdr: TSpellCloseUdrFunc;
    Handle: TSPLID;
    SpecChars: TWSC;
    Mdrs: TMDRS;
    Udr: TUDR;
    InputBuffer: TSIB;
    ResultBuffer: TSRB;
    UdrRO: Boolean;
  public
    constructor Create(Language: TLanguage; Options: TSpellOptions);
    destructor Destroy; override;
    procedure SetOptions(AOptions: TSpellOptions);
    procedure SetUserDict(AFileName: AnsiString);
    function FindMisspell(Buf: PChar; MaxLen: Integer; var Start, Len: Integer): TSpellReturnCode;
    procedure Add(Word: AnsiString);
    procedure IgnoreAlways(Word: AnsiString);
    procedure GetVariants(Word: AnsiString; Variants: TStrings);
  end;

  TMSSpeller = class
    FUse: boolean;
    FInitialized: boolean;
    FOptions: TSpellOptions;
    FMainLang: TLanguage;
    FMainSpeller: TCSAPISpeller;
    FOtherSpellers: TList;
    FUserDict: string;
    FDefaultUserDict: string;
    procedure SetOptions(AOptions: TSpellOptions);
    procedure SetUse(AValue: boolean);
    procedure SetUserDict(AFileName: string);
  public
    Languages: TStringList;
    constructor Create(AUse: boolean);
    destructor Destroy; override;
    procedure Init;
    function IsKnownWord(Word: string): Boolean;
    procedure GetVariants(Word: string; Variants: TStrings);
    procedure Add(Word: string);
    procedure IgnoreAlways(Word: string);
    property Options: TSpellOptions read FOptions write SetOptions;
    property MainLang: TLanguage read FMainLang;
    property Use: boolean read FUse write SetUse;
    property UserDict: string read FUserDict write SetUserDict;
    property DefaultUserDict: string read FDefaultUserDict;
  end;

  function GetSpellLanguages(Languages: TStrings; Option: TLangOption): Integer;

implementation

procedure CheckSR(SR: TSEC);
begin
  if (SR<>secNoErrors) then
    raise ESpellError.CreateFmt('Spelling error No ', [SR]);
end;

procedure d(s: string);
begin
  Application.MessageBox(pchar(s),'',0);
end;

function GetSpellLanguages(Languages: TStrings; Option: TLangOption): Integer;
var
  Registry: TRegistry;
  N, I: Integer;
  LCTypeVar: Integer;
  Buf: array[0..255]of Char;

begin
  Registry:= TRegistry.Create;
  try
    Registry.Access := KEY_READ;
    Registry.RootKey:= HKEY_LOCAL_MACHINE;
    if Registry.OpenKey('\SOFTWARE\Microsoft\Shared Tools\Proofing Tools\Spelling', False)
      then Registry.GetKeyNames(Languages);
  finally
    Registry.Free;
  end;
  LCTypeVar := LCType(Option);
  for I:= Languages.Count-1 downto 0 do
    begin
      N:= StrToIntDef(Languages[I], -1);
      if N=-1 then
        Languages.Delete(I)
      else
        begin
          Languages.Objects[I]:= Pointer(N);
          GetLocaleInfo(N, LCTypeVar, Buf, 255);
          Languages[I]:= Buf;
        end;
    end;
  Result:= Languages.Count;
end; {GetSpellLanguages MS}

{$O-}
constructor TCSAPISpeller.Create(Language: TLanguage; Options: TSpellOptions);
var
  UdrRO: Boolean;
  NotFound: Boolean;
  Registry: TRegistry;
begin
  FLanguage:= Language;
  FOptions:= Options;
  with SpecChars do
    begin
      bIgnore:= #0;
      bHyphenHard:= #45;
      bHyphenSoft:= #31;
      bHyphenNonBreaking:= #30;
      bEmDash:= #151;
      bEnDash:= #150;
      bEllipsis:= #133;
      rgLineBreak:= #11#10;
      rgParaBreak:= #13#10;
    end;
  Registry:= TRegistry.Create;
  Registry.RootKey:= HKEY_LOCAL_MACHINE;
  try
    NotFound:= True;
    if Registry.OpenKeyReadOnly(
        Format('\SOFTWARE\Microsoft\Shared Tools\Proofing Tools\Spelling\%d\Normal', [FLanguage])) or
       Registry.OpenKeyReadOnly(
        Format('\SOFTWARE\Microsoft\Shared Tools\Proofing Tools\Spelling\%d\Normal', [1024+(FLanguage mod 1024)]))
      then
      begin
        DLLName:= Registry.ReadString('Engine');
        LexName:= Registry.ReadString('Dictionary');
        NotFound := False;
      end;
    if not NotFound then begin
      if Registry.OpenKeyReadOnly(
         '\SOFTWARE\Microsoft\Shared Tools\Proofing Tools\Custom Dictionaries')
        then UserDict:= Registry.ReadString('1') else
        begin
          UserDict:= '';
          try
            Registry.Access := KEY_ALL_ACCESS;
            Registry.OpenKey(
              '\SOFTWARE\Microsoft\Shared Tools\Proofing Tools\Custom Dictionaries', True)
          except on E: Exception do
            Registry.Access := KEY_READ;
          end;
        end;
      if UserDict='' then
        begin
          UserDict:= ExtractFilePath(LexName)+'CUSTOM.DIC';
          try
            Registry.WriteString('1', UserDict);
            Registry.CloseKey;
          except end;
        end;
    end;
  finally
    Registry.Free;
  end;
  if NotFound then
    begin
      FNotActive:= True;
      Exit;
    end;
  try
    SpellInstance:= LoadLibrary(PChar(DllName));
  except
    FNotActive:= True;
    raise ESpellError.CreateFmt('Error loading Spell DLL %s', [DllName]);
  end;
  try
    @SpellVer:= GetProcAddress(SpellInstance, 'SpellVer');
    @SpellInit:= GetProcAddress(SpellInstance, 'SpellInit');
    @SpellOptions:= GetProcAddress(SpellInstance, 'SpellOptions');
    @SpellCheck:= GetProcAddress(SpellInstance, 'SpellCheck');
    @SpellTerminate:= GetProcAddress(SpellInstance, 'SpellTerminate');
    @SpellVerifyMdr:= GetProcAddress(SpellInstance, 'SpellVerifyMdr');
    @SpellOpenMdr:= GetProcAddress(SpellInstance, 'SpellOpenMdr');
    @SpellOpenUdr:= GetProcAddress(SpellInstance, 'SpellOpenUdr');
    @SpellAddUdr:= GetProcAddress(SpellInstance, 'SpellAddUdr');
    @SpellAddChangeUdr:= GetProcAddress(SpellInstance, 'SpellAddChangeUdr');
    @SpellDelUdr:= GetProcAddress(SpellInstance, 'SpellDelUdr');
    @SpellClearUdr:= GetProcAddress(SpellInstance, 'SpellClearUdr');
    @SpellGetSizeUdr:= GetProcAddress(SpellInstance, 'SpellGetSizeUdr');
    @SpellGetListUdr:= GetProcAddress(SpellInstance, 'SpellGetListUdr');
    @SpellCloseMdr:= GetProcAddress(SpellInstance, 'SpellCloseMdr');
    @SpellCloseUdr:= GetProcAddress(SpellInstance, 'SpellCloseUdr');
  except
    FreeLibrary(SpellInstance);
    FNotActive:= True;
    raise ESpellError.CreateFmt('Error loading Spell DLL %s', [DllName]);
  end;
  FNotActive:= False;
  FOptions:= Options;
  DefaultUserDict:=UserDict;

  CheckSR(SpellInit(Handle, SpecChars));
  CheckSR(SpellOptions(Handle, Word(FOptions)));
  CheckSR(SpellOpenMdr(Handle, PChar(LexName), nil, False, True, FLanguage, Mdrs));
  CheckSR(SpellOpenUdr(Handle, PChar(UserDict), True, IgnoreAlwaysProp, Udr, UdrRO));
  with InputBuffer do
    begin
      cMdr:= 1;
      cUdr:= 1;
      lrgMdr:= @Mdrs.MDR;
      lrgUdr:= @Udr;
    end;
  with ResultBuffer do
    begin
      cch:= 1024;
      lrgsz:= AllocMem(1024);
      lrgbRating:= AllocMem(255);
      cbRate:= 255;
    end;
end;

procedure TCSAPISpeller.SetOptions(AOptions: TSpellOptions);
begin
  FOptions:=AOptions;
  CheckSR(SpellOptions(Handle, Word(FOptions)));
end;

procedure TCSAPISpeller.SetUserDict(AFileName: AnsiString);
begin
  UserDict:=AFileName;
  CheckSR(SpellOpenUdr(Handle, PChar(UserDict), True, IgnoreAlwaysProp, Udr, UdrRO));
end;

destructor TCSAPISpeller.Destroy;
var
 SR1: TSEC;
begin
  if not FNotActive then
    begin
      FreeMem(ResultBuffer.lrgsz);
      FreeMem(ResultBuffer.lrgbRating);
      CheckSR(SpellCloseMdr(Handle, Mdrs));
      SR1 := SpellCloseUdr(Handle, Udr, True);
      if (SR1 <> 33026) then CheckSR(SR1);
      CheckSR(SpellTerminate(Handle, True));
      try
        FreeLibrary(SpellInstance);
      except
        raise ESpellError.CreateFmt('Error unloading Spell DLL %s', [DllName]);
      end;
    end;
  inherited;
end;

function TCSAPISpeller.FindMisspell(Buf: PChar; MaxLen: Integer; var Start, Len: Integer): TSpellReturnCode;
begin
  if FNotActive then
    begin
      Result:= srNoErrors;
      Exit;
    end;
  InputBuffer.cch:= MaxLen;
  InputBuffer.lrgch:= Buf;
  InputBuffer.wSpellState:= fssStartsSentence;

  CheckSR(SpellCheck(handle, sccVerifyBuffer, InputBuffer, ResultBuffer));

  Result:= TSpellReturnCode(ResultBuffer.scrs);
  if Result<>srNoErrors then
    begin
      Start:= ResultBuffer.ichError;
      Len:= ResultBuffer.cchError;
      SetLength(UnkWord, ResultBuffer.cchError);
      StrLCopy(@UnkWord[1], InputBuffer.lrgch+ResultBuffer.ichError, ResultBuffer.cchError);
    end;
end;

procedure TCSAPISpeller.Add(Word: AnsiString);
begin
  if FNotActive then
    Exit;
  CheckSR(SpellAddUdr(Handle, Udr, PChar(Word)));
  CheckSR(SpellCloseUdr(Handle, Udr, true));
  CheckSR(SpellOpenUdr(Handle, PChar(UserDict), True, IgnoreAlwaysProp, Udr, UdrRO));
end;

procedure TCSAPISpeller.IgnoreAlways(Word: AnsiString);
begin
  if FNotActive then
    Exit;
  CheckSR(SpellAddUdr(Handle, udrIgnoreAlways, PChar(Word)));
end;

procedure TCSAPISpeller.GetVariants(Word: AnsiString; Variants: TStrings);
var
  SIB: TSIB;
  SRB: TSRB;
  Buf: array[0..2047]of AnsiChar;
  Ratings: array[0..255]of Byte;
  P: PAnsiChar;
begin
  Variants.Clear;
  if FNotActive then
    Exit;
  with SIB do
    begin
      cch:= Length(Word);
      cMdr:= 1;
      cUdr:= 1;
      wSpellState:= fssNoStateInfo;
      lrgch:= @Word[1];
      lrgMdr:= @Mdrs.MDR;
      lrgUdr:= @Udr;
    end;
  with SRB do
    begin
      cch:= 2047;
      lrgsz:= @Buf;
      lrgbRating:= @Ratings;
      cbRate:= 255;
    end;
  CheckSR(SpellCheck(Handle, sccSuggest, SIB, SRB));
  while SRB.scrs<>scrsNoMoreSuggestions do
    begin
      P:= PAnsiChar(SRB.lrgsz);
      while P^<>#0 do
        begin
          if Variants.IndexOf(P)=-1 then
            Variants.Add(P);
          while P^<>#0 do
            Inc(P);
          Inc(P);
        end;
      CheckSR(SpellCheck(Handle, sccSuggestMore, SIB, SRB));
    end;
end;

{TCSAPISpeller}

{$O+}

constructor TMSSpeller.Create(AUse: boolean);
begin
  FUse:=AUse;
  FInitialized:=false;
  FMainSpeller:=nil;
  FOtherSpellers:=TList.Create;
  Languages:=TStringList.Create;
  FOptions:=[spoSuggestFromUserDict,spoIgnoreAllCaps, spoIgnoreMixedDigits,spoIgnoreRomanNumerals];
  FMainLang:=GetSystemDefaultLCID;
  FDefaultUserDict:='';
  if FUse then Init;
end;

procedure TMSSpeller.Init;
  var i,cnt: integer;
      Lang: TLanguage;
begin
  try
    cnt:=GetSpellLanguages(Languages,loNative);
    for i := 0 to cnt - 1 do
    begin
      Lang:=TLanguage(Languages.Objects[i]);
      if Lang=FMainLang then
        FMainSpeller:=TCSAPISpeller.Create(Lang,FOptions)
      else
        FOtherSpellers.Add(TCSAPISpeller.Create(Lang,FOptions));
    end;
    FInitialized:=true;
    SetOptions(FOptions);
    FDefaultUserDict:=FMainSpeller.DefaultUserDict;
  except
    Application.MessageBox('Cannot find Microsoft Common Speller API','Error',0);
    FMainSpeller:=nil;
    FOtherSpellers.Clear;
    FInitialized:=false;
    FUse:=false;
  end;
end;

destructor TMSSpeller.Destroy;
  var i: integer;
begin
  if FMainSpeller<>nil then FMainSpeller.Free;
  if FOtherSpellers.Count>0 then
  for i := 0 to FOtherSpellers.Count - 1 do
    TCSAPISpeller(FOtherSpellers[i]).Free;
  FOtherSpellers.Free;
  Languages.Free;
end;

procedure TMSSpeller.SetOptions(AOptions: TSpellOptions);
  var i: integer;
begin
  FOptions:=AOptions;
  if not FInitialized then Exit;
  FMainSpeller.SetOptions(FOptions);
  if FOtherSpellers.Count>0 then
  for i := 0 to FOtherSpellers.Count - 1 do
   TCSAPISpeller(FOtherSpellers[i]).SetOptions(FOptions);
end;

procedure TMSSpeller.SetUse(AValue: boolean);
begin
  if AValue and not FInitialized then
  begin
    Init;
    if not FInitialized then
    begin
      FUse:=false;
      Exit;
    end;
  end;
  FUse:=AValue;
end;

procedure TMSSpeller.SetUserDict(AFileName: string);
begin
  if not FInitialized then Exit;
  FUserDict:=AFileName;
  if FUserDict='' then FUserDict:=FDefaultUserDict;
  if FMainSpeller<>nil then
    FMainSpeller.SetUserDict(FUserDict);
end;

function TMSSpeller.IsKnownWord(Word: string): Boolean;
  var w: AnsiString;
      i, Start, Len: Integer;
      sp: TCSAPISpeller;
begin
  if not FInitialized or not FUse then
  begin
    Result:=true;
    Exit;
  end;
  w:=Word;
  Result:=FMainSpeller.FindMisspell(@w[1], Length(w), Start, Len)=srNoErrors;
  if Result or (FOtherSpellers.Count=0) then Exit;
  for i := 0 to FOtherSpellers.Count - 1 do
  begin
    sp:=TCSAPISpeller(FOtherSpellers[i]);
    Result:=sp.FindMisspell(@w[1], Length(w), Start, Len)=srNoErrors;
    if Result then Exit;
  end;
end;

procedure TMSSpeller.GetVariants(Word: string; Variants: TStrings);
  var w: AnsiString;
      i: integer;
      sp: TCSAPISpeller;
begin
  if not FInitialized then Exit;
  w:=Word;
  FMainSpeller.GetVariants(w,Variants);
  if (Variants.Count>0) or (FOtherSpellers.Count=0) then Exit;
  for i := 0 to FOtherSpellers.Count - 1 do
  begin
    sp:=TCSAPISpeller(FOtherSpellers[i]);
    sp.GetVariants(w,Variants);
    if Variants.Count>0 then Exit;
  end;
end;

procedure TMSSpeller.Add(Word: string);
begin
  if not FInitialized then Exit;
  FMainSpeller.Add(Word);
end;

procedure TMSSpeller.IgnoreAlways(Word: string);
begin
  if not FInitialized then Exit;
  FMainSpeller.IgnoreAlways(Word);
end;

end.