Реализовать горизонтальное меню

@S.k.y · Регистрация: 03.08.2011

Студворк — интернет-сервис помощи студентам

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

Условие: Тип меню - горизонтальное, кол-во объектов - 5, кол-во строк в объектах - 3.
Расположение на экране - Верхняя часть.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
program lab7v1;
 
uses
  crt;
{Процедура установки цвета в заданном окне}
procedure ChangeScreen(Xb, Yb, Xh, Yh: integer; color: integer);
begin
  textcolor(color);
  window(Xb, Yb, Xh, Yh);
  clrscr;
end;
 
procedure Left;
begin
  writeln('Левая');
  write('часть');
end;
 
procedure Stop;
begin
  writeln('Центр');
  write(' ');
end;
 
procedure Right;
begin
  writeln('Правая');
  write('Часть');
end;
procedure up;
begin 
 writeln('Верхняя');
 write('часть');
end;
procedure down;
begin
 writeln('Нижняя');
 write('Часть');
end;
{Процедура вывода на экран сообщения}
procedure CaseStep(Step: integer);
begin
  case step of
    1: Left;
    2: Stop;
    3: Right;
    4: Up;
    5: Down;
  end;
end;
 
var
  Ch: char;
  Step: integer; {Переменная для определения выделенного обьекта}
 
