API tools faq
paste
Advertisement
CyberPascal

Untitled

CyberPascal
Dec 21st, 2014
180
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 56.19 KB | None | 0 0
raw download clone embed print report
  1. {***************************************************************************}
  2. { Сибирский Государственный Университет Путей Сообщения (СГУПС)             }
  3. { Кафедра "Информационные технологии транспорта"                            }
  4. {                                                                           }
  5. { Лабораторная работа по теме "Записи".                                     }
  6. { Тема: "База данных автомобилей".                                          }
  7. {                                                                           }
  8. { Структура должна включать не менее 10 столбцов, в том числе - строковые,  }
  9. { числовые и дата. Всего в таблице    должно быть не менее 30 строк.      }
  10. {                                                                           }
  11. { В программе должны реализовываться следующее:                             }
  12. {   - загрузка и сохранение данных в типизированный файл;                   }
  13. {   - ввод, редактирование, поиск, сортировка и удаление строк;             }
  14. {   - просмотр данных в табличной форме;                                    }
  15. {   - формирование отчетов в текстовый файл;                                }
  16. {   - подсчет максимальных и минимальных значений, сумм и средних           }
  17. {     значений для числовых полей.                                          }
  18. {                                                                           }
  19. { Выполнила:                                                                }
  20. { Cтудентка группы МЛ-113, Рудыхина Ольга Вячеславовна                      }
  21. { Новосибирск, 2014                                                         }
  22. {***************************************************************************}
  23.  
  24. Program Ole4ka; uses crt, dos;
  25.  
  26. {----- Описываем константы Start -----}
  27. const f_name_db=('Auto.dat'); {Имя файла Базы Данных}
  28.       f_name_rept=('Auto.txt'); {Имя файла с отчетом}
  29.  
  30.       n_types=10; {11 типов кузова}
  31.       n_fuel=3; {4 вида топлива}
  32.       n_cylinders=4; {5 типов расположения цилиндров}
  33.       n_transmission=3; {4 типа КПП}
  34.       n_drive=2; {3 типа привода}
  35.       n_color=122; {123 цвета автомобилей}
  36.  
  37.       c_types:array [0..n_types] of string = ('Седан','Хэтчбек','Универсал','Внедорожник',
  38.                                   'Кроссовер','Пикап','Купе','Кабриолет',
  39.                                               'Минивен','Фургон','Микроавтобус');
  40.  
  41.       c_fuel:array [0..n_fuel] of string = ('Безнзин','Дизель','Гибрид','Газ/Бензин');
  42.  
  43.       c_cylinders:array [0..n_cylinders] of string = ('Рядное','V-образное','W-образное',
  44.                                           'Роторный двигатель','Оппозитное');
  45.  
  46.       c_transmission:array [0..n_transmission] of string = ('МКПП','АКПП','РКПП','Вариатор');
  47.  
  48.       c_drive:array [0..n_drive] of string = ('Передний','Задний','Полный');
  49.  
  50.       c_color:array [0..n_color] of string = ('Авантюрин','Адриатика','Айсберг','Аквамарин','Аккорд',
  51.                                   'Альпийский снег','Аметист','Амулет','Антилопа','Атлантика',
  52.                                   'Афалина','Баклажан','Балтика','Бальзам','Бежевый','Белый',
  53.                                   'Бриз','Бургундия','Вавилон','Валентина','Валюта',
  54.                                   'Виктория','Вишня','Вишнёвый сад','Гейзер','Голубой',
  55.                                   'Гранат','Дефиле','Дюшес','Жасмин','Жемчуг','Жёлтый (Такси)',
  56.                                   'Зелёная','Зелёный сад','Золотая нива','Золотой лист',
  57.                                   'Игуана','Изумруд','Ирис','Искра','Капри','Кардинал',
  58.                                   'Кармен','Кварц','Кедр','Коралл','Кориандр','Корица',
  59.                                   'Корсика','Кристалл','Ла-Манш','Лаванда','Лагуна',
  60.                                   'Лазурит','Лазурно-синий','Лазурь','Ламинария','Магия',
  61.                                   'Майя','Мальборо','Медео','Миндаль','Мираж','Млечный путь',
  62.                                   'Мокрый асфальт','Монте-Карло','Моцарт','Мулен-Руж',
  63.                                   'Мурена','Нарцисс','Нептун','Нефертити','Ниагара',
  64.                                   'Океан','Оливин','Оливковый','Опал','Опатия','Осока',
  65.                                   'Папирус','Паприка','Петергоф','Пирано','Пицунда',
  66.                                   'Престиж','Приз','Примула','Рапсодия','Ривьера',
  67.                                   'Романс','Рубин','Сандаловый','Сапфир','Сафари',
  68.                                   'Светло-серый','Серебристая ива','Серебристый',
  69.                                   'Серо-бежевый','Серо-голубой','Серо-зелёный',
  70.                                   'Синяя полночь','Сирень','Сливочно-белый',
  71.                                   'Слоновая кость','Снежная королева','Снежно-белый',
  72.                                   'Сочи','Табак','Талая вода','Торнадо','Триумф',
  73.                                   'Тёмно-бежевая','Тёмно-коричневый','Тёмно-серый',
  74.                                   'Тёмно-синий','Фея (Лесная фея)','Фрегат','Цунами',
  75.                                   'Чайная роза','Чароит','Чёрный','Электрон','Юпитер');
  76.  
  77.       maxid=70; {Максимальное кол-во записей в БД}
  78. {----- Описываем константы Start -----}
  79.  
  80. {----- Описываем типы Start -----}
  81. type Automobile=record {Структура БД Автомобилей}
  82.                 maker:string [15]; {Марка}
  83.                 model:string [15]; {Модель}
  84.                 grade:string [15]; {Комплектация}
  85.                 types:string [15]; {Тип кузова}
  86.  
  87.                 engine:record {Характеристика двигателя}
  88.                        fuel_type:string [10]; {Вид топлива}
  89.                        power:word; {Мощность двигателя, л.с.}
  90.                        volume:word; {Объём двигателя, см^3}
  91.                        cylinders:string [20]; {Расположение цилиндров}
  92.                        end; {Record Engine}
  93.  
  94.                 consumption:record {Расход топлива}
  95.                             city:real; {По городу}
  96.                             track:real; {По трассе}
  97.                             mixed:real; {Смешанный}
  98.                             end; {Record Consumption}
  99.  
  100.                 transmission:string [10]; {Трансмиссия}
  101.                 drive:string [10]; {Тип привода}
  102.                 color:string [15]; {Цвет}
  103.                 year:word; {Год выпуска}
  104.                 price:longint; {Стоимость}
  105.                 end; {Record Automobile}
  106.  
  107.      TData=array [1..maxid] of Automobile; {Массив данных}
  108.      TFile=file of Automobile; {Файл БД - f_name_db}
  109. {----- Описываем типы End -----}
  110.  
  111. var data,sdata:TData;
  112.     id:integer;
  113.     ch,ch2:char;
  114.  
  115. {----- Интерфейс программы Start -----}
  116. {----- Печатаем линию Start -----}
  117. Procedure PrintLine;
  118. var i:byte;
  119. Begin
  120. TextColor(White);
  121. for i:=1 to 80 do Write('-');
  122. end;
  123. {----- Печатаем линию End -----}
  124.  
  125. {----- Вывод заголовка Start -----}
  126. Procedure PrintHead(color,x:byte; word:string); {Заголовок}
  127. Begin
  128. TextColor(Color); GotoXY(X,WhereY); Writeln(Word);
  129. end;
  130. {----- Вывод заголовка End -----}
  131.  
  132. {----- Вывод основного меню Start -----}
  133. Procedure PrintMainMenu;
  134. const item=8; {Кол-во пунктов в меню}
  135.       m_item:array [1..item] of string [80] = ('Работа с информацией',
  136.                                            'Просмотр информации',
  137.                                    'Формирование отчета',
  138.                                    'Поиск','Сортировка',
  139.                                    'Справка','Об авторе','Выход');
  140.  
  141. var i:byte; {Счетчик}
  142.  
  143. Begin clrscr;
  144. PrintLine;
  145. PrintHead(Yellow,28,'ОСНОВНОЕ МЕНЮ ПРОГРАММЫ');
  146. PrintHead(LightGreen,8,'Управление: для выбора нужного действия используйте клавиши (0-7)');
  147. PrintLine;
  148.  
  149. for i:=1 to item-1 do
  150.     Begin
  151.     TextColor(Yellow); Write(' { ',i,' } '); TextColor(Cyan); Writeln(m_item[i]); PrintLine;
  152.     end;
  153.  
  154. TextColor(Yellow); Write(' { 0 } '); TextColor(Cyan); Writeln(m_item[item]); PrintLine;
  155. end;
  156. {----- Вывод основного меню End -----}
  157.  
  158. {----- Возврат к основному меню Start -----}
  159. Procedure ReturnMainMenu;
  160. var ch:char;
  161.  
  162. Begin
  163. PrintLine; GotoXY(15,WhereY);
  164. TextColor(Yellow); Writeln('Для возврата в главное меню нажмите клавишу "Enter"');
  165. PrintLine;
  166. Repeat
  167. Ch:=Readkey;
  168. Until (Ch = #13);
  169. PrintMainMenu; {Основное меню программы}
  170. end;
  171. {----- Возврат к основному меню End -----}
  172.  
  173. {----- Вывод дополнительного меню #1 Start -----}
  174. Procedure PrintAdditionalMenu_1;
  175. const item=6; {Кол-во пунктов в меню}
  176.       m_item:array [1..item] of string [80] = ('Добавить информацию',
  177.                                    'Удалить информацию',
  178.                                    'Изменить информацию',
  179.                                    'Сохранить информацию в файл',
  180.                                    'Загрузить информацию из файла',
  181.                                    'Возврат в главное меню');
  182.  
  183. var i:byte; {Счетчик}
  184.  
  185. Begin clrscr;
  186. PrintLine;
  187. PrintHead(Yellow,25,'ДПОЛНИТЕЛЬНОЕ МЕНЮ ПРОГРАММЫ');
  188. PrintHead(LightGreen,8,'Управление: для выбора нужного действия используйте клавиши (1-6)');
  189. PrintLine;
  190.  
  191. for i:=1 to item do
  192.     Begin
  193.     TextColor(Yellow); Write(' { ',i,' } '); TextColor(Cyan); Writeln(m_item[i]); PrintLine;
  194.     end;
  195. end;
  196. {----- Вывод дополнительного меню #1 End -----}
  197.  
  198. {----- Вывод дополнительного меню #2 Start -----}
  199. Procedure PrintAdditionalMenu_2;
  200. const item=3; {Кол-во пунктов в меню}
  201.       m_item:array [1..item] of string [80] = ('Просмотр краткой информации',
  202.                                    'Просмотр подробной информации',
  203.                                    'Возврат в главное меню');
  204.  
  205. var i:byte; {Счетчик}
  206.  
  207. Begin clrscr;
  208. PrintLine;
  209. PrintHead(Yellow,25,'ДПОЛНИТЕЛЬНОЕ МЕНЮ ПРОГРАММЫ');
  210. PrintHead(LightGreen,8,'Управление: для выбора нужного действия используйте клавиши (1-3)');
  211. PrintLine;
  212.  
  213. for i:=1 to item do
  214.     Begin
  215.     TextColor(Yellow); Write(' { ',i,' } '); TextColor(Cyan); Writeln(m_item[i]); PrintLine;
  216.     end;
  217. end;
  218. {----- Вывод дополнительного меню #2 End -----}
  219.  
  220. {----- Вывод дополнительного меню #3 Start -----}
  221. Procedure PrintAdditionalMenu_3;
  222. const item=10; {Кол-во пунктов в меню}
  223.       m_item:array [1..item] of string [80] = ('Поиск по марке автомобиля',
  224.                                    'Поиск по модели автомобиля',
  225.                                    'Поиск по типу кузова',
  226.                                    'Поиск по типу трансмиссии',
  227.                                    'Поиск по типу привода',
  228.                                    'Поиск по виду топлива',
  229.                                    'Поиск по цвету автомобиля',
  230.                                    'Поиск по году выпуска',
  231.                                    'Поиск по стоимости автомобиля',
  232.                                    'Возврат в главное меню');
  233.  
  234. var i:byte; {Счетчик}
  235.  
  236. Begin clrscr;
  237. PrintLine;
  238. PrintHead(Yellow,25,'ДПОЛНИТЕЛЬНОЕ МЕНЮ ПРОГРАММЫ');
  239. PrintHead(LightGreen,8,'Управление: для выбора нужного действия используйте клавиши (0-9)');
  240. PrintLine;
  241.  
  242. for i:=1 to item-1 do
  243.      Begin
  244.      TextColor(Yellow); Write(' { ',i,' } '); TextColor(Cyan); Writeln(m_item[i]);
  245.      PrintLine;
  246.      end;
  247.  
  248. TextColor(Yellow); Write(' { 0 } '); TextColor(Cyan); Writeln(m_item[item]);
  249. PrintLine;
  250. end;
  251. {----- Вывод дополнительного меню #3 End -----}
  252.  
  253. {----- Вывод дополнительного меню #4 Start -----}
  254. Procedure PrintAdditionalMenu_4;
  255. const item=3; {Кол-во пунктов в меню}
  256.       m_item:array [1..item] of string [80] = ('Сортировка данных в БД по году выпуска',
  257.                                    'Сортировка данных в БД по стоимости',
  258.                                    'Возврат в главное меню');
  259.  
  260. var i:byte; {Счетчик}
  261.  
  262. Begin clrscr;
  263. PrintLine;
  264. PrintHead(Yellow,25,'ДПОЛНИТЕЛЬНОЕ МЕНЮ ПРОГРАММЫ');
  265. PrintHead(LightGreen,8,'Управление: для выбора нужного действия используйте клавиши (1-3)');
  266. PrintLine;
  267.  
  268. for i:=1 to item do
  269.      Begin
  270.      TextColor(Yellow); Write(' { ',i,' } '); TextColor(Cyan); Writeln(m_item[i]);
  271.      PrintLine;
  272.      end;
  273. end;
  274. {----- Вывод дополнительного меню #4 End -----}
  275.  
  276. {----- Справка по программе Start -----}
  277. Procedure PrintHelpProgram; {Справка}
  278. Begin clrscr;
  279. PrintLine;
  280. PrintHead(Yellow,35,'СПРАВКА');
  281. PrintHead(LightGreen,22,'Информация о возможностях программы');
  282. PrintLine;
  283. TextColor(Cyan); Writeln(' Данная программа позволяет выполнять следующие действия:');
  284. TextColor(Yellow); Write(' { 1 } '); TextColor(Cyan); Writeln('Добавлять данные в БД');
  285. TextColor(Yellow); Write(' { 2 } '); TextColor(Cyan); Writeln('Загружать данные из БД');
  286. TextColor(Yellow); Write(' { 3 } '); TextColor(Cyan); Writeln('Изменять данные в БД');
  287. TextColor(Yellow); Write(' { 4 } '); TextColor(Cyan); Writeln('Удалять данные из БД');
  288. TextColor(Yellow); Write(' { 5 } '); TextColor(Cyan); Writeln('Осуществлять поиск в БД');
  289. TextColor(Yellow); Write(' { 6 } '); TextColor(Cyan); Writeln('Осуществлять сортировку БД ');
  290. TextColor(Yellow); Write(' { 7 } '); TextColor(Cyan); Writeln('Формировать файл с отчетом');
  291. ReturnMainMenu;
  292. end;
  293. {----- Справка по программе End -----}
  294.  
  295. {----- Информация об авторе программы Start -----}
  296. Procedure PrintInfoAuthor; {Справка}
  297. Begin clrscr;
  298. PrintLine;
  299. PrintHead(Yellow,35,'ОБ АВТОРЕ');
  300. PrintHead(LightGreen,20,'Подробная информация об авторе программы');
  301. PrintLine;
  302. TextColor(Cyan); Write(' Университет: ');
  303. TextColor(Yellow); Writeln('Сибирский государственный университет путей сообщения (СГУПС)');
  304. TextColor(Cyan); Write(' Факультет:   '); TextColor(Yellow); Writeln('Бизнес-информатика (ФБИ)');
  305. TextColor(Cyan); Write(' Кафедра:     '); TextColor(Yellow); Writeln('Информационные технологии транспорта');
  306. TextColor(Cyan); Write(' Группа:      '); TextColor(Yellow); Writeln('МЛ-113');
  307. TextColor(Cyan); Write(' Студентка:   '); TextColor(Yellow); Writeln('Рудыхина Ольга Вячеславовна');
  308. ReturnMainMenu;
  309. end;
  310. {----- Информация об авторе программы End -----}
  311. {----- Интерфейс программы End -----}
  312.  
  313.  
  314. {----- Функционал программы Start -----}
  315. {$S-$M} {Отключаем проверку стека}
  316. {----- Сохранение Базы данных Start -----}
  317. Procedure SaveDataBase(data:TData; ns:integer);
  318. var id:integer;
  319.     fdata:TFile;
  320. Begin clrscr;
  321. PrintLine;
  322. PrintHead(Yellow,31,'СОХРАНЕНИЕ ДАННЫХ');
  323. PrintHead(LightGreen,23,'Сохранение данных в файл '+f_name_db);
  324. PrintLine;
  325. Assign(FData,F_name_db); {Подключаем файл "F_name" к переменной F}
  326. Rewrite(FData); {Создаем файл "F_name" и открываем для записи}
  327.  
  328. for id:=1 to ns do Write(FData,Data[id]); {Записываем информацию в Базу Данных}
  329.  
  330. Close(FData); {Закрываем файл "F_name"}
  331.  
  332. PrintHead(LightGreen,23,'База данных успешно сохранена...');
  333. ReturnMainMenu; {Возврат в основное меню}
  334. end;
  335. {----- Сохранение Базы данных End -----}
  336.  
  337. {----- Чтение из Базы данных Start -----}
  338. Procedure ReadingDataBase(var data:TData; var id:integer; maxid:integer);
  339. var fdata:TFile;
  340. Begin clrscr;
  341. PrintLine;
  342. PrintHead(Yellow,32,'ЗАГРУЗКА ДАННЫХ');
  343. PrintHead(LightGreen,22,'Загрузка данных из файла '+f_name_db);
  344. PrintLine;
  345.  
  346. Assign(FData,F_name_db); {Подключаем файл "F_name_db" к переменной FData}
  347. Reset(FData); {Открываем файл "F_name" для чтения}
  348.  
  349. While ((not Eof(FData)) and (id <= MaxID)) do
  350.       Begin
  351.       Inc(id);
  352.       Read(FData,Data[id]);
  353.       end;
  354.  
  355. Close(FData); {Закрываем файл "F_name_db"}
  356.  
  357. PrintHead(LightGreen,23,'База данных успешно загружена...');
  358. ReturnMainMenu; {Возврат в основное меню}
  359. end;
  360. {----- Чтение из Базы данных End -----}
  361.  
  362. {----- Выбор данных из массивов-констант Start -----}
  363. Function Selection(const value:array of string; item:integer):string;
  364. {Параметры: Value - массив-константа; item - кол-во элементов в массиве Value}
  365. var post:integer;
  366.     ch:char;
  367. Begin
  368. GotoXY(30,WhereY); TextColor(White); Write('[ Для управления используйте стрелки "',#26, '" и "', #27,'" ]');
  369.  
  370. TextColor(Yellow); GotoXY(30,WhereY);
  371. Post:=-1;
  372. Repeat
  373. Ch:=ReadKey;{Считываем ASCII код клавиши}
  374. {#13 - клавиша "Enter" / #75 - стрелка влево / #77 - стрелка вправо}
  375. Case Ch of
  376.      #77:Begin {Стрелка вправо}
  377.          Inc(Post); {Определяем номер элемента в массиве}
  378.  
  379.          {Если элемент был последним, то возвращаемся к первому}
  380.          if (Post > High(Value)) then Post:=Low(Value);{Первый элемент массива}
  381.          GotoXY(30,WhereY); ClrEol; Write(Value[Post]);
  382.          end;
  383.  
  384.      #75:Begin {Стрелка влево}
  385.          Dec(Post); {Определяем номер элемента в массиве}
  386.  
  387.          {Если элемент был первым, то возвращаемся к последнему}
  388.          if (Post < Low(Value)) then Post:=High(Value);
  389.          GotoXY(30,WhereY); ClrEol; Write(Value[Post]);
  390.          end;
  391.  
  392.      #13:Selection:=Value[Post]; {Заоминаем выбранный элемент массива}
  393. end;{Case Ch}
  394. Until (Ch = #13); {Клавиша "Enter"}
  395. Writeln;
  396. end;
  397. {----- Выбор данных из массивов-констант End -----}
  398.  
  399. {----- Ввод/изменение данных в БД Start -----}
  400. Procedure ChangeDataBase(var data:automobile);
  401. var ch:char; {ASCII код клавиши}
  402.  
  403. Begin clrscr;
  404. PrintLine;
  405. PrintHead(Yellow,34,'ВВОД ДАННЫХ');
  406. PrintHead(LightGreen,14,'Управление: для ввода данных используйте клавиатуру');
  407. PrintLine;
  408.  
  409. With Data do
  410.      Begin
  411.      TextColor(Cyan); Write(' Марка: '); TextColor(Yellow); GotoXY(30,WhereY); Readln(Maker);
  412.      TextColor(Cyan); Write(' Модель:'); TextColor(Yellow); GotoXY(30,WhereY); Readln(Model);
  413.      TextColor(Cyan); Write(' Комлектация: '); TextColor(Yellow); GotoXY(30,WhereY); Readln(Grade);
  414.      TextColor(Cyan); Write(' Тип кузова: '); Types:=Selection(c_types,n_types);
  415.  
  416. With Engine do
  417.      Begin
  418.      TextColor(Cyan); Write(' Вид топлива: '); Fuel_Type:=Selection(c_fuel,n_fuel);
  419.      TextColor(Cyan); Write(' Мощность двигателя, л.с.: '); TextColor(Yellow); GotoXY(30,WhereY); Readln(Power);
  420.      TextColor(Cyan); Write(' Объём двигателя, см^3: '); TextColor(Yellow); GotoXY(30,WhereY); Readln(Volume);
  421.      TextColor(Cyan); Write(' Расположение цилиндров: '); Cylinders:=Selection(c_cylinders,n_cylinders);
  422.      end;
  423.  
  424. TextColor(Cyan); Writeln(' Расход топлива, л/100 км: ');
  425. With Consumption do
  426.      Begin
  427.      GotoXY(1,WhereY); TextColor(Cyan); Write(' По городу: '); TextColor(Yellow); Readln(City);
  428.      GotoXY(32,WhereY-1); TextColor(Cyan); Write(' По трассе: '); TextColor(Yellow); Readln(Track);
  429.      GotoXY(63,WhereY-1); TextColor(Cyan); Write(' Смешанный: '); TextColor(Yellow); Readln(Mixed);
  430.      end;
  431.  
  432. TextColor(Cyan); Write(' Трансмиссия: '); Transmission:=Selection(c_transmission,n_transmission);
  433. TextColor(Cyan); Write(' Тип привода: '); Drive:=Selection(c_drive,n_drive);
  434. TextColor(Cyan); Write(' Цвет: '); Color:=Selection(c_color,n_color);
  435. TextColor(Cyan); Write(' Год выпуска: '); TextColor(Yellow); GotoXY(30,WhereY); Readln(Year);
  436. TextColor(Cyan); Write(' Стоимость, руб.: '); TextColor(Yellow); GotoXY(30,WhereY); Readln(Price);
  437. end;
  438.  
  439. ReturnMainMenu; {Возврат в основное меню}
  440. end;
  441. {----- Ввод/изменение данных в БД End -----}
  442.  
  443. {----- Выбор номера Start -----}
  444. Function SelectionID(id:integer):integer;
  445. var num:integer;
  446.     st:string;
  447. Begin clrscr;
  448. Repeat
  449. PrintLine;
  450. PrintHead(Yellow,34,'ВЫБОР ЗАПИСИ');
  451. Str(id,St); {ID - последней записи}
  452. PrintHead(LightGreen,24,'Выберите номер записи от 1 до '+St);
  453. PrintLine;
  454.  
  455. TextColor(Cyan); Write(' Введите номер: '); TextColor(Yellow); Readln(Num);
  456.  
  457. if ((Num < 1) or (id < Num)) then
  458.                                  Begin
  459.                                  PrintLine;
  460.                                  PrintHead(Red,8,'ОШИБКА #003: Введенный ID не принадлежит допустимому диапазону');
  461.                                  PrintHead(LightGreen,31,'Повторите ввод...');
  462.                                  PrintLine;
  463.                                  Delay(3000); {Задержка 3 сек} clrscr;
  464.                                  end;
  465. Until ((1 <= Num) and (Num <= id));
  466.  
  467. SelectionID:=Num; {Присваиваем...}
  468.  
  469. PrintLine;
  470. TextColor(Yellow); GotoXY(19,WhereY); Writeln('Для продолжения нажмите клавишу "Enter"');
  471. PrintLine;
  472. Readln; clrscr;
  473. end;
  474. {----- Выбор номера End -----}
  475.  
  476. {----- Удаление данных Start -----}
  477. Procedure DeleteDataBase(var data:TData; var id:integer; n:integer);
  478. var i:integer;
  479. Begin
  480. PrintLine;
  481. PrintHead(Yellow,33,'УДАЛЕНИЕ ЗАПИСИ');
  482. PrintHead(LightGreen,22,'Удаление записи с выбранным ID из БД');
  483. PrintLine;
  484. if (N in [1..id]) then
  485.                       Begin
  486.               for i:=n to id-1 do Data[i]:=Data[i+1];
  487.                       Dec(id);
  488.                       end;
  489.  
  490. PrintHead(LightGreen,29,'Запись успешно удалена');
  491. ReturnMainMenu; {Возврат в основное меню}
  492. end;
  493. {----- Удаление данных End -----}
  494.  
  495. {----- Вывод краткой информации №1 из БД Start -----}
  496. Procedure ShortStory_1(data:TData; var id:integer; ns:integer);
  497. var count:integer;
  498. Begin clrscr;
  499. PrintLine;
  500. PrintHead(Yellow,32,'ПРОСМОТР ДАННЫХ');
  501. PrintHead(LightGreen,6,'Управление: клавиши "'+#24+'", "'+#25+'", "'+#26+'", "'+#27+'", Esc - выход в основное меню');
  502. PrintLine; Write('| № |      Марка     |      Модель      |   Комлектация   |  КПП  |   Привод   |'); PrintLine;
  503.  
  504. Count:=0;
  505.  
  506. Repeat
  507. Inc(id);
  508. Inc(Count);
  509.  
  510. With Data[id] do {Печатаем таблицу}
  511.      Begin
  512.      GotoXY(1,WhereY); Write('|',id:2);
  513.      GotoXY(5,WhereY); Write('| ',Maker);
  514.      GotoXY(22,WhereY); Write('| ',Model);
  515.      GotoXY(41,WhereY); Write('| ',Grade);
  516.      GotoXY(59,WhereY); Write('| ',Transmission);
  517.      GotoXY(67,WhereY); Write('| ',Drive);
  518.      GotoXY(79,WhereY); Write(' |');
  519.      end; {End With Data[id]}
  520. Until ((Count = 15) or (id = Ns));
  521. PrintLine;
  522. end;
  523. {----- Вывод краткой информации №1 из БД End -----}
  524.  
  525. {----- Вывод краткой информации №2 из БД Start -----}
  526. Procedure ShortStory_2(data:TData; var id:integer; ns:integer);
  527. var count:integer;
  528. Begin clrscr;
  529. PrintLine;
  530. PrintHead(Yellow,32,'ПРОСМОТР ДАННЫХ');
  531. PrintHead(LightGreen,6,'Управление: клавиши "'+#24+'", "'+#25+'", "'+#26+'", "'+#27+'", Esc - выход в основное меню');
  532. PrintLine; Write('| № | Тип кузова |  Топливо   | Объём |      Цвет        |  Год  |  Стоимость  |'); PrintLine;
  533.  
  534. Count:=0;
  535.  
  536. Repeat
  537. Inc(id);
  538. Inc(Count);
  539.  
  540. With Data[id] do {Печатаем таблицу}
  541.      Begin
  542.      GotoXY(1,WhereY); Write('|',id:2);
  543.      GotoXY(5,WhereY); Write('| ',Types);
  544.      GotoXY(18,WhereY); Write('| ',Engine.Fuel_type);
  545.      GotoXY(31,WhereY); Write('| ',Engine.Volume);
  546.      GotoXY(39,WhereY); Write('| ',Color);
  547.      GotoXY(58,WhereY); Write('| ',Year);
  548.      GotoXY(66,WhereY); Write('| ',Price);
  549.      GotoXY(79,WhereY); Write(' |');
  550.      end; {End With Data[id]}
  551. Until ((Count = 15) or (id = Ns));
  552. PrintLine;
  553. end;
  554. {----- Вывод краткой информации №2 из БД End -----}
  555.  
  556. {----- Вывод краткой информации из БД Start -----}
  557. Procedure PrintShortStory(data:TData; ns:integer);
  558. var id:integer;
  559.     ch:char;
  560.     flag:boolean;
  561.  
  562. Begin clrscr;
  563. id:=0;
  564. if (Ns = 0) then
  565.                 Begin
  566.                 PrintLine;
  567.                 PrintHead(Yellow,32,'ПРОСМОТР ДАННЫХ');
  568.                 PrintHead(LightGreen,6,'Управление: клавиши "'+#24+'", "'+#25+'", "'+#26+'", "'+#27+'", '+
  569.                 'Esc - выход в основное меню');
  570.                 PrintLine;
  571.                 PrintHead(Red,6,'ОШИБКА #002: Файл базы данных не загружен или отсутствует информация');
  572.                 ReturnMainMenu; {Возврат в главное меню}
  573.                 end
  574.             else
  575.                 Begin
  576.                 ShortStory_1(Data,id,Ns);
  577.                 Flag:=True; {По умолчанию стоит вывод первой таблицы}
  578.  
  579.                 {----- Управление Start -----}
  580.                 Repeat
  581.                 Ch:=Readkey; {Считываем ASCII-код клавиши}
  582.  
  583.                 {#72 - стрелка вверх / #75 - стрелка влево / #77 - стрелка вправо / #80 - стрелка вниз}
  584.                 Case Ch of
  585.                      #80:Begin {Стрелка вниз}
  586.              {Если элемент был последним, то возвращаемся к первому}
  587.                          if (id >= Ns) then id:=0;{Первый элемент массива}
  588.  
  589.                          {Выбираем таблицу для просмотра}
  590.                          if Flag then ShortStory_1(Data,id,Ns)
  591.                                  else ShortStory_2(Data,id,Ns);
  592.                          end; {Case Ch #80}
  593.  
  594.                      #72:Begin {Стрелка вверх}
  595.                          if (Ns > 15) then {Исправляем ошибку проверки диапазона}
  596.                                            Begin
  597.                                            if (id < Ns) and (id > 15) then Dec(id,30)
  598.                                                                       else
  599.                                                                           Begin
  600.                                                                           if (id >= Ns) then
  601.                                                                                             Begin
  602.                                                 id:=Ns-(Ns mod 15);
  603.                                                                         Dec(id,15);
  604.                                                                         end
  605.                                             else if (id <= 15) and (Ns > 15) then id:=Ns-(Ns mod 15)
  606.                                                                                                                          else Dec(id,15);
  607.                                                                           end;
  608.  
  609.                                            {Определяем таблицу для просмотра}
  610.                                            if Flag then ShortStory_1(Data,id,Ns)
  611.                                                    else ShortStory_2(Data,id,Ns);
  612.                                            end;
  613.                          end; {Case Ch #72}
  614.  
  615.                      #77:Begin {Стрелка вправо}
  616.                          if (id < 1) then id:=0
  617.                                      else if (id = Ns) then Dec(id,(id mod 15))
  618.                                                        else Dec(id,15);
  619.  
  620.                          ShortStory_2(Data,id,Ns);
  621.                          Flag:=False; {Выбрана вторая таблица}
  622.                          end; {Case Ch #77}
  623.  
  624.                      #75:Begin {Стрелка влево}
  625.                          if (id < 1) then id:=0
  626.                                      else if (id = Ns) then Dec(id,(id mod 15))
  627.                                                        else Dec(id,15);
  628.  
  629.                          ShortStory_1(Data,id,Ns);
  630.                          Flag:=True; {Выбрана первая таблица}
  631.                          end; {Case Ch #75}
  632.                 end; {Case Ch}
  633.                 Until (Ch = #27); {Клавиша "Esc"}
  634.                 {----- Управление End -----}
  635.                 end;
  636. PrintMainMenu; {Возврат в основное меню}
  637. end;
  638. {----- Вывод краткой информации из БД End -----}
  639.  
  640. {----- Вывод подробной информации из БД Start -----}
  641. Procedure FullStory(data:TData; ns:integer);
  642. var id:integer;
  643.     ch:char;
  644.  
  645. Begin clrscr;
  646. if (Ns = 0) then
  647.                 Begin
  648.                 PrintLine;
  649.                 PrintHead(Yellow,32,'ПРОСМОТР ДАННЫХ');
  650.                 PrintHead(LightGreen,11,'Управление: клавиши "'+#24+'", "'+#25+'", Esc - выход в основное меню');
  651.                 PrintLine;
  652.                 PrintHead(Red,6,'ОШИБКА #002: Файл базы данных не загружен или отсутствует информация');
  653.                 ReturnMainMenu; {Возврат в главное меню}
  654.                 end
  655.             else
  656.                 Begin
  657.                 id:=1;
  658.                 Repeat clrscr;
  659.                 PrintLine;
  660.                 PrintHead(Yellow,32,'ПРОСМОТР ДАННЫХ');
  661.                 PrintHead(LightGreen,11,'Управление: клавиши "'+#24+'", "'+#25+'", Esc - выход в основное меню');
  662.                 PrintLine;
  663.  
  664.                 With Data[id] do
  665.                      Begin
  666.                      TextColor(Cyan); Write(' Номер записи: '); TextColor(Yellow); GotoXY(30,WhereY); Writeln(id,' из ',ns);
  667.                      PrintLine;
  668.                      TextColor(Cyan); Write(' Марка: '); TextColor(Yellow); GotoXY(30,WhereY); Writeln(Maker);
  669.                      TextColor(Cyan); Write(' Модель:'); TextColor(Yellow); GotoXY(30,WhereY); Writeln(Model);
  670.                      TextColor(Cyan); Write(' Комлектация: '); TextColor(Yellow); GotoXY(30,WhereY); Writeln(Grade);
  671.                      TextColor(Cyan); Write(' Тип кузова: '); TextColor(Yellow); GotoXY(30,WhereY); Writeln(Types);
  672.  
  673.                      With Engine do
  674.                           Begin
  675.                           TextColor(Cyan); Write(' Вид топлива: '); TextColor(Yellow); GotoXY(30,WhereY); Writeln(Fuel_Type);
  676.                           TextColor(Cyan); Write(' Мощность двигателя, л.с.: '); TextColor(Yellow);
  677.                           GotoXY(30,WhereY); Writeln(Power);
  678.                           TextColor(Cyan); Write(' Объём двигателя, см^3: '); TextColor(Yellow);
  679.                           GotoXY(30,WhereY); Writeln(Volume);
  680.                           TextColor(Cyan); Write(' Расположение цилиндров: '); TextColor(Yellow);
  681.                           GotoXY(30,WhereY); Writeln(Cylinders)
  682.                           end; {End with engine}
  683.  
  684.                      Writeln;
  685.                      TextColor(Cyan); Writeln(' Расход топлива, л/100 км: ');
  686.  
  687.                      With Consumption do
  688.                           Begin
  689.                           GotoXY(1,WhereY); TextColor(Cyan); Write(' По городу: '); TextColor(Yellow); Write(City:4:1);
  690.                           GotoXY(32,WhereY); TextColor(Cyan); Write(' По трассе: '); TextColor(Yellow); Write(Track:4:1);
  691.                           GotoXY(63,WhereY); TextColor(Cyan); Write(' Смешанный: '); TextColor(Yellow); Writeln(Mixed:4:1);
  692.                           end; {End with Consumption}
  693.                      Writeln;
  694.  
  695.                      TextColor(Cyan); Write(' Трансмиссия: '); TextColor(Yellow); GotoXY(30,WhereY); Writeln(Transmission);
  696.                      TextColor(Cyan); Write(' Тип привода: '); TextColor(Yellow); GotoXY(30,WhereY); Writeln(Drive);
  697.                      TextColor(Cyan); Write(' Цвет: '); TextColor(Yellow); GotoXY(30,WhereY); Writeln(Color);
  698.                      TextColor(Cyan); Write(' Год выпуска: '); TextColor(Yellow); GotoXY(30,WhereY); Writeln(Year);
  699.                      TextColor(Cyan); Write(' Стоимость, руб.: '); TextColor(Yellow); GotoXY(30,WhereY); Writeln(Price);
  700.                      PrintLine;
  701.                      end; {End with data}
  702.                 {----- Управление Start -----}
  703.                 Ch:=Readkey; {Считываем ASCII-код клавиши}
  704.                 {#72 - стрелка вверх / #80 - стрелка вниз}
  705.  
  706.                                 Case Ch of
  707.                                      #80:Begin {Стрелка вниз}
  708.                                          Inc(id); {Определяем номер элемента в массиве}
  709.  
  710.                                                          {Если элемент был последним, то возвращаемся к первому}
  711.                                          if (id > Ns) then id:=1;{Первый элемент массива}
  712.                                          end;
  713.  
  714.                                      #72:Begin {Стрелка вверх}
  715.                                          Dec(id); {Определяем номер элемента в массиве}
  716.  
  717.                                                                         {Если элемент был первым, то возвращаемся к последнему}
  718.                                                                         if (id < 1) then id:=Ns;
  719.                                                                         end;
  720.                 end; {Case Ch}
  721.                 Until (Ch = #27); {Клавиша "Esc"}
  722.                 {----- Управление End -----}
  723.                 end; {end else}
  724. PrintMainMenu; {Возврат в основное меню}
  725. end;
  726. {----- Вывод подробной информации из БД End -----}
  727.  
  728. {----- Файл с отчетом Start -----}
  729. Procedure OutputTxt(data:TData; ns:integer);
  730. var id:integer; {Счетчик}
  731.     f_data:text; {Файл с отчетом}
  732.     old_year,new_year:word; {Минимальный/максимальный год}
  733.     min_price,max_price:longint; {Минимальная/максимальная стоимость}
  734.     ave_price:real; {Средняя стоимость всех автомобилей}
  735. Begin clrscr;
  736. PrintLine;
  737. PrintHead(Yellow,30,'ФОРМИРОВАНИЕ ОТЧЁТА');
  738. PrintHead(LightGreen,8,'Создание текстового файла с полным отчетом по всем записям в БД');
  739. PrintLine;
  740. Assign(F_Data,F_name_rept); {Подключаем файл "F_name_db" к переменной F_Data}
  741. Rewrite(F_Data); {Создаем и открываем файл "F_name_db"}
  742.  
  743. Min_Price:=Data[1].Price; {Начальное значение минимальной стоимости}
  744. Max_Price:=Data[1].Price; {Начальное значение максимальной стоимости}
  745. Ave_Price:=0; {Начальное значение средней стоимости всех автомобилей}
  746. Old_Year:=Data[1].Year; {Начальное значение минимального года выпуска}
  747. New_Year:=Data[1].Year; {Начальное значение максимального года выпуска}
  748.  
  749. Writeln(F_Data,'----------------------------------------------------------------------------------------',
  750.                '----------------------------------------------------------------------------------------',
  751.                '-------------------------------------------------------------------------');
  752.  
  753.  
  754. Writeln(F_Data,'| № |   Марка   |      Модель     |    Комлектация    |  Тип кузова  |  Вид топлива  ',
  755.                '|Мощность двигателя, л.с.|Объём двигателя, см^3|Расположение цилиндров',
  756.                '|  Расход топлива  |Трансмиссия|  Привод  |         Цвет         |   Год    |   Цена, руб.   |');
  757.  
  758. Writeln(F_Data,'----------------------------------------------------------------------------------------',
  759.                '----------------------------------------------------------------------------------------',
  760.                '-------------------------------------------------------------------------');
  761.  
  762. for id:=1 to ns do
  763.     With Data[id] do
  764.          Begin
  765.          Writeln(F_Data,'|',id:3, '| ', Maker:10, '|', Model:17, '|', Grade:19,'|',Types:14,
  766.                             '|',Engine.Fuel_Type:15, '| ', Engine.Power:23, '|', Engine.Volume:21, '|',Engine.Cylinders:22,
  767.                         '|',Consumption.City:4:1,' / ',Consumption.Track:4:1,' / ',Consumption.Mixed:4:1,
  768.                                 '|', Transmission:13, '|', Drive:10,'|', Color:20,'|',Year:10,'|', Price:16,'|');
  769.          Writeln(F_Data,'----------------------------------------------------------------------------------------',
  770.                         '----------------------------------------------------------------------------------------',
  771.                         '-------------------------------------------------------------------------');
  772.  
  773.          {----- Поиск минимальных/максимальным значений Start -----}
  774.          if (Min_Price > Price) then Min_Price:=Price; {Минимальная цена}
  775.          if (Max_Price < Price) then Max_Price:=Price; {Максимальная цена}
  776.          if (Old_Year > Year) then Old_Year:=Year; {Минимальная цена}
  777.          if (New_Year < Year) then New_Year:=Year; {Максимальная цена}
  778.          Ave_Price:=Ave_Price+Price/Ns;
  779.          {----- Поиск минимальных/максимальным значений End -----}
  780.          end;
  781.  
  782. Writeln(F_Data,'| Минимальная стоимость:    ',Min_Price:213,', руб. |');
  783. Writeln(F_Data,'| Максимальная стоимость:   ',Max_Price:213,', руб. |');
  784. Writeln(F_Data,'| Средняя стоимость:   ',Ave_Price:218:2,', руб. |');
  785. Writeln(F_Data,'| Минимальный год выпуска:  ',Old_Year:219,' |');
  786. Writeln(F_Data,'| Максимальный год выпуска: ',New_Year:219,' |');
  787. Writeln(F_Data,'----------------------------------------------------------------------------------------',
  788.                '----------------------------------------------------------------------------------------',
  789.                '-------------------------------------------------------------------------');
  790. Close(F_Data); {Закрываем файл "F_name2"}
  791.  
  792. GotoXY(13,WhereY); TextColor(LightGreen); Writeln('Файл с отчетом успешно создан. Имя файла: "',F_name_rept,'".');
  793. Delay(3000); {Задержка 3 секунды}
  794. ReturnMainMenu; {Возврат в главное меню}
  795. end;
  796. {----- Файл с отчетом End -----}
  797.  
  798. {----- Поиск информации в БД Start -----}
  799. Procedure FunctionSeach_1(data:TData; field:char; ns:integer; const value:array of string; item:integer);
  800. var id,count:integer;
  801.     sdata:TData;
  802.     nameseach:string;
  803.     ch:char;
  804.  
  805. Begin clrscr;
  806. PrintLine;
  807. PrintHead(Yellow,34,'ПОИСК ДАННЫХ');
  808. PrintHead(LightGreen,11,'Управление: клавиши клавиши "'+#26+'", "'+#27+'", Enter - подтвердить');
  809. PrintLine;
  810.  
  811. TextColor(Cyan); Write(' Критерий поиска: '); NameSeach:=Selection(Value,item);
  812. PrintLine;
  813.  
  814. Count:=0;
  815.  
  816. for id:=1 to Ns do
  817.     Case Field of
  818.         #50:if Data[id].Types=NameSeach then {По типу кузова}
  819.                                             Begin
  820.                                             Inc(Count);
  821.                                             sData[Count]:=Data[id];
  822.                                             end;
  823.  
  824.         #51:if Data[id].Transmission=NameSeach then {По трансмиссии}
  825.                                                    Begin
  826.                                                    Inc(Count);
  827.                                                    sData[Count]:=Data[id];
  828.                                                    end;
  829.  
  830.         #52:if Data[id].Drive=NameSeach then {По типу привода}
  831.                                             Begin
  832.                             Inc(Count);
  833.                             sData[Count]:=Data[id];
  834.                                             end;
  835.  
  836.         #53:if Data[id].Engine.Fuel_type=NameSeach then {По виду топлива}
  837.                                                        Begin
  838.                                                        Inc(Count);
  839.                                                                sData[Count]:=Data[id];
  840.                                                                end;
  841.  
  842.         #54:if Data[id].Color=NameSeach then {По цвету автомобиля}
  843.                                                     Begin
  844.                                             Inc(Count);
  845.                                                     sData[Count]:=Data[id];
  846.                                             end;
  847.     end; {Case Field}
  848.  
  849. if (Count = 0) then
  850.                    Begin
  851.                    TextColor(Red); GotoXY(7,WhereY);
  852.                    Writeln('Результаты поиска: по данному критерию найдено ',Count,' из ',Ns,' записей');
  853.                    Delay(3000); {Задержка 3 секунды}
  854.                    ReturnMainMenu; {Возврат в главное меню}
  855.                    end
  856.                else
  857.                    Begin
  858.                    TextColor(LightGreen); GotoXY(7,WhereY);
  859.                    Writeln('Результаты поиска: по данному критерию найдено ',Count,' из ',Ns,' записей');
  860.                    Delay(3000); {Задержка 3 секунды}
  861.  
  862.                    PrintAdditionalMenu_2; {Выводим меню}
  863.                    Repeat
  864.                    Ch:=Readkey; {Считываем ASCII-код клавиши}
  865.  
  866.                    Case Ch of
  867.                         #49:PrintShortStory(sData,Count); {Вывод информации на экран}
  868.                         #50:FullStory(sData,Count); {Вывод подробной информации на экран}
  869.                         #51:PrintMainMenu; {Возврат в основное меню}
  870.                    end; {Case Ch}
  871.                    Until (Ch in [#49..#51]);
  872.                    end;
  873. end;
  874. {----- Поиск информации в БД End -----}
  875.  
  876. {----- Поиск информации в БД Start -----}
  877. Procedure FunctionSeach_2(data:TData; field:char; ns:integer);
  878. var id,count:integer;
  879.     sdata:TData;
  880.     nameseach:string;
  881.     yearseach:word;
  882.     priceseachleft,priceseachright,fixprice:longint;
  883.     ch:char;
  884.  
  885. Begin clrscr;
  886. PrintLine;
  887. PrintHead(Yellow,34,'ПОИСК ДАННЫХ');
  888. PrintHead(LightGreen,15,'Управление: ввод с клавиатуры, Enter - подтвердить');
  889. PrintLine;
  890.  
  891. Count:=0;
  892.  
  893. Case Field of
  894.      #48:Begin
  895.          TextColor(Cyan); Write(' Критерий поиска: '); TextColor(Yellow); Readln(NameSeach);
  896.          PrintLine;
  897.  
  898.          for id:=1 to Ns do
  899.              if Data[id].Maker=NameSeach then {По марке}
  900.                                      Begin
  901.                                              Inc(Count);
  902.                                      sData[Count]:=Data[id];
  903.                          end;
  904.          end;
  905.  
  906.      #49:Begin
  907.          TextColor(Cyan); Write(' Критерий поиска: '); TextColor(Yellow); Readln(NameSeach);
  908.          PrintLine;
  909.  
  910.          for id:=1 to Ns do
  911.              if Data[id].Model=NameSeach then {По модели}
  912.                                              Begin
  913.                          Inc(Count);
  914.                          sData[Count]:=Data[id];
  915.                          end;
  916.          end;
  917.  
  918.      #55:Begin
  919.          TextColor(Cyan); Write(' Критерий поиска: '); TextColor(Yellow); Readln(YearSeach);
  920.          PrintLine;
  921.  
  922.          for id:=1 to Ns do if Data[id].Year=YearSeach then {По году}
  923.                                            Begin
  924.                                            Inc(Count);
  925.                                            sData[Count]:=Data[id];
  926.                                            end;
  927.          end;
  928.  
  929.      #56:Begin
  930.          TextColor(Cyan); Writeln(' Критерий поиска: ');
  931.          TextColor(Cyan); Write(' Минимальная цена:  '); TextColor(Yellow); Readln(PriceSeachLeft);
  932.          TextColor(Cyan); Write(' Максимальная цена: '); TextColor(Yellow); Readln(PriceSeachRight);
  933.  
  934.          if (PriceSeachLeft > PriceSeachRight) then {На случай ошибки, если введенное значение Min > Max}
  935.                                                    Begin
  936.                                    FixPrice:=PriceSeachLeft;
  937.                                    PriceSeachLeft:=PriceSeachRight;
  938.                                    PriceSeachRight:=FixPrice;
  939.                            end;
  940.          PrintLine;
  941.  
  942.          for id:=1 to Ns do
  943.              if ((PriceSeachLeft <= Data[id].Price) and (Data[id].Price <= PriceSeachRight)) then {По цене}
  944.                                                                          Begin
  945.                                                                                                  Inc(Count);
  946.                                                                                                  sData[Count]:=Data[id];
  947.          end;                                                                                    end;
  948. end; {Case Field}
  949.  
  950. if (Count = 0) then
  951.                    Begin
  952.                    TextColor(Red); GotoXY(7,WhereY);
  953.                    Writeln('Результаты поиска: по данному критерию найдено ',Count,' из ',Ns,' записей');
  954.                    Delay(3000); {Задержка 3 секунды}
  955.                    ReturnMainMenu; {Возврат в главное меню}
  956.                    end
  957.                else
  958.                    Begin
  959.                    TextColor(LightGreen); GotoXY(7,WhereY);
  960.                    Writeln('Результаты поиска: по данному критерию найдено ',Count,' из ',Ns,' записей');
  961.                    Delay(3000); {Задержка 3 секунды}
  962.  
  963.                    PrintAdditionalMenu_2; {Выводим меню}
  964.                    Repeat
  965.                    Ch:=Readkey; {Считываем ASCII-код клавиши}
  966.  
  967.                    Case Ch of
  968.                         #49:PrintShortStory(sData,Count); {Вывод информации на экран}
  969.                         #50:FullStory(sData,Count); {Вывод подробной информации на экран}
  970.                         #51:PrintMainMenu; {Возврат в основное меню}
  971.                    end; {Case Ch}
  972.                    Until (Ch in [#49..#51]);
  973.                    end;
  974. end;
  975. {----- Поиск информации в БД End -----}
  976.  
  977. {----- Сортировка информации в БД Start -----}
  978. Procedure FunctionSorting(var data:TData; field:char; ns:integer);
  979. var i,count,j:integer;
  980.     rem_year:word;
  981.     rem_price:longint;
  982.     cache:automobile;
  983.  
  984. Begin clrscr;
  985. PrintLine;
  986. PrintHead(Yellow,31,'СОРТИРОВКА ДАННЫХ');
  987. PrintHead(LightGreen,20,'Сортировка данных от меньшего к большему');
  988. PrintLine;
  989.  
  990. Case Field of
  991.      #49:Begin {По году}
  992.          for i:=1 to Ns do
  993.              Begin
  994.          Cache:=Data[i];
  995.          Rem_Year:=Data[i].Year; {Запоминаем}
  996.  
  997.          Count:=1;
  998.  
  999.              While (Data[Count].Year < Rem_Year) do Inc(Count); {Считаем}
  1000.  
  1001.              for j:=i downto Count+1 do Data[j]:=Data[j-1]; {Перемещаем значениt}
  1002.              Data[Count]:=Cache; {Записываем}
  1003.              end;
  1004.          end; {Case Field #49}
  1005.  
  1006.      #50:Begin {По цене}
  1007.          for i:=1 to Ns do
  1008.              Begin
  1009.          Cache:=Data[i];
  1010.          Rem_Price:=Data[i].Price; {Запоминаем}
  1011.  
  1012.              Count:=1;
  1013.  
  1014.              While (Data[Count].Price < Rem_Price) do Inc(Count); {Считаем}
  1015.  
  1016.              for j:=i downto Count+1 do Data[j]:=Data[j-1]; {Перемещаем значениt}
  1017.              Data[Count]:=Cache; {Записываем}
  1018.              end;
  1019.          end; {Case Field #50}
  1020. end; {Case Field}
  1021.  
  1022. PrintHead(LightGreen,22,'Сортировка данных выполнена успешно');
  1023. ReturnMainMenu; {Возврат в главное меню}
  1024. end;
  1025. {----- Сортировка информации в БД  End -----}
  1026. {----- Функционал программы End -----}
  1027.  
  1028. Begin {Основная программа}
  1029. id:=0;
  1030.  
  1031. PrintMainMenu; {Выводим основное меню}
  1032.  
  1033. Repeat
  1034. Ch:=Readkey; {Считываем ASCII-код клавиши}
  1035. {[#48..#55] - клавиши от 0 до 7 по таблице ASCII кодов}
  1036.  
  1037. Case Ch of
  1038.      #49:Begin
  1039.          PrintAdditionalMenu_1; {Выводим дополнительное меню}
  1040.  
  1041.          Repeat
  1042.      Ch2:=Readkey; {Считываем ASCII-код клавиши}
  1043.          {[#49..#54] - клавиши от 1 до 6 по таблице ASCII кодов}
  1044.  
  1045.          Case Ch2 of
  1046.           #49:Begin {Ввод информации}
  1047.           if (id < MaxID) then
  1048.                       Begin
  1049.                       Inc(id); {Счетчик}
  1050.                       ChangeDataBase(Data[id]);
  1051.                       end
  1052.                   else
  1053.                       Begin
  1054.                       PrintLine;
  1055.                       PrintHead(Yellow,34,'ВВОД ДАННЫХ');
  1056.                       PrintHead(LightGreen,14,'Управление: для ввода данных используйте клавиатуру');
  1057.                       PrintLine;
  1058.                       PrintHead(Red,3,'ОШИБКА #001: Файл базы данных содержит максимальное количество информации');
  1059.                                       ReturnMainMenu; {Возврат в главное меню}
  1060.                       end;
  1061.           end; {Case Ch2 #49}
  1062.  
  1063.                       #50:DeleteDataBase(Data,id,SelectionID(id)); {Удаление информации}
  1064.                       #51:ChangeDataBase(Data[SelectionID(id)]); {Изменение информации}
  1065.                       #52:SaveDataBase(Data,id); {Сохранение информации в Базу Данных}
  1066.                       #53:ReadingDataBase(Data,id,MaxID); {Загрузка информации из Базы Данных}
  1067.                       #54:PrintMainMenu; {Возврат в основное меню}
  1068.                       end; {Case Ch2}
  1069.                Until Ch2 in [#49..#54];
  1070.              end; {Case Ch #49}
  1071.  
  1072.          #50:Begin
  1073.              PrintAdditionalMenu_2; {Выводим меню}
  1074.  
  1075.            Repeat
  1076.              Ch2:=Readkey; {Считываем ASCII-код клавиши}
  1077.  
  1078.              Case Ch2 of
  1079.                   #49:PrintShortStory(Data,id); {Вывод информации на экран}
  1080.               #50:FullStory(Data,id); {Вывод подробной информации на экран}
  1081.               #51:PrintMainMenu; {Возврат в основное меню}
  1082.           end; {Case Ch2}
  1083.          Until (Ch2 in [#49..#51]);
  1084.          end; {Case Ch #50}
  1085.  
  1086.           #51:OutputTxt(Data,id);
  1087.  
  1088.           #52:Begin clrscr;
  1089.                   PrintAdditionalMenu_3; {Дополнительное меню поиска}
  1090.           Repeat
  1091.           Ch2:=Readkey; {Считываем ASCII-код клавиши}
  1092.           {[#48..#57] - клавиши от 0 до 9 по таблице ASCII кодов}
  1093.  
  1094.           Case Ch2 of
  1095.                #49:FunctionSeach_2(Data,#48,id); {По марке}
  1096.                #50:FunctionSeach_2(Data,#49,id);{По модели}
  1097.                #51:FunctionSeach_1(Data,#50,id,c_types,n_types); {По типу кузова}
  1098.                #52:FunctionSeach_1(Data,#51,id,c_transmission,n_transmission);{По трансмиссии}
  1099.                #53:FunctionSeach_1(Data,#52,id,c_drive,n_drive); {По типу привода}
  1100.                #54:FunctionSeach_1(Data,#53,id,c_fuel,n_fuel); {По виду топлива}
  1101.                #55:FunctionSeach_1(Data,#54,id,c_color,n_color); {По цвету}
  1102.                #56:FunctionSeach_2(Data,#55,id);
  1103.                #57:FunctionSeach_2(Data,#56,id);
  1104.                #48:PrintMainMenu; {Возврат в основное меню}
  1105.                   end;
  1106.           Until (Ch2 in [#48..#57]);
  1107.                end;
  1108.  
  1109.          #53:Begin clrscr;
  1110.                      PrintAdditionalMenu_4; {Дополнительное меню (сортировки)}
  1111.              Repeat
  1112.              Ch2:=Readkey; {Считываем ASCII-код клавиши}
  1113.              {[#49..#51] - клавиши от 1 до 3 по таблице ASCII кодов}
  1114.  
  1115.              Case Ch2 of
  1116.               #49:FunctionSorting(Data,#49,id);{По году}
  1117.               #50:FunctionSorting(Data,#50,id);{По цене}
  1118.               #51:PrintMainMenu; {Возврат в основное меню}
  1119.                      end;
  1120.              Until (Ch2 in [#49..#51]);
  1121.                      end;
  1122.  
  1123.          #54:PrintHelpProgram;
  1124.          #55:PrintInfoAuthor;
  1125.          #48:Exit; {Выходим из программы}
  1126. end; {Case Ch}
  1127. Until (Ch = #48);
  1128. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!