// Der folgende
Code zeigt, wie man die Rechtschreibprüfung von MS-Word //-------------------- Form2 (spell2) ------------------------------------ (Hauptform siehe unten) unit spell2;
interface
uses
Winapi.Windows, System.SysUtils, System.Classes, Vcl.Controls, Vcl.Forms,
Vcl.StdCtrls;
type
TForm2 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure ListBox1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ListBox1DblClick(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure ListBox1KeyPress(Sender: TObject; var Key: Char);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
function leer: boolean;
end;
const
lr = '--- keine Vorschläge ---';
var
Form2: TForm2;
implementation
{$R *.dfm}
var
merk: string;
procedure TForm2.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
Key := #0;
if Button2.enabled then
modalresult := mrok
else
modalresult := mrignore;
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
Edit1.text := '';
ListBox1.clear;
Button1.caption := '&1x Ignorieren';
Button1.modalresult := mrignore;
Button2.caption := '&Ändern';
Button2.modalresult := mrok;
Button3.caption := '&Abbruch';
Button3.modalresult := mrCancel;
Button4.caption := 'Alle &ignorieren';
Button4.modalresult := mrall;
end;
function TForm2.leer: boolean;
begin
Result := ListBox1.items[0] = lr;
end;
procedure TForm2.FormShow(Sender: TObject);
begin
ListBox1.itemindex := ord(not leer) - 1;
with Edit1 do
begin
merk := text;
setfocus;
sellength := 0;
selstart := length(text);
end;
Button2.enabled := not leer;
end;
procedure TForm2.ListBox1Click(Sender: TObject);
begin
if not leer then
Edit1.text := ListBox1.items[ListBox1.itemindex];
end;
procedure TForm2.ListBox1DblClick(Sender: TObject);
begin
if not leer then
modalresult := mrok;
end;
procedure TForm2.ListBox1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
if not leer then
modalresult := mrok;
end;
end;
procedure TForm2.ListBox1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
ListBox1Click(Sender);
end;
procedure TForm2.Edit1Change(Sender: TObject);
begin
Button2.enabled := merk <> Edit1.text;
end;
end.
//-------------------- Form1 (Unit1) ------------------------------------ unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;
type
TForm1 = class(TForm)
RichEdit1: TRichEdit;
Button1: TButton;
Button2: TButton;
OpenDialog1: TOpenDialog;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
function nexttrenner(RE: TRichEdit; out wrt: String): Boolean;
procedure pruef(RE: TRichEdit);
function prf(s: string; ts: TStrings): Boolean;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses System.Win.ComObj, Winapi.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
P, M: PChar;
RST: TRechtschreib;
iglist: TStringlist;
aktiv, allignore: Boolean;
const
bstn = ['a' .. 'z', 'ä', 'ö', 'ü', 'A' .. 'Z', 'Ä', 'Ö', 'Ü', 'ß',
'0' .. '9'];
rp = 'Rechtschreibprüfung ';
constructor TRechtschreib.Create;
begin
try
wrd := CreateOleObject('Word.Application');
aktiv := true;
wrd.Documents.Add;
wrd.visible := false;
except
if aktiv then
aus;
end;
end;
destructor TRechtschreib.Destroy;
begin
if aktiv then
aus;
inherited Destroy;
end;
procedure TRechtschreib.aus;
begin
aktiv := false;
wrd.Quit;
end;
function TRechtschreib.testen(wort: string; sgg: TStrings): Boolean;
var
x: Integer;
begin
Result := false;
if aktiv then
begin
if wrd.CheckSpelling(wort) then
Result := true
else
begin
sgg.Clear;
ov := wrd.GetSpellingSuggestions(wort);
for x := 1 to ov.count do
sgg.Add(ov.item(x));
ov := VarNull;
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute then
RichEdit1.Lines.LoadFromFile(OpenDialog1.Filename);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
RST := TRechtschreib.Create;
Button2.Caption := '&Öffnen';
Button1.Caption := '&Prüfen';
Button1.visible := aktiv;
if not aktiv then
Label1.Caption := rp + 'nicht möglich'
else
Label1.Caption := '';
iglist := TStringlist.Create;
iglist.Sorted := true;
iglist.Duplicates := dupignore;
OpenDialog1.Filter := 'Textdateien|*.txt';
end;
function TForm1.prf(s: string; ts: TStrings): Boolean;
begin
Result := RST.testen(s, ts);
if not Result and (ts.text = '') then
begin
Form2.Button2.enabled := false;
ts.Add(lr);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(RST);
FreeAndNil(iglist);
end;
function TForm1.nexttrenner(RE: TRichEdit; out wrt: String): Boolean;
var
i: Integer;
begin
wrt := '';
Result := false;
if P^ = #0 then
exit;
i := 0;
while not(charinset(P^, bstn)) do
begin
if P^ <> #$D then
inc(i);
inc(P);
end;
RE.selstart := RE.selstart + i;
M := P;
repeat
if charinset(P^, bstn) then
inc(P)
else
break;
until false;
RE.sellength := P - M;
wrt := RE.seltext;
Result := wrt <> '';
end;
procedure TForm1.pruef(RE: TRichEdit);
var
mrk: Boolean;
pf, s: String;
ss, i, str: Integer;
begin
s := 'beendet';
if RE.text = '' then
begin
showmessage(rp + s);
exit;
end;
screen.cursor := crhourglass;
str := RE.selstart;
RE.selstart := 0;
P := @RE.text[1];
M := P;
mrk := RE.hideselection;
RE.hideselection := false;
allignore := false;
while nexttrenner(RE, pf) do
begin
ss := RE.selstart;
if length(pf) > 1 then
begin
i := iglist.indexof(pf);
if not((allignore and (i >= 0)) or prf(pf, Form2.ListBox1.Items)) then
begin
Form2.edit1.text := pf;
Form2.showmodal;
case Form2.modalresult of
mrOk:
begin
if Form2.edit1.text <> pf then
pf := Form2.edit1.text
else
pf := Form2.ListBox1.Items[Form2.ListBox1.itemindex];
RE.Perform(EM_REPLACESEL, 1, Integer(PChar(pf)));
end;
mrignore, mrall:
begin
if Form2.modalresult = mrall then
begin
allignore := true;
iglist.Add(pf);
end;
RE.selstart := ss + length(pf);
continue;
end;
else
begin
s := 'abgebrochen';
break;
end;
end;
end;
end;
RE.selstart := ss + length(pf);
end;
RE.selstart := str;
RE.sellength := 0;
screen.cursor := crdefault;
RE.Setfocus;
iglist.Clear;
showmessage(rp + s);
RE.hideselection := mrk;
end;
// --- Aufruf ---
procedure TForm1.Button1Click(Sender: TObject);
begin
pruef(RichEdit1);
end;
end.
|
