5,386
社区成员
发帖
与我相关
我的任务
分享
uses OleServer, WordXP,ActiveX, OleCtrls;
procedure TForm1.btnSpellCheckClick(Sender: TObject);
var colSpellErrors : ProofreadingErrors;
colSuggestions : SpellingSuggestions;
i : Integer;
StopLoop : Boolean;
itxtLen, itxtStart : Integer;
varFalse: OleVariant;
begin
try
WordApp.Connect;
except
MessageBox(Application.Handle,
'Please install Microsoft Office Word!',
'Error:', MB_OK + MB_ICONSTOP);
Abort;
end;
try
WordApp.Connect;
WordDoc.ConnectTo(WordApp.Documents.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam));
WordApp.Options.CheckSpellingAsYouType:=True;
WordApp.Options.CheckGrammarAsYouType := True;
//main loop
StopLoop:=False;
itxtStart:=0;
Memo.SelStart:=0;
itxtlen:=0;
while not StopLoop do begin
itxtStart := itxtLen + itxtStart;
itxtLen := Pos(' ', Copy(Memo.Text,itxtStart+1,MaxInt));
if itxtLen = 0 then StopLoop := True;
Memo.SelStart := itxtStart;
Memo.SelLength := -1 + itxtLen;
if Memo.SelText = '' then Continue;
Caption:=Memo.SelText;
WordDoc.Range.Delete(EmptyParam,EmptyParam);
WordDoc.Range.Set_Text(Memo.SelText);
colSpellErrors := WordDoc.SpellingErrors;
if colSpellErrors.Count <> 0 then begin
colSuggestions := WordApp.GetSpellingSuggestions(colSpellErrors.Item(1).Get_Text);
with frSpellCheck do begin
edNID.text := colSpellErrors.Item(1).Get_Text;
lbSuggestions.Items.Clear;
for i:= 1 to colSuggestions.Count do begin
lbSuggestions.Items.Add((colSuggestions.Item(i).Name));
end;
lbSuggestions.ItemIndex := 0;
lbSuggestionsClick(Sender);
ShowModal;
case frSpellCheck.ModalResult of
mrAbort: Break;
mrIgnore: Continue;
mrOK:
if sReplacedWord <> '' then begin
Memo.SelText := sReplacedWord;
itxtLen := Length(sReplacedWord);
end;
end; //case
end; //with frSpellCheck
end; //if colSpellErrors.Count <> 0
end; //main while loop
Memo.SelStart := 0;
Memo.SelLength := 0;
finally
WordDoc.Disconnect;
varFalse:=False;
//WordApp.Quit(varFalse);
end;
end;