Не работают некоторые процедуры в модуле

@hitachinapascal · Регистрация: 12.04.2021

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

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

Основная программа:

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
uses crt, face;
type
    stb = integer;
    stib = integer;
    stnk = string[100];
    stnf = string[100];
    tablica = record
    b:stb;
    ib:stib;
    nk:stnk;
    nf:stnf;
    end;
var
    sp: file of tablica;
        work:tablica;
    vid: byte;
    end_menu: boolean;
    name: string[12];
        //SP866 - тRэр Rчтя
 
 
begin
            clrscr;
            end_menu:=false;
                repeat
                    Writeln('Меню действий с таблицей кинотеатров');
              writeln('---------------------------------------');
                    Writeln('Выберите действие:');
                    Writeln('1 - создать файл');
                    Writeln('2 - просмотр файла');
                    Writeln('3 - изменить запись');
                    Writeln('4 - добавить запись');
                    Writeln('5 - поиск по названию кинотеатра');
              writeln('6 - просмотр данных о количестве проданных билетов');
                    //їц ўЈў Јэя<?-р? чЎўячрў¬
                    writeln('0 - завершение работы');
              writeln('---------------------------------------');
                    writeln('Ваш выбор:');
                    readln(vid);
            case vid of
                1: create_SP;
                2: outputallrec;
                3: updaterec;
                4: addrectoend;
                5: findnk;
            6: averagesold;
                0: end_menu:=true;
                        end;
                         writeln('Для продолжения нажмите Enter ');
                         readln;
                        clrscr;
                until end_menu;
                        readln;
                        readln;
end.

Модуль:

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
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
unit face;
interface
procedure create_SP;
procedure name_file(var name: string[12]);
procedure addrec;
procedure outputrec;
procedure outputallrec;
procedure updaterec;
procedure addrectoend;
procedure findnk;
procedure averagesold;
implementation
type
    stb = integer;
    stib = integer;
    stnk = string[100];
    stnf = string[100];
    tablica = record
    b:stb;
    ib:stib;
    nk:stnk;
    nf:stnf;
    end;
var
    sp: file of tablica;
        work:tablica;
    vid: byte;
    end_menu: boolean;
    name: string[12];
procedure name_file(var name: string[12]);
 
begin
    write('Введите название файла >');
    readln(name);
end;
 
procedure addrec;
 
var
    sp: file of tablica;
        work:tablica;
    vid: byte;
    end_menu: boolean;
begin
        writeln('Ввод записи № ',filepos(sp)+1);
        with work do
        begin
          
  assign(sp, name);
    write('Введите название кинотеатра : ');
    readln(nk);
    write('Введите название фильма : ');
    readln(nf);
    write('Введите количество проданных билетов : ');
    readln(b);
    write(sp,work);
    end;
end;
 
 
 
procedure outputrec;
 
var
    sp: file of tablica;
        work:tablica;
    vid: byte;
    end_menu: boolean;
    name: string[12];
begin
    read(sp, work);
      writeln('+--------------------+----------------------+-------------------+');
    writeln('|                    |                      |Количество         |');
    writeln('|Название кинотеатра |Название фильма       |проданных билетов  |');
    writeln('+-+------------------+----------------------+-------------------+');
    writeln('|№|                                                             |');
    writeln('+---------------------------------------------------------------+');
    with work do
        begin
    writeln('|',filepos(sp),'|',' | ',nk,' | ','|',nf,'  |   ' ,b,'          |');
    writeln('+--------------------+----------------------+-------------------+');
    end;
end;
 
procedure outputallrec;
var
    sp: file of tablica;
        work:tablica;
    vid: byte;
    end_menu: boolean;
    name: string[12];
begin
    name_file(name);
    assign(sp, name);
    {$I-}
    reset(sp);
    {$I+}
    if FileExists(name) then
        begin
            seek(sp, 0);
            writeln('Вывод списка кинотеатров из файла ',name);
                while (not eof(sp)) do
                    outputrec;
                end
                else
                    writeln('Такого файла нет на диске');
end;
 
 
 
procedure updaterec;
var
    sp: file of tablica;
        work:tablica;
    vid: byte;
    end_menu: boolean;
    name: string[12];
