Задача на множества, Можете сказать в чем я ошибся, программа не выводит целевые значения.. Опции

[KenShi]

Program Mnojestva;
Uses crt;
Type txt=array[1..100] of string;
Procedure slovo(x:string; var a:txt; var num:integer);

var p,b:integer;
begin
num:=0;
p:=1;
while p<=length(x) do begin
while (p<=length(x)) and (x[p]=',') do p:=p+1;
if (p<=length(x)) and (x[p]<>'.') then
begin
b:=p;
while (p<=length(x)) and (x[p]<>',') and (x[p]<>'.') do p:=p+1;
if (p-b>0) then begin
num:=num+1;
a[num]:=copy(x,b,p-b);end; end; end; end;
type charset=set of char;var z,z1,z2,z3:charset;
    str, str1: string;{}
    i, j, k: integer;
    a:txt;
    c:char;
begin
clrscr;
    z:=['б','в','г','д','ж','з','л','м','­н','р'];
    z1:=[];
    z2:=[];
writeln('введите строку, разделяя слова запятыми, в конце поставить точку');
read(str);
slovo(str, a, i);
for j:=1 to i do write(a[j],' ');
str1:=a[1];
for k:=1 to length(str1) do
if str1[k] in Z then Z1:=Z1+[str1[k]];
for j:=2 to i do
begin
str1:=a[j];
	if (str1[k] in Z) and (str1[k] in Z1) then z2:=z2+[str1[k]];
	z1:=z1+[str1[k]];
end;
writeln;
write('z2: ');
for c:='а' to 'я' do
if c in z2 then write(c,' ');writeln;
readkey;
end.

М

Тэги не забываем!

________________________________________________________________________________
_______________

Цель программы:
Напечатать в алфавитном порядке все звонкие согласные буквы, которые входят более чем в одно слово, используя стандартные процедуры и функции обработки множества

P.s. заранее спасибо

[Lapp]

Ты ошибся (помимо ошибки в процедуре Slovo) в том, что сравниваешь только с первым словом. Надо в цикле пройтись по всем словамю Примерно так:

Program Mnojestva;
Uses crt;
Type
  txt=array[1..100] of string;

Procedure slovo(x:string; var a:txt; var num:integer);
var
  p,b:integer;
begin
  num:=0;
  p:=1;
  while p<=length(x) do begin
    while (p<=length(x)) and (x[p] in[',','.']) do p:=p+1;
    if (p<=length(x)) and (x[p]<>'.') then begin
      b:=p;
      while (p<=length(x)) and (x[p]<>',') and (x[p]<>'.') do p:=p+1;
      if (p-b>0) then begin
        num:=num+1;
        a[num]:=copy(x,b,p-b);
      end;
    end;
  end;
end;

type
  charset=set of char;
var
  z,z1,z2:charset;
  s: string;{}
  i, j, k, n: integer;
  a:txt;
  c:char;
begin
  clrscr;
  z:=['б','в','г','д','ж','з','л','м','н','р'];
  writeln('введите строку, разделяя слова запятыми, в конце поставить точку');
  readLn(s);
  {s:='бвг,вгд,дзж';}
  slovo(s, a, n);
  for j:=1 to n do write(a[j],' ');
  z2:=[];
  for i:=1 to n do begin
    z1:=[];
    for j:=1 to length(a[i]) do if a[i][j] in z then z1:=z1+[a[i][j]];
    for k:=1 to n do if k<>i then begin
      for j:=1 to Length(a[k]) do if (a[k][j] in z)and(a[k][j] in Z1) then z2:=z2+[a[k][j]];
    end
  end;
  writeln;
  write('z2: ');
  for c:='а' to 'я' do if c in z2 then write(c,' ');
  writeln;
  readkey;
end.

А вообще, решать нужно, конечно, не так..
И, будь добр, обрати внимание на правильное форматирование (на примере исправленного кода).