Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.11.2014, 01:44   #1
Анатолий666
Пользователь
 
Регистрация: 27.11.2014
Сообщений: 10
По умолчанию Файлы

В двух файлах записать последовательности чисел А и В. Создать новый файл, в котором содержатся только те числа, которые не содержатся одновременно в этих последовательностях. Вывести на экран исходные последовательности и результат преобразования. Все операции выполняются через текстовое меню.
Анатолий666 вне форума Ответить с цитированием
Старый 27.11.2014, 07:59   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Попытки? Наработки?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 27.11.2014, 13:45   #3
Анатолий666
Пользователь
 
Регистрация: 27.11.2014
Сообщений: 10
По умолчанию

Код:
uses crt;
type mas=array[1..100] of integer;
var t1,t2,t3:boolean;
procedure readfile(var f:text;fname:string;var a:mas;
var n:byte;var t:boolean;c:char);
var i:byte;
begin
clrscr;
assign(f,fname);
reset(f);
n:=0;
while not seekeof(f) do
begin
n:=n+1;
read(f,a[n]);
end;
close(f);
t:=true;
write('Последовательность ',c,' прочитана');
readln
end;
procedure newposl(a,b:mas;n,m:byte;var c:mas;var k:byte);
var i,j:byte;
f:boolean;
begin
clrscr;
if not t1 then
begin
write('Последовательность А еще не прочитана, вернитесь к пункту 1');
readln;
exit
end;
if not t2 then
begin
write('Последовательность B еще не прочитана, вернитесь к пункту 2');
readln;
exit
end;
k:=0;
for i:=1 to n do
begin
f:=true;
j:=1;
while(j<=m)and f do
if b[j]=a[i] then f:=false
else j:=j+1;
if f then
begin
k:=k+1;
c[k]:=a[i];
end;
end;
for i:=1 to m do
begin
f:=true;
j:=1;
while(j<=n)and f do
if a[j]=b[i] then f:=false
else j:=j+1;
if f then
begin
k:=k+1;
c[k]:=b[i];
end;
end;
if k=0 then write('Все числа в последовательностях А и В совпадают')
else write('Новая последовательность создана');
t3:=true;
readln
end;
procedure print(a,b,c:mas;n,m,k:byte);
var i:byte;
begin
clrscr;
if not t1 then
begin
write('Последовательность А еще не прочитана, вернитесь к пункту 1');
readln;
exit
end;
if not t2 then
begin
write('Последовательность B еще не прочитана, вернитесь к пункту 2');
readln;
exit
end;
if not t3 then
begin
write('Новая последовательность еще не создана, вернитесь к пункту 3');
readln;
exit
end;
writeln('Последовательность А');
for i:=1 to n do
write(a[i],' ');
writeln;
writeln('Последовательность B');
for i:=1 to m do
write(b[i],' ');
writeln;
if k=0 then write('Все числа в последовательностях А и В совпадают')
else
begin
writeln('Последовательность C');
for i:=1 to k do
write(c[i],' ');
end;
readln
end;
procedure writefile(var f:text;c:mas;k:byte);
var i:byte;
begin
clrscr;
if not t1 then
begin
write('Последовательность А еще не прочитана, вернитесь к пункту 1');
readln;
exit
end;
if not t2 then
begin
write('Последовательность B еще не прочитана, вернитесь к пункту 2');
readln;
exit
end;
if not t3 then
begin
write('Новая последовательность еще не создана, вернитесь к пункту 3');
readln;
exit
end;
assign(f,'C.txt');
rewrite(f);
if k=0 then write(f,'Vse chisla v posledovatelnostyah A i B sovpadayut')
else
begin
writeln(f,'Posledovatelnost C');
for i:=1 to k do
write(f,c[i],' ');
end;
close(f);
write('Результат записан в файл C.txt');
readln
end;
var f:text;
a,b,c:mas;
n,m,k:byte;
w:char;
begin
clrscr;
t1:=false;
t2:=false;
repeat
clrscr;
writeln('Выберите действие');
writeln('1-прочитать последовательность А');
writeln('2-прочитать последовательность B');
writeln('3-получить последовательность C');
writeln('4-Вывести последовательности на экран');
writeln('5-Вывести последовательности в файл');
writeln('другое - выход');
readln(w);
case w of
'1':readfile(f,'A.txt',a,n,t1,'A');
'2':readfile(f,'B.txt',b,m,t2,'B');
'3':newposl(a,b,n,m,c,k);
'4':print(a,b,c,n,m,k);
'5':writefile(f,c,k);
else exit;
end;
until not(w in ['1'..'5']);
end.
Можно как-то проще сделать, укротить код

Последний раз редактировалось Stilet; 27.11.2014 в 14:34.
Анатолий666 вне форума Ответить с цитированием
Старый 27.11.2014, 14:35   #4
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Если программа работает, то зачем ее укорачивать?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 27.11.2014, 14:39   #5
Анатолий666
Пользователь
 
Регистрация: 27.11.2014
Сообщений: 10
По умолчанию

Да, но она слишком большая. Мне для отчета, помогите укоротить
Анатолий666 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Файлы: Составить программу, которая перепишет фамилии в отдельные файлы в соответствии с названием группы Гульвира Помощь студентам 1 23.05.2013 10:04
Очень нужно сделать задачу в Delphi(Типизированные файлы. файлы записи) Vitalik1 Помощь студентам 1 16.12.2011 10:38
Не сохраняет файлы (Создает файлы пустышки) Rock231 Помощь студентам 2 25.12.2010 12:31
Файлы данных.Типизированные файлы. вылка Помощь студентам 6 17.05.2010 15:42
два вредных вопроса:про асю и прикриплёные файлы файлы steck Свободное общение 3 17.06.2007 14:53