1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Немогу придумать алгоритм процедуры, которая должна читать из файла record записи, проверять на условие, прошедшие в условие сортировать в алфавитном и записывать в другой файл. все переменные объявлены в главном варе, это процедура здесь только дополнительные
Код
procedure picture_perepis;
Var a : integer; f2 : string[40]; d2 : data2; mas : array [1..3,1..3] of picture; j : integer; Begin clrscr; f1:='C:\shakhov\picture.dat'; f2:='c:\shakhov\picture2.dat'; assign(d1,f1); assign(d2,f2); reset(d1); repeat read(d1,pic); with pic do begin for i := 1 to 3 do begin; mas[i,1]:=nazv; mas[i,2]:=avt; mas[i,3]:=god; end; end; until EOF(d1); for i := 1 to 3 do begin for j:= 1 to 3 do write(' ',mas[i,j],' '); writeln; end; writeln; close(d1); clrscr; end;
Type picture = record nazv, avt : string[20]; god : integer; end; picture2 = record nazv2,avt2 : string[20]; god: integer; end; data = file of picture; data2 = file of picture2;
Var pic : picture; i,v : integer; f1 : string[40]; d1 : data;
Procedure picture_search;
Var search: string[20]; Begin clrscr; f1:='c:\shakhov\picture.dat'; assign(d1,f1); reset(d1); write('vvedite nazvanie kartini: '); readln(search); repeat read(d1,pic); with pic do begin if nazv=search then begin writeln('naideno:'); writeln; writeln('Nazvanie: ',nazv,' Avtor: ',avt,' God: ',god); end; end; until EOF(d1); Close(d1); repeat until keypressed; clrscr; end;
Procedure picture_old;
Var min : integer;
Begin clrscr; min:=3000; f1:='c:\shakhov\picture.dat'; assign(d1,f1); reset(d1); repeat read(d1,pic); with pic do if min>god then min:=god; until EOF(d1); close(d1); assign(d1,f1); reset(d1); repeat read(d1,pic); with pic do begin if min=god then begin writeln('Naideno'); writeln('Nazvanie: ',nazv,' Avtor: ',avt); end; end; until EOF(d1); close(d1); repeat until Keypressed; clrscr; end;
procedure picture_perepis;
Var a : integer; f2 : string[40]; d2 : data2; mas : array [1..3,1..3] of picture; j : integer; Begin clrscr; f1:='C:\shakhov\picture.dat'; f2:='c:\shakhov\picture2.dat'; assign(d1,f1); assign(d2,f2); reset(d1); repeat read(d1,pic); with pic do begin for i := 1 to 3 do begin; mas[i,1]:=nazv; mas[i,2]:=avt; mas[i,3]:=god; end; end; until EOF(d1); for i := 1 to 3 do begin for j:= 1 to 3 do write(' ',mas[i,j],' '); writeln; end; writeln; close(d1); clrscr; end;
Begin clrscr; while 1=1 do begin writeln('1. Poisk'); writeln('2. Samaya staraya kartina'); writeln('3. perepis statih kartin'); writeln('4. vihod'); writeln('viberite variant'); readln(v); Case v of 1: picture_search; 2: picture_old; 3: picture_perepis; 4: exit; else exit; end; end; end.
Тогда сделай так: У тебя picture, picture2 - совершенно одинаковые по структуре. Сделай тип picture и одномерный массив типа picture Mas_picture : array [1..n] of picture;