Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.12.2018, 07:54   #1
Vladimir57
Новичок
Джуниор
 
Регистрация: 31.08.2013
Сообщений: 2
По умолчанию Создание горизонтального меню на Pascal 7.0

Подскажите пожалуйста !!!

Как сделать в этом шаблоне, чтоб меню было горизонтальным ?

Код:
Program Template;
Uses Crt;

Const
  kol = 8;  { количество элементов меню      }
Var
  ch  :char;{ код нажатой клавиши            }
  N,        { номер выбранного элемента меню }
  old:byte;
(*    Spisok - массив с названием элементов меню     *)
const  spisok:array[1..kol] of string[10]=('Файл','Правка',
       'Поиск','Компиляция','Отладка','Пуск','Настройки','Помощь');

(*--------------------------------------------------*)
(*     подпрограмма формирования рамки              *)
(* переменные :                                     *)
(* contur-параметры вида линий рамки                *)
(* name - имя для меню                              *)
(* fonr - цвет для заполнения окна с рамкой         *)
(* colr - цвет символов линий рамки окна            *)
(*--------------------------------------------------*)
Procedure Ramka(x1,y1,x2,y2:word;fonr,colr:byte;contur,
                name:string);
var k:integer;
begin
   window(1,1,80,25);           { установка полного экрана }
   TextColor(colr);
   TextBackGround(fonr);
   GotoXY(x1,y1);
   write(contur[1]);
   for k:=x1+1 to x2-1 do
     write(contur[5]);
     write(contur[2]);
     GotoXY(x1+trunc((x2-x1-Length(name))/2),y1);
     write(name);                 { вывод названия меню }
   for k:=y1+1 to y2-1 do
     begin
       GotoXY(x2,k);write(contur[6]);
       GotoXY(x1,k);write(contur[6])
     end;
   GotoXY(x1,y2);
   write(contur[3]);
   for k:=x1+1 to x2-1 do
     write(contur[5]);
     write(contur[4]);
     Window(x1+1,y1+1,x2-1,y2-1);  { установка и очистка окна}
     clrscr;                       { ограниченного рамкой    }
end;
(*--------------------------------------------------*)
(*     Подпрограмма формирующая меню команд         *)
(* переменные :                                     *)
(* Кординаты X1,Y1 - верхий левый угол              *)
(*           X2,Y2 - правый нижний угол             *)
(* Цвета     FonR  - цвет фона рамки                *)
(*           ColR  - цвет рамки                     *)
(*           FonS  - цвет фона строки               *)
(*           ColS  - цвет строки                    *)
(*--------------------------------------------------*)

Procedure NewMenu(var number:byte; x1,y1,x2,y2:word;
                   fonr,colr,fons,cols:byte;
                   contur,name:string);
const
  Enter = #13; { выбор пункта меню }
  Esc   = #27; { отмена работы с меню}
  sdvig = #0;  { признак управляющей клавиши }
  Up    = #72; { вверх по меню }
  Down  = #80; { вниз по меню }
Var
  CopyAttr:array[1..2] of byte;  { атрибуты цветности }
  old : byte;
  x,y : word;
  ch  : char;
  n,
  newkursor : integer;
