IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Паскаль турбо и АВСNet, Паскаль турбо и АВС.Net
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 3
Пол: Мужской

Репутация: -  0  +


написала программу в паскаль турбо. перенесла в паскаль авс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.


Сообщение отредактировано: Bajiaoxing -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 4.05.2024 10:43
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name