Показать сообщение отдельно
  #4  
Старый 30.12.2009, 18:09
Asinkrit Asinkrit вне форума
Местный
 
Регистрация: 29.10.2009
Сообщения: 446
Репутация: 271
По умолчанию

Держи)
Написал с функциями, для более простого понимания, можешь их объеденить в один алгоритм, если потребуется.

Код:
{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes;

type
  TSetChar = Set of char;

function WordIsHaveChars(const aWord:String; const aChars:TSetChar):boolean;
//возвращает истину, если в слове есть хотя бы один символ из множества
var
  b:byte;
begin
  Result:=false;
  if Length(aWord) > 0 then
    for b:=1 to Length(aWord) do
      if aWord[b] in aChars then
        begin
        Result:=false;
        exit;
        end;
end;

function WordGetHaveChars(const aWord:String; const aChars:TSetChar):TSetChar;
//возвращает символы, которые встречаются и в слове и во множестве
var
  b:byte;
begin
  Result:=[];
  if Length(aWord) > 0 then
    for b:=1 to Length(aWord) do
      if aWord[b] in aChars then
        Result:=Result+[aWord[b]];
end;

var
  Str, tmpStr:String;
  i:integer;
  ResChars:TSetChar;
  c:char;

begin
  Write('Enter string:');
  Readln(Str);
  tmpStr:='';
  ResChars:=[];
  //парсим строку на слова, попутно прогоняя их через функции
  if Length(Str) > 0 then
    for i:=1 to Length(Str)+1 do
      if (Str[i] <> #32) and (i <= Length(Str)) then tmpStr:=tmpStr+Str[i]
        else
          if Length(tmpStr) > 0 then
            begin
            if not WordIsHaveChars(tmpStr,['b','d','g','j','n','m','r','v','z','w']) then
              ResChars:=ResChars+WordGetHaveChars(tmpStr,['c','f','h','k','l','q','p','s','t','x']);
            tmpStr:='';
            end;
  //выводим результат
  for c:=chr(0) to chr (255) do
    if c in ResChars then
      write(c,' ');
  Readln;
end.
Ответить с цитированием