// Der folgende Code zeigt, wie man die Rechtschreibprüfung von MS-Word
// nutzen kann. Man erstellt eine Anwendung mit 2 Formularen. Auf Form1
// kommt 1 TRichedit, welches den zu kontrollierenden Text aufnimmt und
// 1 TButton, welcher die Prüfung startet. Auf Form2 kommt 1 TListbox
// für die Vorschläge, 1 TEdit für das zu ändernde Wort und 3 TButton
// für Ignorieren, Ändern und Abbrechen.
// Vor und während der Code läuft, darf MS-Word nicht laufen.


// Getestet mit D4 unter XP

//--------------------Mainform------------------------------------ 

unit spell; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, 
  StdCtrls, ComCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    RichEdit1: TRichEdit; 
    procedure Button1Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure getnext(RE: TRichedit); 
    function GetWort(RE: TRichedit): string; 
    procedure pruefe(RE: TRichedit; start: integer); 
    function prf(s: string; ts: TStrings): boolean; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
uses Comobj, Richedit, spell2; 
 
type 
  TRechtschreib = class(TObject) 
  private 
    wrd, ov: OleVariant; 
  public 
    constructor Create; 
    destructor Destroy; override; 
    procedure aus; 
    function testen(wort: string; sgg: TStrings): boolean; 
  end; 
 
var 
  RST: TRechtschreib; 
  aktiv: boolean = false; 
 
constructor TRechtschreib.Create; 
begin 
  try 
    wrd := CreateOleObject('Word.Application'); 
    aktiv := true; 
    wrd.Documents.Add; 
  except 
    if aktiv then aus; 
    aktiv := false; 
  end; 
end; 
 
destructor TRechtschreib.Destroy; 
begin 
  if aktiv then aus; 
  inherited Destroy; 
end; 
 
procedure TRechtschreib.aus; 
begin 
  wrd.Quit; 
  wrd := VarNull; 
end; 
 
function TRechtschreib.testen(wort: string; sgg: TStrings): boolean; 
var 
  x: integer; 
begin 
  Result := false; 
  sgg.Clear; 
  if aktiv then begin 
    if wrd.CheckSpelling(wort) then Result := true 
    else begin 
      ov := wrd.GetSpellingSuggestions(wort); 
      for x := 1 to ov.count do 
        sgg.add(ov.item(x)); 
      ov := VarNull; 
    end; 
  end; 
end; 
 
function TForm1.prf(s: string; ts: TStrings): boolean; 
begin 
  Result := RST.testen(s, ts); 
  if not Result and (ts.text = '') then 
    ts.add('--- keine Vorschläge ---'); 
end; 
 
function TForm1.GetWort(RE: TRichedit): string; 
begin 
  RE.Sellength := RE.Perform(EM_FINDWORDBREAK, WB_MOVEWORDRIGHT, RE.Selstart) 
    - RE.selstart; 
  Result := TRim(RE.seltext); 
  RE.Sellength := length(Result); 
end; 
 
procedure TForm1.getnext(RE: TRichedit); 
begin 
  RE.selstart := RE.Perform(EM_FINDWORDBREAK, WB_MOVEWORDRIGHT, 
    RE.Selstart); 
end; 
 
procedure TForm1.pruefe(RE: TRichedit; start: integer); 
var 
  s: string; 
  mrk: boolean; 
begin 
  screen.cursor := crhourglass; 
  mrk := RE.hideselection; 
  RE.selstart := RE.Perform(EM_FINDWORDBREAK, WB_LEFTBREAK, start); 
  s := 'beendet'; 
  RE.hideselection := true; 
  while RE.selstart < length(RE.text) do begin 
    Form2.edit1.text := getwort(RE); 
    if length(Form2.edit1.text) > 1 then 
      if not prf(Form2.edit1.text, Form2.ListBox1.Items) 
        then begin 
        beep; 
        RE.hideselection := false; 
        RE.setfocus; 
        Form2.showmodal; 
        RE.hideselection := true; 
        RE.perform(WM_killfocus, 0, 0); 
        case form2.modalresult of 
          mrOk: begin 
              RE.perform(EM_REPLACESEL, 1, 
                integer(pchar(Form2.edit1.text))); 
            end; 
          mrignore: begin 
              getnext(RE); 
              continue; 
            end; 
        else begin 
            s := 'abgebrochen'; 
            break; 
          end; 
        end; 
      end; 
    getnext(RE); 
  end; 
  RE.sellength := 0; 
  RE.hideselection := mrk; 
  screen.cursor := crdefault; 
  showmessage('Rechtschreibprüfung ' + s); 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  RST := TRechtschreib.Create; 
  Button1.enabled := aktiv; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  RST.Free; 
end; 
 
//----------------------Form2---------------------------------- 
 
unit spell2; 
 
interface 
 
uses 
  Classes, Forms, StdCtrls, Controls; 
 
type 
  TForm2 = class(TForm) 
    ListBox1: TListBox; 
    Edit1: TEdit; 
    Button1: TButton; 
    Button2: TButton; 
    Button3: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure FormShow(Sender: TObject); 
    procedure ListBox1Click(Sender: TObject); 
    procedure Edit1Change(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    function leer: boolean; 
  end; 
 
var 
  Form2: TForm2; 
 
implementation 
 
{$R *.DFM} 
 
procedure TForm2.FormCreate(Sender: TObject); 
begin 
  Edit1.text := ''; 
  Listbox1.clear; 
  Button1.caption := '&Ignorieren'; 
  Button1.modalresult := mrIgnore; 
  Button2.caption := 'Än&dern'; 
  Button2.modalresult := mrOk; 
  Button3.caption := '&Abbrechen'; 
  Button3.modalresult := mrCancel; 
end; 
 
function TForm2.leer: boolean; 
begin 
  Result := copy(Listbox1.items[0], 1, 3) = '---'; 
end; 
 
procedure TForm2.FormShow(Sender: TObject); 
begin 
  Listbox1.itemindex := ord(not leer) - 1; 
  with Edit1 do begin 
    setfocus; 
    sellength := 0; 
    selstart := length(text); 
  end; 
  Button2.enabled := false; 
end; 
 
procedure TForm2.ListBox1Click(Sender: TObject); 
begin 
  if not leer then 
    edit1.text := Listbox1.items[Listbox1.itemindex]; 
end; 
 
procedure TForm2.Edit1Change(Sender: TObject); 
begin 
  Button2.enabled := true; 
end; 
 
end. 

//------------------------------------------------------------- 

// Beispielaufruf mit Button1 auf Form1
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  pruefe(Richedit1, 0); 
end; 
 
end. 
 



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke