1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169:
| unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm) Edit1: TEdit; Button1: TButton; Edit2: TEdit; Label1: TLabel; Label2: TLabel; procedure splitt(zeichenkette: string; leerzeichen: char; sList: TStringList); procedure Button1Click(Sender: TObject); function addingchar(s: string; pos: Integer; chr: string): String; procedure FormCreate(Sender: TObject); private public end;
var Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.splitt(zeichenkette: string; leerzeichen: char; sList: TStringList); var s, r: string; i, x, j, k: integer; arr: array[0..200] of string; begin s := zeichenkette; i := 0; sList.Clear; repeat j := Pos(leerzeichen, s); if j > 0 then begin r := copy(s, 1, j - 1); arr[i] := r; inc(i); delete(s, 1, j);
end else break; until j = 0; if length(s) > 0 then begin arr[i] := s; for k := 0 to i do slIst.Add(arr[k]); end end;
procedure TForm1.Button1Click(Sender: TObject); var x, y,z,starting,ending,fehlerzahl,counting,fehlerwoerter,plusending,pleis: Integer; selectedtext, eingabetext, editgames,unterstreichenen: string; okaystringboolean: array of Boolean; inputtext, outputtext,unterstreichen,spleil: TStringList; begin inputtext := TStringList.Create; outputtext := TStringList.Create; unterstreichen := TStringList.Create; spleil := TStringList.Create; try eingabetext := Edit1.Text; splitt(Edit2.Text, ' ', inputtext); selectedtext := Edit2.Text; setlength(okaystringboolean, length(selectedtext)); fehlerzahl:=0; fehlerwoerter:=0; for x := 1 to length(selectedtext) do okaystringboolean[x] := selectedtext[x] = eingabetext[x]; starting:=1; counting:=1; plusending:=0; pleis:=0; for x := 1 to length(selectedtext) do begin if (selectedtext[x] = eingabetext[x]) and (selectedtext[x+1] <> eingabetext[x+1]) and (selectedtext[x+2] <> eingabetext[x+2]) and (selectedtext[x+1] = eingabetext[x+2]) then begin delete(eingabetext,x+1,1); inc(fehlerzahl); inc(plusending); inc(plusending); inc(pleis); end; if (selectedtext[x] = eingabetext[x]) and (selectedtext[x + 2] = eingabetext[x + 1]) and (eingabetext[x + 1]<>#0) then begin eingabetext := addingchar(eingabetext, x + 1, selectedtext[x + 1]); inc(fehlerzahl); inc(pleis); end; if (okaystringboolean[x - 1]) and (okaystringboolean[x + 1]) and (okaystringboolean[x] = False) then begin eingabetext[x] := selectedtext[x]; inc(fehlerzahl); end; if (okaystringboolean[x] <> True) and (selectedtext[x] = eingabetext[x + 1]) then begin delete(eingabetext, x, 1); inc(fehlerzahl); end; splitt(eingabetext, ' ', outputtext); if (outputtext.Count>fehlerwoerter) and (inputtext.Count>fehlerwoerter) then if (outputtext.Strings[fehlerwoerter]=inputtext.Strings[fehlerwoerter]) and (fehlerzahl>0) then begin fehlerzahl:=0; inc(counting); ending:=x+plusending+pleis; unterstreichen.Add(inttostr(starting)+'|'+inttostr(ending)); starting:=ending+1-pleis; inc(fehlerwoerter); pleis:=0; end; Label1.Caption := eingabetext; Label1.Caption := Label1.Caption+'Es wurden '+inttostr(fehlerwoerter)+' Fehlerhafte Wörter entdeckt'; end; unterstreichenen := Edit1.Text; For y:=unterstreichen.Count-1 downto 0 do begin splitt(unterstreichen.Strings[y],'|',spleil); unterstreichenen:=addingchar(unterstreichenen,strtoint(spleil.Strings[1]),'</u>'); Label2.Caption:=unterstreichenen; Application.ProcessMessages; unterstreichenen:=addingchar(unterstreichenen,strtoint(spleil.Strings[0]),'<u>'); Label2.Caption:=unterstreichenen; Application.ProcessMessages; end; splitt(eingabetext, ' ', inputtext); for y := 0 to inputtext.Count - 1 do begin end; finally inputtext.free; outputtext.Free; unterstreichen.free; spleil.free; end; end;
function TFOrm1.addingchar(s: string; pos: Integer; chr: string): String; var x: Integer; sct: string; begin for x := 1 to length(s) do begin sct := sct + s[x]; if x = pos-1 then sct := sct + chr; end; Result := sct; end;
procedure TForm1.FormCreate(Sender: TObject); begin Edit1.Text:='H ll o ih bin da.'; Edit2.Text:='Hallo ich bin da.'; end;
end. |