Запуск программы осуществляется двойным нажатием левой клавиши мыши по значку исполняемого модуля с названием Kurs.

После открытия окна программы пользователь видит вертикальное меню. Выбор пункта меню осуществляется функциональными клавишами (рисунок В. 1).

При выборе пункта меню "Ввод данных" программа предлагает ввести предполагаемое количество данных. После чего поэлементно запрашивает ФИО садовода, количество соток, цену одной сотки (рисунок В.2).

При выборе пункта меню "Запись в файл" программа предлагает ввести имя файла (предпочтительно латинскими буквами).

При выборе пункта меню "Чтение из файла" программа запрашивает имя ранее созданного файла.

При выборе пункта меню "Вывод данных" программа выводит на экран заполненную базу данных (рисунок В.3).

При выборе пункта меню "Удаление" программа предлагает ввести ФИО удаляемого садовода, если садовод с такими данными найден, он удаляется из списка.

При выборе пункта меню "Поиск" пользователю предлагается выбрать атрибут, по которому будет производится поиск (ФИО, количество соток, общий взнос). После выбора атрибута необходимо ввести атрибут, принадлежащий искомому садоводу. Если садовод будет найден, на экран будут выведены данные о нем (рисунок В.5).

При выборе пункта меню "Сортировка" список садоводов будет отсортирован по возрастанию (ключ сортировки - количество соток).

При выборе пункта меню "Диаграмма" на экран будет выведена круговая диаграмма, отражающая соотношение годовых взносов всех садоводов с соответствующими подписями (рисунок В.4).

программа язык turbo pascal

При выборе пункта меню "Дополнение данных" повторяется алгоритм пункта "Ввод данных".

При выборе пункта меню "Выход из программы" будет произведен выход из программного приложения.

Все изменения, произошедшие в базе данных можно увидеть, выбрав пункт меню "Вывод данных".

В любое время пользователь может вернуться в меню, нажав клавишу Enter.

Таблица 2 - Сообщения программы

Заключение

А.1. Текст основной программы (Kurs)

uses crt, IO,graph;

const

FillPattern: FillPatternType= ($00,$11,$10,$12,$7e,$fa,$18,$00);

procedure InputData;

begin

NumberGartner: =0;

Input;

end;

procedure paint;

const R=100; x=150; y=150;

colorG=7;

var sum: integer;

gd,gm,m,n,err, i: integer;

a,b: real; ss: string;

begin

DetectGraph (gd,gm);

InitGraph (gd,gm,'');

if GraphResult<>grOk then Halt (1);

SetColor (colorG);

Circle (x,y,R);

sum: =0;

a: =0;

for i: =1 to NumberGartner do

sum: =sum+GartnerArray [i]. PriseAll;

for i: =1 to NumberGartner do

begin

a: =a+2*Pi*GartnerArray [i]. PriseAll/sum;

Line (x,y,x+round (R*cos (a)),y+round (R*sin (a)));

end;

a: =0; b: =0; i: =0;

for i: =1 to NumberGartner do

begin

b: =a;

a: =a+2*Pi*GartnerArray [i]. PriseAll/sum;

SetFillPattern (FillPattern,Random (GetMaxColor));

m: = (2*x+round (R*cos (a- (a-b) /2))) div 2;

n: = (2*y+round (R*sin (a- (a-b) /2))) div 2;

FloodFill (m,n,colorG);

str (GartnerArray [i]. PriseAll,ss);

OutTextXY (m,n,ss);

RectAngle (3*R, i*25, 3*R+20, i*25+20);

FloodFill (3*R+2, i*25+3,colorG);

OutTextXY (3*R+30, i*25+5, GartnerArray [i]. fio);

end;

end;

begin

NumberGartner: =0;

repeat

clrscr;

Writeln ('F1-Ввод данных');

Writeln ('F2-Запись в файл');

Writeln ('F3-Чтение из файла');

Writeln ('F4-Вывод данных');

Writeln ('F5-Удаление');

Writeln ('F6-Поиск');

Writeln ('F7-Сортировка');

Writeln ('F8-Диаграмма');

Writeln ('F9-Дополнение данных');

