[Asira]

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63

{$APPTYPE CONSOLE}   uses   SysUtils;   var str, slovo: string;        ks, ns, i, j: integer;        sb,mn1, mn2, mn3, mn4: set of char;        c, a: char;   begin    mn1:=[]; mn2:=[]; mn4:=[];    sb:=['b','d','g','j','n','m','r','v','z','w'];    readln (str);    i:=1;    while i<=length (str) do      begin         while (str[i]=' ')         //and (i<=length (str))         do i:=i+1;         ns:=i;         while (str[i]<>' ')         //and (i<=length (str))          do i:=i+1;         ks:=i;         slovo:= copy(str, ns, ks-ns);         for j:=1 to length(slovo) do mn1:=[slovo[j]];         mn4:=sb -mn1;           for c:=chr(0) to chr (255) do    if c in mn4 then write (c,' ');  writeln(' ');         end; begin i:=length(str);; while (str[i]=' ')  ///and (i<=length (str))   do i:=i-1;         ks:=i;         while (str[i]<>' ')         //and (i<=length (str))          do i:=i-1;         ns:=i;         slovo:= copy(str, ns, ks-ns); for j:=1 to length (slovo) do mn3:=[slovo[j]];        mn1:=[]; mn1:=mn4 - mn3;   for c:=chr(0) to chr (255) do    if c in mn4 then write (c,' ') end; while i<=length (str) do begin       while (str[i]=' ') and (i<=length (str)) do i:=i+1;         ns:=i;         while (str[i]<>' ') and (i<=length (str)) do i:=i+1;         ks:=i;         slovo:= copy(str, ns, ks-ns); for j:=1 to length(slovo) do mn2:=mn2+[slovo[j]]; mn3:=mn2*mn1; for c:=chr(0) to chr (255) do    if c in mn3 then write (c,' ');    writeln(' ');    readln;    end; end.

[Asinkrit]

Я же тебе уже давал код для решения этой задачи?

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34

{$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]

Мне сказали надо первое и последнее слово запихать во множество а потом работать со множествами без строк

[Asinkrit]

Держи)

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43

{$APPTYPE CONSOLE}   uses   SysUtils;   var   S:String;   b:byte;   sb, nsb, rsb: set of char;   zBegin, zEnd:Byte;   c:char;   begin   Writeln('Enter string ');   Readln(S);   sb:=['b','d','g','j','n','m','r','v','z','w']; //символы которые ищем   nsb:=[];  //символы которые в первом и последнем слове   rsb:=[];  //символы которые будем выводить на экран   //сначала пробежимся по первому и последнему слову, и соберем nsb   zBegin:=Pos(' ', S);   for b:=1 to zBegin do     if S[b] in sb then       nsb:=nsb+[S[b]];   b:=length(s);   while (b > 1) and (S[b]<>' ') do     begin     if S[b] in sb then       nsb:=nsb+[S[b]];     Dec(b);     end;   zEnd:=(b+1);   //теперь пробежимся по остальным словам и соберем rsb   for b:=zBegin to zEnd do     if (S[b] in sb) then       rsb:=rsb+[S[b]];   //вычтем из rsb символы nsb   rsb:=rsb-nsb;   //и выведем результат   for c:=chr(0) to chr (255) do     if c in rsb then       write(c,' ');   readln; end.

[Asira]

Спасибо!..............