1537

Программа для обработки справочного массива записей о банковской карточке лицевого счета

Контрольная

Информатика, кибернетика и программирование

В данной работе используется сортировка обменом, суть ее состоит в том, что пары стоящих рядом элементов просматриваются в направлении снизу вверх и сравниваются. Если верхний элемент оказывается меньше нижнего по рисунку, то они меняются местами. Продолжая этот процесс циклически, в конце концов приходим к отсортированному файлу.

Русский

2013-01-06

199.82 KB

2 чел.

Техническое задание.

Разработанная программа предназначена для обработки справочного массива записей, содержащих сведения о банковской карточке лицевого счета. Структура записи: фамилия , вклад, годовой процент. Записи сохраняются в типизированном файле. Программа обеспечивает получение следующей информации:

  1. фамилий клиентов со всеми соответствующими их карточке данными;
  2. вычисление наличных, положенных к выплате за год;
  3. реализация снятия и поступления на счет произвольной суммы;

Для получения информации используется сортировка обменом.

Разработчик – студент группы ПЭ - 10 Лещенко А.В.

Теоретическое введение.

2.1 Сортировка обменом.

В данной работе используется сортировка обменом, суть ее состоит в том, что пары стоящих рядом элементов просматриваются в направлении снизу вверх и сравниваются. Если верхний элемент оказывается меньше нижнего по рисунку, то они меняются местами. Продолжая этот процесс циклически, в конце концов приходим к отсортированному файлу.

В данной задаче код сортировки будет выглядеть так:

begin

for i:=1 to n-1 do

for j:=i+1 to n-1 do begin

if  a[j].name<a[i].name  then

begin

 t:=a[j].name;

o:=a[j].nalichnye;

z:=a[j].percent;

a[j].name:=a[i].name;

a[j].nalichnye:=a[i].nalichnye;

a[j].percent:=a[i].percent;

a[i].name:=t;

a[i].nalichnye:=o;

a[i].percent:=z;

 end;

end;

2.2 Блок-схема сортировки. 

 

Практическая часть.

3.1 Анализ технического задания.

 В соответствии с техническим заданием необходимо разработать многомодульную программу создания и обработки справочного массива записей.

 Обязательным для программы является наличие меню со следующими опциями:

  1. ввод данных из файла;
  2. вывод;
  3. сортировка (методом вставки);
  4. поиск;
  5. обработка;
  6. О программе (Сведения о программе и разработчике);

дополнительные опции:

  1. добавление;
  2. удаление;
  3. редактирование;
  4. поступление и снятие платежа;

 Программа состоит из процедур и функций, каждая из которых соответствует пункту меню или служит для его обработки.

 Использование модулей в программе сокращает время разработки, уменьшает объем памяти, занимаемый программой, делает ее структуру простой и понятной. Сортировка вставкой является простейшей, но ресурсоемкой, однако, когда число элементов массива не велико это не имеет значения.

 Защита от неправильного и случайного ввода осуществляется следующим образом: если ввод случаен, т. е. вместо цифры введена буква – программа просто проигнорирует это действие пользователя и продолжит ожидать ввода.

 Использование типизированного файла для внешнего хранения информации с одной стороны снижает универсальность программы (невозможность открытия другими программами), но с другой стороны предотвращает несанкционированный доступ к базе данных.

3.2 Пример текстового файла записей программы.

1  Лорицкий        30      400     150

2  Абрамов          300     2        306

3  Ферзев             20        3       20.6

4  Якубов              40       30       52

3.3 Текст программы.

{Программа - база данных}

Program tipovoy;

Uses CRT;

TYPE sotr=record

    name:string[20];

    nalichnye:integer;

    percent:real;

end;

CONST x1=1;

     x2=80;

     y1=1;

     y2=3;

     delta=15;

VAR f,f1: file of sotr;

   ch:Char;

   ExtendedKey:Boolean; {Флаг pасшиpенного  кода}

   x,y:Byte;

   a:array[1..100] of sotr;

   n,kp:integer;

   lin:Array [1..5] of String [15];

   lin1:Array [1..9] of String [25];

   lin2:array [0..30] of String [25];

   lin3:array [0..100] of integer;

   i,j:Integer;

Procedure ramka(x1,y1,x2,y2:Integer);

Begin

 Window(x1,y1,x2,y2);

 ClrScr;

 Window(1,1,80,25);

 GotoXY(x1,y1);

 Write('');

 For j:=x1 to x2-3 do Write('');

 Write('');

 For j:=y1+1 to y2-1 do

 Begin

   GotoXY(x1,j);

   Write('');

   GotoXY(x2-1,j);

   Write('');

 end;

 GotoXY(x1,y2);

 Write('');

 For j:=x1 to x2-3 do Write('');

 Write('');

 GotoXY(x1+2,y1+1);

end;

{Вывод главного меню}

Procedure out_menu (num:Integer);

Var j:Integer;

Begin

 TextBackGround(Black);

 TextColor(LightGray);

 Window(1,1,80,25);

 ClrScr;

 GotoXY(2,1);

  for i:=1 to 30 do

   Writeln('░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░');

 ramka(x1,y1,x2,y2);

 lin[1]:=' О пpогpамме   ';

 lin[2]:=' Записи        ';

 lin[3]:=' Поиск         ';

 lin[4]:=' Соpтиpовка    ';

 lin[5]:=' Выход         ';

 For j:=1 to 5 do

 Begin

  If j=num then begin

                TextBackGround(Cyan);

                TextColor(Black);

              end

         else begin

                TextBackGround(Blue);

                TextColor(Yellow);

              end;

   Write(lin[j]:delta);

 end;

 GotoXY(2,2);

 i:=num;

