spellers.pas

拼写检查

      FStartSentence:= C=#13;
    end;
end;

procedure TSpellChecker.Init;
var
  MemoClass: TMemoClass;
  MS: TMemoryStream;
  S: String;
  P: PChar;
  L: Integer;
  PT: Boolean;
begin
  FCancelled := False;
  GetMemoProperties;
  MemoClass:= TMemoClass(FMemo.ClassType);
  if Assigned(FBackMemo) then
    FBackMemo.Free;
  FBackMemo:= MemoClass.Create(FMemo.Owner);
  FBackMemo.Visible := False;
  FBackMemo.Parent := FMemo.Owner as TWinControl;
  MS:= TMemoryStream.Create;
  FMemoRichEd := (FMemo is TCustomRichEdit);
  if FMemoRichEd then
    begin
      PT:= TRichEdit(FMemo).PlainText;
      TRichEdit(FMemo).PlainText:= False;
      TRichEdit(FMemo).Lines.SaveToStream(MS);
      MS.Position:= 0;
      TRichEdit(FBackMemo).Lines.LoadFromStream(MS);
      TRichEdit(FMemo).PlainText:= PT;
    end
  else
    begin
      FMemo.Lines.SaveToStream(MS);
      MS.Position:= 0;
      FBackMemo.Lines.LoadFromStream(MS);
    end;
  MS.Free;
  FMemo.Perform(EM_GETSEL, Integer(@FSpellStart), Integer(@FSpellEnd));
  if FSpellEnd=FSpellStart then
    FSpellEnd:= FMemo.Perform(WM_GETTEXTLENGTH, 0, 0);
  FSpellStart:= FMemo.Perform(EM_FINDWORDBREAK, WB_LEFTBREAK, FSpellStart);
  if FSpellStart>0 then
    FSpellStart:= FMemo.Perform(EM_FINDWORDBREAK, WB_RIGHT, FSpellStart);
  if FHTML then
    begin
      S:= FBackMemo.Text;
      P:= @S[1];
      repeat
        P:= StrPos(P, '<');
        if (P=nil) or (P-@S[1]>FSpellStart) then
          Break;
        GetTag(P-@S[1], L);
        if (P-@S[1]+L>FSpellStart) then
          begin
            if (P-@S[1]+L<FSpellEnd) then
              FSpellStart:= P-@S[1]+L
            else
              FSpellStart:= FSpellEnd;
            Break;
          end;
        Inc(P, L);
      until False;
    end;
  FMisspellStart:= FSpellStart;
  FMisspellLen:= 0;
  CrPos:= 0;
  TagPos:= 0;
  LangPos:= 0;
end;

function TSpellChecker.SentenceCapitalize(const S: String): String;
begin
  REsult:= S;
  LCMapString(CurrentLanguage, LCMAP_Uppercase, @S[1], 1, @Result[1], 1);
end;

procedure TSpellChecker.Check(Memo: TCustomMemo);
begin
  If (ActiveLanguage = False) or (Memo.Text = '') then Exit;
  FUserLanguage := F1UserLanguage;
  FMemo:= Memo;
  if not Assigned(FDialog) then
    FDialog:= TSpellerDialog2.Create(Self);
  Init;
  ContinueCheck;
end;

procedure TSpellChecker.FinishCheck;
begin
  FDialog.Hide;
  FDialog.Close;
  if Assigned(FBackMemo) then
    FBackMemo.Free;
  FBackMemo:= nil;
  if Assigned(FOnFinished) then FOnFinished(Self);
  if FShowFinishMessage and (FFinishMessage<>'') and (not FSpeller.FNotActive) then
    case FUserLanguage of
      ulEnglish: MessageBox(Application.Handle, @FFinishMessage[1],
              PChar(SpellRes.spsFinishCaption),mb_Ok+mb_IconInformation);
      ulown: MessageBox(Application.Handle, @FFinishMessage[1],
              PChar(SpellResDe.spsFinishCaption), mb_Ok+mb_IconInformation);
      ulother: MessageBox(Application.Handle, @FFinishMessage[1],
              PChar(spOFinishCaption), mb_Ok+mb_IconInformation);
    end;
end;

procedure TSpellChecker.ContinueCheck;
var
  StartPos,
  EndPos: Integer;
  L: TLanguage;
  Buf: PChar;
