Text Component Spell Checker

Es gibt eine Möglichkeit, in Delphi Textkomponenten auf die Rechtschreibung überprüfen zu lassen. Dazu muss allerdings Word installiert sein.

Wenn sich auf der Form z.B. ein Memofeld mit einem Text befindet, kann der zu überprüfenden Text markiert und zu dem RPC-Server gesendet und auch wieder empfangen werden.

Das funktioniert folgendermaßen: 

• Als Erstes wird Word im Hintergrund gestartet, ohne sichtliches Dokument
• Dann wird der markierte Text als Objekt an die Rechtschreibüberprüfung gesendet
• Die Rechtschreibüberprüfung öffnet sich und wartet auf Bestätigung.
• Der Text wird an die Form zu seinem Platz zurückgesendet.
• Word wird geschlossen.

Probleme können auftauchen bei..

- 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 ExtCtrls, Word2000, TlHelp32, OleServer, WordXP, StrUtils

private
    { Private declarations }
    function IsSatzZeichen(c: CHAR): Boolean;
    procedure CheckText(Memo: TMemo);
    
//

function KillTask(ExeFileName: string): Integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
      Result := Integer(TerminateProcess(
                        OpenProcess(PROCESS_TERMINATE,
                                    BOOL(0),
                                    FProcessEntry32.th32ProcessID),
                                    0));
     ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;


function IsExeRunning(const AExeName: string): boolean;
var  h: THandle;  p: TProcessEntry32;
begin
  Result := False; p.dwSize := SizeOf(p);
  h := CreateToolHelp32Snapshot(TH32CS_SnapProcess, 0);
  try Process32First(h, p); repeat
      Result := AnsiUpperCase(AExeName) = AnsiUpperCase(p.szExeFile);
    until Result or (not Process32Next(h, p));
  finally CloseHandle(h); end;
end;

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;
  options  : TReplaceFlags;
begin
  // Läuft Word?
  if IsExeRunning('WINWORD.EXE') 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
    WordApplication1.Disconnect;
    WordDocument1.Disconnect;
    WordApplication1.Connect;
    WordApplication1.Visible := False;
    // Leeres Dokument erzeugen
    WordDocument1.ConnectTo(WordApplication1.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
        WordApplication1.Visible := False;
        // WordDokumentinhalt löschen
        WordDocument1.Range.Delete(EmptyParam, EmptyParam);
        // Token in Word einfügen
        WordDocument1.Range.Set_Text(WordList[i]);
        // Rechtschreibprüfung aufrufen
        WordApplication1.Visible := False;
        WordDocument1.CheckSpelling;
        WordApplication1.Visible := False;
        // Resultat von der Rechtschreibprüfung holen und aufbereiten
        options := [rfReplaceAll, rfIgnoreCase];
        ReplaceStr := WordDocument1.Range.Get_Text;
        WordApplication1.Visible := False;
        ReplaceStr := StringReplace(ReplaceStr, #$D, '', options);
        // 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
    WordDocument1.Disconnect;
    WordApplication1.Disconnect;
    varFalse := False;
    WordApplication1.Quit(varFalse);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CheckText(Memo1);
end;