var
    numrec:longint;
begin
    name_file(name);
    assign(sp, name);
    {$I-}
    reset(sp);
    {$I+}
    if FileExists(name) then
        begin
        write('Укажите номер изменяемой записи :');
        readln(numrec);
        seek(sp, numrec-1);
        writeln('- прежнее значение записи : ');
        outputrec;
        seek(sp, numrec-1);
        writeln('Задаем новое значение ',numrec,' записи');
        addrec;
        close(sp);
        end
            else
            writeln('Файла с таким именем нет на диске');
end;
 
procedure addrectoend;
var
    sp: file of tablica;
        work:tablica;
    vid: byte;
    end_menu: boolean;
    name: string[12];
begin
    name_file(name);
    assign(sp, name);
    {$I-}
    reset(sp);
    {$I+}
    if FileExists(name) then
        begin
        seek(sp, filesize(sp));
        addrec;
        writeln('Измененный файл данных имеет ',filesize(sp),' записи');
        close(sp);
        end
            else
            writeln('Файла с таким именем нет на диске');
end;
 
procedure findnk;
var
    sp: file of tablica;
        work:tablica;
    vid: byte;
    end_menu: boolean;
    name: string[12];
var
    maska1: stnk;
    rez_find: boolean;
    countrec: integer;
begin
    name_file(name);
    assign(sp, name);
    {$I-}
    reset(sp);
    {$I+}
    if FileExists(name) then
        begin
        write('Введите название кинотеатра: ');
                readln(maska1);
                rez_find:=false;
        countrec:=0;
        while (not eof(sp)) do
            begin
            read(sp, work);
            with work do
            if pos(maska1, nk) <>0 then
                begin
                rez_find:=true;
                inc(countrec);
                                writeln('---------------------------------------');
                writeln('|Найдены следующие данные: ');
                writeln('|Название кинотеатра : ',nk,
                                '|Название фильма : ',nf,
                                '|Количество проданных билетов: ',b, '|');
                end;
            if rez_find then
            writeln('Чило записей для ',maska1,'=', countrec)
            else
            writeln('Данные отсутствуют');
                close(sp);
                        end;
                        end;
end;
procedure create_SP;
var
    sp: file of tablica;
        work:tablica;
    vid: byte;
    end_menu: boolean;
    name: string[12];
var
    ind, count: integer;
begin
    name_file(name);
    writeln(name);
    assign(sp, name);
    rewrite(sp);
    writeln('Создание записей файла ', name);
    writeln('Введите количество записей: ');
    readln(count);
        for ind:=1 to count do
        addrec;
    writeln('Создание файла записей завершено');
    writeln('Файл имеет ', filesize(sp),' записей');
    close(sp);
end;
 
 
 
 
 
 
 
procedure averagesold;
var
    sp: file of tablica;
        work:tablica;
    vid: byte;
    end_menu: boolean;
    name: string[12];
        ib:integer;
 
begin
        assign(sp, name);
        {$I-}
        reset(sp);
        ib:=1;
        {$I+}
        while not eof(sp) do
             begin
             read(sp, work);
             with work do
                      begin
                      read(b);
                      ib:=ib+b;
                      end;
             end;
    writeln('+--------------------+----------------------+');
    writeln('|                    |Общее количество      |');
    writeln('|Название кинотеатра |проданных билетов     |');
    writeln('+-+------------------+----------------------+');
    writeln('|№|                  |                      |');
    writeln('+-------------------------------------------+');
    with work do
        begin
    writeln('|',filepos(sp),'|',' |   ' ,b,'             |');
    writeln('+--------------------+----------------------+');
    end;
    writeln('|Итого:              |',ib, '               |');
    writeln('+-------------------------------------------+');
 
end;
end.

@mr-Crocodile · 19.05.2021, 14:59

Сообщение от hitachinapascal

var
sp: file of tablica;

так нельзя.
нужно УБИРАТЬ sp из локальных параметров.
либо сделать одну, ГЛОБАЛЬНУЮ переменную, либо передавать SP как параметр во все процедуры, где она используется.

Добавлено через 4 минуты
а нет, посмотрел.
у тебя везде имя файла запрашивается каждый раз при входе в процедуру.
так можно использовать локальные переменные SP