Writeln ('F10-Выход из программы');

case readkey of

#59: begin clrscr; inputdata; end;

#60: begin clrscr; writefile; end;

#61: begin clrscr; readfile; end;

#62: begin clrscr; Outputall; end;

#63: begin clrscr; Deletegartner1; end;

#64: begin clrscr; Search; end;

#65: begin clrscr; sort; end;

#66: paint;

#67: begin clrscr; input; end;

#68: halt;

end;

until false;

end.

А.2. Текст модуля программы (IO)

unit IO;

interface

uses crt;

const Nconst=50;

type

TGartner=record

FIO: string [50];

NumberSot: integer;

Prise1,PriseAll: integer;

end;

procedure Input;

procedure Output1 (i: integer);

procedure OutputAll;

procedure ReadFile;

procedure WriteFile;

procedure DeleteGartner1;

procedure Search;

procedure Sort;

var GartnerArray: array [1. Nconst] of TGartner;

NumberGartner: integer;

implementation

procedure Input;

var n, i: integer;

begin

writeln;

writeln ('Ввод данных в массив. Следуйте пошаговой инструкции. Ввод очередного элемента завершайте нажатием клавиши Enter');

writeln;

writeln;

Writeln ('Введите число записей->');

Readln (n);

for i: =1 to n do

with GartnerArray [NumberGartner+1] do

begin

Writeln ('Садовод №', i);

Write ('Введите ФИО->');

Readln (FIO);

Write ('Введите количество соток->');

{$I-}

Readln (NumberSot);

{$I+}

if IOResult<>0 then

begin

Writeln ('Введен недопустимый символ! ');

Readln;

readln;

exit;

end;

Write ('Введите цену одной сотки->');

{$I-}

Readln (Prise1);

{$I+}

if IOResult<>0 then

begin

Writeln ('Введен недопустимый символ! ');

Readln;

readln;

exit;

end;

PriseAll: =Prise1*NumberSot;

inc (NumberGartner);

Writeln ();

end;

Writeln ('Ввод окончен');

readln;

end;

procedure Output1 (i: integer);

begin

Writeln;

with GartnerArray [i] do

begin

Writeln ('ФИО',FIO);

Writeln ('Количество соток',NumberSot);

Writeln ('Цена одной сотки',Prise1);

Writeln ('Общий взнос',PriseAll);

end;

readln;

end;

procedure OutputAll;

var i,j: integer;

begin

writeln;

writeln ('Вывод данных на экран. Для возврата в меню нажмите клавишу Enter');

writeln;

writeln;

