Запуск программы и меню запросов

После запуска программы пользователю предоставляется меню с доступными действиями. Для выбора действия требуется ввести индекс пункта меню, указанный слева от описания нужного действия и подтвердить его клавишей <Enter>.

Рисунок 1 – Меню программы сразу после запуска

В случае нелегального ввода выводится сообщение об ошибке (рисунок 2).

 

Рисунок 2 – Сообщение об ошибке ввода номера пункта меню

Загрузка файлов

Рисунок 3 – Загрузка массива данных с диска

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

Рисунок 4 – Сообщение об ошибке загрузки файла

Добавление записи в конец массива

Рисунок 5 – Ввод данных для добавления новой записи

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

Просмотр массива данных в виде таблицы

Все записи выводятся на экран в виде таблицы в том порядке, в каком они хранятся в массиве.

Рисунок 6 – Просмотр всех записей в массиве данных

Редактирование записи

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

Рисунок 7 – Массив после редактирования записи

Сортировка записей

Рисунок 8 – Меню выбора поля и направления сортировки

Рисунок 9 – Отсортированный по возрастанию количества единиц техники массив

При выборе пункта сортировки пользователю выводятся дополнительные меню для выбора поля сортировки (номер, количество техники или длина маршрута) и направления сортировки (по возрастанию или убыванию). Меню работают полностью аналогично главному меню.

Удаление элементов, начиная с указанного

При удалении «хвоста» массива пользователю требуется ввести начальный индекс удаляемых элементов.

Рисунок 10 – Удаление элементов до конца

Сохранение массива данных

Рисунок 11 – Сохранение массива записей под новым (или старым) именем

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

Заключение

В процессе выполнения курсовой работы на языке Паскаль в системе Borland Turbo Pascal 7.0 было написано приложение, обрабатывающее массив записей, описывающих маршруты общественного транспорта и содержащие поля для номера (строка), количества единиц техники на маршруте (целое число) и длины маршрута (вещественное число).

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

В процессе работы были изучены приемы работы с массивами записей, функции для работы с консолью, способы преобразования данных между строковым и числовым представлениями, базовые приемы работы с объектно-ориентированными  расширениями Borland Pascal 7.0.

Список использованных источников

1  Кинг, Д. Создание эффективного программного обеспечения: Пер. с англ. / Дэвид Кинг – М.: Мир, 1991. – 288 с., ил. ISBN 5-03-002005-5

2  Кнут, Д. Э. Искусство программирования: т. 3 – Сортировка и поиск / Дональд Э. Кнут. – М.: Мир, 1978. – 335 с.

3  Рапаков, Г. Г., Ржеуцкая, С. Ю. Программирование на языке Pascal. – СПб.: БХВ-Петербург, 2004. – 351 с.

4  Фаронов В. В. Turbo Pascal 7.0. Учебный курс. // В. В. Фаронов. – М.: КноРус. – 2011. – 368 с.

5  Borland Pascal. Руководство пользователя [Электронный ресурс] – 1994 – Режим доступа: http://www.helloworld.ru/texts/comp/lang/pascal/bp70/index.htm – Дата доступа: 09.03.2017

Приложение А

(*****************************************************************************

Главная программа.

Отображает меню и выполняет запросы пользователя.

 

*****************************************************************************)

PROGRAM Main;

 

USES

Util,

TextMenu,

Transp;

 

VAR

main_menu: PMenu;

load_item: integer;

save_item: integer;

view_item: integer;

add_item: integer;

edit_item: integer;

sort_item: integer;

del_item: integer;

selection: integer;

field_menu: PMenu; { меню поля сортировки }

num_item: integer;

cnt_item: integer;

len_item: integer;

dir_menu: PMenu; { меню направления сортировки }

asc_item: integer; { по возр. }

desc_item: integer; { по убыв. }

filename: string; { имя файла текущего загруженного или пустая }

 

procedure view;

begin

viewItems;

end;

 

procedure load;

var

f: text;

okay: boolean;

fname: string;

tmp: Marshrut;

data: string;

begin

fname:= InputString('имя файла');

okay:= OpenFileRead(fname,f);