end;

{Веpтикальное меню пункта запись}

Procedure out_men1(k:Integer);

Begin

 TextBackGround(Blue);

 TextColor(Yellow);

 ramka(13,3,35,13);

 Window(1,1,80,25);

 GotoXY(14,4);

 lin1[1]:=' Ввод            ';

 lin1[2]:=' Поступление     ';

 lin1[3]:=' Снятие          ';

 lin1[4]:=' Редактирование  ';

 lin1[5]:=' Очистка         ';

 lin1[6]:=' Удаление        ';

 lin1[7]:=' Просмотр        ';

 lin1[8]:=' Чтение из файла ';

 lin1[9]:=' Запись в файл   ';

 For i:=1 to 9 do

 Begin

  If i=k then begin

                TextBackGround(Cyan);

                TextColor(Black);

              end

         else begin

                TextBackGround(Blue);

                TextColor(Yellow);

              end;

   Writeln(lin1[i]);

   GotoXY(14,i+4)

 end;

end;

{вертикальное меню пункта поиск}

Procedure out_men2(k:Integer);

Begin

 TextBackGround(Blue);

 TextColor(Yellow);

 ramka(27,3,50,6);

 Window(1,1,80,25);

 GotoXY(28,4);

 lin1[1]:=' По фамилии          ';

 lin1[2]:=' По проценту         ';

  For i:=1 to 2 do

 Begin

  If i=k then begin

                TextBackGround(Cyan);

                TextColor(Black);

              end

         else begin

                TextBackGround(Blue);

                TextColor(Yellow);

              end;

   Writeln(lin1[i]);

   GotoXY(28,i+4)

 end;

end;

{Пpоцедуpа ввода записей}

procedure vvod;

Label 1,2;

Var j:Integer;

   c:Char;

begin

Window(1,1,80,25);

TextBackGround(blue);

TextColor(White);

ramka(24,5,50,7);

GotoXY(26,6);

Writeln ('Для выхода введите "0"');

textbackground(green);

textcolor(White);

ramka(15,13,70,23);

Window(17,14,67,22);

n:=1;

Repeat

ClrScr;

write('Введите фамилию: ');

readln(a[n].name);

if a[n].name='0' then break;

repeat

{$I-}

 write('Введите количество наличных: ');

 readln(a[n].nalichnye);

{$I+}

until ioresult = 0;

if a[n].nalichnye=0 then break;;

write('Введите годовой процент: ');

readln(a[n].percent);

if a[n].percent=0 then break;;

n:=n+1;

Write('Продолжить? Y(N)');

Readln(c);

until (c='N') or (c='n');

clrscr;

out_menu(1);

Window(1,1,80,25);

textbackground(black);

textcolor(LightGray);

GotoXY(1,13);

 for j:=13 to 30 do

 Writeln('░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░');

clrscr;

out_menu(1);

end;

procedure view;

Var j:Integer;

   c:Char;

begin

Window(1,1,80,25);

textbackground(green);

textcolor(white);

ramka(5,7,75,23);

Window(6,8,73,22);

writeln(' №   Фамилия    Наличные  Процент годовых  К выплате ');

writeln(  '═══╬═════════════╬══════════╬═════════════════╬══════════╬');

for j:=1 to n-1 do

writeln(j:2,' ',a[j].name:12,' ',a[j].nalichnye:10,'',a[j].percent:10:3,'       '

,a[j].nalichnye*(a[j].percent*0.01)+a[j].nalichnye:10:5);

 repeat until keypressed;

Window(1,1,80,25);

textbackground(black);

textcolor(LightGray);

GotoXY(1,7);

 for j:=7 to 23 do

 Writeln('░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░');

end;

{процедура изменения}

procedure edit;

Label 1,2,3,4;

var l:integer;

   cha,c:char;

   nov:string[12];

   novc:integer;

begin

if n-1 = 0 then

           begin

            TextBackGround(cyan);

            TextColor(white);

            ramka(20,12,55,20);

            GotoXY(25,15);

            Writeln('нет данных для обработки');

            gotoXY(28,20);

            Writeln('<enter> - продолжить');

            readkey;

            goto 2;

           end;

Window(1,1,80,25);

TextBackGround(Cyan);

TextColor(White);

ramka(24,3,50,5);

GotoXY(26,4);

Writeln ('Для выхода введите "0"');

4:

textbackground(green);

textcolor(white);

ramka(5,7,75,23);

Window(6,8,73,22);

writeln(' №   Фамилия    Наличные  Процент годовых  К выплате ');

writeln(  '═══╬═════════════╬══════════╬═════════════════╬══════════╬');

for j:=1 to n-1 do

writeln(j:2,' ',a[j].name:12,' ',a[j].nalichnye:10,'',a[j].percent:10:3,'       '

,a[j].nalichnye*(a[j].percent*0.01)+a[j].nalichnye:10:5);

  write('введите номер записи, которую вы хотите отредактировать: ');readln(l);

  if l=0 then goto 2;

  if l>n-1 then

             begin

              writeln('Такой записи нет!');

              goto 1;

             end;

