Mega Code Archive
Use the spell check functionality from word
<![CDATA[
Title: use the spell check functionality from word?
{
Die Rechtschreibprüfung von Word kann für die eigene Zwecke verwendet werden.
So funktionierts:
1. Word mit einem leeren Dokument öffnen
2. Wort, das zu überprüfen ist, an Word übergeben
3. Rechtschreibprüfung von Word starten
4. Ersetztes Wort wieder holen und im Memo wieder einsetzen
Problematik:
- Einige Wörter werden von Word ignoriert:
- Wörter mit Zahlen
- Wörter mit der Länge 1
- Rechtschreibprüfung lässt sich nicht abbrechen
- Wenn Word schon geöffnet ist, kann unter Umständen die Rechtschreibprüfung
nicht gestartet werden (Fehlermeldung: RPC-Server nicht vorhanden)
}
uses Word2000;
function TForm1.IsSatzZeichen(c: CHAR): Boolean;
begin
case c of
'(': Result := True;
')': Result := True;
' ': Result := True;
'.': Result := True;
',': Result := True;
'!': Result := True;
'?': Result := True;
'-': Result := True;
':': Result := True;
';': Result := True;
#$D: Result := True;
#$A: Result := True;
else
Result := False;
end;
end;
procedure TForm1.CheckText(Memo: TMemo);
var
i: Integer;
MySelStart: INTEGER;
Token: string;
Line: string;
ReplaceStr: string;
WordList: TStrings;
varFalse: OleVariant;
begin
// Läuft Word?
if EXE_Running('WINWORD.EXE', False) then
begin
if mrYes = MessageDlg('Word ist geöffnet.' + #13 + #10 +
'Für die Rechtschreibprüfung muss Word beendet werden.' + #13 + #10 +
'' + #13 + #10 + 'Word abschiessen?', mtWarning, [mbYes, mbNo], 0) then
begin
KillTask('WINWORD.EXE');
end;
end
else
begin
// Startwerte
i := 1;
Line := Memo.Text;
WordList := TStringList.Create;
// Memo traviersieren und einzelne Wörter (Token) rausholen
while not (Line[i] = #0) do
begin
Token := '';
// Tokem zusammenstellen
while not IsSatzZeichen(Line[i]) do
begin
Token := Token + Line[i];
Inc(i);
end;
if Token '' then
begin
// Token speichern
WordList.Add(Token);
end;
if IsSatzZeichen(Line[i]) then
begin
// "Token" speichern
WordList.Add(Line[i]);
Inc(i);
end;
end;
// Verbindung zu Word aufbauen
WordApp.Disconnect;
WordDoc.Disconnect;
WordApp.Connect;
WordApp.Visible := False;
// Leeres Dokument erzeugen
WordDoc.ConnectTo(WordApp.Documents.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam));
MySelStart := 0;
// WordList traversieren und auf Rechschreibung prüfen
for i := 0 to WordList.Count - 1 do
begin
if not IsSatzzeichen(Wordlist[i][1]) then
begin
WordApp.Visible := False;
// WordDokumentinhalt löschen
WordDoc.Range.Delete(EmptyParam, EmptyParam);
// Token in Word einfügen
WordDoc.Range.Set_Text(WordList[i]);
// Rechtschreibprüfung aufrufen
WordApp.Visible := False;
WordDoc.CheckSpelling;
WordApp.Visible := False;
// Resultat von der Rechtschreibprüfung holen und aufbereiten
ReplaceStr := WordDoc.Range.Get_Text;
WordApp.Visible := False;
ReplaceStr := ReplaceString(ReplaceStr, #$D, '');
// Neues Wort in Memo einfügen
Memo.SetFocus;
Memo.SelStart := MySelStart;
Memo.SelLength := Length(WordList[i]);
Memo.SelText := ReplaceStr;
WordList[i] := ReplaceStr;
end;
MySelStart := MySelStart + Length(WordList[i]);
end;
MessageDlg('Rechtschreibprüfung abgeschlossen.', mtInformation, [mbOK], 0);
// Verbindung zu Word abbrechen und Word schliessen ohne zu speichern
WordDoc.Disconnect;
WordApp.Disconnect;
varFalse := False;
WordApp.Quit(varFalse);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Rechtschreibprüfung durchführen
CheckText(Memo1);
end;
]]>