Как Программно Посчитать Количество Слов В Тексте.

[Sascha]

Приведу маленький пример как программно посчитать количество слов в тексте.
Кидаем на форму Memo,Button,Label


Далее создадим функцию по подсчету слов :

function CountWords(InputString: string): integer;
var
  aChar: char;
  WordCount: integer;
  IsWord: boolean;
  i: integer;
begin
  WordCount := 0;
  IsWord := False;
  for i := 0 to Length(InputString) do
  begin
    aChar := InputString[i];
    if (aChar in [
      'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's',
        't', 'u', 'v', 'w', 'x', 'y', 'z',
        'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S',
        'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
        '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '''', '-'
        ]) then
    begin
      if not IsWord then Inc(WordCount);
      IsWord := True;
    end
    else if aChar = '\' then IsWord := True
    else IsWord := False

  end;

  IsWord := False;
  Result := WordCount;
end;

Далее нажимаем на Button и вписываем код

Label1.Caption := IntToStr(CountWords(Memo1.Text));

вписываем или загружаем текст и считаем только латинские слова

Не забываем ставить лаки!drink

 

[Lomanu4]

С этой функцией можно сделать так же подсчет слов в тексте или знаков,спасибо очень полезно.

 

[Sascha]

Ищё один код только для консоли, подсчитать количество слов.

[HIDE=10]

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
   SysUtils;

var
i,n,count:integer;
t:string;
p:boolean=false;

function Rus(mes:string):string;   <--- Можно создавать для любого языка в данный момент это Русский
  var
     i:integer;
begin
   for i:=1 to length(mes) do
     case mes[i] of
     'А'..'п': mes[i]:=Chr(Ord(mes[i])-64);         <--- Меняем алфавит языка 
       'р'..'я': mes[i]:=Chr(Ord(mes[i])-16);       <---- продолжение
     end;
   Rus:=mes;
end;
begin
  writeln(rus('Введите текст '));readln(t);
n:=length(t);

if (n>0) then begin
count:=1;
for i:=1 to n-1 do begin
  if ((t[i]=' ') or (t[i]='.') or (t[i]=',')) and (not p) then
   begin
    inc(count);
    p:=true;
   end
    else
   if (t[i]<>' ') and (t[i]<>'.') and (t[i]<>',') then
     p:=false;
end;
end
else count:=0;
if (t[n]=' ') or (t[n]=',') then
  count:=1;
write(count);
readln;

end.

[/HIDE]