Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ обработка нетипизированного файла

Автор: inviceble 8.01.2008 23:57

Здраствуйте.

Немогу придумать алгоритм процедуры, которая должна читать из файла 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;

Автор: Ozzя 9.01.2008 13:24

inviceble
Так не пойдет.
Приведи полный текст программы, файл данных, с которым работаешь.

Автор: inviceble 9.01.2008 14:36

Вот...

program obrabotka;
uses crt;

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.rar ( 154 байт ) Кол-во скачиваний: 180

Автор: Ozzя 9.01.2008 14:54

Сортировка массива записей тут - http://forum.pascal.net.ru/index.php?showtopic=9198#


Автор: inviceble 9.01.2008 15:33

Цитата(Ozzя @ 9.01.2008 14:54) *

Сортировка массива записей тут - http://forum.pascal.net.ru/index.php?showtopic=9198#

у меня проблема в том что-бы из файла занести значения в массив. при заносе ругается на тип массива

Автор: Ozzя 9.01.2008 15:43

Тогда сделай так:
У тебя picture, picture2 - совершенно одинаковые по структуре.
Сделай тип picture и одномерный массив типа picture
Mas_picture : array [1..n] of picture;

Автор: inviceble 9.01.2008 16:11

Цитата(Ozzя @ 9.01.2008 15:43) *
Тогда сделай так:
у меня так и сделано
mas : array [1..3,1..3] of picture;

Автор: Ozzя 9.01.2008 16:22

Одномерный!

i:=1;
While not eof(d1) do
begin
read(d1,pic);
mas[i]:=pic;
inc(i);
end;

Тогда и программа занесения в массив - такая

Автор: inviceble 10.01.2008 22:36

благодарю за помощь