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 Count;
var   i, anzahl_saetze, anzahl_woerter: integer;
      text: string;
begin
 anzahl_saetze := 0;
 anzahl_woerter := 1;

 for i := 0 to Form1.richedit.GetTextLen-1 do
  begin
    text := copy(Form1.richedit.Text,i+1,1);
    if (text = '.') or (text = '?') or (text = '!') then
     begin
       inc(anzahl_saetze); // erhöhre anzahl_saetze um eins
       continue; // setze den schleifendurchlauf fort
     end else
       if (text = ' ') then // falls ein leerzeichen enthalten ist
       if ((copy(Form1.RichEdit.Text,i+2,1) <> ' ')) then // und das drauffolgende keines ist
      begin
        inc(anzahl_woerter); // erhöhe anzahl_woerter
        continue; // setze den schleifendurchlauf fort
      end else // ansonsten
       continue; // setze nur den schleifendurchlauf fort 
    end;

   Form1.Label1.Caption := IntToStr(anzahl_saetze);
   Form1.Label2.Caption := IntToStr(anzahl_woerter);

end;


procedure TForm1.Button1Click(Sender: TObject);
var id: DWord;
begin
 CreateThread(nil,0,@Count,nil,0,id); // thread für die procedure, damit das programm nicht gefriert
end;					

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

  
procedure CountWordsAndSentences (Const aText : String; Var SentenceCount, WordCount : Integer);
Const
  SentenceDelimiter = ['.','!','?'];
  WordDelimiter = [' ',#13,#10,','];

var   
  i,l,i0,j0 : integer;
  
begin
  SentenceCount := 0;
  WordCount := 0;
  i0 := i;
  j0 := 1;
  For i:=1 to Length (aText) Do Begin
    if aText[i] in SentenceDelimiter Then Begin
      if i-i0>2 then inc (SentenceCount);
      i0 := i;
    End
    else if aText[i] in WordDelimiter Then Begin
      If i-j0>2 Then inc (WordCount);
      j0 := i;
      End;
End;