1:
2:

inc(i);
 ch:=txt[i];					

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:

function KleinInGross(c:char):char;
begin
  case c of
  'ä': KleinInGross:='Ä';
  'ö': KleinInGross:='Ö';
  'ü': KleinInGross:='Ü';
  else
  KleinInGross:=Upcase(c)
  end;
end;


procedure TForm1.Memo1Change(Sender: TObject);
var i,anz_worte:integer;
    txt, wort:string;
    ch:char;
const buchstaben=['A'..'Z'];

begin
  anz_worte:=0;
  txt:=Memo1.text;
  for i:=1 to Memo1.lines.count-1 do
  begin
    txt:=trim(Memo1.lines[i]);
    if txt<>'' then
    begin
      i:=1;   // hier meckert er rum
      ch:=txt[i];
      while i<= length(txt) do
      if KleinInGross(ch) in buchstaben
      then begin
      inc(anz_worte);
      while KleinInGross(ch) in buchstaben do
      begin
        wort:=wort+ch;
        inc(i);
        ch:=txt[i];
      end;
      end;
    end;
  end;
l_worte.caption:=IntToStr(anz_worte);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:

Function Wordcount(s:string):integer;
const wDelimiter = [' ',':','.',',','!','?','-',#$D,#$A,#9]; // kann noch ergänzt werden
var run,len:integer;
begin
  run := 1;
  result := 0;
  len := length(s);
  repeat
    while s[run] in wDelimiter do inc(run);
    if run>len then exit;
    inc(result);
    While not (s[run] in wDelimiter) do inc(run);
  until run>len;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

if txt<>'' then
    begin
      k:=1;
      ch:=txt[k];
      while k<= length(txt) do
      if KleinInGross(ch) in buchstaben
      then begin
        inc(anz_worte);
        while KleinInGross(ch) in buchstaben do
        begin
          wort:=wort+ch;
          inc(k);
          ch:=txt[k];
        end;
      end;
    end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:

Function Wordcount(s:string):integer;
const validChars = ['a'..'z','A'..'Z','0'..'9','ä','ü','ö','Ä','Ü','Ö'];
var run,len:integer;
begin
  run := 1;
  result := 0;
  len := length(s);
  repeat
    while (run<=len) and not (s[run] in validChars) do inc(run);
    if run>len then exit;
    inc(result);
    While (run<=len) and (s[run] in validChars) do inc(run);
  until run>len;
end;					

1:

if txt<>'' then					

1:

      k:=1;					

1:

      ch:=txt[k];					

1:

      while k<= length(txt) do					

1:

      if KleinInGross(ch) in buchstaben					

1:
2:

      then begin
        inc(anz_worte);					

1:
2:

        while KleinInGross(ch) in buchstaben do
        begin					

1:

          wort:=wort+ch;					

1:
2:

          inc(k);
          ch:=txt[k];					

1:

if KleinInGross(ch) in buchstaben					

1:
2:
3:
4:

if KleinInGross(ch) in buchstaben
then begin
{...}
end else inc(k);					

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:

procedure TForm1.Memo1Change(Sender: TObject);
var i, k, anz_worte : Integer;
    txt, wort:string;
    ch:char;
const buchstaben=['A'..'Z'];

begin
  anz_worte:=0;
  txt:=Memo1.text;
  for i:=0 to Memo1.lines.count-1 do
  begin
    txt:=trim(Memo1.lines[i]);
    if txt<>'' then
    begin
      k:=1;
      ch:=txt[k];
      while k<= length(txt) do
      if KleinInGross(ch) in buchstaben
      then begin
        inc(anz_worte);
        while KleinInGross(ch) in buchstaben do
        begin
          wort:=wort+ch;
          inc(k);
          ch:=txt[k];
        end;
      end else //<--
      begin //<--
        inc(k); //<--
        if k <=length(txt) then ch:=txt[k]; //<--
      end; //<--
    end;
  end;
l_worte.caption:=IntToStr(anz_worte);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:

const
  gcWordDelims     = [#1..#47,#58..#64,#91..#96,#123..#126]-['`'];

function TStringManager.ExtractWords(const s : String; const aList : TStrings = nil; const Delims : TCharSet = gcWordDelims) : TStrings;
var  i : Integer;
     j : Integer;
  SLen : Integer;
begin
  if aList=nil
    then Result := TStringList.Create
    else Result := aList;
  SLen := Length(s);
  i := 1;
  while i<=SLen do
  begin
    while (i<=SLen) and (s[i] in Delims) do Inc(i);
    j := i;
    while (i<=SLen) and (not (s[i] in Delims)) do Inc(i);
    if i-j>0 then Result.Add(System.Copy(s, j, i-j));
  end;
end;