begin
  FSRC:= srNoErrors;
  repeat
    GetBlock(FMisspellStart+FMisspellLen, StartPos, EndPos);
    if StartPos=EndPos then
      begin
        FinishCheck;
        Break;
      end;
    FBackMemo.Perform(EM_SETSEL, StartPos, StartPos+1);
    L:= GetMemoLanguage;
    FSpeller:= Findlanguage(L, SpellerType);
    Buf:= AllocMem(EndPos-StartPos+1);
    GetTextRange(Buf, StartPos, EndPos, CodePageFromLocale(L));
    if FStartSentence then
      FSRC:= FSpeller.FindMisspell(Buf, EndPos-StartPos, FMisspellStart, FMisspellLen)
    else
      FSRC:= FSpeller.FindNextMisspell(Buf, EndPos-StartPos, FMisspellStart, FMisspellLen);
    FreeMem(Buf);
    if FSRC<>srNoErrors then
      begin
        Inc(FMisspellStart, StartPos);
        if FSRC=srExtraSpaces then
          Dec(FMisspellLen);
        FMemo.SelStart:= FMisspellStart;
        FMemo.SelLength:= FMisspellLen;
        FBackMemo.SelStart:= FMisspellStart;
        FBackMemo.SelLength:= FMisspellLen;
        FMisspellText:= FSpeller.MisspellText;
      end
    else
      begin
        FMisspellStart:= EndPos;
        FMisspellLen:= 0;
      end;
    if (FSRC=srReturningChangeAlways) then
      Change(FSpeller.ChangeText);
  until not (FSRC in [srNoErrors, srReturningChangeAlways]);
  if not (FSRC in [srNoErrors, srReturningChangeAlways]) then
    begin
      if FSpeller.Language <> 0
        then FDialog.Caption:= Format(Caption, [LanguageName(FSpeller.Language,
                                      LangOption)])
        else FDialog.Caption:= Format(Caption, [FSpeller.LangName]);
      case FUserLanguage of
        ulEnglish: begin
          case FSRC of
            srUnknownInputWord: FDialog.ShowForChange(SpellRes.spsNotFound);
            srReturningChangeOnce:
              begin
               FDialog.ShowForChange(SpellRes.spsNotFound);
               if FDialog.Variants.Items.IndexOf(FSpeller.ChangeText)=-1 then
                 FDialog.Variants.Items.Insert(0, FSpeller.ChangeText);
              end;
            srInvalidHyphenation: FDialog.ShowForChange(SpellRes.spsHyphen);
            srErrorCapitalization: FDialog.ShowForChange(SpellRes.spsCaps);
            srWordConsideredAbbreviation: FDialog.ShowForChange(SpellRes.spsAbbrev);
            srNoSentenceStartCap: FDialog.ShowForChange(SpellRes.spsNoSentenceCap);
            srRepeatWord: FDialog.ShowForDelete;
            srExtraSpaces: FDialog.ShowForChange(SpellRes.spsExtraSpaces);
            srMissingSpace: FDialog.ShowForEdit(SpellRes.spsMissingSpace);
            srInitialNumeral: FDialog.ShowForEdit(SpellRes.spsInitialNumeral);
          end;
        end;
        ulown: begin
          case FSRC of
            srUnknownInputWord: FDialog.ShowForChange(SpellResDe.spsNotFound);
            srReturningChangeOnce:
              begin
               FDialog.ShowForChange(SpellResDe.spsNotFound);
               if FDialog.Variants.Items.IndexOf(FSpeller.ChangeText)=-1 then
                 FDialog.Variants.Items.Insert(0, FSpeller.ChangeText);
              end;
            srInvalidHyphenation: FDialog.ShowForChange(SpellResDe.spsHyphen);
            srErrorCapitalization: FDialog.ShowForChange(SpellResDe.spsCaps);
            srWordConsideredAbbreviation: FDialog.ShowForChange(SpellResDe.spsAbbrev);
            srNoSentenceStartCap: FDialog.ShowForChange(SpellResDe.spsNoSentenceCap);
            srRepeatWord: FDialog.ShowForDelete;
            srExtraSpaces: FDialog.ShowForChange(SpellResDe.spsExtraSpaces);
            srMissingSpace: FDialog.ShowForEdit(SpellResDe.spsMissingSpace);
            srInitialNumeral: FDialog.ShowForEdit(SpellResDe.spsInitialNumeral);
         end;
        end;
        ulother: begin
          case FSRC of
            srUnknownInputWord: FDialog.ShowForChange(spONotFound);
            srReturningChangeOnce:
              begin
               FDialog.ShowForChange(spONotFound);
               if FDialog.Variants.Items.IndexOf(FSpeller.ChangeText)=-1 then
                 FDialog.Variants.Items.Insert(0, FSpeller.ChangeText);
              end;
            srInvalidHyphenation: FDialog.ShowForChange(spOHyphen);
            srErrorCapitalization: FDialog.ShowForChange(spOCaps);
            srWordConsideredAbbreviation: FDialog.ShowForChange(spOAbbrev);
            srNoSentenceStartCap: FDialog.ShowForChange(spONoSentenceCap);
            srRepeatWord: FDialog.ShowForDelete;
            srExtraSpaces: FDialog.ShowForChange(spOExtraSpaces);
            srMissingSpace: FDialog.ShowForEdit(spOMissingSpace);
            srInitialNumeral: FDialog.ShowForEdit(spOInitialNumeral);
          end;
        end;
      end; //case FUserLanguage
      if not (FDialog.Visible or (FSRC in [srNoErrors, srReturningChangeAlways])
              or FCancelled)
        then
          if FModalDialog then
            FDialog.ShowModal
          else
            FDialog.Show;
    end; //if not (FSRC ...