if okay then begin

   clearItems;

   repeat

       ReadLn(f,data);

       if length(data)>0 then begin

           okay:= readItem(tmp,data);

           if okay then okay:= addItem(tmp);

       end;

   until EOF(f) or (not okay);

   CloseFile(f);

end;

if not okay then

   Report('* Ошибка чтения!')

else begin

   filename:= fname;

   view;

end;

end;

 

procedure save;

var

f: text;

okay: boolean;

fname: string;

sz, i: integer;

tmp: Marshrut;

begin

if length(filename)>0 then begin

   fname:= InputString('имя файла ('+filename+')');

   if length(fname)=0 then fname:= filename;

end else begin

   fname:= InputString('имя файла');

end;

okay:= OpenFileWrite(fname,f);

if okay then begin

   sz:= getSize;

   for i:=1 to sz do begin

       okay:= getItem(i,tmp);

       WriteLn(f,writeItem(tmp));

   end;

   CloseFile(f);

end;

if not okay then

   Report('* Ошибка записи!')

else begin

   filename:= fname;

   WriteLn('Операция выполнена успешно.');

end;

end;

 

procedure add;

var

tmp: Marshrut;

okay: boolean;

buf: string;

begin

okay:= true;

tmp.number:= InputString('номер маршрута');

okay:= StrToInt(InputString('кол-во единиц техники'),tmp.count);

if okay then okay:= StrToReal(InputString('длину маршрута'),tmp.length_km);

if okay then okay:= addItem(tmp);

if okay then view else Report('Операция отменена');

end;

 

procedure edit;

var

tmp: Marshrut;

okay: boolean;

buf: string;

idx: integer;

begin

okay:= StrToInt(InputString('индекс редактируемого элемента'),idx);

if okay then okay:= getItem(idx,tmp);

if okay then begin

   buf:= InputString('номер ('+tmp.number+')');

   if length(buf)>0 then tmp.number:= buf;

end;

if okay then begin

  if okay then buf:= InputString('кол-во единиц техники ('+IntToStr(tmp.count)+')');

   if okay then begin

       if length(buf)>0 then

           okay:= StrToInt(buf,tmp.count)

   end;

end;

if okay then begin

   if okay then buf:= InputString('длина маршрута ('+RealToStr(tmp.length_km)+')');

   if okay then begin

       if length(buf)>0 then

           okay:= StrToReal(buf,tmp.length_km)

   end;

end;

if okay then okay:= setItem(idx,tmp);

if okay then view else Report('Операция отменена');

end;

 

procedure sort;

var

field: integer;

dir: integer;

okay: boolean;

begin

field:= field_menu^.SelectItem;

okay:= field<>EXIT_ITEM;

if okay then dir:= dir_menu^.SelectItem;

if okay then okay:= dir<>EXIT_ITEM;

if okay then begin

   if field=num_item then sortItemsByNumber(dir=desc_item)

   else if field=cnt_item then sortItemsByCount(dir=desc_item)

   else if field=len_item then sortItemsByLength(dir=desc_item);

   view;

end else

   Report('Операция отменена');

end;

 

procedure delToEnd;

var

index: integer;

okay: boolean;

begin

okay:= StrToInt(InputString('индекс первого удаляемого элемента'),index);

if okay then okay:= trimItems(index);

if okay then view else Report('Операция отменена');

end;

 

BEGIN

main_menu:= New(PMenu,Init('Главное меню','Выход'));

load_item:= main_menu^.AddItem('Загрузить файл');

save_item:= main_menu^.AddItem('Сохранить файл');

view_item:= main_menu^.AddItem('Просмотреть элементы');

add_item:= main_menu^.AddItem('Добавить элемент');

edit_item:= main_menu^.AddItem('Изменить элемент');

sort_item:= main_menu^.AddItem('Сортировать элементы');

del_item:= main_menu^.AddItem('Удалить элементы');

field_menu:= New(PMenu,Init('Поле сортировки','Отмена'));

num_item:= field_menu^.AddItem('Номер маршрута');

cnt_item:= field_menu^.AddItem('Кол-во единиц техники');

len_item:= field_menu^.AddItem('Длина маршрута');

dir_menu:= New(PMenu,Init('Порядок сортировки','Отмена'));

asc_item:= dir_menu^.AddItem('По возрастанию');

