Помощь - Поиск - Пользователи - Календарь
Полная версия: Паскаль турбо и АВСNet
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Dasha21
написала программу в паскаль турбо. перенесла в паскаль авсNet /перестала работать что не так Подскажите?

uses Crt;

const
  Nmax = 100;  { Максемальное колличество элементов множества  }

type
  T = Char; {тип элемента множества}
  TSet = Array[1..Nmax] of T; { Множество}
procedure Sort(var A: TSet; const N: Integer);
var
  i, j, k: Integer;
  tmp: T;
begin
  for i := 1 to N - 1 do begin
    k := i;
    for j := i + 1 to N do
      if A[j] < A[k] then k := j;
    tmp := A[i];
    A[i] := A[k];
    A[k] := tmp;
  end;
end;

{ Ввести множество  }
procedure Set_Input(var A: TSet; var N: Integer);
var
  i, j: Integer;
  tmp: T;
  F: Boolean;
begin
  N := 0;
  while not SeekEoLn (Input) do begin 
    Inc(N);
    Read(Input, A[N]);
  end;
  Sort(A, N);
  F := False;
  i := 1;
  while i < N do begin
    if A[i] = A[i + 1] then begin
      F := True;
      Dec(N);
      for j := i + 1 to N do
        A[j] := A[j + 1];
    end
    else
      Inc(i);
  end;
  if F then WriteLn('Повторяющийся элемент удален');
end;
procedure Print(const A: TSet; const N: Integer);{Вывод множества}
var
  i: Integer;
begin
  for i := 1 to N do
    Write(A[i], ' ');
  if N = 0 then Write('Пустое множество');
  WriteLn;
end;
procedure Print_Sets(const A, B: TSet; const N, M: Integer);
var
  i: Integer;
begin
  WriteLn;
  Write('Множество A:  ');
  for i := 1 to N do
    Write(A[i], ' ');
  WriteLn;
  Write('Множество B:  ');
  for i := 1 to M do
    Write(B[i], ' ');
  WriteLn;
end;
procedure Union(var U: TSet; var k: Integer; const A, B: TSet; const N, M: Integer);
{Определение множества A и B }
var
  i, j: Integer;
begin
  i := 1;
  j := 1;
  k := 0;
  while (i <= N) or (j <= M) do
    if (j <= M) and (i <= N) and (A[i] = B[j]) then begin
      Inc(k);
      U[k] := A[i];
      Inc(i);
      Inc(j);
    end
    else if (j > M) or (i <= N) and (A[i] < B[j]) then begin
      Inc(k);
      U[k] := A[i];
      Inc(i);
    end
    else begin
      Inc(k);
      U[k] := B[j];
      Inc(j);
    end;
end;
procedure Product(var P: TSet; var k: Integer; const A, B: TSet; const N, M: Integer);
{Пересечение множеств A и B }
var
  i, j, W: Integer;
begin
  i := 1;
  j := 1;
  k := 0;
  while (i <= N) and (j <= M) do
    if (A[i] = B[j]) then begin
      Inc(k);
      P[k] := A[i];
      Inc(i);
      Inc(j);
    end
    else if A[i] < B[j] then
      Inc(i)
    else
      Inc(j);
end;
procedure Diff(var D: TSet; var k: Integer; const A, B: TSet; const N, M: Integer);
{Разность множеств  A и B}
var
  i, j: Integer;
begin
  i := 1;
  j := 1;
  k := 0;
  while (i <= N) and (j <= M) do
    if A[i] = B[j] then begin
      Inc(i);
      Inc(j);
    end
    else if A[i] < B[j] then begin
      Inc(k);
      D[k] := A[i];
      Inc(i);
    end
    else if A[i] > B[j] then
      Inc(j);
  while (i <= N) and (j > M) do begin
    Inc(k);
    D[k] := A[i];
    Inc(i);
  end;
end;
function Incl(const A, B: TSet; const N, M: Integer): Boolean; {Проверка на вхождение  A в B}
var
  i, j: Integer;
