Tips (1541)

Tip Rating (10):

{
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;