desc_item:= dir_menu^.AddItem('По убыванию');

filename:= '';

 

repeat

   selection:= main_menu^.SelectItem;

   if selection=load_item then load

   else if selection=save_item then save

   else if selection=view_item then view

   else if selection=add_item then add

   else if selection=edit_item then edit

  else if selection=sort_item then sort

   else if selection=del_item then delToEnd;

until selection=EXIT_ITEM;

 

Dispose(dir_menu,Done);

Dispose(field_menu,Done);

Dispose(main_menu,Done);

END.

Приложение Б

(*****************************************************************************

Определения записи о транспорте, и функции доступа к массиву этих

записей.

*****************************************************************************)

UNIT Transp;

 

INTERFACE

 

CONST

MAX_SIZE = 128;

 

TYPE

Marshrut = record

   number: string;

   count: integer;

   length_km: real;

end;

 

(**

 * Создание маршрута из строки (прочитанной из файла например).

 *)

function readItem(var item: Marshrut; str: string): boolean;

(**

 * Получение строки для записи в файл.

 *)

function writeItem(var item: Marshrut): string;

(**

 * Размер массива.

 *)

function getSize: integer;

(**

 * Очистка массива.

 *)

procedure clearItems;

(**

 * Удаление элемемнтов начиная с startindex до конца массива.

 *)

function trimItems(startindex: integer): boolean;

(**

 * Добавление элемента в конец массива.

 *)

function addItem(var item: Marshrut): boolean;

(**

 * Редактирование элемента в позиции index.

 *)

function setItem(index: integer; var item: Marshrut): boolean;

(**

 * Редактирование элемента в позиции index.

 *)

function getItem(index: integer; var item: Marshrut): boolean;

(**

 * Просмотр всех элементов.

 *)

procedure viewItems;

(**

 * Сортировка элементов по номеру. desc = true - по убыванию.

 *)

procedure sortItemsByNumber(desc: boolean);

(**

 * Сортировка элементов по кол-ву. desc = true - по убыванию.

 *)

procedure sortItemsByCount(desc: boolean);

(**

 * Сортировка элементов по длине. desc = true - по убыванию.

 *)

procedure sortItemsByLength(desc: boolean);

 

IMPLEMENTATION

 

USES

Util;

 

VAR

items: array [1..MAX_SIZE] of Marshrut;

item_count: integer;

 

function readItem(var item: Marshrut; str: string): boolean;

var

rest:  string;

okay:  boolean;

tmp:   Marshrut;

strpos: byte;

begin

okay:= true;

rest:= str;

strpos:= Pos('|',rest);

if strpos>0 then

   tmp.number:= Copy(rest,1,strpos-1)

else

   okay:= false;

if okay then begin

   rest:= Copy(rest,strpos+1,length(rest)-strpos);

   strpos:= Pos('|',rest);

   if strpos>0 then

       okay:= StrToInt(Copy(rest,1,strpos-1),tmp.count)

   else

       okay:= false;

end;

if okay then begin

   rest:= Copy(rest,strpos+1,length(rest)-strpos);

   okay:= StrToReal(Copy(rest,1,length(rest)),tmp.length_km);

end;

if okay then

   item:= tmp;

readItem:= okay;

end;

 

function writeItem(var item: Marshrut): string;

var

numstr: string;

begin

writeItem:= item.number

   + '|' + IntToStr(item.count)

   + '|' + RealToStr(item.length_km);

end;

 

function getSize: integer;

begin

getSize:= item_count;

end;

 

procedure clearItems;

begin

item_count:= 0;

end;

 

function trimItems(startindex: integer): boolean;

begin

if (startindex<0) or (startindex>item_count) then

   trimItems:= false

else begin

   item_count:= startindex-1;

   trimItems:= true;

end;

end;

 

function addItem(var item: Marshrut): boolean;

begin

if item_count>=MAX_SIZE then

   addItem:= false

else begin

   inc(item_count);

   items[item_count]:= item;

   addItem:= true;

end;

end;

 

function setItem(index: integer; var item: Marshrut): boolean;

begin

if (index<1) or (index>item_count) then

   setItem:= false

else begin

   items[index]:= item;

   setItem:= true;

