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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 25.02.2010, 20:10   #1
Bapr
Пользователь
 
Регистрация: 06.10.2009
Сообщений: 18
По умолчанию текстовый файл

Запрограммировать следующие процедуры и функции:
а) поиск записи по двум любым полям, определенным в программе,
б) вывод записи,
в) добавление новой записи в конец файла,
г) циклический сдвиг файла на N записей влево (к началу файла),
д) удаление записей по критерию,
е) вывод файла,
ж) построение диаграммы по одному из полей записи.
Код:
uses crt;
const n=15;
{type data=record
dr:1900..2000;
end;}
type
dan=record
fio:string[20];
god:1900..2000;
mark:longint;
end;
mas=array[1..n] of dan;
var f:text;
u:mas;
a:dan;
i,j,c,x1,y1,x2,y2,dx,q:byte;
pr:boolean;
m:1..12;
p:string;
k:array[1..n] of byte;
ky,max:real;
procedure poisk;
          begin assign(f,'dan.txt');
                reset(f);
                i:=0;
                while not seekeof(f) do
                begin read(f,a.fio);
                read(f,a.god);
                     inc(i);
                      u[i]:=a;
                end;
                c:=i;
                writeln('Vvedite FIO');
                readln(p);
                if p='FOI' then
                begin readln(f,a.god);

                      end;
               readkey;
          end;
procedure dobavka;
begin
writeln('Vvedute FIO');
readln(a.fio);
for i:=1 to n do
a.fio:=a.fio+'';
writeln('Vvedite god rogdenia');
readln(a.god);
append(f);
writeln(f,a.fio,a.god:5);
close(f);
end;
procedure izmenenia;
          begin writeln('Vvedite FIO dly izmenenia');
                readln(p);
                j:=40-length(p);
                for i:=1 to j do
                    p:=p+' ';
                reset(f);
                i:=0;
                while not seekeof(f) do
                begin read(f,a.fio,a.god);
                      readln(f);
                      inc(i);
                      u[i]:=a;
                end;
                x2:=i;
                for i:=1 to x2 do
                    if p=u[i].fio then
                       begin c:=i;
                             writeln('Vvedite FIO dly redactirovania');
                             readln(a.fio);
                             j:=40-length(a.fio);
                             for dx:=1 to j do
                                 a.fio:=a.fio+' ';
                             writeln('Vvedite god rogdenia dly redoctirovania');
                             readln(a.god);
                      end;
                u[c]:=a;
                reset(f);
                rewrite(f);
                for i:=1 to x2 do
                    writeln(f,u[i].fio,u[i].god:5);
                close(f);
          end;
Bapr вне форума Ответить с цитированием
Старый 25.02.2010, 20:11   #2
Bapr
Пользователь
 
Регистрация: 06.10.2009
Сообщений: 18
По умолчанию

Код:
procedure delete;
begin assign(f,'dan.txt');
reset(f);
writeln('Vvedite FIO dly delete');
i:=1;
while i=n do
begin
dec(i);
for j:=1 to n do
u[j]:=u[j+1];
u[i+1].mark:=0;
dec(i);
end;
close(f);
end;
procedure vivod;
          begin assign(f,'dan.txt');
                reset(f);
                i:=0;
                while not seekeof(f) do
                begin read(f,a.fio,a.god);
                      readln(f);
                      inc(i);
                      u[i]:=a;
                end;
                c:=i;
                for i:=1 to c do
                      writeln(u[i].fio,u[i].god:5);
                readkey;
          end;
procedure diagr;
          begin assign(f,'dan.txt');
                reset(f);
                i:=0;
                while not seekeof(f) do
                begin read(f,a.fio,a.god);
                      readln(f);
                      inc(i);
                      u[i]:=a;
                end;
                q:=i;
                for j:=1 to 11 do
                    k[j]:=0;
                for i:=1 to q do
                    for j:=1 to 11 do
                        inc(k[j]);
                {for j:=1 to 11 do
                writeln(k[j]);
                readkey;}
                window(1,8,80,25);
                textbackground(0);
                clrscr;
                max:=k[1];
                for i:=2 to 11 do
                    if k[i]>max then
                    max:=k[i];
                ky:=17/max;
                dx:=75 div 10;
                x1:=1;
                y2:=25;
                c:=1;
                for i:=1 to 11 do
                    begin x2:=x1+dx;
                          y1:=y2-round(k[i]*ky);
                          window(x1,y1,x2,y2);
                          textbackground(c);
                          clrscr;
                          write(i);
                          inc(c);
                          if c=8 then
                          c:=1;
                          x1:=x2;
                    end;
                readkey;
                window(1,1,80,25);
                textbackground(0);
                clrscr;
          end;
begin clrscr;
      assign(f,'dan.txt');
      {$I-} reset(f); {$I+}
      if ioresult<>0 then
      writeln('SOZDAY FAIL!')
      else repeat pr:=false;
                  clrscr;
                  writeln('1 - Poisk zapisi');
                  writeln('2 - Dobavlenie zapisi v konec');
                  writeln('3 - Izmenenie zapisi');
                  writeln('4 - Delete');
                  writeln('5 - Vivod file');
                  writeln('6 - Diagramma');
                  writeln('7 - Vihod');
                  case readkey of '1':poisk;
                                  '2':dobavka;
                                  '3':izmenenia;
                                  '4':delete;
                                  '5':vivod;
                                  '6':diagr;
                                  '7':pr:=true;
                  end;
           until pr;
end.
ктот может помочь немного поправить
Bapr вне форума Ответить с цитированием
Старый 18.03.2010, 23:51   #3
Bapr
Пользователь
 
Регистрация: 06.10.2009
Сообщений: 18
По умолчанию

оп оп оп оп оп
Bapr вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
как текстовый файл в формате word 2007 переделать в файл в формате ZAY JULIA Microsoft Office Word 13 09.06.2010 19:43
Текстовый файл virtuhay266 Общие вопросы Delphi 20 28.05.2009 16:54
Текстовый файл _Smoke_ Паскаль, Turbo Pascal, PascalABC.NET 0 27.05.2009 13:25
Текстовый файл в текстовый массив Kimimaru Общие вопросы C/C++ 1 02.12.2007 11:55