begin
  Incl := False;
  if N > M then Exit;
  i := 1;
  j := 1;
  while (i <= N) and (j <= M) and (A[i] >= B[j]) do
    if A[i] > B[j] then
      Inc(j)
    else if A[i] = B[j] then begin
      Inc(i);
      Inc(j);
    end;
  Incl := i - 1 = N;
end;
procedure Keys; {Вывод клавиш}
begin
  ClrScr;
  WriteLn('Введите номер желаемого действия:');
  WriteLn;
  WriteLn('1 - Ввод множества A');
  WriteLn('2 - Ввод множества B');
  WriteLn('3 - Проверка вхождения A в B');
  WriteLn('4 - вывести обьеденение множеств A и B');
  WriteLn('5 - Вывести пересечение множиств  A и B');
  WriteLn('6 - Вывести азность A \ B');
  WriteLn('0 - Очистка');
  WriteLn('Esc - ВЫХОД');
  WriteLn;
end;

var
  N, M, K: Integer;
  A, B, C: TSet;
  v: Char;
begin
  Keys;
  N := 0;
  M := 0;
  repeat
    v := ReadKey;
    if v in ['3'..'6'] then Print_Sets(A, B, N, M);
    case v of
      '1':
        begin
          WriteLn('Введите множество A:');
          Set_Input(A, N);
          WriteLn('Готово');
          WriteLn;
        end;
      '2':
        begin
          WriteLn('Введите множество B:');
          Set_Input(B, M);
          WriteLn('Complet');
          WriteLn;
        end;
      '3': if Incl(A, B, N, M) then WriteLn('A входит в B') else WriteLn('A Не входит в  B');
      '4':
        begin
          WriteLn('Объеденение A и B:');
          Union(C, K, A, B, N, M);
          Print(C, K);
        end;
      '5':
        begin
          WriteLn('Пересечение множеств A and B:');
          Product(C, K, A, B, N, M);
          Print(C, K);
        end;
      '6':
        begin
          WriteLn('Разность множеств A \ B:');
          Diff(C, K, A, B, N, M);
          Print(C, K);
        end;
      '0': Keys;
    end;
  until v = #27;
  end.
Федосеев Павел
По крайней мере вы сюда скопировали с ошибкой - первой строкой ожидалось слово uses.

А так - непонятно, что такое перестала работать. Лучше уточняйте.
Dasha21
Цитата(Федосеев Павел @ 9.12.2016 1:19) *

По крайней мере вы сюда скопировали с ошибкой - первой строкой ожидалось слово uses.

А так - непонятно, что такое перестала работать. Лучше уточняйте.



все работает за исключением ввода А
Федосеев Павел
Смотрите. Вы вводите элементы множества до символа EoLn. Причём, SeekEoLn. Но сам символ EoLn из буфера ввода (буфера клавиатуры) не извлекаете. Это приводит к тому, что после ввода одного множества, второе ввести невозможно - while not SeekEoLn (Input) do begin сразу завершает цикл, т.к. EoLn всё ещё в буфере клавиатуры.

Извлеките этот символ - readln(input) после завершения цикла ввода перед завершением процедуры.

И ещё. Пользуйтесь кнопкой CODE и закрывайте тэг кнопкой #. Код будет выглядеть аккуратнее.
А также, воспользуйтесь программой для автоматического форматирования кода на Pascal - JCF. Здесь я описал вкратце, как его установить Форматтер кода

А так будет выглядеть ваша подпрограмма после исправления и форматирования
  { Ввести множество }
  procedure Set_Input(var A: TSet; var N: integer);
  var
    i, j: integer;
    tmp: T;
    F: boolean;
  begin
    N := 0;
    while not SeekEoLn(Input) do
    begin
      Inc(N);
      Read(Input, A[N]);
    end;
    readln(input);
    Sort(A, N);
    F := False;
    i := 1;
    while i < N do
    begin
      if A[i] = A[i + 1] then
      begin
        F := True;
        Dec(N);
        for j := i + 1 to N do
          A[j] := A[j + 1];
      end
      else
        Inc(i);
    end;
    if F then
      WriteLn('Повторяющийся элемент удален');
  end;
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.