end;

end;

 

function getItem(index: integer; var item: Marshrut): boolean;

begin

if (index<1) or (index>item_count) then

   getItem:= false

else begin

   item:= items[index];

   getItem:= true;

end;

end;

 

procedure viewItems;

var

i: integer;

begin

WriteLn('+-----+------------+-------------+-----------+');

WriteLn('| | Маршрут | Ед. техники | Длина, км |');

WriteLn('+-----+------------+-------------+-----------+');

for i:=1 to item_count do begin

   WriteLn('| ',i:3,

       ' | ',fit(items[i].number,10),

       ' | ',items[i].count:11,

       ' | ',items[i].length_km:9:2,' |');

end;

WriteLn('+-----+------------+-------------+-----------+');

WriteLn('Маршрутов: ',item_count);

end;

 

procedure sortItemsByNumber(desc: boolean);

var

i,j: integer;

tmp: Marshrut;

begin

if desc then begin

   for i:=1 to item_count-1 do begin

       for j:=i+1 to item_count do begin

           if items[i].number<items[j].number then begin

               tmp:= items[i];

               items[i]:= items[j];

               items[j]:= tmp;

           end;

       end;

   end;

end else begin

   for i:=1 to item_count-1 do begin

       for j:=i+1 to item_count do begin

           if items[i].number>items[j].number then begin

               tmp:= items[i];

               items[i]:= items[j];

               items[j]:= tmp;

           end;

       end;

   end;

end;

end;

 

procedure sortItemsByCount(desc: boolean);

var

i,j: integer;

tmp: Marshrut;

begin

if desc then begin

   for i:=1 to item_count-1 do begin

       for j:=i+1 to item_count do begin

           if items[i].count<items[j].count then begin

               tmp:= items[i];

               items[i]:= items[j];

               items[j]:= tmp;

           end;

       end;

   end;

end else begin

   for i:=1 to item_count-1 do begin

       for j:=i+1 to item_count do begin

           if items[i].count>items[j].count then begin

               tmp:= items[i];

               items[i]:= items[j];

               items[j]:= tmp;

           end;

       end;

   end;

end;

end;

 

procedure sortItemsByLength(desc: boolean);

var

i,j: integer;

tmp: Marshrut;

begin

if desc then begin

   for i:=1 to item_count-1 do begin

       for j:=i+1 to item_count do begin

           if items[i].length_km<items[j].length_km then begin

               tmp:= items[i];

               items[i]:= items[j];

               items[j]:= tmp;

           end;

       end;

   end;

end else begin

   for i:=1 to item_count-1 do begin

       for j:=i+1 to item_count do begin

           if items[i].length_km>items[j].length_km then begin

               tmp:= items[i];

               items[i]:= items[j];

               items[j]:= tmp;

           end;

         end;

   end;

end;

end;

 

BEGIN

item_count:= 0;

END.

Приложение В

(*************************************************************************

Управление текстовым меню с пунктами.

 

*************************************************************************)

UNIT TextMenu;

 

INTERFACE

 

CONST

MAX_ITEMS  = 128;

EXIT_ITEM  = 0;

 

TYPE

TMenu = object

   items:     array [0..MAX_ITEMS] of string;

   numitems:  integer;

   menuname:  string;

 

   constructor Init(name, quit_label: string);

   destructor Done;

 

   function   AddItem(name: string): integer;

   function   SelectItem: integer;

end;

PMenu = ^TMenu;

 

IMPLEMENTATION

 

USES

Util;

 

procedure printItem(index: integer; item: string);

begin

WriteLn(index:2,'> ',item);

end;

 

constructor TMenu.Init(name, quit_label: string);

begin

items[0]:= quit_label;

numitems:= 0;

menuname:= name;

end;

 

destructor TMenu.Done;

begin

end;

 

function TMenu.AddItem(name: string): integer;

begin

if numitems<MAX_ITEMS then begin

   inc(numitems);

   items[numitems]:= name;

   AddItem:= numitems;

end else

   AddItem:= EXIT_ITEM;

end;

 

function TMenu.SelectItem: integer;

var

i: integer;

input: string;

select: integer;

legal: boolean;

begin

WriteLn('======== ',menuname,' ========');

