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 до сих пор является достаточно мощной и гибкой средой программирования. Невозможность создания современного интерфейса с лихвой компенсируется простотой написания программ и скоростью компиляции.


 

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

10706. Мина Мазайло - Куліш Микола - Комедія 17.74 KB
  Мина Мазайло Куліш Микола Комедія Перша дія 1 Розмова Рини Мазайло з її подругою Улею з якої зясовується що у родині Мазайла відбуваються сварки через сторичне питання. Мокій Мазайло дуже захоплюється українською мовою і хоче переробити своє прізвище на МазайлоКв...
10707. Лісова пісня - Українка Леся - Драма-феєрія в 3-х діях 16.09 KB
  Лісова пісня Українка Леся Драмафеєрія в 3х діях Пролог Старий ліс на Волині дика і таємнича місцина. Початок весни. З лісу вибігає Той що греблі рве. Вік перемовляється з потерчатами та Русалкою яка нагадує йому про своє кохання дорікає зрадою. Водяник сварить Рус...
10708. Камінний господар - Леся Українка 14.25 KB
  Камінний господар Леся Українка Камінний господар поетична драма обробка Лесі Українки в якій уперше в українській літературі зображається образ чоловікаспокусника. Імпульсом до написання твору стала пушкінська драма Камінний гість. У творі було вкладено відм
10709. Микола Джеря - Нечуй-Левицький Іван 16.56 KB
  Микола Джеря Нечуй-Левицький Іван Понад самим берегом вється в траві стежка через усе село. Підеш тією стежкою глянеш кругом себе і скрізь бачиш зеленезелене море верб садків конопель соняшників кукурудзи та густої осоки. От стеляться розложисті як скатерть зел
10710. Маруся Чурай - Костенко Ліна 20.11 KB
  Маруся Чурай Костенко Ліна РОЗДІЛ І Якби знайшлась неопалима книга Під час пожежі у Полтаві 1658 року згоріли всі документи міських судових справ. А можливо серед них могла б знайтися справа Марусі Чурай. Справа ця розглядалася на одному з судів з приводу вбивства козака...
10711. Fata morgana - Коцюбинський Михайло - (З сільських настроїв) - Повість 19.4 KB
  Fata morgana Коцюбинський Михайло З сільських настроїв Повість ЧАСТИНА ПЕРША Проходячи біля зруйнованої сахарні Андрій Волик згадує своє колишнє життя. Він працював на фабриці та отримував кожного місяця 13 карбованців. Тепер сахарня стоїть пусткою але Андрій сподіває...
10712. Три зозулі з поклоном - Тютюнник Григір – Новела - Любові всевишній присвячується 14 KB
  Три зозулі з поклоном Тютюнник Григір Новела Любові всевишній присвячується Повертаючись додому хлопець помічає що сусідка Марфа Яркова щось дуже пильно його розглядає. Мати пояснює що Марфа любила його батька а він на нього схожий. Потім мати згадує що Марфа за
10713. Місто - Підмогильний Валерян 21.33 KB
  Місто Підмогильний Валерян Частина перша Степан стояв на палубі корабля що плив до Києва по Дніпру оглядав береги прощався подумки з рідним селом селами що виднілися на березі. Він їде до великого міста щоб учитись і жити щоб здійсни ти свою давню мрію. Разом із ним...
10714. Мойсей - Франко Іван 19.03 KB
  Мойсей Франко Іван Автор звертається у пролозі до свого замученого розбитого народу який стоїть на роздоріжжі й не знає куди йти. Саме його майбутнім і тривожиться поет не вірить що судилося йому в сусідів бути гноєм що його долею буде укрита злість облудлива пок