Нужно сделать меню для курсового проекта

@годвилль · Регистрация: 05.12.2017

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

Здесь все работает, но для полной готовности проекта нужно меню с кнопками. Я пытался кнопки встроить в программу, но они почему то не работаеют.

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
231
232
233
234
program magazin;
uses graphabc;
type
 
Ukaz1 = ^Tovar;
  tovar = record
 n,size:integer;    
 name: string[15];
    m: integer;
    Next1:Ukaz1;
  end;
  
tovar2 = record
  n:integer;   
  name: string[15];
   m: integer;
  end; 
   Ukaz2 = ^sklad;
   sklad = Record
     Nom,size:integer;  
     cob:String[20]; 
     Tovar1:ukaz1;
    
     Next2:Ukaz2;
    
     end;
     
 
   sklad2 = Record
     Nom:integer;  
     cob:String[20]; 
     end;
     
 
Var
   F1 : file of sklad2;
   a: sklad2;
   f2 : file of Tovar2;
   b: Tovar2;
     VIDD, VIID: STRING[20]; 
   Zagol,Tek1,Zveno,tekm : ukaz2;
   Ras1,Ras2: Ukaz1;
   Okey,Ok: Boolean;
   S:Char;
   W,R,I,K:Integer;
   Name:String[20];   
   
   
   
   Procedure Cozsp;
begin
 
 Okey:=True;
 New(Zagol);
 Tek1:=Zagol;
 While Okey do Begin
 textout(400,5,'Номер склада?');
 Readln(Tek1^.Nom);
 textout(400,20,'адрес? ');
 Readln(Tek1^.Cob);
 Tek1^.Tovar1:=Nil;{предполагаем что товаров нет}
 textout(400,35,'есть товары?');
 Readln(S);
 i:=0;
  If (s='y') or (s='Y')  then
 begin
 
    New(Ras1);
    ras2:=ras1;
    Ok:=True;
    While OK do begin
    i:=i+1;
    Ras2^.N:=Tek1^.Nom;
    textout(400,40,'Наименование товара?');
    Readln(Ras2^.name);
    textout(400,55,'номер товара?');
    Readln(Ras2^.n);
    textout(400,70,'номер на складе?');
    Readln(Ras2^.m);
    textout(400,85,'еще есть товары? y/n');
    readln(s);
     If (s='y') or (s='Y') then begin
      New(Ras2^.Next1);
      Ras2:=Ras2^.Next1;end;
 
     If (s='n') or (s='N') then begin
       Ras2^.next1:=Nil;
       Ok:=False;
     Tek1^.Tovar1:=Ras1;
          end;
       end;
 end;
 
    Writeln('еще есть склады? y/n');
    readln(s);
      If (s='y') or (s='Y') then   begin
      New(Tek1^.Next2);
      Tek1:=Tek1^.Next2; end
      else begin
       Tek1^.Next2:= Nil;
       Okey:=False;
       clearwindow;
   
      end;
      end;
        end; 
 
Procedure Zapfile;
begin
 
 assign(f1,'sklad.dat');
 rewrite(f1);
 reset(f1);
 assign(f2,'tov.dat');
 rewrite(f2);
 reset(f2);
 Tek1:=Zagol;
 While Tek1<> Nil do
 begin
  a.Nom := Tek1^.Nom;
  a.Cob := Tek1^.Cob;
 write(f1,a);
 If Tek1^.Tovar1<> Nil Then
 begin
  Ras1:=Tek1^.Tovar1;
   While Ras1<>Nil do
   begin
    b.Name := ras1^.Name;
    b.N := ras1^.n;
   
    b.m := ras1^.m;
    Write(f2,b);
    Ras1:=Ras1^.Next1;
   end;
  end;
 Tek1:= Tek1^.Next2;
 end;
 close(f1); close(f2);
 clearwindow;
end;
 
 
Procedure SpisFile;
begin
  assign(f1,'sklad.dat');
 reset(f1);
 New(Zagol); 
 Tek1:=Zagol;
 While not eof(f1) do  begin
  read(f1,a);
  Tek1^.Nom:= a.Nom;
  Tek1^.Cob:= a.Cob;
  If Tek1^.Tovar1<>Nil Then
  Begin
   New(Ras1);
   Tek1^.Tovar1:= Ras1;
    assign(f2,'tov.dat');
    reset(f2);
    While not eof(f2) do  begin
    read(f2,b);
    If B.N = A.Nom then begin
    Ras1^.name:= b.name;
    Ras1^.n:= b.N;
    Ras1^.m:= b.m;
   
    Ras2:=Ras1;
    New(Ras1^.Next1);
    Ras1:=Ras1^.Next1;
   end{if}
  end;{while}
   Ras2^.Next1:=Nil;
   Dispose(Ras1);
  close(f2);
 end;
 Zveno:=Tek1;
 New(Tek1^.Next2);
 Tek1:=Tek1^.Next2;
 end;
 zveno^.Next2:=Nil;
 dispose(tek1);
 close(f1);
 clearwindow;
end;
 
 
 
Procedure Print;
Begin
 
Tek1:=Zagol;
While Tek1<>Nil do begin
 writeln('номер склада ':18,'адрес':15);
 writeln(Tek1^.Nom:18,Tek1^.Cob:15);
 Ras1:=tek1^.Tovar1;
  If Ras1=Nil Then  writeln('товаров нет')
   else begin
    writeln('название':20,'номер':10,'номер на складе':15);
     While Ras1<>Nil do begin
     writeln(Ras1^.name:20,inttostr(Ras1^.n):10, inttostr(Ras1^.m):10);
     Ras1:=Ras1^.Next1;
    end;
   end;
   writeln('для продолжения нажмите enter');
   readln; Tek1:=Tek1^.Next2;
    clearwindow;
   end;
  end;
  
  
  
 Begin 
  W:=0;
  While W<> 5 do
  begin
 
 
  writeln ('Вы можете:');
  writeln('1 - создать табличный список');
  writeln('2 - записать список в файл');
  writeln('3 - записать данные из файла в список');
  writeln('4 - распечатать данный список');
  writeln('5 - закончить работу');
  writeln('Ваши действия');
  readln(W);
  Case W of
  1: Cozsp;
  2: Zapfile;
  3: Spisfile;
  4: Print;
 
  end;
  end;
 
  end.

