[Asira]

Код:

{$APPTYPE CONSOLE}
    uses
  SysUtils;

var s,slovo,slovo1,slovo2:string;
  k,i,j,ns,ks:integer;
   c:char;
  mn1, mn2,mn3,sb: set of char;
begin
writeln('Enter string ');
readln(s);
sb:=['b','d','g','j','n','m','r','v','z','w'];
while (s[i]=' ') and (i<=length(s)) do
i:=i+1;
while(s[i]<>' ') and (i<=length(s)) do i:=i+1;
begin
mn1:= mn1 +[s[i]];
i:=i+1;
end;
i:=length(s);
while(s[i]=' ') and (i>0) do i:=i-1;
while(s[i]<>' ') and(i>0) do i:=i-1;
begin
mn2:=mn2+[s[i]];
i:=i-1;
end;
while i<=k do
begin
while(s[i]=' ') and (i<=k)do i:=i+1;
ns:=i;
while(s[i]<>' ') and (i<=k) do i:=i+1;
ks:=i;
slovo:=copy(s,ns,ks-ns);
for j:=1 to length(slovo) do
mn3:=mn3 +[slovo[i]];
end;
mn3:=mn3*sb -mn2 -mn1;

for c:=chr(0) to chr(255) do
if c in mn3 then write(c,' ');
readln;
end.

Тут вообще есть хоть что то правильное???

[Asinkrit]

На счет правильности не знаю, вот тебе рабочий вариант:

Код:

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  S:String;
  b:byte;
  sb: set of char;

begin
  Writeln('Enter string ');
  Readln(S);
  sb:=['b','d','g','j','n','m','r','v','z','w'];
  Delete(S, 1, Pos(' ', S));
  b:=length(s);
  while (b > 1) and (S[b]<>' ') do Dec(b);
  Delete(S, b, Length(S)-(b+1));
  for b:=1 to Length(S) do
    if S[b] in sb then
      begin
      sb:=sb-[S[b]];
      write(S[b],' ');
      end;
  readln;
end.

[Asira]

СПАСИБИЩЕ!!!!!!!!!!!!!!!Хоть один отзывчивый человек тут нашёлся!!!!!

[Asinkrit]

Да не за что, главное, что бы было понимание, как этот код работает!)

[Asira]

хотя вроде бы эта программа тож не удовлетворяет условию-
за исключением тех, которые входят в первое и последнее слово

[Asinkrit]

Ну дык, первое и последнее слова, сразу отбрасываются.

Код:

  Delete(S, 1, Pos(' ', S));
  b:=length(s);
  while (b > 1) and (S[b]<>' ') do Dec(b);
  Delete(S, b, Length(S)-(b+1));

[Asira]

А вдруг эти согласные звонкие встречаются и в первом слове например а прога их выведет хотя не должна этого делать....

[Asira]

Например есть строка
drecgre cghkjfjkld crtuifh drefjtg
прога выведет d ...... хотя не должна этого делать ведь d есть и в первом слове помимо второго

[Asinkrit]

Не выведет, так как эти слова - именно первое и последнее отбрасываются, а после проверятся вся строка. Внимательнее смотри, код работает по твоим условиям.
Удаляем все до первого пробела:

Код:

  Delete(S, 1, Pos(' ', S));

Удаляем все после последнего пробела:

Код:

  b:=length(s);
  while (b > 1) and (S[b]<>' ') do Dec(b);
  Delete(S, b, Length(S)-(b+1));

В S - остается строка без первого и последнего слова, и с ней мы уже начинаем работать.

[Asinkrit]

Понял что ты имеешь ввиду, держи:

Код:

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  S, NewS:String;
  b:byte;
  sb: set of char;

begin
  Writeln('Enter string ');
  Readln(S);
  sb:=['b','d','g','j','n','m','r','v','z','w'];
  for b:=1 to Pos(' ', S) do
    if S[b] in sb then
      sb:=sb-[S[b]];
  Delete(S, 1, Pos(' ', S));
  b:=length(s);
  while (b > 1) and (S[b]<>' ') do
    begin
    if S[b] in sb then
      sb:=sb-[S[b]];
    Dec(b); 
    end;
  Delete(S, b, Length(S)-(b+1));
  for b:=1 to Length(S) do
    if S[b] in sb then
      begin
      sb:=sb-[S[b]];
      write(S[b],' ');
      end;
  readln;
end.

[Asira]

Спасибо!!!!!!!!!!!! Вот теперя всё тип-топ!!!!!!!!!