тогда исправь только добавление записей - процедуру addrec

Добавлено через 32 минуты

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
unit face;
 
interface
 
procedure create_SP;
procedure name_file(var name: string[12]);
procedure addrec;
procedure outputrec;
procedure outputallrec;
procedure updaterec;
procedure addrectoend;
procedure findnk;
procedure averagesold;
implementation
 
type
  stb = integer;
  stnk = string[100];
  stnf = string[100];
  tablica = record
    b: stb;
    nk: stnk;
    nf: stnf;
  end;
 
var
  sp: file of tablica;
  work: tablica;
  name: string[12];
 
procedure name_file(var name: string[12]);
begin
  write('Введите название файла >');
  readln(name);
end;
 
procedure addrec;
begin
  writeln('Ввод записи № ', filepos(sp) + 1);
  with work do
  begin
    write('Введите название кинотеатра : ');
    readln(nk);
    write('Введите название фильма : ');
    readln(nf);
    write('Введите количество проданных билетов : ');
    readln(b);
  end;
  write(sp, work);
end;
 
 
 
procedure outputrec;
begin
  read(sp, work);
  writeln('+--------------------+----------------------+-------------------+');
  writeln('|                    |                      |Количество         |');
  writeln('|Название кинотеатра |Название фильма       |проданных билетов  |');
  writeln('+-+------------------+----------------------+-------------------+');
  writeln('|№|                                                             |');
  writeln('+---------------------------------------------------------------+');
  with work do
  begin
    writeln('|', filepos(sp), '|', ' | ', nk, ' | ', '|', nf, '  |   ', b, '          |');
    writeln('+--------------------+----------------------+-------------------+');
  end;
end;
 
procedure outputallrec;
begin
  name_file(name);
  if FileExists(name) then
  begin
    assign(sp, name);
    {$I-}
    reset(sp);
    {$I+}
    writeln('Вывод списка кинотеатров из файла ', name);
    while (not eof(sp)) do outputrec;
    close(sp)
  end
  else
    writeln('Такого файла нет на диске');
end;
 
procedure updaterec;
var
  numrec: longint;
begin
  name_file(name);
  if FileExists(name) then
  begin
    assign(sp, name);
    {$I-}
    reset(sp);
    {$I+}
    write('Укажите номер изменяемой записи :');
    readln(numrec);
    seek(sp, numrec - 1);
    writeln('- прежнее значение записи : ');
    outputrec;
    seek(sp, numrec - 1);
    writeln('Задаем новое значение ', numrec, ' записи');
    addrec;
    close(sp);
  end
  else
    writeln('Файла с таким именем нет на диске');
end;
 
procedure addrectoend;
begin
  name_file(name);
  if FileExists(name) then
  begin
    assign(sp, name);
    {$I-}
    reset(sp);
    {$I+}
    seek(sp, filesize(sp));
    addrec;
    writeln('Измененный файл данных имеет ', filesize(sp), ' записи');
    close(sp);
  end
  else
    writeln('Файла с таким именем нет на диске');
end;
 
procedure findnk;
var
  maska1: stnk;
  rez_find: boolean;
  countrec: integer;
begin
  name_file(name);
  if FileExists(name) then
  begin
    assign(sp, name);
    {$I-}
    reset(sp);
    {$I+}
    write('Введите название кинотеатра: ');
    readln(maska1);
    rez_find := false;
    countrec := 0;
    while (not eof(sp)) do
    begin
      read(sp, work);
      with work do
        if pos(maska1, nk) <> 0 then
        begin
          rez_find := true;
          inc(countrec);
          writeln('---------------------------------------');
          writeln('|Найдены следующие данные: ');
          writeln('|Название кинотеатра : ', nk,
                        '|Название фильма : ', nf,
                        '|Количество проданных билетов: ', b, '|');
        end;
    end;
    
    if rez_find then
      writeln('Чило записей для ', maska1, '=', countrec)
    else
      writeln('Данные отсутствуют');
    
    close(sp);
    
  end;
end;
 
procedure create_SP;
var
  ind, count: integer;