writeln('Введите поле для редактирования: ');

3:

writeln('1-фамилия, 2-наличные, 3-процент');

readln(c);

if c='0' then goto 2;

if c='1' then

        begin

write('введите новые данные: ');

textcolor(blue);

readln(nov);

textcolor(white);

if nov='0' then goto 2;

      for j:=1 to n-1 do

     if j=l then

       a[j].name:=nov;

        end;

if c='2' then

        begin

write('введите новые данные: ');

textcolor(blue);

readln(novc);

textcolor(white);

if novc=0 then goto 2;

      for j:=1 to n-1 do

     if j=l then

       a[j].nalichnye:=novc;

        end;

if c='3' then

        begin

write('введите новые данные: ');

textcolor(blue);

readln(novc);

textcolor(white);

if nov='0' then goto 2;

      for j:=1 to n-1 do

     if j=l then

       a[j].percent:=novc;

        end;

1:

  write('продолжить изменение? Y/N: ');readln(cha);

 if (cha='y') or (cha='Y') then goto 4;

 if (cha='n') or (cha='N') or (cha='0') then goto 2

 else goto 1;

Out_menu(1);

view;

2:

Out_menu(1);

end;

{Процедура добавления наличных}

procedure nal;

Label 1,2,3,4;

var l:integer;

   cha,c:char;

   novc:integer;

begin

if n-1 = 0 then

           begin

            TextBackGround(cyan);

            TextColor(white);

            ramka(20,12,55,20);

            GotoXY(25,15);

            Writeln('нет данных для обработки');

            gotoXY(28,20);

            Writeln('<enter> - продолжить');

            readkey;

            goto 2;

           end;

Window(1,1,80,25);

TextBackGround(Cyan);

TextColor(White);

ramka(24,3,50,5);

GotoXY(26,4);

Writeln ('Для выхода введите "0"');

4:

textbackground(green);

textcolor(white);

ramka(5,7,75,23);

Window(6,8,73,22);

writeln(' №   Фамилия    Наличные  Процент годовых  К выплате ');

writeln(  '═══╬═════════════╬══════════╬═════════════════╬══════════╬');

for j:=1 to n-1 do

writeln(j:2,' ',a[j].name:12,' ',a[j].nalichnye:10,'',a[j].percent:10:3,'       '

,a[j].nalichnye*(a[j].percent*0.01)+a[j].nalichnye:10:5);

  write('введите номер записи, которую вы хотите отредактировать: ');readln(l);

  if l=0 then goto 2;

  if l>n-1 then

             begin

              writeln('Такой записи нет!');

              goto 1;

             end;

3:

writeln('Введите количество наличных:');

        begin

textcolor(blue);

readln(novc);

textcolor(white);

      for j:=1 to n-1 do

     if j=l then

       a[j].nalichnye:=a[j].nalichnye+novc;

        end;

1:

  write('продолжить изменение? Y/N: ');readln(cha);

 if (cha='y') or (cha='Y') then goto 4;

 if (cha='n') or (cha='N') or (cha='0') then goto 2

 else goto 1;

Out_menu(1);

view;

2:

Out_menu(1);

end;

{Процедура снятия наличных}

procedure snt;

Label 1,2,3,4;

var l:integer;

   cha,c:char;

   novc:integer;

begin

if n-1 = 0 then

           begin

            TextBackGround(cyan);

            TextColor(white);

            ramka(20,12,55,20);

            GotoXY(25,15);

            Writeln('нет данных для обработки');

            gotoXY(28,20);

            Writeln('<enter> - продолжить');

            readkey;

            goto 2;

           end;

Window(1,1,80,25);

TextBackGround(Cyan);

TextColor(White);

ramka(24,3,50,5);

GotoXY(26,4);

Writeln ('Для выхода введите "0"');

4:

textbackground(green);

textcolor(white);

ramka(5,7,75,23);

Window(6,8,73,22);

writeln(' №   Фамилия    Наличные  Процент годовых  К выплате ');

writeln(  '═══╬═════════════╬══════════╬═════════════════╬══════════╬');

for j:=1 to n-1 do

writeln(j:2,' ',a[j].name:12,' ',a[j].nalichnye:10,'',a[j].percent:10:3,'       '

,a[j].nalichnye*(a[j].percent*0.01)+a[j].nalichnye:10:5);

  write('введите номер записи, с которой произведено снятие наличных: ');readln(l);

  if l=0 then goto 2;

  if l>n-1 then

             begin

              writeln('Такой записи нет!');

              goto 1;

             end;

3:

writeln('Введите количество наличных:');

        begin

textcolor(blue);

readln(novc);

textcolor(white);

      for j:=1 to n-1 do

     if j=l then

       a[j].nalichnye:=a[j].nalichnye-novc;

        end;

1:

  write('продолжить изменение? Y/N: ');readln(cha);

 if (cha='y') or (cha='Y') then goto 4;

 if (cha='n') or (cha='N') or (cha='0') then goto 2

 else goto 1;

Out_menu(1);

view;

2:

Out_menu(1);

end;

{удаление данных}

procedure delete;

Label 1,2,4;

var l:integer;

   cha:char;

begin

if n-1 = 0 then

           begin

            TextBackGround(cyan);

            TextColor(white);

            ramka(20,12,55,20);

            GotoXY(25,15);

            Writeln('нет данных для обработки');

            gotoXY(28,20);

            Writeln('<enter> - продолжить');

            readkey;

            goto 2;

           end;

