Разбиение текста на слова и получение количества слов в тексте
Автор: 777
WEB-сайт: http://delphibase.endimus.com
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Разбиение текста на слова + получение количества слов в тексте
T : Собственно строка, которая будет разбиваться на слова
Mode: Режим, может быть
0: получение английских и русских слов
1: только русских
2: только английских
List: Здесь хранятся найденые слова (по умолчанию = nil)
возвращаемое значение: количество слов.
P/S
По идейным соображениям специальные символы, цифры
и пробелы игнорируются.
Зависимости: Windows, Classes
Автор: 777, nix@rbcmail.ru, Архангельск
Copyright: 777
Дата: 15 июня 2002 г.
***************************************************** }
function StringToWords(T: string; Mode: Short; List: Tstrings = nil): integer;
var
i, z: integer;
s: string;
c: Char;
procedure Check;
begin
if (s > '') and (List <> nil) then
begin
List.Add(S);
z := z + 1;
end;
s := '';
end;
begin
i := 0;
z := 0;
s := '';
if t > '' then
begin
while i <= Length(t) + 1 do
begin
c := t[i];
case Mode of
0: {русские и английские слова}
if (c in ['a'..'z']) or (c in ['A'..'Z']) or (c in ['а'..'я']) or
(c in ['А'..'Я']) and (c <> ' ') then
s := s + c
else
Check;
1: {только русские слова}
if (c in ['а'..'я']) or (c in ['А'..'Я']) and (c <> ' ') then
s := s + c
else
Check;
2: {только английские слова}
if (c in ['a'..'z']) or (c in ['A'..'Z']) and (c <> ' ') then
s := s + c
else
check;
end;
i := i + 1;
end;
end;
result := z;
end;
Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
var
Source, Dest: Tstrings;
i: integer;
begin
Source := TstringList.Create;
Dest := TstringList.Create;
Source.LoadFromFile('c:\MyText.txt');
for i := 0 to Source.Count - 1 do
begin
StringToWords(Source[i], 2, Dest);
Application.ProcessMessages;
end;
Dest.SaveToFile('c:\MyWords.txt');
ShowMessage('Найдено ' + IntToStr(Dest.Count) + ' слов');
end;
|