Ask Question

Name:
Title:
Your Question:

Answer Question

Name:
Your Answer:
User Submitted Source Code!


Description:
  123
Language: PASCAL
Code:
uses crt, menu, info;

var
 buses:  ListOfBus; {список записей}

{очистка списка}
procedure ClearArray;
begin
 Clear(buses);
 ColorWindow(20,1,40,3,1);
 ShowText('Массив очищен!',13,2,14,1);
 readkey;
end;

{Вставка записи в массив записей}
procedure InsertToArray;
var
  bus:BusInfo; {вводимая запись}
begin
 {вывод приглашения}
 ColorWindow(1,16,80,10,3);
 ShowText('Введите поля записи:',20,1,14,3);

 ShowText('Номер маршрута ',3,3,15,3);
 ShowText('Количество остановок: ',3,4,15,3);
 ShowText('Первая конечная остановка: ',3,5,15,3);
 ShowText('Вторая конечная остановка: ',3,6,15,3);
  {ввод всех полей}
 gotoxy(20,3);
 readln(bus.NumberRoute);
 gotoxy(20,4);
 readln(bus.StopsCount);
 gotoxy(20,5);
 readln(bus.FirstStop);
 gotoxy(20,6);
 readln(bus.LastStop);

 if AddBus(buses, bus) {дабавляем запись в список}
 then
  begin {если запись добавлена}
    ColorWindow(20,1,40,3,1);
    ShowText('Запись в массив добавлена!',6,2,14,1);
  end
 else
  begin {если запись не добавлена}
    ColorWindow(20,1,40,3,4);
    ShowText('Массив полон - добавлять некуда!',3,2,15,1);
  end;
 readkey;
end;

{Удалить запись из массива}
procedure DeleteFromArray;
var
  del:byte; {индекс удаляемого элемента массива}
begin
 {вывод приглашения}
 ColorWindow(1,16,80,10,3);
 ShowText('Введите индекс удаляемой записи:',10,3,14,3);

 gotoxy(45,3);
 readln(del);

 if DelBus(buses,del)
 then
  begin {если запись удалена}
    ColorWindow(20,1,40,3,1);
    ShowText('Запись из массива удалена!',6,2,14,1);
  end
 else
  begin {если запись не удалена}
    ColorWindow(15,1,50,3,4);
    ShowText('Неверный индекс записи - запись не удалена!',3,2,15,4);
  end;
 readkey;
end;

{Сортировка записей в списке по фамилиям}
procedure SortArray;
begin
 SortList(buses);
 ColorWindow(20,1,40,3,1);
 ShowText('Массив отсортирован!',13,2,14,1);
 readkey;
end;

{Просмотр массива}
procedure ViewArray;
var
 i:byte;{счетчик}
begin
 BlackScreen;
 ColorWindow(1,1,80,23,1);
 {вывод шапки}
 gotoxy(1,1);
 write('Номер трамвая      |ФИО водителя |Номер маршрута| Год последнего кап. ремонта ');
 gotoxy(1,2);
 write('-------------------+-------------+------------+---------------------------------');

 {вывод всех записей}
 for i:=1 to buses.n do
  begin
    gotoxy(1,i+2);
    write('|',buses.Bus[i].NumberRoute);
    gotoxy(20,i+2);
    write('|',buses.Bus[i].StopsCount);
    gotoxy(34,i+2);
    write('|',buses.Bus[i].FirstStop);
    gotoxy(47,i+2);
    write('|',buses.Bus[i].LastStop);

  end;

 ShowText('Нажмите любую клавишу для продолжения работы!',15,23,15,4);
 readkey;
end;

procedure ViewPartArray;
var
 i,j:byte;{счетчик}
begin
 BlackScreen;
 ColorWindow(1,1,80,23,1);
 {вывод шапки}
 ShowText('Список автобусов с количеством остановок > 6, но < 12',5,1,14,1);
 textcolor(15);
 gotoxy(1,2);
 write('|Номер маршрута   |Кол-во остановок|Конечная |Конечная  |');
 gotoxy(1,3);
 write('+-----------------+--------------+-----------+----------+');

 j:=1;
 {просмотр всех записей}
 for i:=1 to buses.n do
  with buses.Bus[i] do
   if (StopsCount > 6) and (StopsCount < 12)
   then
   begin
    gotoxy(1,j+3);
    write('|',NumberRoute);
    gotoxy(19,j+3);
    write('|',StopsCount);
    gotoxy(34,j+3);
    write('|',FirstStop);
    gotoxy(46,j+3);
    write('|',LastStop);

    j:=j+1;
  end;

 ShowText('Нажмите любую клавишу для продолжения работы!',15,23,15,4);
 readkey;
end;

{сохранение списка в файле}
procedure SaveArray;
var
 filename: string;{имя файла}
begin
 {ввод имени файла}
 ColorWindow(1,16,80,10,3);
 ShowText('Введите имя файла для записи массива:',10,3,14,3);
 gotoxy(50,3);
 readln(filename);

 if  SaveList(buses,filename) {сохранение}
 then
  begin {если список сохранен в файле}
    ColorWindow(20,1,40,3,1);
    ShowText('Массив сохранен в файле '+filename,2,2,14,1);
  end
 else
  begin {если была ошибка сохранения}
    ColorWindow(15,1,50,3,4);
    ShowText('Ошибка записи в файл '+filename,3,2,15,4);
  end;

 readkey;
end;


{загрузка списка из файла}
procedure LoadArray;
var
 filename: string;
begin
 {ввод имени файла}
 ColorWindow(1,16,80,10,3);
 ShowText('Введите имя файла для чтения массива:',10,3,14,3);
 gotoxy(50,3);
 readln(filename);

 if LoadList(buses,filename) {загрузка}
 then
  begin {если список загружен}
    ColorWindow(20,1,40,3,1);
    ShowText('Массив загружен из файла '+filename,2,2,14,1);
  end
 else
  begin {если список не загружен}
    ColorWindow(15,1,50,3,4);
    ShowText('Ошибка при чтении из файла '+filename,3,2,15,4);
  end;

 readkey;
end;


{Тело программы}

begin

 Clear(buses); {инициализация списка - очистка}
 repeat
   BlackScreen; {очистка экрана}

   case MenuHoriz of   {Вызываем меню
                и в зависимости от выбранного пункта выполняем
                соответствующее действие}
    'a': ClearArray;
    'b': ViewArray;
    'c': ViewPartArray;
    'd': LoadArray;
    'e': SaveArray;
    'f': InsertToArray;
    'g': DeleteFromArray;
    'h': SortArray;
    'i', #27: Exit;    {выход, если выбран пункт "Выход из программы"}
                    {или нажат Esc}
   end;
 until false;
end.

          
Comments: