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


 

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

83630. Перечислить основные виды спецификаций и что отражает экспликация на чертеже 30.3 KB
  Описание спецификации дается в ГОСТ 2. Над основной надписью помещаются графы спецификации. В основной надписи спецификации указывают наименование сборочной единицы масштаб ее изображения. Спецификации первого типа чаще используются в конструкторскотехнологических подразделениях а второго на сборочных участках и при работе по заказам.
83631. Перечислить мероприятия предотвращающие электромагнитную наводку на кабели в ОРУ и устройства в ЗРУ 29.45 KB
  Должны выполняться мероприятия исключающие электростатические и электромагнитные наводки на металлических элементах расположенных в помещениях аккумуляторных батарей а также заносы туда высоких потенциалов. Для защиты от электростатической индукции на указанных элементах достаточно надежно присоединить к общему заземляющему устройству электростанций и подстанций гладкие трубы в помещениях аккумуляторных батарей предназначенные для отопления и выдержать расстояния от токоведущих шин до частей здания и других заземленных элементов не менее...
83632. Назначение кабельного журнала и что отражено на листах кабельного журнала 30.27 KB
  В кабельном журнале описывается маркировка каждого кабеля откуда и куда он идет его марка длина кабельной линии и его назначение. Назначение: Всю необходимую информацию о кабелях можно представить непосредственно на схемах: можно указать марку длину способ прокладки кабеля. Однако при построении достаточно большой системы во избежание перегруженности чертежей удобнее вынести эти данные в отдельную таблицу оставив на схемах лишь присвоенные кабелям обозначения. Во время монтажа в кабельный журнал заносятся следующие сведения: номер...
83633. Выполнение чертежей оперативной блокировки на ПС. Что должно быть отражено на чертеже. Какие виды блокировки коммутационных оборудований используются на ПС 30.11 KB
  Основные требования к оперативной блокировке: Блокзамки блокировки должны запирать приводы разъединителей только в крайних положениях включено и отключено; они не должны запирать привод разъединителя в промежуточном положении; Оперативная блокировка не должна давать ложное разрешение на операции с разъединителями при исчезновении напряжения оперативного тока или неисправностях самой оперативной блокировки. Механическая блокировка это блокировка непосредственного действия которая может быть выполнена на близко...
83634. Нелинейные магнитные цепи при постоянных потоках 161 KB
  Для концентрации магнитного поля и придания ему желаемой конфигурации отдельные части электротехнических устройств выполняются из ферромагнитных материалов. Векторные величины характеризующие магнитное поле Наименование Обозначение Единицы измерения Определение Вектор магнитной индукции Тл тесла Векторная величина характеризующая силовое действие магнитного поля на ток по закону Ампера Вектор намагниченности А м Магнитный момент единицы объема вещества Вектор напряженности магнитного поля А м где Гн м магнитная постоянная Основные...
83635. Общая характеристика задач и методов расчета магнитных цепей 128 KB
  При этом для наглядности можно составить эквивалентную электрическую схему замещения исходной магнитной цепи с использованием которой выполняется расчет. При расчете магнитных цепей на практике встречаются две типичные задачи: задача определения величины намагничивающей силы НС необходимой для создания заданного магнитного потока заданной магнитной индукции на каком либо участке магнитопровода задача синтеза или ldquo;прямаяldquo; задача; задача нахождения потоков магнитных индукций на отдельных участках цепи по заданным...
83636. Нелинейные цепи переменного тока в стационарных режимах 136.5 KB
  Когда постоянная времени нагрева τ одного порядка с Т соотношения между переменными составляюшими напряжения и тока являются более сложными определяющими сдвиг по фазе между ними. Другой важной особенностью нелинейных элементов в цепи переменного тока является вызываемое ими появление высших гармоник даже при наличии в цепи только источников синусоидального напряжения и или тока. На этом принципе строится например ряд умножителей частоты а также преобразователей формы тока или напряжения.
83637. Графический метод с использованием характеристик по первым гармоникам 130 KB
  Основные этапы расчета: строится график зависимости нелинейного элемента для первых гармоник; произвольно задаются амплитудой одной из переменных например связанной с нелинейным элементом и по характеристике последнего находят другую переменную определяющую режим работы нелинейного элемента после чего принимая все величины синусоидально изменяющимися во времени на основании построения векторной диаграммы определяется амплитуда первой гармоники переменной на входе цепи; путем построения ряда векторных диаграмм для различных...
83638. Метод кусочно-линейной аппроксимации 134 KB
  Для каждого участка ломаной определяются эквивалентные линейные параметры нелинейного элемента и рисуются соответствующие линейные схемы замещения исходной цепи. Расчет каждой из полученных линейных схем замещения при наличии в цепи одного нелинейного элемента и произвольного числа линейных не представляет труда. При наличии в цепи переменного источника энергии рабочая изображающая точка будет постоянно скользить по аппроксимирующей характеристике переходя через точки излома.