Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  4 853

•  TDictionary Custom Sort  6 832

•  Fast Watermark Sources  6 614

•  3D Designer  9 578

•  Sik Screen Capture  6 957

•  Patch Maker  7 400

•  Айболит (remote control)  7 347

•  ListBox Drag & Drop  6 206

•  Доска для игры Реверси  98 255

•  Графические эффекты  7 522

•  Рисование по маске  6 804

•  Перетаскивание изображений  5 656

•  Canvas Drawing  6 038

•  Рисование Луны  5 832

•  Поворот изображения  5 281

•  Рисование стержней  3 870

•  Paint on Shape  3 024

•  Генератор кроссвордов  3 983

•  Головоломка Paletto  3 157

•  Теорема Монжа об окружностях  3 998

•  Пазл Numbrix  2 637

•  Заборы и коммивояжеры  3 453

•  Игра HIP  2 367

•  Игра Go (Го)  2 285

•  Симулятор лифта  2 680

•  Программа укладки плитки  2 244

•  Генератор лабиринта  2 801

•  Проверка числового ввода  2 403

•  HEX View  2 746

•  Физический маятник  2 435

 
скрыть

Разбиение текста на слова и получение количества слов в тексте



Автор: 777

{ **** 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;