begin
  name_file(name);
  writeln(name);
  assign(sp, name);
  rewrite(sp);
  writeln('Создание записей файла ', name);
  writeln('Введите количество записей: ');
  readln(count);
  
  for ind := 1 to count do 
    addrec;
  
  writeln('Создание файла записей завершено');
  writeln('Файл имеет ', filesize(sp), ' записей');
  close(sp);
end;
 
 
procedure averagesold;
var
  ib: integer;
begin
  assign(sp, name);
  if FileExists(name) then
  begin
        {$I-}
    reset(sp);
        {$I+}
    writeln('+--------------------+----------------------+');
    writeln('|                    |Общее количество      |');
    writeln('|Название кинотеатра |проданных билетов     |');
    writeln('+-+------------------+----------------------+');
    writeln('|№|                  |                      |');
    writeln('+-------------------------------------------+');
    
    ib := 0;
    while not eof(sp) do
    begin
      read(sp, work);
      with work do
        ib := ib + b;
    end;
    writeln('|Итого:              |', ib, '               |');
    writeln('+-------------------------------------------+');
  end
  else
    writeln('Файла с таким именем нет на диске');  
end;
end.

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
uses crt, face;
 
var
  vid: integer;
  end_menu: boolean;
 
begin
  clrscr;
  end_menu := false;
  repeat
    Writeln('Меню действий с таблицей кинотеатров');
    writeln('---------------------------------------');
    Writeln('Выберите действие:');
    Writeln('1 - создать файл');
    Writeln('2 - просмотр файла');
    Writeln('3 - изменить запись');
    Writeln('4 - добавить запись');
    Writeln('5 - поиск по названию кинотеатра');
    writeln('6 - просмотр данных о количестве проданных билетов');
    writeln('0 - завершение работы');
    writeln('---------------------------------------');
    writeln('Ваш выбор:');
    readln(vid);
    case vid of
      1: create_SP;
      2: outputallrec;
      3: updaterec;
      4: addrectoend;
      5: findnk;
      6: averagesold;
      0: end_menu := true;
    end;
    writeln('Для продолжения нажмите Enter ');
    readln;
    clrscr;
  until end_menu;
end.

@hitachinapascal · 19.05.2021, 17:11 **[ТС]**

Спасибо! Разобралась, кажется

Новые блоги и статьи Все статьи Все блоги /
Доступность команды формы по условию Maks 07.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: сделать доступной кнопку (команда формы "ЗавершитьСписание") при. . .	Уведомление о неверно выбранном значении справочника Maks 06.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "НарядПутевка", разработанного в конфигурации КА2. Задача: уведомлять пользователя, если в документе выбран неверный склад. . .	Установка Qt Creator для C и C++: ставим среду, CMake и MinGW без фреймворка Qt 8Observer8 05.04.2026 Среду разработки Qt Creator можно установить без фреймворка Qt. Есть отдельный репозиторий для этой среды: https:/ / github. com/ qt-creator/ qt-creator, где можно скачать установщик, на вкладке Releases:. . .	AkelPad-скрипты, структуры, и немного лирики.. testuser2 05.04.2026 Такая программа, как AkelPad существует уже давно, и также давно существуют скрипты под нее. Тем не менее, прога живет, периодически что-то не спеша дополняется, улучшается. Что меня в первую очередь. . .
Отображение реквизитов в документе по условию и контроль их заполнения Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеСпецтехники", разработанного в конфигурации КА2. Данный документ берёт данные из другого нетипового документа. . .	Фото всей Земли с борта корабля Orion миссии Artemis II kumehtar 04.04.2026 Это первое подобное фото сделанное человеком за 50 лет. Снимок называют новым вариантом легендарной фотографии «The Blue Marble» 1972 года, сделанной с борта корабля «Аполлон-17». Новое фото. . .	Вывод диалогового окна перед закрытием, если документ не проведён Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать программный контроль на предмет проведения документа. . .	Программный контроль заполнения реквизитов табличной части документа Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: 1. Реализовать контроль заполнения реквизита. . .

@hitachinapascal 0 / 0 / 0 Регистрация: 12.04.2021 Сообщений: 4
	19.05.2021, 17:11 [ТС]
	Спасибо! Разобралась, кажется 0

Не работают некоторые процедуры в модуле

Решение