API tools faq
paste
Guest User

Untitled

a guest
Jan 23rd, 2018
98
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 33.00 KB | None | 0 0
raw download clone embed print report
  1. uses CRT;
  2.  
  3. const  Parts: array [1..6] of string = ('Австралия и Океания', 'Азия', 'Америка', 'Антарктида', 'Африка', 'Европа');
  4.  
  5. Type Data = Record                  {Запись с данными}
  6.                Country:string;  {Страна}
  7.                Part:integer;    {Часть света (номер элемента в массиве Parts)}
  8.                Capital:string;  {Столица}
  9.              End;
  10.  
  11. Predicate = function(var D:Data):boolean; {Процедурный тип. Функции этого типа (ShowAll, Mode1, Mode2) возвращают значение true, если переданная им запись подходит под соответствующий режим}
  12.  
  13. var
  14.   Mode:byte;            {Текущий режим}
  15.   Mode1Part: integer;   {Часть света (номер элемента в массиве Parts) для 1-го режима}
  16.   Mode2Country: string; {Столица для 2-го режима}
  17.  
  18. {-----------------------------------------------------------------------------}
  19. function Menu:integer;           {Подпрограмма для вывода меню}
  20. procedure Select(SM,N:integer);  {Меняет пункт меню SM на N. Процедура доступна только в подпрограмме Menu}
  21. begin
  22.   if N in [1..3] then           {Проверка 1<=N<=3}
  23.   begin
  24.     GotoXY(2, SM + 1);          {Cтереть * в предыдущем выбранном пункте}
  25.     write(' ');
  26.     GotoXY(2, N + 1);           {Вывести * в новом пнкте}
  27.     write('*');
  28.   end
  29. end;
  30.  
  31. var
  32.   mode: integer;    {Текущий выбранный пункт}
  33.   c: char;          {Код нажатой клавиши}
  34.   ext:boolean;      {True если нажата клавиша с расширенным кодом}
  35. begin
  36.   clrscr;           {Очистить экран}
  37.   repeat
  38.     writeln('Выберите Режим');
  39.     writeln('[*] Ввод данных');
  40.     writeln('[ ] Просмотр и редактирование');
  41.     writeln('[ ] Выход');
  42.     mode := 1;      {Изначально выбран 1-й пункт}
  43.     repeat
  44.       c := readkey; {Считываем код клавиши}
  45.       if c in ['1'..'3'] then  {Если нажата клавиша 1, 2 или 3, то}
  46.       begin
  47.          Select(mode, ord(c) - ord('0'));   {выберем соответствующий пункт и}{ord(c)-код символа c, напрмер ord('1')-ord('0') = 1}
  48.          mode := ord(C) - ord('0');         {Изменим значение переменной mode}
  49.       end;
  50.       if c = #0 then ext := true;           {Если нажата клавиша с расширенным кодом, установим ext}
  51.       if (c in [#72,#80]) and ext then      {Нажата клавиша 'Up' или 'Down'}
  52.       begin
  53.         if (c = #72) and (mode > 1) then    {обработка нажатия 'UP'}
  54.         begin
  55.            Select(mode, mode - 1);          {Выбор пункта, который выше текущего}
  56.            dec(mode);
  57.         end;
  58.         if (c = #80) and (mode < 3) then    {обработка нажатия 'Down'}
  59.         begin
  60.            Select(mode, mode + 1 );         {Выбор пункта, который ниже текущего}
  61.            inc(mode);
  62.         end;
  63.         ext := false;   {Нажатие клавиши с расширенным кодом обработано, сбрасываем ext}
  64.       end;
  65.     until c = #13;  {Повторять пока код клавиши не равен 13 (Enter)}
  66.   until c = #13;
  67.   menu := mode;     {Возращаем вызывающей программе номер выбранного пункта}
  68. end;
  69.  
  70. {-----------------------------------------------------------------------------}
  71. procedure ClrLine(Y,X:integer); {Процедура очищает строку Y, начиная с позиции X}
  72. begin
  73.   GotoXY(X,Y); {Переместить курсор в точку (X,Y)}
  74.   ClrEOL;       {Удалить символы с позиции X до конца строки}
  75. end;
  76. {---------------------------------------------------------------------------}
  77. procedure Message(Y:word; s:string); {Вывод сообщения S в строке Y}
  78. var
  79. X_,Y_:integer; {Текущие координаты курсора}
  80. begin
  81.   X_ := WhereX; {Сохраним старые}
  82.   Y_ := WhereY; {координаты курсора}
  83.   ClrLine(Y,1); {Перейдем в строку Y и очистим ее}
  84.   write(s);     {выведем строку}
  85.   GotoXY(X_,Y_);{Восстановим старые координаты}
  86. end;
  87. {-----------------------------------------------------------------------------}
  88. function ReadStr(Y:integer; var S:string; var Quit:boolean):char; {Ввод и редактирование строки S в строке c номером Y. Возвращает код последней нажатой клавиши (возможные значения: #13, #72, #80). Quit = true, если нажата клавиша Esc}
  89. var
  90.   c:char;       {код клавиши}
  91.   i:integer;    {текущая длина строки}
  92.   ext:boolean;  {True если нажата клавиша с расширенным кодом}
  93. begin
  94.   ClrLine(Y, 14); {Перейдем в строку Y и очистим ее с позиции 14 до конца (до 14 выведено название поля)}
  95.   i := Length(S); {длина строки}
  96.  
  97.   write(S);      {вывод строки}
  98.   ext := false;  {инициализация}
  99.   Quit := false;
  100.   repeat
  101.     c := readkey; {Считываем код клавиши}
  102.     if c = #27 then {если нажата клавиша Esc, то}
  103.     begin
  104.       Quit := true; {Установим Quit и}
  105.       exit;         {выйдем из функции}
  106.     end;
  107.     if (c = #8) and (i > 0) then {обработка Backspace}
  108.     begin
  109.       GotoXY(WhereX-1, WhereY); {стереть последний символ}
  110.       write(' ');
  111.       GotoXY(WhereX-1, WhereY);
  112.       delete(S, i, 1);          {Удалить последний символ из строки S}
  113.       dec(i);                   {Уменьшить длину строки}
  114.     end;
  115.     if c = #0 then ext := true; {Если нажата клавиша с расширенным кодом, установим ext}
  116.     if (c in ['a'..'z', 'A'..'Z', 'а'..'я', 'А'..'Я','-']) and (i<80-14) and not ext then {проверка кода клавиши на принадлежность к множеству алфавитных и проверка текущей длины  строки}
  117.     begin
  118.       write(c); {выведем введенный символ}
  119.       s := s+c; {присоединим его к концу строки S}
  120.       inc(i);   {увеличим длину строки на 1}
  121.     end;
  122.  
  123.   until (c = #13) or ((c in [#72, #80]) and ext);  {выход из функции происходит при нажатии Enter(13), Up(72) или Down(80)}
  124.   ReadStr := c;     {вернем код последней нажатой клавиши. М.б. только 13, 72, или 80}
  125. end;
  126. {-----------------------------------------------------------------------------}
  127. function ReadPart(Y:integer; var P:integer; var Quit:boolean):char; {Считывание части света (параметры и возвращаемое значение аналогичны предыдущей функции)}
  128. var
  129.   c:char;       {код клавиши}
  130.   i:integer;    {номер текущей строки}
  131.   ext:boolean;  {True если нажата клавиша с расширенным кодом}
  132. begin
  133.   ClrLine(Y,14);{Перейдем в строку Y и очистим ее с позиции 14 до конца (до 14 выведено название поля)}
  134.   if P <> 0 then {Если происходит редактирование, а не ввод, то выведем уже выбранную часть света}
  135.     write(Parts[P]);
  136.  
  137.   Quit:=false; {инициализация}
  138.  
  139.   Message(9,'Выберите часть света, в которой расположена страна'); {Вывести сообщение в 9 строку}
  140.   GotoXY(1, 10);     {Переместить курсор в точку (1, 10)}
  141.   for i:=1 to 6 do   {Вывести названия частей света}
  142.     Writeln(i,' - ', Parts[i]);
  143.   i:= 0;
  144.   GotoXY(14, Y);    {Переместить курсор в точку (14, Y)}
  145.   repeat
  146.     c := readkey;   {Считать код клавиши}
  147.     if c = #27 then {Обработка нажатия Escape (как в предыдущей функции)}
  148.     begin
  149.       Quit := true;
  150.       exit;
  151.     end;
  152.     if c = #0 then ext := true; {Если нажата клавиша с расширенным кодом, установим ext}
  153.     if c in ['1'..'6'] then     {Если нажата клавиша из диапазона 1..6, то}
  154.     begin
  155.        ClrLine(Y,14);           {Очистим строку Y с позиции 14 до конца и }
  156.        Write(Parts[ord(c)-ord('0')]); {Выведем название выбранной части света}
  157.        GotoXY(WhereX-1, WhereY);
  158.        P := ord(c)-ord('0');   {Сохраним номер выбранной части света}
  159.     end;
  160.  
  161.   until (c=#13) or ((c in [#72, #80]) and ext); {выход из функции, если нажата клавиша Enter(13), Up(72) или Down(80)}
  162.  
  163.   for i:=0 to 6 do      {Очистим строки 9-15}
  164.     Message(9+i, '');
  165.   ReadPart := c;        {Вернем код последней клавиши (как в предыдущей функции)}
  166. end;
  167. {-----------------------------------------------------------}
  168. {-----------------------------------------------------------}
  169. procedure EnterData;  {Процедура, в которой происходит ввод данных}
  170. var
  171.   F: file of Data;  {Файл с данными}
  172.   G: Data;          {Запись с данными}
  173.   c: char;          {Символ}
  174.   s, quit:boolean;  {Флаги: s = True, если заполнены все поля. Quit = true, если пользователь нажал Esc}
  175.   i: word;          {Номер заполняемого поля}
  176. begin            
  177.   assign(F, 'base.dat'); {связать F с файлом base.dat}
  178.   {$I-}     {отключить проверки IO}
  179.   reset(F); {открыть файл}
  180.   {$I+}     {включить проверки IO}
  181.   if IOResult <> 0 then {Если результат последней операции IO (открытие файла) <>0 (например, файл base.dat не существует), то создадим файл}
  182.      rewrite(F)
  183.   else                     {иначе переместимся в конец файла}
  184.      while not EOF(F) do Read(F, G);
  185.   repeat
  186.     clrscr; {очистить экран}
  187.     i := 1;             {Инициализация}
  188.     G.Country := '';    {Инициализация}
  189.     G.Part := 0;        {Инициализация}
  190.     G.Capital := '';    {Инициализация}
  191.     Writeln('Страна     : ');
  192.     Writeln('Часть света: ');
  193.     Writeln('Столица    : ');
  194.  
  195.     Message(9, 'ESC - возврат в меню');
  196.     repeat
  197.     repeat
  198.       GotoXY(14, i);
  199.       case i of                     {в соответствии с текущим номером поля (i), считываем}
  200.         1: c := ReadStr(1, G.Country, quit); {Название страны}
  201.         2: c := ReadPart(2, G.Part, quit);   {Части света}
  202.         3: c := ReadStr(3, G.Capital, quit); {или столицы}
  203.       end;
  204.       if quit then {Если пользователь нажал Esc (В функциях ReadStr или ReadPart), то закроем файл и выйдем из процедуры}
  205.       begin
  206.         close(F);
  207.         exit;
  208.         end;
  209.  
  210.       if (c in [#72, #80]) then {Если пользователь нажал Up или Down (В функциях ReadStr или ReadPart), то перейдем в соответствующее поле}
  211.       begin
  212.         if (c = #72) and (i > 1) then
  213.            dec(i);
  214.         if (c = #80) and (i < 3) then
  215.            inc(i);
  216.        end;
  217.       if (c = #13) and (i < 3) then {Если пользователь нажал Enter в 1-й или 2-й строке, то}
  218.       begin
  219.         inc(i);  {Перейти к следующей строке}
  220.         c := #0;
  221.       end;
  222.     until (c = #13) and (i = 3); {выйти из цикла ввода, когда пользователь нажимет Enter в 3 поле}
  223.  
  224.       if G.Country = '' then {Введено название страны?}
  225.       begin    
  226.         i := 1; {если нет, то перейти в 1-е поле}
  227.         s := false;
  228.         end
  229.       else s:= true; {Если заполнено 1-е поле, возможно, что все данные введены (далее еще 2 проверки)}
  230.  
  231.       if g.Part = 0 then {Введена часть света?}
  232.         begin
  233.         i:=2; {если нет, то перейти во 2-е поле}
  234.         s := false;
  235.         end;
  236.       if G.Capital = '' then {Введена столица?}
  237.         begin
  238.         i:=3; {если нет, то перейти в 3-е поле}
  239.         s := false;
  240.         end;
  241.  
  242.        if not s then {Если не данные введены, то выведем сообщение и перейдем в начало цикла ввода (выбранным будет незаполненное поле)}
  243.          Message(9, 'Нужно заполнить все поля');
  244.  
  245.     until s; {Выход, если s = true (все поля заполнены)}
  246.  
  247.    Write(F, G); {Запишем введенную запись в файл}
  248.    until  c = #27; {Повторять ввод пока пользователь не нажмет Esc}
  249.    close(F); {Закрыть файл}
  250. end;
  251.  
  252.  
  253. Procedure WriteItem(var D:Data); {Вывод записи D}
  254. Var
  255.   X,Y, i:integer;
  256.   s:string;
  257. begin
  258.   Y := WhereY;          {Номер строки, в которой находится курсор}
  259.   GotoXY(2, Y);         {Переместить курсор в точку (2, Y)}
  260.   s := D.Country;       {Сохраняем название страны во временную переменную}
  261.   if Length(D.Country)<24 then   {Если длина строки < 24, то выводим ее полность}
  262.      write('│',D.Country)
  263.   else
  264.   begin     {иначе обрезаем ее и добавляем '...'}
  265.     Delete(S, 22 , Length(s) - 21);
  266.     write('│', s+'...');
  267.   end;
  268.  
  269.   GotoXY(27, Y);
  270.   Write('│', Parts[D.Part]); {Выводим часть света}
  271.  
  272.   {Вывод столицы (Также как вывод названия страны)}
  273.   GotoXY(52, Y);
  274.   s := D.Capital;
  275.   if Length(D.Capital)<26 then {}
  276.      write('│',D.Capital)
  277.   else
  278.   begin
  279.     Delete(S, 25 , Length(s) - 25);
  280.     write('│', s+'...');
  281.   end;
  282.  
  283. end;
  284.  
  285. {Следующие 3 функции - режимы}
  286. {---------------------------------------------------------------------------}
  287. Function ShowAll(var I:Data):boolean;far; {Все записи}
  288. begin
  289.   ShowAll := True;
  290. end;
  291. {----------------------------------------------------------------------------}
  292. Function Mode1(var I:Data):boolean;far; {Режим 1}
  293. begin
  294.     if I.Part = Mode1Part then {Если запись I удовлетворяет условию (Mode1Part определяется в функции выбора режима),}
  295.         Mode1:=true             {то вернем True}
  296.     else Mode1:=false;  {иначе - False}
  297. end;
  298. {----------------------------------------------------------------------------}
  299. Function Mode2(var I:Data):boolean;far;
  300. begin
  301.     if I.Country = Mode2Country then {Если запись I удовлетворяет условию (Mode2Country определяется в функции выбора режима),}
  302.         Mode2:=true     {то вернем True}
  303.     else Mode2:=false;  {иначе - False}
  304. end;
  305. {----------------------------------------------------------------------------}
  306.  
  307. procedure Del(N:integer); {Удаление N-й записи из файла}
  308. var
  309.   F, tmp:file of Data; {Файл с данными и временный файл}
  310.   t:Data;           {Переменная, с помощью которой будет происходить копирование записей во временный файл и обратно}
  311.   i:integer;
  312. begin
  313.   assign(F, 'base.dat');
  314.   reset(F); {открываем файл с данными}
  315.   assign(tmp, 'tmp.dat');
  316.   rewrite(tmp); {создаем временный файл}
  317.   Seek(F, N); {Перемещаемся в файле с данными к N-й записи}
  318.   for i:=N to FileSize(F)-1 do {Копируем оставшиеся записи (от записи N до последней) во временный файл}
  319.   begin
  320.     read(F, t);
  321.     write(tmp, t);
  322.   end;
  323.   close(tmp); {Закрываем временный файл}
  324.   close(F); {Закрываем файл с данными}
  325.   reset(F); {открываем файл с данными}
  326.   seek(F, N-1); {Перемещаемся в файле с данными к N-й записи}
  327.   Truncate(F); {Удаляем записи от записи с номером N до последней}
  328.   close(F); {Закрываем файл с данными}
  329.   reset(F);  {открываем файл с данными}
  330.   reset(tmp);{открываем временный файл}
  331.   Seek(F, FileSize(F)); {Перемещаемся к концу файла с данными}
  332.   for i:=1 to FileSize(tmp) do {Копируем записи из временного файла в файл с данными}
  333.   begin
  334.     read(tmp, t);
  335.     write(F, t);
  336.   end;
  337.   close(F); {Закрываем файл с данными}
  338.   close(tmp);{Закрываем временный файл}
  339.   erase(tmp);{удаляем временный файл}
  340. end;
  341. {--------------------------------------------------------------------------}
  342. procedure Edit(N:integer); {Процедура для редактирования N-й записи}
  343. var
  344.   F: file of Data; {Файл с данными}
  345.   t: Data;          {Редактируемая запись}
  346.   c: char;      {Символ}
  347.   s,quit:boolean; {Флаги: s = True, если заполнены все поля. Quit = true, если пользователь нажал Esc}
  348.   i: word;      {Номер заполняемого поля}
  349.  
  350. begin
  351.     clrscr; {очистить экран}
  352.     assign(F, 'base.dat'); {связать F с файлом base.dat}
  353.     reset(F); {открыть файл}
  354.     seek(F, N-1); {Переместиться к записи N-1}
  355.     read(F, t); {считать запись}
  356.         {Вывод данных}
  357.     Writeln('Страна     : ', t.Country);     {Название страны}
  358.     Writeln('Часть света: ', Parts[t.Part]); {Часть света}
  359.     Writeln('Столица    : ', t.Capital);  {Столица}
  360.     i := 1;
  361.     repeat
  362.     repeat
  363.       case i of {в соответствии с текущим номером поля (i), редактируем}
  364.            1: c := ReadStr(1,t.Country, quit); {Название страны}
  365.            2: c := ReadPart(2,t.Part, quit);   {Часть света}
  366.            3: c := ReadStr(3,t.Capital, quit); {или столицу}
  367.       end;
  368.       if quit then {Если пользователь нажал Esc (В функциях ReadStr или ReadPart), то сохраним изменения, закроем файл и выйдем из процедуры}
  369.       begin
  370.         close(F);
  371.         reset(F);
  372.         Seek(F, N-1);
  373.         Write(F, t);
  374.         close(F);
  375.         exit;
  376.       end;
  377.  
  378.       if (c in [#72, #80]) then {Если пользователь нажал Up или Down (В функциях ReadStr или ReadPart), то перейдем в соответствующее поле}
  379.       begin
  380.         if (c = #72) and (i > 1) then
  381.            dec(i);
  382.         if (c = #80) and (i < 3) then
  383.            inc(i);
  384.  
  385.       end;
  386.       if (c = #13) and (i < 3) then {Если пользователь нажал Enter в 1-й или 2-й строке, то}
  387.       begin
  388.         inc(i); {Перейти к следующей строке}
  389.         c := #0;
  390.       end
  391.     until  (c = #13) and (i = 3); {выйти из цикла ввода, когда пользователь нажимет Enter в 3 поле}
  392.    
  393.       if t.Country = '' then  {Введено название страны?}
  394.       begin
  395.         i := 1; {если нет, то перейти в 1-е поле}
  396.         s := false;
  397.         end
  398.       else s:= true; {Если заполнено 1-е поле, возможно, что все данные введены (далее еще 2 проверки)}
  399.  
  400.       if t.Part = 0 then {Введена часть света?}
  401.         begin
  402.         i:=2; {если нет, то перейти во 2-е поле}
  403.         s := false;
  404.         end;
  405.       if t.Capital = '' then  {Введена столица?}
  406.         begin
  407.         i:=3; {если нет, то перейти в 3-е поле}
  408.         s := false;
  409.         end;
  410.  
  411.        if not s then {Если не данные введены, то выведем сообщение и перейдем в начало цикла ввода (выбранным будет незаполненное поле)}
  412.          Message(9, 'Нужно заполнить все поля');
  413.  
  414.     until s; {Выход, если s = true (все поля заполнены)}
  415.  
  416.     {Сохранение изменений}
  417.   close(F);
  418.   reset(F);
  419.   Seek(F, N-1);
  420.   Write(F, t);
  421.   close(F);
  422. end;
  423. {---------------------------------------------------------------------------}
  424.  
  425. Procedure SelectMode(var S:Predicate); {Выбор режима. Возвращает в параметре-переменной S функцию, соответствующую выбранному режиму}
  426. var
  427.   c:char;
  428.   i:integer;{текущий пункт}
  429.   ext, quit:boolean; {Флаги: ext = True, если нажата клавиша с расширенным кодом. Quit = true, если пользователь нажал Esc}
  430. begin
  431.   ClrScr; {очистить экран}
  432.   writeln('[*] Показывать все записи');
  433.   writeln('[ ] Вывод списка стран, расположенных в заданной части света');
  434.   writeln('[ ] Вывод информации о заданной стране');
  435.   ext := false;
  436.   i := 1;       {Изначально выбран 1-й пункт}
  437.   repeat
  438.     GotoXY(2, i); {выбрать i-й пункт}
  439.     write('*');
  440.  
  441.     c := readkey;
  442.     if c = #0 then ext := true; {установить ext, если нажата клавиша с расширенным кодом}
  443.     if (c = #72) and ext and (i > 1) then {обработка нажатия UP}
  444.     begin
  445.       dec(i); {Выбрать пункт, который выше текущего}
  446.       GotoXY(2, i+1); {Стереть *}
  447.       write(' '); {в предыдущем пункте}
  448.     end;
  449.     if (c = #80) and ext and (i<3) then {обработка нажатия DOWN}
  450.     begin
  451.       inc(i); {Выбрать пункт, который ниже текущего}
  452.       GotoXY(2, i-1); {Стереть *}
  453.       write(' ');   {в предыдущем пункте}
  454.     end;
  455.   until c = #13; {Выход из цикла при нажатии Enter}
  456.   case i of {В зависимости от выбранного режима вернуть соответствующую функцию}
  457.     1: S := ShowAll; {Все записи}
  458.     2: begin
  459.         S := Mode1; {1-й режим}
  460.         ClrScr; {Очистить экран}
  461.         Write('Часть света:');
  462.         Mode1Part := 0;
  463.         repeat
  464.             c := ReadPart(1, Mode1Part, quit); {Считать часть света}
  465.         until (c = #13) and (Mode1Part <> 0); {Выход поизойдет, когда пользователь выберет часть света и нажмет Enter}
  466.         end;
  467.     3: begin
  468.         S := Mode2; {2-й режим}
  469.         ClrScr;
  470.         Write('Страна     : ');
  471.         Mode2Country := '';
  472.         repeat
  473.             c := ReadStr(1, Mode2Country, quit); {Считать название страны}
  474.         until (c = #13) and (Mode2Country <> '');  {Выход поизойдет, когда пользователь введет название страны и нажмет Enter}
  475.         end;
  476.     end;
  477.  
  478. end;
  479. {---------------------------------------------------------------------------}
  480. Procedure Show; {вывод данных}
  481. var
  482.   Items:array [1..22] of word; {массив из 22 элементов с номерами (в файле) выведенных на экран записей}
  483.   t: Data;
  484.   Select:Predicate; {Функция для режимов}
  485.   N, i, j, k, offset, Y:integer; {offset - смещение в файле}
  486.   F:file of data; {файл с данными}
  487.   c:char;
  488.   ext,scroll, refresh:boolean; {Флаги: ext = true, если нажата клавиша с расширенным кодом. Scroll = true, если необходима прокрутка. Refresh = true, если необходимо обновление экрана}
  489. begin
  490.   ClrScr; {очистить экран}
  491.   offset := 0; {находимя в начале файла}
  492.   assign(F, 'base.dat'); {связать F с файлом base.dat}
  493.   {$I-}     {отключить проверки IO}
  494.   reset(F); {открыть файл}
  495.   {$I+}     {включить проверки IO}
  496.   if IOResult <> 0 then {Если результат последней операции IO (открытие файла) <>0, то выведем сообщение и выйдем из процедуры}
  497.   begin
  498.      Writeln('Файл base.dat не найден');
  499.      Writeln('Нажмите любую клавишу чтобы вернуться в меню');
  500.      readkey; {ожидание нажатия клавиши}
  501.      exit;
  502.   end;
  503.  
  504.   if FileSize(F) = 0 then {Если размер файла = 0, то выведем сообщение и выйдем из процедуры}
  505.   begin
  506.      ClrScr;
  507.      Writeln('Нет записей');
  508.      Writeln('Нажмите любую клавишу чтобы вернуться в меню');
  509.      readkey;
  510.      exit;
  511.   end;
  512.   GotoXY(1,2); {Выберем      }
  513.   write('*'); {Первую Запись, которая }
  514.   Y := 2; {находится во 2-й строке}
  515.   j := 1;
  516.  
  517.   scroll := false;{Прокрутка не нужна,}
  518.   refresh := true;{но нужно обновление}
  519.   N := 0;   {Пока выведено 0 записей}
  520.   Select := ShowAll; {Выводить все записи}
  521.   repeat
  522.   reset(f); {открываем файл}
  523.  
  524.   if (N = 0) or scroll or refresh then
  525.   begin
  526.   if refresh then {обновление}
  527.   begin
  528.   Message(1,' │        Страна          │       Часть света      │         Столица       ');
  529.   TextBackground(LightGray); {цвет фона}
  530.   TextColor(Black);          {цвет текста}
  531.   Message(25,'Up/Down - навигация  Del - удаление F3 - режим F4 - редактирование  ESC - выход');
  532.  
  533.   TextColor(LightGray);  {цвет текста}
  534.   TextBackground(Black); {цвет фона}
  535.   end;
  536.   Seek(F, offset*22); {Перемещаемся в файле к блоку из 22 записей}
  537.   for i:=2 to 24 do ClrLine(i,1); {очищаем экран (кроме заголовка таблицы)}
  538.   i := offset*22 + 1;
  539.   k:=1; {текущая строка на экране}
  540.   GotoXY(3, 2);
  541.   while (Not EOF(F)) and (k<=23) do  {пока не достигнут конец файла и строка <= 23}
  542.   begin
  543.     read(F, t);         {считываем запись}
  544.     if Select(t) then   {если она удовлетворяет выбранному режиму, то}
  545.        begin
  546.        WriteItem(t);    {выводим ее}
  547.        Items[k] := i;   {сохраняем ее позицию в файле}
  548.        inc(k);          {увеличиваем номер строки}
  549.        GotoXY(3, 1+k);  {перемещаем курсор в следующую строку }
  550.        end;
  551.     inc(i);     {увеличиваем номер записи в файле}
  552.   end;
  553.   N := k - 1; {сколько выведено записей}
  554.   if N = 0 then {если выведено 0 записей, то}
  555.   begin
  556.      ClrScr;     {предложим пользователю вернуться в меню или выбрать другой режим}
  557.      Writeln('Нет записей');
  558.      Writeln('ESC - вернуться в меню');
  559.      Writeln('F3  - выбрать режим');
  560.      c := readkey;
  561.      if c = #0 then c:=readkey; {если нажата клавиша с расширенным кодом, то считаем следующий код}
  562.      if c = #61 then {обработка F3}
  563.      begin
  564.        SelectMode(Select); {Выбрать режим}
  565.        Refresh := true; {требуется обновление}
  566.        offset := 0; {в начало файла}
  567.        Y:=2;        {перейти во 2-ю строку}
  568.        Close(F);    {закрыть файл}
  569.        Continue;    {перейти в начало цикла}
  570.      end;
  571.      if c = #27 then {если нажата клавиша Esc, то выйдем из процедуры}
  572.         exit;
  573.   end;
  574.   GotoXY(1,Y); {выберем запись}
  575.   write('*'); {в строке Y}
  576.   Scroll := false;
  577.   refresh := false;
  578.   end;
  579.  
  580.   repeat
  581.     c := readkey;
  582.     if c = #0 then ext := true; {нажата клавиша с расширенным кодом}
  583.     if (c = #83) and ext then   {обработка Delete}
  584.     begin
  585.        clrscr;
  586.        writeln('Удалить? y/n');
  587.        repeat
  588.          c := readkey;
  589.          if UpCase(c) = 'Y' then {UpCase(c) преобразует символ в верхний регистр. Если пользователь нажал 'y' или 'Y', то}
  590.          begin
  591.             del(Items[j]); {удалим запись из файла}
  592.             break;         {выйдем из цикла}
  593.          end;
  594.        until UpCase(c) = 'N'; {Если пользователь нажал 'n' или 'N', то выйдем из цикла}
  595.  
  596.        if N = 1 then {если перед удалением была выведена всего 1 запись, то переместимся назад в файле }
  597.        begin
  598.          Dec(Offset);
  599.          Y:=25;
  600.          j := 23;
  601.        end;
  602.        if j > 1 then dec(j);
  603.        if Y > 2 then dec(Y);
  604.        refresh := true;   {и произведем обновление}
  605.        break;               {выход из цикла}
  606.     end;
  607.     if (c = #61) and ext then {обработка F3}
  608.     begin
  609.       SelectMode(Select); {выбор режима}
  610.       j := 1;
  611.       Y := 2;
  612.       offset := 0;       {в начало файла}
  613.       Refresh := true;   {произведем обновление}
  614.       break;            {выход из цикла}
  615.     end;
  616.     if (c = #62) and ext then {Обработка F4}
  617.     begin
  618.       Edit(Items[j]);   {Редактирование записи}
  619.       refresh := true;  {произведем обновление}
  620.       break;            {выход из цикла}
  621.     end;
  622.     if (c = #72) and ext and (Y >= 2) then {Обработка нажатия UP}
  623.     begin
  624.        if (Y = 2) and (j >= 1) then {Если находимся во 2-й строке }
  625.        begin
  626.          if offset > 0 then {и не в начале файла}
  627.          begin
  628.               dec(offset); {то переместимя назад в файле}
  629.               Scroll := true; {и произведем прокрутку}
  630.               Y:=24;
  631.               j:=23;
  632.               break;
  633.          end
  634.        end;
  635.         {В противном случае - выберем запись, которая находится выше текущей}
  636.        if j > 1 then dec(j);
  637.        if Y > 2 then dec(Y);
  638.        GotoXY(1, Y+1);
  639.        write(' ');
  640.        GotoXY(1, Y);
  641.        write('*');
  642.     end;
  643.     if (c = #80) and ext and (Y <= N+1) then {Обработка нажатия Down}
  644.     begin
  645.       if (Y = 24) and( j <= FileSize(F)) then {Если находимся в 24-й строке и не в конце файла}
  646.       begin
  647.         inc(offset);    {Переместимся вперед в файле}
  648.         scroll := true; {произведем прокрутку}
  649.         Y := 2;
  650.         j := 1;
  651.         break;
  652.       end;
  653.        
  654.       If Y <= N then {Если находимся в строке с номером, меньшим, чем число выведенных записей, то выберем следующую запись}
  655.       begin    
  656.         inc(j);
  657.         inc(Y);
  658.         GotoXY(1, Y-1);
  659.         write(' ');
  660.         GotoXY(1, Y);
  661.         write('*');
  662.       end;
  663.     end;
  664.   until (c in [#72, #80]) and ext or (c = #27);
  665.   close(F); {Закрытие файла}
  666.   until c = #27; {выход при нажатии Esc}
  667. end;
  668.  
  669.  
  670.  
  671. begin
  672.   repeat
  673.     Mode := Menu; {вывод Меню}
  674.     case Mode of
  675.       1: EnterData; {Ввод данных}
  676.       2: Show;      {Просмотр данных}
  677.       end;
  678.   until mode = 3;   {выход}
  679. end.
Add Comment
Please, Sign In to add comment
Public Pastes
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!