write (#218);

for i: =1 to 67 do

write (#196);

writeln (#191);

Writeln (#179,'ФИО': 30,#179,'Кол. соток': 12,#179,'Цена 1-й': 10,#179,'Итог: 12,#179);

for i: =1 to NumberGartner do

with GartnerArray [i] do

begin

writeln (#179,Fio: 30,#179,NumberSot: 12,#179,Prise1: 10,#179,PriseAll: 12,#179);

end;

write (#192);

for j: =1 to 67 do

write (#196);

writeln (#217);

readln;

end;

procedure ReadFile;

var f: file of TGartner; fileName: string;

begin

writeln;

writeln ('Чтение данных из файла. Введите имя уже существующего файла, затем нажмите клавишу Enter');

writeln;

writeln;

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

Readln (fileName);

Assign (f,fileName);

{$I-}

Reset (f);

{$I+}

if IOResult<>0then

begin

writeln ('Указанный файл не найден! ');

readln;

exit;

end;

while not (Eof (f)) do

begin

inc (NumberGartner);

Read (f,GartnerArray [NumberGartner]);

end;

Close (f);

Writeln ('Ввод окончен! ');

readln;

end;

procedure WriteFile;

var f: file of TGartner; fileName: string; i: integer;

begin

writeln;

writeln ('Запись данных в файл. Введите имя файла, затем нажмите клавишу Enter');

writeln;

writeln;

if NumberGartner=0 then

begin

Writeln ('Список садоводов пуст! ');

readln;

exit;

end;

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

Readln (fileName);

Assign (f,fileName);

Rewrite (f);

for i: =1 to NumberGartner do

Write (f,GartnerArray [i]);

Close (f);

Writeln ('Запись завершена');

readln;

end;

procedure DeleteGartner1;

var fio: string; i,j: integer;

begin

writeln;

writeln ('Удаление элемента массива. Введите предлагаемый атрибут, затем нажмите клавишу Enter');

writeln;

writeln;

Write ('Введите ФИО садовода->');

Readln (fio);

for i: =1 to NumberGartner do

if GartnerArray [i]. FIO=fio then

begin

for j: =i to NumberGartner-1 do

GartnerArray [j]: =GartnerArray [j+1];

Writeln ('Запись успешно удалена');

dec (NumberGartner);

readln;

exit;

end;

Writeln ('Садовод с такими данными не найден! ');

readln;

end;

procedure Search;

var menu,buf, i: integer; fio: string; key: boolean;

begin

writeln;

writeln (`Поиск элемента массива. Выберете один из предлагаемых атрибутов поиска, введите соответствующий ему номер и нажмите Enter');

writeln;

writeln;

Writeln ('Введите атрибуты поиска: ');

Writeln ('1-ФИО');

Writeln ('2-Количество соток');

Writeln ('3-Общий взнос');

Write ('->');

{$I-}

Readln (menu);

{$I+}

if IOResult<>0 then

begin

Writeln ('Введен недопустимый символ! ');

readln;

readln;

exit;

end;

key: =false;

case menu of

1:

begin

Write ('Введите ФИО->');

Readln (fio);

for i: =1 to NumberGartner do

if fio=GartnerArray [i]. FIO then

begin

if key=false then Writeln ('Найденные записи: ');

Output1 (i);

key: =true;

end;

if key=false then Writeln ('Садоводы с требуемыми атрибутами не найдены');

readln;

end;

2:

begin

Write ('Введите количество соток->');

{$I-}

Readln (buf);

{$I+}

if IOResult <>0 then

begin

Writeln ('Введен недопустимый символ! ');

readln;

readln;

exit;

end;

for i: =1 to NumberGartner do

if buf=GartnerArray [i]. NumberSot then

begin

if key=false then Writeln ('Найденные записи: ');

Output1 (i);

key: =true;

end;

if key=false then Writeln (' Садоводы с требуемыми атрибутами не найдены');

readln;

end;

3:

begin

Write ('Введите сумму общего взноса->');

{$I-}

Readln (buf);

{$I+}

if IOResult <>0 then

begin

Writeln ('Введен недопустимый символ! ');

readln;

readln;

exit;

for i: =1 to NumberGartner do

if buf=GartnerArray [i]. PriseAll then

begin

if key=false then Writeln ('Найденные записи: ');

Output1 (i);

key: =true;

end;

end;

if key=false then Writeln ('Садоводы с требуемыми атрибутами не найдены');

readln;

end;

end;

end;

procedure Sort;

var bufArray: array [1. Nconst] of TGartner;

KeyArray: array [1. Nconst] of byte; i,j: integer;

begin

if NumberGartner=0 then

begin

Writeln ('Список садоводов пуст! ');

readln;

exit;

end;

for i: =1 to NumberGartner do

KeyArray [i]: =0;

writeln;

Writeln ('Сортировка по возрастанию');

for i: =1 to NumberGartner-1 do

for j: =i+1 to NumberGartner do

if GartnerArray [i]. PriseAll>GartnerArray [j]. PriseAll

then inc (keyArray [i]) else inc (keyArray [j]);

for i: =1 to NumberGartner do

bufArray [keyArray [i] +1]: =GartnerArray [i];

for i: =1 to NumberGartner do

GartnerArray [i]: =bufArray [i];

Writeln ('Список отсортирован! ');

readln;

end;

end.

Приложение В. результаты работы программы

Рисунок В. 2-Вид окна программы после запуска

Рисунок В. 3-Ввод данных с клавиатуры

Рисунок В. 4-Вывод данных на экран

Рисунок В. 5-вывод на экран круговой диаграммы

Рисунок В.1. 6-Поиск по заданному атрибуту

Размещено на Allbest.ru