Задача на множества

program lab_1;
uses crt;
Type
    mnog = set of char;
var
   power, : byte;
   elem, R: mnog;
   A: set of 'a'..'z';
begin
     ClrScr;
{задаем мощность множества:}
     Write ('ведите можность множества А: '  );
     Readln (power);
     writeln ('Множество А содержит ' , power, ' элемента' );
     write ('Введите ' , power, ' элемента множества через пробел: ');
     R:=[];
{вводим элементы множества:}
        for i:= 1 to power do
        begin
             writeln ('Введите ',i,'-тый элемент множества');
             readln ([i]);
 
   
end.

Write(Cell[(m[i,j] and m[j,i])]:W)

{вывод пар множества}
procedure mWritePairs(const m: TMatrix; n: Integer);
var k: Integer;
begin
  k:=0;
  for i:=1 to n do for j:=1 to n do if m[i,j] then begin
    Inc(k); WriteLn(k,'-(',Chr(i+Ord('A')-1),' ',Chr(j+Ord('A')-1),')');
  end;
end;

procedure WriteRow(r: Integer; cl: Byte);
var j: Integer;
begin
  GotoXY(BaseX,BaseY+r); TextAttr:=cl; Write(Chr(r+Ord('A')-1):W); { !! }
  for j:=1 to ac-1 do Write(Cell[m[r,j]]:W);
  TextAttr:=Clr[True]; Write(Cell[m[r,ac]]:W); TextAttr:=cl;
  for j:=ac+1 to n do Write(Cell[m[r,j]]:W);
  ToActive;
end;
 
procedure WriteCol(c: Integer; cl: Byte);
var i, x: Integer;
begin
  x:=BaseX+c*W; GotoXY(x,BaseY); TextAttr:=cl; Write(Chr(c+Ord('A')-1):W);  { !! }
  for i:=1 to n do begin
    GotoXY(x,BaseY+i);
    if i<>ar then
      Write(Cell[m[i,c]]:W)
    else begin
      TextAttr:=Clr[True]; Write(Cell[m[i,c]]:W); TextAttr:=cl;
    end;
  end;
  ToActive;
end;
 
procedure WriteAll;
var i, j: Integer;
begin
  TextAttr:=Clr[False]; ClrScr; Write('':W);
  for j:=1 to n do begin TextAttr:=Clr[j=ac]; Write(Chr(j+Ord('A')-1):W); end;  { !! }
  for i:=1 to n do WriteRow(i,Clr[i=ar]);
end;

Write('Вершина ',(chr(i+Ord('A')-1)),' и ',(chr(j+Ord('A')-1)),' связана?: ' );

begin
     FillChar(m,SizeOf(m),#0);
     repeat
           Write('Мощность множества  [2..',nMax,']: '); Read(n);
     until n in [2..nMax];
     Writeln('Определим связные вершины (1-да, 0-нет) : ');
        for i:=1 to n do
        for j:=i+1 to n do
            begin
            repeat
            Write('Вершина ',(chr(i+Ord('A')-1)),' и ',(chr(j+Ord('A')-1)),' связана?: ' );
                  Readln(t); until t in ['0','1'];
              if t = '1' then m[i,j]:=true
                 else m[i,j]:=false;
            if m[i,j]=true then m[j,i]:=true else m[j,i]:=false;
              end;
        writeln('************************');
end;

{ вывод компонентов связности и вершин входящих в них}
procedure mWrite_com;
var top_n,top_l:integer;
 
procedure check_l(v,nom:byte);
 var i:integer;
 begin
    t[v]:=nom;
    for i:=1 to n do
        if(m[v,i]=true)and(t[i]=0) then check_l(i,nom);
 end;
 
function check_top:integer; {функция проверяющая - есть ли непомеченные вершины}
 var i,k:integer;
 begin
    k:=0;
    for i:=1 to n do
        if t[i]=0 then
    begin
        k:=i;
        break;
    end;
    check_top:=k;
 end;
begin
    fillchar(t,sizeof(t),0);
    top_n:=0; {кол-во компонентов связности}
    top_l:=1;
    writeln('Компоненты связности и вершины, входящие в них: ');
    repeat
        inc(top_n);
        check_l(top_l,top_n);
        write(top_n,'. ');
        for i:=1 to n do
        if t[i]=top_n then
        write(Chr(i+Ord('A')-1),' ');
        writeln;
        top_l:=check_top;
    until (top_l=0);
end;

begin
Write('Вершина ',(chr(i+Ord('A')-1)),' и ',(chr(j+Ord('A')-1)),' связана?: ' );
repeat
Read(t); 
until t in ['0','1'];