Window(1,1,80,25);

TextBackGround(Cyan);

TextColor(White);

ramka(24,3,50,5);

GotoXY(26,4);

Writeln ('Для выхода введите "0"');

4:

textbackground(green);

textcolor(white);

ramka(5,7,75,23);

Window(6,8,73,22);

writeln(' №   Фамилия    Наличные  Процент годовых  К выплате ');

writeln(  '═══╬═════════════╬══════════╬═════════════════╬══════════╬');

for j:=1 to n-1 do

writeln(j:2,' ',a[j].name:12,' ',a[j].nalichnye:10,'',a[j].percent:10:3,'       '

,a[j].nalichnye*(a[j].percent*0.01)+a[j].nalichnye:10:5);

  write('введите номер записи, которую вы хотите удалить: ');readln(l);

  if l=0 then goto 2;

  if l>n-1 then

             begin

              writeln('Такой записи нет!');

              goto 1;

             end;

      for j:=1 to n-1 do

     if j=l then

      begin

       a[j].name:=a[j+1].name;

       a[j].nalichnye:=a[j+1].nalichnye;

       a[j].percent:=a[j+1].percent;

      end;

       for j:=l+1 to n-1 do

        begin

         a[j].name:=a[j+1].name;

         a[j].nalichnye:=a[j+1].nalichnye;

         a[j].percent:=a[j+1].percent;

        end;

n:=n-1;

1:

 write('продолжить удаление? Y/N ');readln(cha);

 if (cha='y') or (cha='Y') then goto 4;

 if (cha='n') or (cha='N') or (cha='0') then goto 2

 else goto 1;

Out_menu(1);

view;

2:

Out_menu(1);

end;

procedure ochistka;

begin

n:=1;

textcolor(white);

ramka(20,12,55,20);

GotoXY(28,20);

Writeln('<Enter> - продолжить');

GotoXY(29,16);

Writeln('Очистка произведена');

readkey;

out_menu(1);

end;

Procedure zapis;

Label 1;

var

k:char;

iv:string [10];

begin

   Repeat

    TextBackGround(Cyan);

    TextColor(White);

    ramka(24,5,50,7);

    GotoXY(26,6);

    Writeln ('Для выхода введите "0"');

    TextBackGround(green);

    TextColor(white);

    ramka(20,12,55,20);

    GotoXY(30,20);

    Writeln('<Enter> - ввод');

    GotoXY(29,12);

    Writeln('Введите имя файла');

    GotoXY(32,16);

    Textcolor(white);

    Readln(iv);

   until length(iv) <> 0 ;

if iv='0' then goto 1;

 ClrScr;

 out_menu(1);

 iv:=(concat(iv,'.dat'));

assign (f,iv);

rewrite (f);

for j:=1 to n do

 write (f,a[j]);

 close (f);

 TextBackGround(Cyan);

 TextColor(Yellow);

 ramka(20,12,55,20);

 GotoXY(30,16);

 Textcolor(black);

 writeln ('Запись произведена');

 Readln;

1:

 ClrScr;

 out_menu(0);

end;

Procedure chtenie;

Label 1;

Var iv1:string[10];

begin

Repeat

    TextBackGround(Cyan);

    TextColor(White);

    ramka(24,5,50,7);

    GotoXY(26,6);

    Writeln ('Для выхода введите "0"');

    TextBackGround(green);

    TextColor(white);

    ramka(20,12,55,20);

    GotoXY(29,12);

    Writeln('Введите имя файла: ');

    GotoXY(32,16);

    Textcolor(white);

    Readln(iv1);

until length(iv1) <> 0 ;

if iv1='0' then goto 1;

 ClrScr;

 out_menu(0);

 iv1:=(concat(iv1,'.dat'));

j:=1;

{$I-}

assign (f1,iv1);

reset (f1);

{$I+}

if ioresult <> 0 then

                 begin

                  TextBackGround(Cyan);

                  TextColor(Yellow);

                  ramka(20,12,55,20);

                  GotoXY(30,16);

                  Textcolor(black);

                  writeln ('Файл не найден');

                  Readln;

                  goto 1;

                 end;

                  while not eof (f1) do

                    begin

                     read (f1,a[j]);

                     j:=j+1;

                    end;

                    n:=j-1;

                  close (f1);

view;

1:

ClrScr;

out_menu(1);

end;

{Обpаботка пунктов веpтикального меню}

procedure obrabvm(i1:integer);

begin

case i1 of

1:vvod;

2:nal;

3:snt;

4:edit;

5:ochistka;

6:delete;

7:view;

8:chtenie;

9:zapis;

end;

end;

{Обpаботка пеpвого пункта главного меню}

Procedure work_zap;

Var x2,y2,i1:Integer;