for i:=1 to numitems do begin

   printItem(i,items[i]);

end;

printItem(0,items[0]);

 

legal:= true;

repeat

   if not legal then

       Report('* Ошибка выбора!');

   Write('> ');

   ReadLn(input);

   legal:= StrToInt(input,select) and (select>=0) and (select<=numitems);

until legal;

 

WriteLn('========');

SelectItem:= select;

end;

 

BEGIN

END.

Приложение Г

(*****************************************************************************

Утилиты для приведения типов и пр.

 

*****************************************************************************)

UNIT Util;

 

INTERFACE

 

function dup(ch: char; count: byte): string;

function fit(str: string; width: byte): string;

function IntToStr(value: integer): string;

function StrToInt(str: string; var value: integer): boolean;

function RealToStr(value: real): string;

function StrToReal(str: string; var value: real): boolean;

function OpenFileRead(fname: string; var f: text): boolean;

function OpenFileWrite(fname: string; var f: text): boolean;

function ReadFileString(var f: text; var target: string): boolean;

function CloseFile(var f: text): boolean;

function InputString(prompt: string): string;

procedure Report(errmsg: string);

 

IMPLEMENTATION

 

USES

CRT;

 

function dup(ch: char; count: byte): string;

var

i: integer; { счетчик }

res: string; { результат }

begin

res:= '';

for i:=1 to count do res:= res+ch;

dup:= res;

end;

 

function fit(str: string; width: byte): string;

var

l: integer;               { длина строки }

begin

l:= length(str);          { вычисляем длину }

if l<width then            { если длина меньше нужной ширины }

   fit:= str+dup(' ',width-l) { дополняем пробелами }

else

   fit:= Copy(str,1,width); { иначе обрезаем }

end;

 

function IntToStr(value: integer): string;

var

retval: string;

begin

Str(value,retval);

IntToStr:= retval;

end;

 

function StrToInt(str: string; var value: integer): boolean;

var

errorc: integer;

begin

errorc:= 0;

Val(str,value,errorc);

StrToInt:= (errorc = 0);

end;

 

function RealToStr(value: real): string;

var

retval: string;

begin

Str(value,retval);

RealToStr:= retval;

end;

 

function StrToReal(str: string; var value: real): boolean;

var

errorc: integer;

begin

errorc:= 0;

Val(str,value,errorc);

StrToReal:= (errorc = 0);

end;

 

function OpenFileRead(fname: string; var f: text): boolean;

begin

{$I-}

Assign(f,fname);

Reset(f);

{$I+}

if IOResult<>0 then

   OpenFileRead:= false

else

   OpenFileRead:= true;

end;

 

function OpenFileWrite(fname: string; var f: text): boolean;

begin

{$I-}

Assign(f,fname);

Rewrite(f);

{$I+}

if IOResult<>0 then

   OpenFileWrite:= false

else

   OpenFileWrite:= true;

end;

 

function ReadFileString(var f: text; var target: string): boolean;

begin

{$I-}

ReadLn(f,target);

{$I+}

if IOResult<>0 then

   ReadFileString:= false

else

   ReadFileString:= true;

end;

 

function CloseFile(var f: text): boolean;

begin

Close(f);

end;

 

function InputString(prompt: string): string;

var

ret: string;

begin

Write('Введите ',prompt,': ');

ReadLn(ret);

InputString:= ret;

end;

 

procedure Report(errmsg: string);

var

oldattr: byte;

begin

oldattr:= TextAttr;

TextAttr:= (oldattr and $F0) or $04;

WriteLn(errmsg);

TextAttr:= oldattr;

end;

 

END.

Приложение Д

1

25а|6| 1.2600000000E+01

25|14| 1.1500000000E+01

5|8| 1.4900000000E+01

3|6| 6.7000000000E+00

1|8| 7.2000000000E+00

16|10| 8.0000000000E+00

10|4| 7.6000000000E+00

2

25а|6|12.6

25|14|11.5

5|8|14.9

3|6|6.7

1|8|7.2

16|10|8.0

10|4|7.6

3

15а|3| 6.3800000000E+00

10|4| 7.6000000000E+00

25а|6| 1.2600000000E+01

3|6| 6.7000000000E+00