spellers.pas

拼写检查

unit Spellers;

interface

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

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

  TSpellOptions = set of TSpellOption;

  TSpellerType = (sptMSOffice, sptISpell);

  TSpellListObj = class
    ISpellCmd,ISpellCharset,ISpellSurrogate,Flag: String;
    Language: TLanguage;
    SpellerType: TSpellerType;
  end;

  TUserLanguage = (ulEnglish, ulOwn, ulOther);

  TSpellCommand = (scVerifyWord, scVerifyBuffer, scSuggest, scSuggestMore,
                   scHyphInfo, scWildCard, scAnagram);

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

  TMisspellFont = class(TPersistent)
  private
      FMspName: TFontName;
      FMspColor: TColor;
      FMspStyle: TFontStyles;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property MspName: TFontName read FMspName write FMspName;
    property MspColor: TColor read FMspColor write FMspColor;
    property MspStyle: TFontStyles read FMspStyle write FMspStyle;
  end;

  TMisspellEvent = procedure (Sender: TObject; SRC: TSpellReturnCode;
                              BufPos, Len: Integer) of object;
  TChangeTextEvent = procedure(Sender: TObject; BufPos, Len: Integer;
                               NewWord: String) of object;
  TGetDictEvent = procedure(Sender: TObject; Language: TLanguage;
                            var Dict: TFileName) of object;

  TSpellerDialog2 = class;
  TAbstractSpeller = class;

 {$IFDEF VER130} { Borland Delphi 5.x }
  UTF8String = type string;
 {$ENDIF}