begin
  {Начальная установка меню}
  textbackground(2);
  //clrscr;
  ChangeScreen(15, 14, 25, 16, 0);Left;
  ChangeScreen(30, 14, 30, 16, 0);Stop;
  ChangeScreen(45, 14, 60, 16, 0);Right;
  
  Step := 1;
  ChangeScreen(Step * 15, 14, Step * 15 + 10, 16, 15);
  CaseStep(Step);
  repeat
    ch := Readkey;
    {Анализ нажатой клавиши}
    if ch = #0 then
    begin
      Ch := Readkey;
      case Ch of
        {Выбор обьекта при движении влево}
        #75:
          begin
            ChangeScreen(Step * 15, 14, Step * 15 + 10, 16, 0);
            CaseStep(Step);
            Dec(Step);
            if Step < 1 then Step := 3;
            ChangeScreen(Step * 15, 14, Step * 15 + 10, 16, 15);
            CaseStep(Step);
          end;
        {Выбор обьекта при движении вправо}
        #77:
          begin
            ChangeScreen(Step * 15, 14, Step * 15 + 10, 16, 0);
            CaseStep(Step);
            Dec(Step);
            if Step > 3 then Step := 1;
            ChangeScreen(Step * 15, 14, Step * 15 + 10, 16, 15);
            CaseStep(Step);
          end;
         {Выбор объекта при движении вверх}
       { #72:
         begin
          ChangeScreen();
          CaseStep(Step);
          Dec(Step);}
      end;
    end;
  until (Ch = #27) or (Ch = #13);
  {Запуск программы для выбранного обьекта}
  ChangeScreen(1, 1, 80, 25, 15);
  GotoXY(20, 12);
  if Ch = #13 then
    case Step of
      1: writeln('Выполняется программа для левого обьекта');
      2: writeln('Выполняется программа для центрального обьекта');
      3: writeln('Выполняется программа для правого обьекта');
      4: writeln('Выполняется программа для верхнего обьекта');
      5: writeln('Выполняется программа для нижнего обьекта');
    end
  else writeln('запуск программы не выполняется');
  GotoXY(55, 25);
  write('Нажмите любую клавишу...');
  writeln;
  Ch := ReadKey;
end.

@Puporev · 14.08.2011, 20:33

Посмотрите пример горизонтального меню с выпадающими пунктами в это теме. ТЬо что там Турбо Паскаль роли не играет..
https://www.cyberforum.ru/pascal/thread135004.html

@S.k.y · 14.08.2011, 23:16 **[ТС]**

Меня интересует - почему не происходит переход по пунктам меню, когда я нажимаю нужные клавиши #77 и #75. Пока этого там, где вы сказали, не могу найти. В любом случае Спасибо,показали интересный код, есть информация для раздумий

@Puporev · 15.08.2011, 07:22

Сообщение от S.k.y

когда я нажимаю нужные клавиши #77 и #75. Пока этого там, где вы сказали, не могу найти.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
 repeat
  kod:=readkey;
  until kod in [#13, #75, #77];
  case kod of
  #75: begin  {стрелка влево}
       k:=k-1;
       if k=0 then k:=kol;{если левый край, в конец}
       end;
  #77: begin  {стрелка вправо}
       k:=k+1;
       if k>kol then k:=1;{если правый край, в нвчало}
       end;
   end;

@S.k.y · 15.08.2011, 14:54 **[ТС]**

Спасибо большое!!!

@Puporev · 15.08.2011, 15:00

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

Сообщение от S.k.y

Условие: Тип меню - горизонтальное, кол-во объектов - 5, кол-во строк в объектах - 3.
Расположение на экране - Верхняя часть.

Не хотите, не нужно, творите дальше, мне это не нужно.

@S.k.y · 15.08.2011, 15:34 **[ТС]**

Я осознал что там было не так, и что отошел от условия, поэтому удалил тот пост, извините что так получилось. Спасибо еще раз!

@Puporev · 15.08.2011, 17:41

Вот набросал меню для 5 пунктов по 3 подпункта в каждом.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
uses crt;
{массив названий пунктов главного меню}
const glav:array[1..5] of string=('1-Пункт 1',
                                  '2-Пункт 2',
                                  '3-Пункт 3',
                                  '4-Пункт 4',
                                  '5-Пункт 5');
                                  {наверное нужен пункт 6 - выход из программы}
{массив названий 15 пунетов подменю}
     p:array[1..5,1..3] of string=(('1-Подпункт 11','2-Подпункт 12','3-Подпункт 13'),
                                   ('1-Подпункт 21','2-Подпункт 22','3-Подпункт 23'),
                                   ('1-Подпункт 31','2-Подпункт 32','3-Подпункт 33'),
                                   ('1-Подпункт 41','2-Подпункт 42','3-Подпункт 43'),
                                   ('1-Подпункт 51','2-Подпункт 52','3-Подпункт 53'));
procedure Menyu(var k: byte;kol:byte);
var kod: char;
    i:byte;
begin
textbackground(0);
clrscr;
gotoxy(5,1);
k:=1;
repeat
  for i:=1 to kol do
   begin
     if i=k then
      begin
         textbackground(3);
         textcolor(12);
      end
     else
      begin
         textbackground(0);
         textcolor(15)
      end;
     gotoxy(14*(i-1)+1,1);
     write(glav[i]);
   end;
  repeat
  kod:=readkey;
  until kod in [#13, #75, #77];
  case kod of
  #75: begin  {стрелка влево}
       k:=k-1;
       if k=0 then k:=kol;{если левый край, в конец}
       end;
  #77: begin  {стрелка вправо}
       k:=k+1;
       if k>kol then k:=1;{если правый край, в нвчало}
       end;
   end;
 until kod=#13;
end;
 
procedure SubMenyu(k:byte;kol1,kol2:byte;var w:byte);{создание и вывод на экран основного меню}
var kod: char;
    i:byte;
begin
for i:=1 to kol2 do{воостановим главное меню}
 begin
  gotoxy(14*(i-1)+1,1);
  write(glav[i]);
 end;
gotoxy(4,2);
w:=1; {выведен первый пункт меню}
repeat
for i:=1 to kol1 do
 begin
  if i=w then {выделенный пункт}
   begin
    textbackground(3);
    textcolor(9);
   end
  else  {остальные}
   begin
    textbackground(0);
    textcolor(15)
   end;
gotoxy(1,i+1);{ставим курсор}
write(p[k,i]){выводим пункты}
end;
repeat
kod:=readkey;
until Kod in [#13, #72, #80];
case kod of
#72: begin{стрелка вверх}
     w:=w-1;
     if w=0 then w:=kol1;{если выше верха, вниз}
     end;
#80: begin {стрелка вниз}
     w:=w+1;
     if w>kol1 then w:=1;{если ниже низа, вверх}
     end;
end;
until kod=#13;{нажат Enter, выходим из меню в выбранную процедуру}
end;
{основная программа}
var k,w:byte;
begin
textbackground(0);
textcolor(15);
clrscr;
repeat
  Menyu(k,5);{выводим меню}
  case k of{выбираем стрелками действие}
   1:begin
     SubMenyu(k,3,5,w);
     case w of
     1:begin
       clrscr;
       writeln('Это подпункт 11');//здесь вызов процедуры
       readln;
       Menyu(k,5);
       end;
     2:begin
       clrscr;
       writeln('Это подпункт 12');
       readln;
       Menyu(k,5);
       end;
     3:begin
       textbackground(0);
       textcolor(15);
       clrscr;
       writeln('Это подпункт 13');
       readln;
       Menyu(k,5);
       end;
     end;
     end;
   2:begin
     SubMenyu(k,3,5,w);
     case w of
     1:begin
       clrscr;
       writeln('Это подпункт 21');
       readln;
       Menyu(k,5);
       end;
     2:begin
       clrscr;
       writeln('Это подпункт 22');
       readln;
       Menyu(k,5);
       end;
     3:begin
       textbackground(0);
       textcolor(15);
       clrscr;
       writeln('Это подпункт 23');
       readln;
       Menyu(k,5);
       end;
     end;
     end;
   3:begin
     SubMenyu(k,3,5,w);
     case w of
     1:begin
       clrscr;
       writeln('Это подпункт 31');
       readln;
       Menyu(k,5);
       end;
     2:begin
       writeln('Это подпункт 32');
       readln;
       end;
     3:begin
       textbackground(0);
       textcolor(15);
       clrscr;
       writeln('Это подпункт 33');
       readln;
       Menyu(k,5);
       end;
     end;
     end;
   4:begin
     SubMenyu(k,3,5,w);
     case w of
     1:begin
       clrscr;
       writeln('Это подпункт 41');
       readln;
       Menyu(k,5);
       end;
     2:begin
       clrscr;
       writeln('Это подпункт 42');
       readln;
       Menyu(k,5);
       end;
     3:begin
       textbackground(0);
       textcolor(15);
       clrscr;
       writeln('Это подпункт 43');
       readln;
       Menyu(k,5);
       end;
     end;
     end;
   5:begin
     SubMenyu(k,3,5,w);
     case w of
     1:begin
       clrscr;
       writeln('Это подпункт 51');
       readln;
       Menyu(k,5);
       end;
     2:begin
       clrscr;
       writeln('Это подпункт 52');
       readln;
       Menyu(k,5);
       end;
     3:begin
       textbackground(0);
       textcolor(15);
       clrscr;
       writeln('Это подпункт 53');
       readln;
       end;
     end;
     end;
   end;
 until k=5;
 end.

Новые блоги и статьи Все статьи Все блоги /
Автозаполнение реквизита при выборе элемента справочника Maks 27.03.2026 Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. При выборе "Спецтехники" (Тип Справочник. Спецтехника), заполняется. . .	Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .	Автозаполнение реквизитов при создании документа Maks 26.03.2026 Программный код из решения ниже размещается в модуле объекта документа, в процедуре "ПриСозданииНаСервере". Алгоритм проверки заполнения реализован для исключения перезаписи значения реквизита,. . .	Команды формы и диалоговое окно Maks 26.03.2026 1. Команда формы "ЗаполнитьЗапчасти". Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. В качестве источника данных. . .
Кому нужен AOT? DevAlt 26.03.2026 Решил сделать простой ланчер Написал заготовку: dotnet new console --aot -o UrlHandler var items = args. Split(":"); var tag = items; var id = items; var executable = args;. . .	Отправка уведомления на почту при создании или изменении элементов справочника Maks 24.03.2026 Программная отправка письма электронной почты на примере типового справочника "Склады" в конфигурации БП3. Перед реализацией необходимо выполнить настройку системной учетной записи электронной. . .	модель ЗдравоСохранения 5. Меньше увольнений- больше дохода! anaschu 24.03.2026 Теперь система здравосохранения уменьшает количество увольнений. 9TO2GP2bpX4 a42b81fb172ffc12ca589c7898261ccb/ https:/ / rutube. ru/ video/ a42b81fb172ffc12ca589c7898261ccb/ Слева синяя линия -. . .	Midnight Chicago Blues kumehtar 24.03.2026 Такой Midnight Chicago Blues, знаешь?. . Когда вечерние улицы становятся ночными, а ты не можешь уснуть. Ты идёшь в любимый старый бар, и бармен наливает тебе виски. Ты смотришь на пролетающие. . .

Реализовать горизонтальное меню

Решение

Решение

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	14.08.2011, 20:33
	Посмотрите пример горизонтального меню с выпадающими пунктами в это теме. ТЬо что там Турбо Паскаль роли не играет.. https://www.cyberforum.ru/pascal/thread135004.html 2

@S.k.y 23 / 23 / 3 Регистрация: 03.08.2011 Сообщений: 158
	14.08.2011, 23:16 [ТС]
	Меня интересует - почему не происходит переход по пунктам меню, когда я нажимаю нужные клавиши #77 и #75. Пока этого там, где вы сказали, не могу найти. В любом случае Спасибо,показали интересный код, есть информация для раздумий 0

@S.k.y 23 / 23 / 3 Регистрация: 03.08.2011 Сообщений: 158
	15.08.2011, 14:54 [ТС]
	Спасибо большое!!! 0

@S.k.y 23 / 23 / 3 Регистрация: 03.08.2011 Сообщений: 158
	15.08.2011, 15:34 [ТС]
	Я осознал что там было не так, и что отошел от условия, поэтому удалил тот пост, извините что так получилось. Спасибо еще раз! 0