Begin

 out_men1(1);

 GotoXY(14,4);

 i:=1;

 x2:=14;y2:=4;

 repeat

   ch:=ReadKey;

   if ch=#0 then

           begin

             ch:=Readkey;

             ExtendedKey:=True;

           end

           else ExtendedKey:=False;

   case ch of

     #72: Begin  {Стpелка ввеpх}

            y:=WhereY;

            TextBackGround(Blue);

            TextColor(Yellow);

            GotoXY(x2,y);

            Write(lin1[i]);

            If i=1 then begin

                         y:=y2+8;

                         i:=9;

                       end

                  else begin

                         y:=y-1;

                         i:=i-1;

                       end;

            TextBackGround(Cyan);

            TextColor(Black);

            GotoXY(x2,y);

            Write(lin1[i]);

          end;

     #80: Begin  {Стpелка вниз}

           y:=WhereY;

           TextBackGround(Blue);

           TextColor(Yellow);

           GotoXY(x2,y);

           Write(lin1[i]);

           If i=9 then begin

                         y:=y2;

                         i:=1;

                       end

                  else begin

                         y:=y+1;

                         i:=i+1;

                       end;

           TextBackGround(Cyan);

           TextColor(Black);

           GotoXY(x2,y);

           Write(lin1[i]);

          end;

     #13: Begin  {Enter}

            y:=WhereY;

            i1:=i;

            obrabvm(i);

            Window(1,1,80,25);

            out_men1(i);

            i:=i1;

            TextBackGround(Cyan);

            TextColor(Black);

            GotoXY(14,y);

            Write(lin1[i]);

          end;

   end;

 until (ch=#27)  ;

 TextBackGround(Black);

 ClrScr;

 ch:=' ';

 out_menu(1);

end;

{процедура поиска по имени}

procedure poisk_name;

label 1;

Var j:Integer;

   c:Char;

   st:string;

   cha:char;

   z:boolean;

begin

Window(1,1,80,25);

TextBackGround(cyan);

TextColor(White);

ramka(24,3,50,5);

GotoXY(26,4);

Writeln ('Для выхода введите "0"');

textbackground(green);

textcolor(white);

ramka(5,7,75,23);

Window(6,8,73,22);

z:=false;

repeat

clrscr;

gotoxy(1,1);

writeln('Введите фамилию: ');readln(st);

if st='0' then goto 1;

clrscr;

writeln(' №   Фамилия    Наличные  Процент годовых  К выплате ');

writeln(  '═══╬═════════════╬══════════╬═════════════════╬══════════╬');

for j:=1 to n-1 do

 if a[j].name=st then

 begin

  z:=true;

  writeln(j:2,' ',a[j].name:12,' ',a[j].nalichnye:10,'',a[j].percent:10:3,'       '

,a[j].nalichnye*(a[j].percent*0.01)+a[j].nalichnye:10:5);

 end;

   if (a[j].name<>st) and (z=false) then

 writeln('Записей не найдено');

 writeln('Продолжить поиск? <y/n>');readln(cha);

 until (cha='n') or (cha='N') or (cha='0');

1:

out_menu(1);

end;

{процедура поиска по процентам}

procedure poisk_perc;

label 1;

Var j:Integer;

   c:Char;

   st:real;

   cha:char;

   z:boolean;

begin

Window(1,1,80,25);

TextBackGround(cyan);

TextColor(White);

ramka(24,3,50,5);

GotoXY(26,4);

Writeln ('Для выхода введите "0"');

textbackground(green);

textcolor(white);

ramka(5,7,75,23);

Window(6,8,73,22);

z:=false;

repeat

clrscr;

gotoxy(1,1);

writeln('Введите процент: ');readln(st);

if st=0 then goto 1;

clrscr;

writeln(' №   Фамилия    Наличные  Процент годовых  К выплате ');

writeln(  '═══╬═════════════╬══════════╬═════════════════╬══════════╬');

for j:=1 to n-1 do

 if a[j].percent=st then

 begin

  z:=true;

  writeln(j:2,' ',a[j].name:12,' ',a[j].nalichnye:10,'',a[j].percent:10:3,'       '

,a[j].nalichnye*(a[j].percent*0.01)+a[j].nalichnye:10:5);

 end;

   if (a[j].percent<>st) and (z=false) then

 writeln('Записей не найдено');

 writeln('Продолжить поиск? <y/n>');readln(cha);

 until (cha='n') or (cha='N') or (cha='0');

1:

out_menu(1);

end;

{обработка меню поиск}

procedure obrabvm2(i1:integer);

begin

case i1 of

1:poisk_name;

2:poisk_perc;

end;

end;

{обработка команд главного меню(пункт поиск)}

Procedure work1_zap;

Var x2,y2,i1:Integer;

Begin

 out_men2(1);

 GotoXY(28,4);

 i:=1;

 x2:=28;y2:=4;

 repeat

   ch:=ReadKey;

   if ch=#0 then

           begin

             ch:=Readkey;

             ExtendedKey:=True;

           end

           else ExtendedKey:=False;

   case ch of

     #72: Begin  {Стpелка ввеpх}

            y:=WhereY;

            TextBackGround(Blue);

            TextColor(Yellow);

            GotoXY(x2,y);

            Write(lin1[i]);

            If i=1 then begin

                         y:=y2+1;

                         i:=2;

                       end

                  else begin

                         y:=y-1;

                         i:=i-1;

                       end;

            TextBackGround(Cyan);

            TextColor(Black);

            GotoXY(x2,y);

            Write(lin1[i]);

          end;

     #80: Begin  {Стpелка вниз}

           y:=WhereY;

           TextBackGround(Blue);

           TextColor(Yellow);

           GotoXY(x2,y);

           Write(lin1[i]);

           If i=2 then begin

                         y:=y2;

                         i:=1;

                       end

                  else begin

                         y:=y+1;

                         i:=i+1;

                       end;

           TextBackGround(Cyan);

           TextColor(Black);

           GotoXY(x2,y);

           Write(lin1[i]);

          end;

     #13: Begin  {Enter}

            y:=WhereY;

            i1:=i;

            obrabvm2(i);

            Window(1,1,80,25);

            out_men2(i);

            i:=i1;

            TextBackGround(Cyan);

            TextColor(Black);

            GotoXY(28,y);

            Write(lin1[i]);

          end;

   end;

 until (ch=#27)  ;

 TextBackGround(Black);

 ClrScr;

 ch:=' ';

 out_menu(1);

end;

{сортировка по имени}

procedure sort_name;

var t:string;

z:real;o:integer;

begin

for i:=1 to n-1 do

for j:=i+1 to n-1 do begin

if  a[j].name<a[i].name  then

begin

t:=a[j].name;

o:=a[j].nalichnye;

z:=a[j].percent;

a[j].name:=a[i].name;

a[j].nalichnye:=a[i].nalichnye;

a[j].percent:=a[i].percent;

a[i].name:=t;

a[i].nalichnye:=o;

a[i].percent:=z;

end;

end;

begin

Window(1,1,80,25);

textbackground(green);

textcolor(white);

ramka(5,7,75,23);

Window(6,8,73,22);

writeln(' №   Фамилия    Наличные  Процент годовых  К выплате ');

writeln(  '═══╬═════════════╬══════════╬═════════════════╬══════════╬');

for j:=1 to n-1 do

writeln(j:2,' ',a[j].name:12,' ',a[j].nalichnye:10,'',a[j].percent:10:3,'       '

,a[j].nalichnye*(a[j].percent*0.01)+a[j].nalichnye:10:5);

 repeat until keypressed;

Window(1,1,80,25);

textbackground(black);

textcolor(LightGray);

GotoXY(1,7);

 for j:=7 to 23 do

 Writeln('░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░');

end;

end;

{Сортировка по вкладу}

procedure sort_nal;

var t:string;

z:real;o:integer;

begin

for i:=1 to n-1 do

for j:=i+1 to n-1 do begin

if  a[j].nalichnye<a[i].nalichnye  then

begin

t:=a[j].name;

o:=a[j].nalichnye;

z:=a[j].percent;

a[j].name:=a[i].name;

a[j].nalichnye:=a[i].nalichnye;

a[j].percent:=a[i].percent;

a[i].name:=t;

a[i].nalichnye:=o;

a[i].percent:=z;

end;

end;

begin

Window(1,1,80,25);

textbackground(green);

textcolor(white);

ramka(5,7,75,23);

Window(6,8,73,22);

writeln(' №   Фамилия    Наличные  Процент годовых  К выплате ');

writeln(  '═══╬═════════════╬══════════╬═════════════════╬══════════╬');

for j:=1 to n-1 do

writeln(j:2,' ',a[j].name:12,' ',a[j].nalichnye:10,'',a[j].percent:10:3,'       '

,a[j].nalichnye*(a[j].percent*0.01)+a[j].nalichnye:10:5);

 repeat until keypressed;

Window(1,1,80,25);

textbackground(black);

textcolor(LightGray);

GotoXY(1,7);

 for j:=7 to 23 do

 Writeln('░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░');

end;

end;

{Сортировка по годовому проценту}

procedure sort_percent;

var t:string;

z:real;o:integer;

begin

for i:=1 to n-1 do

for j:=i+1 to n-1 do begin

if  a[j].percent<a[i].percent  then

begin

t:=a[j].name;

o:=a[j].nalichnye;

z:=a[j].percent;

a[j].name:=a[i].name;

a[j].nalichnye:=a[i].nalichnye;

a[j].percent:=a[i].percent;

a[i].name:=t;

a[i].nalichnye:=o;

a[i].percent:=z;

end;

end;

begin

Window(1,1,80,25);

textbackground(green);

textcolor(white);

ramka(5,7,75,23);

Window(6,8,73,22);

writeln(' №   Фамилия    Наличные  Процент годовых  К выплате ');

writeln(  '═══╬═════════════╬══════════╬═════════════════╬══════════╬');

for j:=1 to n-1 do

writeln(j:2,' ',a[j].name:12,' ',a[j].nalichnye:10,'',a[j].percent:10:3,'       '

,a[j].nalichnye*(a[j].percent*0.01)+a[j].nalichnye:10:5);

 repeat until keypressed;

Window(1,1,80,25);

textbackground(black);

textcolor(LightGray);

GotoXY(1,7);

 for j:=7 to 23 do

 Writeln('░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░');

end;

end;

{вертикальное меню сортировка}

Procedure out_men3(k:Integer);

Begin

 TextBackGround(Blue);

 TextColor(Yellow);

 ramka(43,3,65,9);

 Window(1,1,80,25);

 GotoXY(44,4);

 lin1[1]:=' По фамилии         ';

 lin1[2]:=' По вкладу          ';

 lin1[3]:=' По проценту        ';

 For i:=1 to 5 do

 Begin

  If i=k then begin

                TextBackGround(Cyan);

                TextColor(Black);

              end

         else begin

                TextBackGround(Blue);

                TextColor(Yellow);

              end;

   Writeln(lin1[i]);

   GotoXY(44,i+4)

 end;

end;

Procedure sort;

Begin

 Case i of

  1:sort_name;

  2:sort_nal;

  3:sort_percent;

 end;

end;

{обработка главного меню (пункт сортировка)}

Procedure work2_zap;

Var x2,y2,i1:Integer;

Begin

 out_men3(1);

 GotoXY(44,4);

 i:=1;

 x2:=44;y2:=4;

 repeat

   ch:=ReadKey;

   if ch=#0 then

           begin

             ch:=Readkey;

             ExtendedKey:=True;

           end

           else ExtendedKey:=False;

   case ch of

     #72: Begin  {Стpелка ввеpх}

            y:=WhereY;

            TextBackGround(Blue);

            TextColor(Yellow);

            GotoXY(x2,y);

            Write(lin1[i]);

            If i=1 then begin

                         y:=y2+4;

                         i:=5;

                       end

                  else begin

                         y:=y-1;

                         i:=i-1;

                       end;

            TextBackGround(Cyan);

            TextColor(Black);

            GotoXY(x2,y);

            Write(lin1[i]);

          end;

     #80: Begin  {Стpелка вниз}

           y:=WhereY;

           TextBackGround(Blue);

           TextColor(Yellow);

           GotoXY(x2,y);

           Write(lin1[i]);

           If i=5 then begin

                         y:=y2;

                         i:=1;

                       end

                  else begin

                         y:=y+1;

                         i:=i+1;

                       end;

           TextBackGround(Cyan);

           TextColor(Black);

           GotoXY(x2,y);

           Write(lin1[i]);

          end;

     #13: Begin  {Enter}

            y:=WhereY;

            i1:=i;

            sort;

            Window(1,1,80,25);

            out_men3(i);

            i:=i1;

            TextBackGround(Cyan);

            TextColor(Black);

            GotoXY(44,y);

            Write(lin1[i]);

          end;

   end;

 until (ch=#27)  ;

 TextBackGround(Black);

 ClrScr;

 ch:=' ';

 out_menu(1);

end;

Procedure inf;

Begin

 TextBackGround(Green);

 TextColor(White);

 ramka(5,5,75,20);

 GotoXY(27,6);

 Writeln ('Программа - база данных.');

 GotoXY(27,12);

 Writeln ('Сведения о разработчике');

 GotoXY(29,14);

 Writeln ('Преподаватель Бояринов Ю. Г.');

 GotoXY(29,15);

 Writeln ('группа ПЭ-10');

 GotoXY(29,16);

 Writeln ('бригада № 9');

 GotoXY(29,17);

 Writeln ('студент Лещенко А.В.');

 GotoXY(30,20);

 Writeln('<Enter> - Выход');

 Readln;

 ClrScr;

 out_menu(i);

 GotoXY((i-1)*delta,2);

end;

{Выход с подтверждением}

Procedure Vixod;

Label 1;

Var k:char;

Begin

1:

clrscr;

out_menu(1);

TextBackGround(blue);

TextColor(White);

ramka(16,5,59,9);

GotoXY(32,6);

Writeln('Внимание!');

GotoXY(18,8);

Writeln('Все несохраненные данные будут утеряны');

 TextBackGround(yellow);

TextColor(white);

ramka(20,12,55,15);

GotoXY(28,15);

Writeln('<y> - да, <n> - нет');

 GotoXY(22,12);

Writeln('Вы действительно хотите выйти?');

 GotoXY(34,14);

Textcolor(black);

k:=readkey;

if k='y' then halt

  else if (k='n') or (k=#27) then

                               begin

                                clrscr;

                                out_menu(1);

  end

        else goto 1;

end;

{Обpаботка команд главного меню}

Procedure obrab;

Begin

 Case i of

  1: inf;

  2: work_zap;

  3: work1_zap;

  4: work2_zap;

  5: vixod;

 end;

end;

{основная пpогpамма}

Begin

out_menu(1);

n:=1;

repeat

   ch:=ReadKey;

   if ch=#0 then

           begin

             ch:=Readkey;

             ExtendedKey:=True;

           end

           else ExtendedKey:=False;

   case ch of

     #75: Begin  {Стpелка влево}

            x:=WhereX;

            y:=WhereY;

            TextBackGround(Blue);

            TextColor(Yellow);

            GotoXY((i-1)*delta+2,y);

            Write(lin[i]:delta);

            If i=1 then begin

                         i:=5;

                         x:=(i-1)*delta+2;

                       end

                  else begin

                         i:=i-1;

                         x:=(i-1)*delta+2;

                       end;

            TextBackGround(Cyan);

            TextColor(Black);

            GotoXY(x,y);

            Write(lin[i]:delta);

          end;

     #77: Begin  {Стpелка впpаво}

           x:=WhereX;

           y:=WhereY;

           TextBackGround(Blue);

           TextColor(Yellow);

           GotoXY((i-1)*delta+2,y);

           Write(lin[i]:delta);

           If i=5 then begin

                         i:=1;

                         x:=2;

                       end

                  else begin

                         i:=i+1;

                         x:=(i-1)*delta+2;

                       end;

           TextBackGround(Cyan);

           TextColor(Black);

           GotoXY(x,y);

           Write(lin[i]:delta);

          end;

     #13: Begin  {Enter}

          obrab;

          end;

   end;

 until (0=1) ;

 TextBackGround(Black);

 ClrScr;

end.

 

Выходные формы.

  1. Основной вид программы:

  1. Открытое меню:

  1.  Открытый файл записей:

  1.  Отсортированный файл:

  1.  Поиск по фамилии:

  1. Выход:

Заключение.

Созданная программа удовлетворяет всем предъявленным требованиям, имеет удобный пользовательский интерфейс, позволяющий получить легкий доступ ко всем функциям программы. Использование процедур и функций многократно упрощает и ускоряет написание программы. Язык программирование Turbo Pascal до сих пор является достаточно мощной и гибкой средой программирования. Невозможность создания современного интерфейса с лихвой компенсируется простотой написания программ и скоростью компиляции.


 

А также другие работы, которые могут Вас заинтересовать

29045. Договор подряда: понятие, элементы, права и обязанности сторон 51.5 KB
  По договору подряда одна сторона подрядчик обязуется выполнить по заданию другой стороны заказчика определенную работу и сдать ее результат заказчику а заказчик обязуется принять результат работы и оплатить его. Особенности данного договора: предметом договора является изготовление или переработка вещи либо выполнение другой работы. Оплачивается результат работы который подлежит передаче заказчику а не процесс; сторонами договора являются: подрядчик физическое или юридическое лицо. Отдельные виды договора подряда: бытовой подряд;...
29046. Договор хранения: понятие, элементы, права и обязанности сторон 87 KB
  Договор хранения: предмет договора виды форма договоров хранения. Права и обязанности сторон по договору хранения Договор хранения соглашение по которому хранитель должен хранить вещь переданную ему поклажедателем и возвратить ее в сохранности. Договоры хранения можно разделить на два вида: бытовые как правило безвозмездные и коммерческие.
29047. Договор займа: понятие, элементы, исполнение договора 46.5 KB
  По договору займа одна сторона займодавец передает в собственность другой стороне заемщику деньги или другие вещи определенные родовыми признаками а заемщик обязуется возвратить займодавцу такую же сумму денег сумму займа или равное количество других полученных им вещей того же рода и качества. Предметом займа обычно являются денежные средства однако заем может предоставляться и иными вещами определенными родовыми признаками например зерном топливом. Договор займа является реальным и односторонним договором и считается...
29048. а предусмотренных обстоятельств страхового случая произвести обусловленную страховую выплату другому лиц. 56 KB
  По договору страхования одно лицо страховщик обязано при наступлении в определенный срок или без указания срока предусмотренных обстоятельств страхового случая произвести обусловленную страховую выплату другому лицу страхователю или иному лицу выгодоприобретателю застрахованному лицу и вправе требовать оплаты страховых премий а страхователь обязан уплачивать страховые премии и вправе требовать предоставления соответствующих страховых выплат. Основная функция страхования распределение разложение имущественных потерь...
29049. Договоры поручения, комиссии, агентирования: сравнительная характеристика 90.5 KB
  Договор поручения Договор поручения это соглашение в силу которого одна сторона поверенный обязуется совершить от имени и за счет другой стороны доверителя определенные юридические действия. Договор поручения тесно связан с институтами представительства и доверенности. В то же время в отличие от представительства призванного в первую очередь определить полномочия представителя вовне перед третьими лицами договор поручения регулирует внутреннюю сторону отношений между представителем и представляемым.
29050. Договор банковского счета: понятие, элементы, права и обязанности сторон, ответственность 74 KB
  Договор банковского счета – соглашение в силу которого банк обязуется принимать и зачислять поступающие на счет открытый клиенту владельцу счета денежные средства выполнять распоряжения клиента о перечислении и выдаче соответствующих сумм со счета и проведении других операций по счету . Банк обязан незамедлительно открыть счет клиенту независимо от того поступили для или от клиента денежные средства или нет. Он также является как правило возмездным поскольку обычно клиент уплачивает банку комиссионные за проведение расчетных...
29051. Обязательства из причинения вреда: понятие, условия возникновения, объем возмещения 57 KB
  Обязательства возникающее вследствие причинения вреда это охранительное правоотношение в силу которого должник причинитель вреда обязан возместить в полном объеме вред причиненный личности или имуществу кредитора потерпевшего а кредитор вправе требовать возмещения понесенного им вреда. В связи с тем что возникновение обязательств из причинения вреда не основано на договоре соглашении его участников их наряду с обязательствами из неосновательного обогащения относят к категории внедоговорных обязательств. Исполнение этого...
29052. Авторское право: понятие, объекты, субъекты, права авторов произведений 105 KB
  Необходимо различать сами произведения имеющие нематериальную сущность и ту вещественную форму в которой они воплощены рукопись изображение. Авторское право распространяется на произведения науки литературы и искусства являющиеся результатом творческой деятельности независимо от назначения и достоинства произведения а также способа его выражения. К таким произведениям относятся: литературные произведения включая программы для ЭВМ; драматические и музыкальнодраматические сценарные произведения; хореографические произведения и...
29053. Права, смежные с авторскими: понятие, объекты 83 KB
  Смежные права это интеллектуальные права на результаты исполнительской деятельности исполнения на фонограммы на сообщение в эфир или по кабелю радио и телепередач вещание организаций эфирного и кабельного вещания на содержание баз данных а также на произведения науки литературы и искусства впервые обнародованные после их перехода в общественное достояние. Cмежные права существуют только тогда когда есть произведение которое можно исполнить записать на фонограмму включить в передачу организации эфирного и кабельного вещания и...