[NeField]

Условие: Текст дан. Выведите в алфавитном порядке все глухие согласные буквы, не входящие только в одно слово;
Проблема: Должен выводить повторяющиеся буквы в алфавитном порядке, но выводит только одну букву, ближайшую к концу алфавита

Код:

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

procedure TForm1.Button1Click(Sender: TObject);     const     gl=['к','п','с','т','ф','х','ц','ч','ш','щ'];     bk:string='кпстфхцчшщ';     type mnoz=set of char;     var  s,s1:string;      m:array[1..100] of mnoz;      mn,mn1:mnoz;      n,i,j:byte;      word: ShortString;    begin     s := LowerCase(Memo1.Text);     s:=s+' ';     n:=0;     while pos(' ',s)>0 do    begin      s1:=copy(s,1,pos(' ',s)-1);      n:=n+1;      m[n]:=[];     for j:=1 to length(s1) do     if s1[j] in gl then m[n]:=m[n]+[s1[j]];     delete(s,1,pos(' ',s));    end;   mn1:=[];   for i:=1 to n do    begin     mn:=[];     for j:=1 to n do     if j<>i then mn:=mn+m[j];     mn1:=mn1+(m[i]*mn);     end;    if mn1=[] then    Memo2.Lines[0] := 'Букв, которые не входят только в одно слово, нет!';     begin      for i:=1 to length(bk) do      if (bk[i] in mn1) then      word := bk[i] + ' ';     end;     Memo2.Text := word;  end;

[lmikle]

Line 37 должна быть:

Код:

1	word := word + bk[i] + ' ';

PS. Лучше не использовать 'word' как имя переменной, т.к. есть такой тип данных.

PPS. Более простой способ деления текста на слова (по пробелу):

Код:

1 2 3 4 5 6 7 8 9 10 11

var   sl : TStringList; begin   sl := TStringList.Create;   Try     sl.Delimiter := ' ';     sl.Delimitedtext := Memo1.Lines.Text;     ...   Finally     sl.Free;   End;

В результате у тебя есть переменная sl - список слов (фактически, массив), доступ к элементам через sl[i]:

Код:

1 2	for I := 0 To sl.count-1 Do   ShowMessage(sl[i]);

[lmikle]

Вообще, все можно сделать проще:

Код:

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

procedure TForm1.Button1Click(Sender: TObject); const   Leters=['к','п','с','т','ф','х','ц','ч','ш','щ']; var   Out : String;   sl : TStringList;   I, J : Integer;   Cnt : Integer; begin   Out := '';   sl := TStringList.Create;   Try     sl.Delimiter := ' ';     sl.Delimitedtext := AnsiLowerCase(Memo1.Lines.Text);       For I := Low(Letters) To High(Letters) Do       Begin         Cnt := 0;         For J := 0 To sl.Count-1 Do           If Pos(Letters[i],sl[J]) > 0 Then Inc(Cnt)         If (Cnt > 0) and (Cnt = sl.Count-1)           Then Out := Out + Letters[i] + ' ';       End;   Finally     sl.Free;   End;    If Out = ''     Then Memo2.Lines.Text := 'Букв, которые не входят только в одно слово, нет!'     Else Memo2.Lines.Text := Out; end;

Как-то так. Должно работать.