...use the spell check functionality from word?

Author: Scrap

Category: Objects/ActiveX

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

 

printed from
www.swissdelphicenter.ch
developers knowledge base