end;

function TSpellChecker.GetLineFromPos(Pos: Integer; var LineStart: Integer): String;
var
  L: Integer;
  Buf: String;
  PS, PE: Integer;
begin
  L:= FBackMemo.Perform(WM_GETTEXTLENGTH, 0, 0);
  SetLength(Buf, L);
  GetTextRange(@Buf[1], 0, L, CodePageFromLocale(FSpeller.Language));
  PS:= Pos;
  while (PS>0) and not (Buf[PS+1] in [#10, #13]) do
    Dec(PS);
  if (Buf[PS+1] in [#10, #13]) then
    Inc(PS);
  PE:= Pos;
  try
   while not (Buf[PE+1] in [#10, #13, #0]) do
    Inc(PE);
   except on ERangeError do
    PE := Length(Buf)-PS;
   end;  
  Result:= Copy(Buf, PS+1, PE-PS);
  LineStart:= PS;
end;

function TSpellChecker.GetCurrentLanguage: TLanguage;
begin
  if Assigned(FSpeller) then
    Result:= FSpeller.Language
  else
    Result:= 0;
end;

///    functions, which are locally used only for streaming
function AdjustLineBreaks(Dest, Source: PChar): Integer; assembler;
asm
        PUSH    ESI
        PUSH    EDI
        MOV     EDI,EAX
        MOV     ESI,EDX
        MOV     EDX,EAX
        CLD
@@1:    LODSB
@@2:    OR      AL,AL
        JE      @@4
        CMP     AL,0AH
        JE      @@3
        STOSB
        CMP     AL,0DH
        JNE     @@1
        MOV     AL,0AH
        STOSB
        LODSB
        CMP     AL,0AH
        JE      @@1
        JMP     @@2
@@3:    MOV     EAX,0A0DH
        STOSW
        JMP     @@1
@@4:    STOSB
        LEA     EAX,[EDI-1]
        SUB     EAX,EDX
        POP     EDI
        POP     ESI
end;

function StreamLoad(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): Longint; stdcall;
var
  Buffer, pBuff: PChar;
  StreamInfo: PRichEditStreamInfo;
begin
  Result := NoError;
  StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  Buffer := StrAlloc(cb + 1);
  try
    cb := cb div 2;
    pcb := 0;
    pBuff := Buffer + cb;
    try
      if StreamInfo^.Converter <> nil then
        pcb := StreamInfo^.Converter.ConvertReadStream(StreamInfo^.Stream, pBuff, cb);
      if pcb > 0 then
      begin
        pBuff[pcb] := #0;
        if pBuff[pcb - 1] = #13 then pBuff[pcb - 1] := #0;
        pcb := AdjustLineBreaks(Buffer, pBuff);
        Move(Buffer^, pbBuff^, pcb);
      end;
    except
      Result := $0001;
    end;
  finally
    StrDispose(Buffer);
  end;
end;
/// end {functions, which are locally used only for streaming}

{$IFDEF VER130} { Borland Delphi 5.x }
   // functions, which are locally used only for Delphi 5
function Utf8Encode(const WS: WideString): UTF8String;
begin
  Result := ToUTF8(WS);
end;
{$ENDIF}

procedure TSpellChecker.ChangeOnce(Word1: String);
var
  N, WWLength: Integer;
  TempCP: Word;
  EditStream: TEditStream;
  StreamInfo: TRichEditStreamInfo;
  TextType: Longint;
  WideWord: String;
  NotStream: Boolean;
begin
  FSpeller.ChangeOnce(FSpeller.MisspellText, Word1);
  NotStream := True;
  if FUnicode or (WinNt and FMemoRichEd) then begin
    TempCP := CodePageFromLocale(FSpeller.Language);
    if (FSpeller.Language = 0) and (FSpellerType = sptISpell)
      then TempCP := GetICodePage(FISpellCharset);
    if (TempCP <> GetAcp())
      then begin
        NotStream := False;
        TextType :=  SF_TEXT or SFF_SELECTION;
        StreamInfo.Converter := TConversion.Create;
        try
         StreamInfo.Stream := TMemoryStream.Create;
         try
          WideWord := '锘