@JuriiMW · 10.05.2018, 13:10

Нужно использовать обработку событий нажатий на кнопку мыши.
В таком случае необходимо полностью избавиться, по крайней мере, от всех операторов вывода… Иначе ерунда получится!

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
uses GraphABC;
 
type
  tMenu = class
    msg : String;
    x, y, w, h : Integer;
    size : Integer;
    clr, fone : Color;
    reaction : Procedure;
    selNumber : Integer;
    
    constructor (x_, y_, w_, h_, size_ : Integer; clr_, fone_ : Color; msg_ : String; reaction_ : Procedure; selNumber_ : Integer);
    begin
      var fnt := Font.Size;
      Font.Size := size_;
      msg := msg_;
      x := x_; y := y_; w := w_; h := h_;
      size := size_;
      clr := clr_; fone := fone_;
      reaction := reaction_;
      selNumber := selNumber_;
    end;
    
    procedure Show;
    begin
      var (fntSize, fntColor, brushColor, penStyle) := (Font.Size, Font.Color, Brush.Color, Pen.Style);
      Brush.Color := fone; Pen.Style := psClear; Rectangle(x, y, x+w, y+h);
      Font.Size := size; Font.Color := clr;
      DrawTextCentered(x, y, x+w, y+h, msg);
      Font.Size := fntSize; Font.Color := fntColor; Brush.Color := brushColor; Pen.Style := penStyle;
    end;
    
    function Selected(x_, y_ : Integer) := x_.InRange(x, x+w) and y_.InRange(y, y+h);
    
  end;
 
var mainMenu : array of tMenu;
var oldMenu : tMenu;
var numberOfMenu := 0;
 
procedure ShowMainMenu;
begin
  Window.Clear;
  
  Font.Size := 16;
  Font.Color := rgb(16,32,128);
  TextOut(10, 10, 'Вы можете:');
  foreach var menu in mainMenu do menu.Show;
end;
 
procedure MouseDown(x, y, mb : Integer);
begin
  case numberOfMenu of
    0 : foreach var menu in mainMenu do
          if menu.Selected(x, y) then
            begin
              numberOfMenu := menu.selNumber;
              menu.reaction;
            end;
  else
    if oldMenu.Selected(x, y) then
      begin
        numberOfMenu := oldMenu.selNumber;
        oldMenu.reaction;
      end;
  end; 
end;
 
procedure theEndOfProgram;
begin
  Window.Close;
end;
  
procedure Cozsp;
begin
  Window.Clear;
  oldMenu := New tMenu(100, 100, 150, 30, 20, clYellow, clBlack, 'ВЫХОД', ShowMainMenu, 0);
  oldMenu.Show;
  
  /// работа процедуры
end;
 
procedure Zapfile;
begin
  Window.Clear;
  oldMenu := New tMenu(100, 100, 150, 30, 20, clYellow, clBlack, 'ВЫХОД', ShowMainMenu, 0);
  oldMenu.Show;
  
  /// работа процедуры
end;
 
procedure Spisfile;
begin
  Window.Clear;
  oldMenu := New tMenu(100, 100, 150, 30, 20, clYellow, clBlack, 'ВЫХОД', ShowMainMenu, 0);
  oldMenu.Show;
  
  /// работа процедуры
end;
 
procedure Print;
begin
  Window.Clear;
  oldMenu := New tMenu(100, 100, 150, 30, 20, clYellow, clBlack, 'ВЫХОД', ShowMainMenu, 0);
  oldMenu.Show;
  
  /// работа процедуры
end;
 
begin 
  SetLength(mainMenu, 5);
  mainMenu[0] := New tMenu(20,  40, 400, 20, 14, rgb(128,32,128), rgb(16,255,255), '1 - создать табличный список', Cozsp, 1);
  mainMenu[1] := New tMenu(20,  65, 400, 20, 14, rgb(128,32,128), rgb(16,255,255), '2 - записать список в файл', Zapfile, 2);
  mainMenu[2] := New tMenu(20,  90, 400, 20, 14, rgb(128,32,128), rgb(16,255,255), '3 - записать данные из файла в список', Spisfile, 3);
  mainMenu[3] := New tMenu(20, 115, 400, 20, 14, rgb(128,32,128), rgb(16,255,255), '4 - распечатать данный список', Print, 4);
  mainMenu[4] := New tMenu(20, 140, 400, 20, 14, rgb(128,32,128), rgb(16,255,255), '5 - закончить работу', theEndOfProgram, 0);
  
  onMouseDown := MouseDown;
 
  ShowMainMenu;
end.

Новые блоги и статьи Все статьи Все блоги /
Символьное дифференцирование igorrr37 13.02.2026 / * Логарифм записывается как: (x-2)log(x^2+2) - означает логарифм (x^2+2) по основанию (x-2). Унарный минус обозначается как ! */ #include <iostream> #include <stack> #include <cctype>. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»
SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image 8Observer8 10.02.2026 Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .	Установка Qt-версии Lazarus IDE в Debian Trixie Xfce volvo 10.02.2026 В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .

Нужно сделать меню для курсового проекта

Решение