Begin
   old:=TextAttr;
   Number:=0;
   Ramka(x1,y1,x2,y2,fonr,colr,'╔╗╚╝═║',' Меню ');
   GotoXY(30,1);
   CopyAttr[1]:=TextAttr;
   writeln;
   n:=0;
   while n<8 do
     begin
       n:=n+1;
       GotoXy(1,n+1);writeln(' ':4,spisok[n]);
     end;
   newkursor:=1; n:=1;
   GotoXY(1,newkursor+1);
   TextColor(cols);
   TextBackGround(fons);
   CopyAttr[2]:=TextAttr;
   write(' ':4,spisok[1]); ClrEol; { подсветка первого
                                     элемента меню }
   repeat
       ch:=readkey;
       if ch=sdvig
         then begin
              ch:=readkey;
              case ch of
              { переход на один элемент вверх }
              up  :  begin
                     newkursor:=n-1;
                     if newkursor=0 then newkursor:=kol
                     end;
              { переход на один элемент вниз }
              down : begin
                     newkursor:=n+1;
                     if newkursor=kol+1 then newkursor:=1
                     end
              end;
              { снять выделение старого пункта иеню }
              GotoXY(1,n+1);
              TextAttr:=CopyAttr[1];
              write(' ':4,spisok[n]);
              ClrEol;
              { выделить новый пункт меню }
              { световым пятном           }
              TextAttr:=CopyAttr[2];
              GotoXY(1,newkursor+1);
              write(' ':4,spisok[newkursor]);
              ClrEol;
              n:=newkursor;
              end
    until (ch=enter)or(ch=Esc) ;
    if ch=Enter then Number:=n;
    TextAttr:=old;
end;
(*--------------------------------------------------*)
(* подпрограмма формирующая подсказки               *)
(*--------------------------------------------------*)

procedure help;
begin
   ramka(1,21,80,24,10,14,'╔╗╚╝═║',' ВЫБОР КЛАВИШ ');
   GotoXY(1,1);
   writeln(' ':10,'ENTER - выбор команды Esc - выход из меню');
   write(' ':10,'CТРЕЛКИ (вверх,вниз)-выбор пункта меню');
end;

(*--------------------------------------------------*)
(*              Основная программа                  *)
(*--------------------------------------------------*)
Begin
  old:=lastmode;
  Clrscr;
                (* Окно редактора *)
  Ramka(1,2,80,24,Blue,White,'╔╗╚╝═║',' Здесь будет имя файла ');
                     (* Меню *)
  NewMenu(N,27,4,52,20,13,14,3,8,'╔╗╚╝═║','---------');
  if N=8 then
{ вывод подсказки }
    begin
      Help;
    end
  else
  Ramka(20,15,60,18,3,15,'╔╗╚╝═║',' РЕЗУЛЬТАТ ');
  write(' выбран элемент меню :',Spisok[N]);


  ch:=readkey;
  textmode(old);
end.
Вложения
Тип файла: rar Template.rar (1.9 Кб, 8 просмотров)
Vladimir57 вне форума Ответить с цитированием
Старый 10.12.2018, 12:43   #2
jillitil
Форумчанин
 
Аватар для jillitil
 
Регистрация: 17.10.2018
Сообщений: 184
По умолчанию

Цитата:
Сообщение от Vladimir57 Посмотреть сообщение
Как сделать в этом шаблоне, чтоб меню было горизонтальным ?
Всего лишь переписать Procedure NewMenu(var number:byte; x1,y1,x2,y2:word; ...)

Код:
var
 I, MSel: Integer;
begin
 MSel:= 4;
 For I:= 1 to Kol do
 begin
   If I <> MSel Then TextAttr:= $70 Else TextAttr:= $2F;
   Write(' ', Spisok[i], ' ');
 end; 
 ClrEol;
end;
Изображения
Тип файла: gif bp_005.gif (7.8 Кб, 30 просмотров)

Последний раз редактировалось jillitil; 10.12.2018 в 13:02.
jillitil вне форума Ответить с цитированием
Старый 13.12.2018, 06:59   #3
Vladimir57
Новичок
Джуниор
 
Регистрация: 31.08.2013
Сообщений: 2
По умолчанию

Большое спасибо !!!
Vladimir57 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Дизайн горизонтального меню garrettt HTML и CSS 1 08.04.2017 21:31
Выравнивание горизонтального меню по центру. Dennis777 HTML и CSS 14 18.06.2015 16:09
фиксированная ширина пунктов горизонтального меню ellays HTML и CSS 3 27.08.2012 02:08
Перелистывание TabbedNoteBook с горизонтального меню BukTop2009 Помощь студентам 1 06.06.2012 21:20
центрирование горизонтального выпадающего меню deface2k9 HTML и CSS 2 23.08.2010 16:21