{ TSpellChecker }
  TSpellChecker = class(TComponent)
  private
    { Private declarations }
    FMemo,
    FBackMemo: TCustomMemo;
    FMemoRichEd: Boolean;
    FOptions: TSpellOptions;
    FLanguage: TLanguage;
    FLangOption: TLangOption;
    FSpellerType: TSpellerType;
    FISpellCmd,
    FISpellCharset,
    FISpellSurrogate,
    FFlag,
    FLangName: String;
    FActiveLanguage: Boolean;
    FDialog: TSpellerDialog2;
    FModalDialog: Boolean;
    FHTML: Boolean;
    FCustomDict: TFileName;
    FCaption: TCaption;
    FFont: TFont;
    FMissFont: TMisspellFont;
    Spellers: TList;
    CRPos,
    TagPos,
    LangPos: Integer;
    FStartSentence: Boolean;
    FSpellStart,
    FSpellEnd: Integer;
    FSpeller: TAbstractSpeller;
    FMisspellStart,
    FMisspellLen: Integer;
    FMisspellText: String;
    FLangSupport: Boolean;
    FUnicode: Boolean;
    FSRC: TSpellReturnCode;
    FFinishMessage: String;
    F1UserLanguage: TUserLanguage;
    FShowFinishMessage: Boolean;
    FOnMisspell: TMisspellEvent;
    FOnChangeText: TChangeTextEvent;
    FOnFinished: TNotifyEvent;
    FOnCancel: TNotifyEvent;
    FCancelled: Boolean;
    FOnGetDict: TGetDictEvent;
  protected
    { Protected declarations }
    procedure SetLanguage(Value: TLanguage);
    procedure SetSpellerType(Value: TSpellerType);
    procedure SetFont(Value: TFont);
    procedure SetMissFont(Value: TMisspellFont);
    procedure ChangeOnce(Word1: String);
    procedure Change(Word1: String);
    procedure ChangeAlways(Word1: String);
    procedure Delete;
    procedure Add;
    procedure IgnoreAlways;
    function OpenLanguage(Value: TLanguage; SpType: TSpellerType): Boolean;
    function FindLanguage(Value: TLanguage; SpType: TSpellerType): TAbstractSpeller;
    procedure Init;
    procedure GetBlock(From: Integer; var StartPos, EndPos: Integer);
    function GetMemoLanguage: TLanguage;
    procedure GetTag(From: Integer; var Len: Integer);
    procedure GetTextRange(Buf: PChar; StartPos, EndPos: Integer; CP: Word);
    function SentenceCapitalize(const S: String): String;
    procedure ContinueCheck;
    procedure FinishCheck;
    function GetLineFromPos(Pos: Integer; var LineStart: Integer): String;
    procedure GetMemoProperties;
    function GetCurrentLanguage: TLanguage;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class procedure RegisterEditControl(MemoClass: String; Unicode, Multilanguage: Boolean);
    procedure Check(Memo: TCustomMemo);
    function IsKnownWord(Word: String; Language: TLanguage): Boolean;
    procedure AddWord(Word: String; Language: TLanguage);
    procedure GetVariants(Word: String; Variants: TStrings; Language: TLanguage);
    procedure SetFontDefault; virtual;
    property CurrentLanguage: TLanguage read GetCurrentLanguage;
    property ISpellCmd: String read FISpellCmd write FISpellCmd;
    property ISpellCharset: String read FISpellCharset write FISpellCharset;
    property ISpellSurrogate: String read FISpellSurrogate write FISpellSurrogate;
    property Flag: String read FFlag write FFlag;
    property LangName: String read FLangName write FLangName;
    property ActiveLanguage: Boolean read FActiveLanguage write FActiveLanguage;
  published
    { Published declarations }
    property Language: TLanguage read FLanguage write SetLanguage;
    property LangOption: TLangOption read FLangOption write FLangOption
      default loLocalized;
    property SpellerType: TSpellerType read FSpellerType write SetSpellerType;
    property UserLanguage: TUserLanguage read F1UserLanguage write F1UserLanguage;
    property Options: TSpellOptions read FOptions write FOptions;
    property OnMisspelling: TMisspellEvent read FOnMisspell write FOnMisspell;
    property OnChangeText: TChangeTextEvent read FOnChangeText write FOnChangeText;
    property OnFinished: TNotifyEvent read FOnFinished write FOnFinished;
    property OnCancel: TNotifyEvent read FOnCancel write FOnCancel;
    property OnGetDictionary: TGetDictEvent read FOnGetDict write FOnGetDict;
    property Caption: TCaption read FCaption write FCaption;
    property Font: TFont read FFont write SetFont;
    property MisspellFont: TMisspellFont read FMissFont write SetMissFont;
    property ModalDialog: Boolean read FModalDialog write FModalDialog;
    property HTMLSupport: Boolean read FHTML write FHTML default False;
    property CustomDict: TFileName read FCustomDict write FCustomDict;
    property FinishMessage: String read FFinishMessage write FFinishMessage;
    property ShowFinishMessage: Boolean read FShowFinishMessage write FShowFinishMessage;
  end;

  TAbstractSpeller = class(TObject)
    FLanguage: TLanguage;
    FSpellerType: TSpellerType;
    FISpellCmd,
    FISpellCharset,
    FISpellSurrogate,
    FFlag,
    FLangName: String;
    FOptions: TSpellOptions;
    SpellChecker: TSpellChecker;
    FNotActive: Boolean;
    constructor Create(Language: TLanguage; Owner: TSpellChecker; Options: TSpellOptions); virtual;
    function FindMisspell(Buf: PChar; MaxLen: Integer; var Start, Len: Integer): TSpellReturnCode; virtual; abstract;
    function FindNextMisspell(Buf: PChar; MaxLen: Integer; var Start, Len: Integer): TSpellReturnCode; virtual; abstract;
    procedure ChangeOnce(Word, NewWord: String); virtual; abstract;
    procedure ChangeAlways(Word, NewWord: String); virtual; abstract;
    procedure Add(Word: String);  virtual; abstract;
    procedure IgnoreAlways(Word: String); virtual; abstract;
    procedure GetVariants(Word: String; Variants: TStrings); virtual; abstract;
    property Language: TLanguage read FLanguage;
    property SpellerType: TSpellerType read FSpellerType;
    property ISpellCmd: String read FISpellCmd;
    property ISpellCharset: String read FISpellCharset;
    property ISpellSurrogate: String read FISpellSurrogate;
    property Flag: String read FFlag;
    property LangName: String read FLangName;
    property Options: TSpellOptions read FOptions;
    function GetChangeText: String; virtual; abstract;
    function GetMisspellText: String; virtual; abstract;
    property ChangeText: String read GetChangeText;
    property MisspellText: String read GetMisspellText;
    property NotActive: Boolean read FNotActive;
  end;
  TSpellerClass = class of TAbstractSpeller;

  ESpellError = class(Exception);

  TSpellerDialog2 = class(TForm)
    InfoMsg: TLabel;
    Misspelling: TRichEdit;
    Label2: TLabel;
    Variants: TListBox;
    ChangeButton: TButton;
    ChangeAllButton: TButton;
    SkipButton: TButton;
    SkipAllButton: TButton;
    AddButton: TButton;
    CancelButton: TButton;
    CancelEdit: TButton;
    DelButton: TButton;
    StartButton: TButton;
    procedure DelButtonClick(Sender: TObject);
    procedure SkipButtonClick(Sender: TObject);
    procedure SkipAllButtonClick(Sender: TObject);
    procedure AddButtonClick(Sender: TObject);
    procedure ChangeButtonClick(Sender: TObject);
    procedure ChangeAllButtonClick(Sender: TObject);
    procedure MisspellingProtectChange(Sender: TObject; StartPos,
      EndPos: Integer; var AllowChange: Boolean);
    procedure MisspellingChange(Sender: TObject);
    procedure CancelEditClick(Sender: TObject);
    procedure CancelButtonClick(Sender: TObject);
    procedure StartButtonClick(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    Checker: TSpellChecker;
    FShowing: Boolean;
    procedure ShowForChange(Msg: TCaption);
    procedure ShowForDelete;
    procedure ShowForEdit(Msg: TCaption);
    procedure ShowMisspelling;
    procedure GetHotArea(var SS, SL: Integer);
  public
    { Public declarations }

    constructor Create(SpellChecker: TSpellChecker); reintroduce; overload;
  end;

const
  langAfrikaans = TLanguage(1078);
  langAlbanian = TLanguage(1052);
  langArabic = TLanguage(1025);
  langBasque = TLanguage(1069);
  langBelgianDutch = TLanguage(2067);
  langBelgianFrench = TLanguage(2060);
  langBrazilianPortuguese = TLanguage(1046);
  langBulgarian = TLanguage(1026);
  langByelorussian = TLanguage(1059);
  langCatalan = TLanguage(1027);
  langCroatian = TLanguage(1050);
  langCzech = TLanguage(1029);
  langDanish = TLanguage(1030);
  langDutch = TLanguage(1043);
  langEnglishAUS = TLanguage(3081);
  langEnglishCanadian = TLanguage(4105);
  langEnglishNewZealand = TLanguage(5129);
  langEnglishSouthAfrica = TLanguage(7177);
  langEnglishUK = TLanguage(2057);
  langEnglishUS = TLanguage(1033);
  langEstonian = TLanguage(1061);
  langFaeroese = TLanguage(1080);
  langFarsi = TLanguage(1065);
  langFinnish = TLanguage(1035);
  langFinnishSwedish = TLanguage(2077);
  langFrench = TLanguage(1036);
  langFrenchCanadian = TLanguage(3084);
  langGerman = TLanguage(1031);
  langGreek = TLanguage(1032);
  langHebrew = TLanguage(1037);
  langHungarian = TLanguage(1038);
  langItalian = TLanguage(1040);
  langIcelandic = TLanguage(1039);
  langIndonesian = TLanguage(1057);
  langJapanese = TLanguage(1041);
  langKorean = TLanguage(1042);
  langLatvian = TLanguage(1062);
  langLithuanian = TLanguage(1063);
  langMacedonian = TLanguage(1071);
  langMalaysian = TLanguage(1086);
  langMexicanSpanish = TLanguage(2058);
  langNorwegianBokmol = TLanguage(1044);
  langNorwegianNynorsk = TLanguage(2068);
  langPolish = TLanguage(1045);
  langPortuguese = TLanguage(2070);
  langRomanian = TLanguage(1048);
  langRussian = TLanguage(1049);
  langSerbianCyrillic = TLanguage(3098);
  langSerbianLatin = TLanguage(2074);
  langSesotho = TLanguage(1072);
  langSimplifiedChinese = TLanguage(2052);
  langSlovak = TLanguage(1051);
  langSlovenian = TLanguage(1060);
  langSpanish = TLanguage(1034);
  langSpanishModernSort = TLanguage(3082);
  langSwedish = TLanguage(1053);
  langSwissFrench = TLanguage(4108);
  langSwissGerman = TLanguage(2055);
  langSwissItalian = TLanguage(2064);
  langThai = TLanguage(1054);
  langTraditionalChinese = TLanguage(1028);
  langTsonga = TLanguage(1073);
  langTswana = TLanguage(1074);
  langTurkish = TLanguage(1055);
  langUkrainian = TLanguage(1058);
  langVenda = TLanguage(1075);
  langVietnamese = TLanguage(1066);
  langXhosa = TLanguage(1076);
  langZulu = TLanguage(1077);

var
  spOVariants, spODelete, spOChange, spOChangeAll, spOSkip, spOSkipAll, spOAdd,
   spOCancel, spOCancelEdit, spONotFound, spOHyphen, spOCaps, spOAbbrev,
   spONoSentenceCap, spOExtraSpaces, spOMissingSpace, spOInitialNumeral,
   spORepeatedWord, spOFinish, spOFinishCaption, spOCaption, spOError,
   spOErrorLoad, spOErrorUnload, spOErrorNoSpellChecker, spOStart: String;
  WinNT: Boolean; 

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

function SptToStr(Value: TSpellerType): String;

implementation

uses
  CSAPI, SpellRes, SpellResDe, Registry, ISpell;

{$R *.DFM}

var
  FUserLanguage: TUserLanguage;

type
  TMemoClass = class of TCustomMemo;

{TAbstractSpeller}
constructor TAbstractSpeller.Create(Language: TLanguage; Owner: TSpellChecker; Options: TSpellOptions);
begin
  inherited Create;
  FLanguage:= Language;