1537
Программа для обработки справочного массива записей о банковской карточке лицевого счета
Контрольная
Информатика, кибернетика и программирование
В данной работе используется сортировка обменом, суть ее состоит в том, что пары стоящих рядом элементов просматриваются в направлении снизу вверх и сравниваются. Если верхний элемент оказывается меньше нижнего по рисунку, то они меняются местами. Продолжая этот процесс циклически, в конце концов приходим к отсортированному файлу.
Русский
2013-01-06
199.82 KB
2 чел.
Техническое задание.
Разработанная программа предназначена для обработки справочного массива записей, содержащих сведения о банковской карточке лицевого счета. Структура записи: фамилия , вклад, годовой процент. Записи сохраняются в типизированном файле. Программа обеспечивает получение следующей информации:
Для получения информации используется сортировка обменом.
Разработчик студент группы ПЭ - 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 Анализ технического задания.
В соответствии с техническим заданием необходимо разработать многомодульную программу создания и обработки справочного массива записей.
Обязательным для программы является наличие меню со следующими опциями:
дополнительные опции:
Программа состоит из процедур и функций, каждая из которых соответствует пункту меню или служит для его обработки.
Использование модулей в программе сокращает время разработки, уменьшает объем памяти, занимаемый программой, делает ее структуру простой и понятной. Сортировка вставкой является простейшей, но ресурсоемкой, однако, когда число элементов массива не велико это не имеет значения.
Защита от неправильного и случайного ввода осуществляется следующим образом: если ввод случаен, т. е. вместо цифры введена буква программа просто проигнорирует это действие пользователя и продолжит ожидать ввода.
Использование типизированного файла для внешнего хранения информации с одной стороны снижает универсальность программы (невозможность открытия другими программами), но с другой стороны предотвращает несанкционированный доступ к базе данных.
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.
Выходные формы.
Заключение.
Созданная программа удовлетворяет всем предъявленным требованиям, имеет удобный пользовательский интерфейс, позволяющий получить легкий доступ ко всем функциям программы. Использование процедур и функций многократно упрощает и ускоряет написание программы. Язык программирование Turbo Pascal до сих пор является достаточно мощной и гибкой средой программирования. Невозможность создания современного интерфейса с лихвой компенсируется простотой написания программ и скоростью компиляции.
А также другие работы, которые могут Вас заинтересовать | |||
73659. | Латинская патристика IV - V века | 150 KB | |
Прилагательное латинская приложенное к слову патристика указывая на то внешнее обстоятельство что церковные писатели о которых пойдет речь пользовались преимущественно или только латинским языком вместе с тем нацеливает на выявление некоторых особенностей более существенным образом характеризующих описываемое явление коль скоро перевод с одного языка на другой это всегда в какойто степени переход из одной культурной реальности в другую. Движение это происходит не только в пространстве но и... | |||
73660. | Антинаполеоновские коалиции и их противник | 37.73 KB | |
Троицкий считает что гуманная фразеология дипломатических документов освобождение от ига и цепей Наполеона обеспечение прав и свобод народов это не более чем фиговый листок . Данное обстоятельство в немалой степени обеспечило поражение Наполеона в информационной и идеологической войне а это в свою очередь безусловно повлияло и на достижение конечного победного результата в военных действиях. Поэтому не стоит столь категорично сбрасывать со счетов либеральную... | |||
73661. | ПРАКТИКА ИСПОЛЬЗОВАНИЯ АВТОМАТИЗИРОВАННЫХ ИНФОРМАЦИОННЫХ ТЕХНОЛОГИЙ УПРАВЛЕНИЯ | 350.5 KB | |
Первоначально системы MRP фактически просто формировали на основе утвержденной производственной программы план заказов на определенный период. Термин замкнутый цикл отражал основную особенность модифицированной системы заключающуюся r том что созданные в процессе ее работы отчеты анализируются и учитываются на дальнейших этапах планирования т. Системы типа MRP используют то что зависимый спрос можно прогнозировать поскольку в его основе лежат планы производства. Суть системы MRP состоит в следующем: на базе заказов определяется... | |||
73663. | Управление финансовой деятельностью предприятия | 79.5 KB | |
Управление финансовой деятельностью предприятия Тема включает два раздела: Сущность управления финансовой деятельностью предприятия. Сущность управления финансовой деятельностью предприятия Цели задачи и функции финансового менеджмента. Финансовый механизм и основные инструменты управления финансовой деятельностью предприятия. Финансовая политика предприятия. | |||
73664. | Информационное обеспечение управления финансовой деятельностью | 68.5 KB | |
Управленческий учет как механизм финансового менеджмента Информационное обеспечение предназначено для предоставления управленческому персоналу информации оперативного и финансового учета необходимой для анализа результатов финансово-хозяйственной деятельности предприятия. | |||