Составить программу, которая будет считывать задания с файла

@PacificABCNET · Регистрация: 22.05.2013

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

всем привет) скажите, можно ли составить программу которая будет считывать вопросы с файла? то есть программа считывает заданный файл, в который записаны вопросы с вариантами ответов, а затем выводит этот вопрос и пользователь на него отвечает. реально ли сделать такое?
заранее спасибо

@Striker · 28.05.2013, 08:10

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

сделал. при запуске теста выдает ошибку "индекс находится вне границ массива"

У Вас в процедуре "files" программа пытается записать в mas[0] строку, в паскале нету нулевого элемента в массиве, поэтому он ругается. Вот Ваша программа с исправлением и моими вложениями, запустите весь мой проект и проверьте.

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
uses
  GraphABC, ABCbuttons;
 
var
  voprosy := 0;
  f, l: Text;
  s, s2, s3, s4, fon: string;
  procenty: real;
  answ: char;
  x, otvety, ocenka, y: integer;
  b, b2, b3, b4: ButtonABC;
  mas: array[1..10] of string;
 
procedure otv; forward;
 
procedure otv2; forward;
 
procedure otv3; forward;
 
procedure otv4; forward;
 
procedure vivod;
begin
  clearwindow;
  FillWindow(fon);
  setfontstyle(fsbold);
  setfontsize(15);
  s2 := inttostr(otvety);
  textout(0, 0, 'Количество правильных ответов:');
  textout(365, 0, s2);
  procenty := otvety / voprosy * 100;
  s3 := floattostr(round(procenty));
  textout(0, 30, 'Процент правильных ответов:');
  textout(350, 30, s3);
  textout(390, 30, '%');
  if procenty < 50 then ocenka := 2 else if (procenty >= 50) and (procenty < 75 ) then ocenka := 3 else if (procenty >= 75) and (procenty < 95) then ocenka := 4 else if procenty >= 95 then ocenka := 5;
  s4 := inttostr(ocenka);
  textout(0, 60, 'Оценка за тест:');
  textout(175, 60, s4);
end;
 
procedure files;
begin
  sleep(1000);
  clearwindow;
  FillWindow(fon);
  setfontstyle(fsbold);
  setfontsize(12);
  x := 0;
  y := 1;
  repeat
    if s[1] <> 'к' Then
    begin
      readln(f, s);
      if (x < 20) then
        textout(0, x, s);
      x += 20;
      if s[1] = 'к' Then
      begin
        vivod;
      end;
      if (x > 20) then
      begin
        mas[y] := s;
        inc(y);
      end;
    end;
  until ((s[1] = 'г') or (s[1] = 'к'));
  
  
  b := new buttonABC(230, 120, 120, 40, mas[1], ClWhite);
  b2 := new buttonABC(230, 170, 120, 40, mas[2], ClWhite);
  b3 := new buttonABC(230, 220, 120, 40, mas[3], ClWhite);
  b4 := new buttonABC(230, 270, 120, 40, mas[4], ClWhite);
  b.OnClick := otv;
  b2.OnClick := otv2;
  b3.OnClick := otv3;
  b4.OnClick := otv4;
  if s[1] = 'к' then
  begin
    b.Destroy;
    b2.Destroy;
    b3.Destroy;
    b4.Destroy;
    b := new buttonABC(320, 260, 150, 70, 'ЗАВЕРШИТЬ', ClWhite);
    b.OnClick := closewindow;
  end;
  
end;
 
procedure otv;
begin
  answ := 'а';
  readln(f, s);
  voprosy := voprosy + 1;
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;
 
procedure otv2;
begin
  answ := 'б';
  readln(f, s);
  voprosy := voprosy + 1;
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;
 
procedure otv3;
begin
  answ := 'в';
  readln(f, s);
  voprosy := voprosy + 1;
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;
 
procedure otv4;
begin
  answ := 'г';
  readln(f, s);
  voprosy := voprosy + 1;
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;
 
procedure okno;
begin
  readln(f, fon);
end;
 
procedure test;
begin
  window.clear;
  b.Destroy;
  b2.Destroy;
  s := ' ';
  assign(f, 'quest.txt');
  reset(f);
  okno;
  files;
end;
 
procedure instr;
begin
  setfontsize(12);
  window.clear;
  b.Destroy;
  b2.Destroy;
  textout(100, 0, 'Инструкция для тех, кто хочет составить свой тест.');
  textout(40, 40, 'В приложенном файле intro.txt вы можете изменить название теста.');
  textout(40, 60, 'В приложенном файле quest.txt вы можете изменить вопросы теста.');
  textout(40, 80, 'Сменить фон можно, изменив в первой строчке название картинки на свое.');
  textout(40, 100, 'Обязетельно все делайте по шаблону : .');
  textout(70, 120, '№вопроса (цифра). Вопрос (текст)');
  textout(70, 140, 'а)Вариант ответа №1');  
  textout(70, 160, 'б)Вариант ответа №2');  
  textout(70, 180, 'в)Вариант ответа №3');  
  textout(70, 200, 'г)Вариант ответа №4');  
  textout(70, 220, 'Правильный ответ: а)'); 
  textout(40, 240, 'Буква может быть любая другая. Не забывайте скобку в конце!'); 
  textout(40, 260, 'Вариантов ответов должно быть обязательно 4!');
  textout(40, 280, 'В конце файла quest.txt слова "конец" не удалять и не изменять! Это важно!');  
  textout(40, 300, 'Удачи вам!'); 
  b := buttonabc.create(320, 340, 190, 60, 'ПЕРЕЙТИ К ТЕСТУ', clwhite);
  b.OnClick := test;
  b2 := buttonabc.create(320, 410, 190, 60, 'ЗАВЕРШИТЬ', clwhite);
  b2.OnClick := closewindow;
end;
 
procedure main;
begin
  assign(l, 'intro.txt');
  reset(l);
  setfontsize(15);
  b := buttonabc.create(200, 70, 250, 80, 'НАЧАТЬ ТЕСТИРОВАНИЕ', clwhite);
  b.OnClick := test;
  setfontsize(15);
  b2 := buttonabc.create(200, 250, 250, 80, 'ИНСТРУКЦИЯ ПО ИЗМЕНЕНИЮ ТЕСТА', clwhite);
  b2.OnClick := instr;
end;
 
procedure Close(key: integer);
begin
  if key = vk_ESCAPE then Window.Close;  
end;
 
begin
  Window.Title := 'Тест';
  OnKeyDown := Close;
  begin
    main;
  end;
end.

Файл intro.txt у меня пустой. Картинка корзины - это фон в программе, quest.txt содержит путь к фону и вопросы с 4-мя ответами. Варианты ответов выводятся на кнопки.

Прикрепляю скриншот запущенной программы.

@PacificABCNET · 28.05.2013, 11:31 **[ТС]**

кнопки работают, спасибо

но вот фоновая картинка не желает запускаться вначале, на выборе теста или инструкции... почему?

@Striker · 28.05.2013, 11:36

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

но вот фоновая картинка не желает запускаться вначале, на выборе теста или инструкции... почему?

Нужно было переписать порядок выполнения процедур и инициализацию включить в главной программе.
Вот:

Кликните здесь для просмотра всего текста

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
uses
  GraphABC, ABCbuttons;
 
var
  voprosy := 0;
  f, l: Text;
  s, s2, s3, s4, fon: string;
  procenty: real;
  answ: char;
  x, otvety, ocenka, y: integer;
  b, b2, b3, b4: ButtonABC;
  mas: array[1..10] of string;
 
procedure otv; forward;
 
procedure otv2; forward;
 
procedure otv3; forward;
 
procedure otv4; forward;
 
procedure vivod;
begin
  clearwindow;
  FillWindow(fon);
  setfontstyle(fsbold);
  setfontsize(15);
  s2 := inttostr(otvety);
  textout(0, 0, 'Количество правильных ответов:');
  textout(365, 0, s2);
  procenty := otvety / voprosy * 100;
  s3 := floattostr(round(procenty));
  textout(0, 30, 'Процент правильных ответов:');
  textout(350, 30, s3);
  textout(390, 30, '%');
  if procenty < 50 then ocenka := 2 else if (procenty >= 50) and (procenty < 75 ) then ocenka := 3 else if (procenty >= 75) and (procenty < 95) then ocenka := 4 else if procenty >= 95 then ocenka := 5;
  s4 := inttostr(ocenka);
  textout(0, 60, 'Оценка за тест:');
  textout(175, 60, s4);
end;
 
procedure files;
begin
  sleep(1000);
  clearwindow;
  FillWindow(fon);
  setfontstyle(fsbold);
  setfontsize(12);
  x := 0;
  y := 1;
  repeat
    if s[1] <> 'к' Then
    begin
      readln(f, s);
      if (x < 20) then
        textout(0, x, s);
      x += 20;
      if s[1] = 'к' Then
      begin
        vivod;
      end;
      if (x > 20) then
      begin
        mas[y] := s;
        inc(y);
      end;
    end;
  until ((s[1] = 'г') or (s[1] = 'к'));
  
  
  b := new buttonABC(230, 120, 120, 40, mas[1], ClWhite);
  b2 := new buttonABC(230, 170, 120, 40, mas[2], ClWhite);
  b3 := new buttonABC(230, 220, 120, 40, mas[3], ClWhite);
  b4 := new buttonABC(230, 270, 120, 40, mas[4], ClWhite);
  b.OnClick := otv;
  b2.OnClick := otv2;
  b3.OnClick := otv3;
  b4.OnClick := otv4;
  if s[1] = 'к' then
  begin
    b.Destroy;
    b2.Destroy;
    b3.Destroy;
    b4.Destroy;
    b := new buttonABC(320, 260, 150, 70, 'ЗАВЕРШИТЬ', ClWhite);
    b.OnClick := closewindow;
  end;
  
end;
 
procedure otv;
begin
  answ := 'а';
  readln(f, s);
  voprosy := voprosy + 1;
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;
 
procedure otv2;
begin
  answ := 'б';
  readln(f, s);
  voprosy := voprosy + 1;
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;
 
procedure otv3;
begin
  answ := 'в';
  readln(f, s);
  voprosy := voprosy + 1;
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;
 
procedure otv4;
begin
  answ := 'г';
  readln(f, s);
  voprosy := voprosy + 1;
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;
 
procedure okno;
begin
  readln(f, fon);
end;
 
procedure test;
begin
  window.clear;
  b.Destroy;
  b2.Destroy;
  s := ' ';
  
  //okno;
  files;
end;
 
procedure instr;
begin
  setfontsize(12);
  window.clear;
  b.Destroy;
  b2.Destroy;
  textout(100, 0, 'Инструкция для тех, кто хочет составить свой тест.');
  textout(40, 40, 'В приложенном файле intro.txt вы можете изменить название теста.');
  textout(40, 60, 'В приложенном файле quest.txt вы можете изменить вопросы теста.');
  textout(40, 80, 'Сменить фон можно, изменив в первой строчке название картинки на свое.');
  textout(40, 100, 'Обязетельно все делайте по шаблону : .');
  textout(70, 120, '№вопроса (цифра). Вопрос (текст)');
  textout(70, 140, 'а)Вариант ответа №1');  
  textout(70, 160, 'б)Вариант ответа №2');  
  textout(70, 180, 'в)Вариант ответа №3');  
  textout(70, 200, 'г)Вариант ответа №4');  
  textout(70, 220, 'Правильный ответ: а)'); 
  textout(40, 240, 'Буква может быть любая другая. Не забывайте скобку в конце!'); 
  textout(40, 260, 'Вариантов ответов должно быть обязательно 4!');
  textout(40, 280, 'В конце файла quest.txt слова "конец" не удалять и не изменять! Это важно!');  
  textout(40, 300, 'Удачи вам!'); 
  b := buttonabc.create(320, 340, 190, 60, 'ПЕРЕЙТИ К ТЕСТУ', clwhite);
  b.OnClick := test;
  b2 := buttonabc.create(320, 410, 190, 60, 'ЗАВЕРШИТЬ', clwhite);
  b2.OnClick := closewindow;
end;
 
procedure main;
begin
  FillWindow(fon);
  assign(l, 'intro.txt');
  reset(l);
  setfontsize(15);
  b := buttonabc.create(200, 70, 250, 80, 'НАЧАТЬ ТЕСТИРОВАНИЕ', clwhite);
  b.OnClick := test;
  setfontsize(15);
  b2 := buttonabc.create(200, 250, 250, 80, 'ИНСТРУКЦИЯ ПО ИЗМЕНЕНИЮ ТЕСТА', clwhite);
  b2.OnClick := instr;
end;
 
procedure Close(key: integer);
begin
  if key = vk_ESCAPE then Window.Close;  
end;
 
begin
  Window.Title := 'Тест';
  OnKeyDown := Close;
  begin
    assign(f, 'quest.txt');
    reset(f);
    okno;
    main;
  end;
end.

@PacificABCNET · 28.05.2013, 11:45 **[ТС]**

и Intro почему то все равно не хочет считываться...

@Striker · 28.05.2013, 11:46

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

и Intro почему то все равно не хочет считываться...

А что в intro находится? Когда должно считываться и куда выводится?

Конечно оно не считывается, нету процедуры чтения.У Вас только инициализация.

@PacificABCNET · 28.05.2013, 11:53 **[ТС]**

в файле Intro содержится текст на главном экране, находящийся над кнопками.
а процедура чтения тогда как будет?

@Striker · 28.05.2013, 12:11

Пришлите пожалуйста содержимое данного файлика, я же не экстрасенс.

Процедура чтения очень проста - считываем содержимое в строку, а эту строку уже выводим на экран. Примерно как считываете вопросы на экран.

@PacificABCNET · 28.05.2013, 12:23 **[ТС]**

файл интро содержит простую текстовую строку, типа "данная программа предназначена для тестирования по..."

@Striker · 28.05.2013, 12:29

Кликните здесь для просмотра всего текста

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
uses
  GraphABC, ABCbuttons;
 
var
  voprosy := 0;
  f, l: Text;
  s, s2, s3, s4, fon: string;
  procenty: real;
  answ: char;
  x, otvety, ocenka, y: integer;
  b, b2, b3, b4: ButtonABC;
  mas: array[1..10] of string;
 
procedure otv; forward;
 
procedure otv2; forward;
 
procedure otv3; forward;
 
procedure otv4; forward;
 
procedure vivod;
begin
  clearwindow;
  FillWindow(fon);
  setfontstyle(fsbold);
  setfontsize(15);
  s2 := inttostr(otvety);
  textout(0, 0, 'Количество правильных ответов:');
  textout(365, 0, s2);
  procenty := otvety / voprosy * 100;
  s3 := floattostr(round(procenty));
  textout(0, 30, 'Процент правильных ответов:');
  textout(350, 30, s3);
  textout(390, 30, '%');
  if procenty < 50 then ocenka := 2 else if (procenty >= 50) and (procenty < 75 ) then ocenka := 3 else if (procenty >= 75) and (procenty < 95) then ocenka := 4 else if procenty >= 95 then ocenka := 5;
  s4 := inttostr(ocenka);
  textout(0, 60, 'Оценка за тест:');
  textout(175, 60, s4);
end;
 
procedure files;
begin
  sleep(1000);
  clearwindow;
  FillWindow(fon);
  setfontstyle(fsbold);
  setfontsize(12);
  x := 0;
  y := 1;
  repeat
    if s[1] <> 'к' Then
    begin
      readln(f, s);
      if (x < 20) then
        textout(0, x, s);
      x += 20;
      if s[1] = 'к' Then
      begin
        vivod;
      end;
      if (x > 20) then
      begin
        mas[y] := s;
        inc(y);
      end;
    end;
  until ((s[1] = 'г') or (s[1] = 'к'));
  
  
  b := new buttonABC(230, 120, 120, 40, mas[1], ClWhite);
  b2 := new buttonABC(230, 170, 120, 40, mas[2], ClWhite);
  b3 := new buttonABC(230, 220, 120, 40, mas[3], ClWhite);
  b4 := new buttonABC(230, 270, 120, 40, mas[4], ClWhite);
  b.OnClick := otv;
  b2.OnClick := otv2;
  b3.OnClick := otv3;
  b4.OnClick := otv4;
  if s[1] = 'к' then
  begin
    b.Destroy;
    b2.Destroy;
    b3.Destroy;
    b4.Destroy;
    b := new buttonABC(320, 260, 150, 70, 'ЗАВЕРШИТЬ', ClWhite);
    b.OnClick := closewindow;
  end;
  
end;
 
procedure otv;
begin
  answ := 'а';
  readln(f, s);
  voprosy := voprosy + 1;
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;
 
procedure otv2;
begin
  answ := 'б';
  readln(f, s);
  voprosy := voprosy + 1;
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;
 
procedure otv3;
begin
  answ := 'в';
  readln(f, s);
  voprosy := voprosy + 1;
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;
 
procedure otv4;
begin
  answ := 'г';
  readln(f, s);
  voprosy := voprosy + 1;
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;
 
procedure okno;
begin
  readln(f, fon);
end;
 
procedure test;
begin
  window.clear;
  b.Destroy;
  b2.Destroy;
  s := ' ';
  
  //okno;
  files;
end;
 
procedure instr;
begin
  setfontsize(12);
  window.clear;
  b.Destroy;
  b2.Destroy;
  textout(100, 0, 'Инструкция для тех, кто хочет составить свой тест.');
  textout(40, 40, 'В приложенном файле intro.txt вы можете изменить название теста.');
  textout(40, 60, 'В приложенном файле quest.txt вы можете изменить вопросы теста.');
  textout(40, 80, 'Сменить фон можно, изменив в первой строчке название картинки на свое.');
  textout(40, 100, 'Обязетельно все делайте по шаблону : .');
  textout(70, 120, '№вопроса (цифра). Вопрос (текст)');
  textout(70, 140, 'а)Вариант ответа №1');  
  textout(70, 160, 'б)Вариант ответа №2');  
  textout(70, 180, 'в)Вариант ответа №3');  
  textout(70, 200, 'г)Вариант ответа №4');  
  textout(70, 220, 'Правильный ответ: а)'); 
  textout(40, 240, 'Буква может быть любая другая. Не забывайте скобку в конце!'); 
  textout(40, 260, 'Вариантов ответов должно быть обязательно 4!');
  textout(40, 280, 'В конце файла quest.txt слова "конец" не удалять и не изменять! Это важно!');  
  textout(40, 300, 'Удачи вам!'); 
  b := buttonabc.create(320, 340, 190, 60, 'ПЕРЕЙТИ К ТЕСТУ', clwhite);
  b.OnClick := test;
  b2 := buttonabc.create(320, 410, 190, 60, 'ЗАВЕРШИТЬ', clwhite);
  b2.OnClick := closewindow;
end;
 
procedure main;
var
  str: string;
  y: integer;
begin
  FillWindow(fon);
  assign(l, 'intro.txt');
  reset(l);
  while not eof(l) do
  begin
    Readln(l, str);
    textout(0, y, str);
    y += 20;
  end;
  setfontsize(15);
  b := buttonabc.create(200, 70, 250, 80, 'НАЧАТЬ ТЕСТИРОВАНИЕ', clwhite);
  b.OnClick := test;
  setfontsize(15);
  b2 := buttonabc.create(200, 250, 250, 80, 'ИНСТРУКЦИЯ ПО ИЗМЕНЕНИЮ ТЕСТА', clwhite);
  b2.OnClick := instr;
end;
 
procedure Close(key: integer);
begin
  if key = vk_ESCAPE then Window.Close;  
end;
 
begin
  Window.Title := 'Тест';
  OnKeyDown := Close;
  begin
    assign(f, 'quest.txt');
    reset(f);
    okno;
    main;
  end;
end.

Я Вас правильно понял?

@PacificABCNET · 28.05.2013, 12:34 **[ТС]**

ооо все! =) все то, что надо было, готово

огромное спасибо

@Striker · 28.05.2013, 12:36

Пожалуйста. Рад был помочь. Удачи Вам

@PacificABCNET · 03.06.2013, 22:12 **[ТС]**

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
procedure otv;
begin
  answ := 'а';
  readln(f, s);
  voprosy := voprosy + 1;
  setbrushstyle(bssolid);
  setbrushcolor(clwhite);
  setfontstyle(fsBoldItalic);
  setfontsize(20);
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(120, 120, 'Правильно!');
  end
  else
    TextOUT(120, 120, 'Неправильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  b4.Destroy;
  files;
end;

вот лазил по коду и решил узнать что значит вот это

Pascal
1
  if answ = s[19] then

s[19] как это понять?

@Striker · 03.06.2013, 22:25

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

s[19] как это понять?

Это значит 19 символ в строке s, а 19 символ это буква правильного ответа.

@PacificABCNET · 03.06.2013, 22:29 **[ТС]**

а откуда берется номер строки? как он определяет нужную строку?

@Striker · 03.06.2013, 22:36

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

а откуда берется номер строки? как он определяет нужную строку?

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

@PacificABCNET · 03.06.2013, 22:43 **[ТС]**

понятно

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
procedure main;
var
  str: string;
  y: integer;
begin
  FillWindow('foninst.jpg');
  setfontsize(15);
  setfontcolor(clwhite);
  assign(l, 'intro.txt');
  reset(l);
  while not eof(l) do
  begin
    Readln(l, str);
    setbrushstyle(bsclear);
    textout(170, y, str);
    y += 20;
  end;
  setfontsize(15);
  setbrushstyle(bssolid);
  b := buttonabc.create(170, 90, 290, 80, 'НАЧАТЬ ТЕСТИРОВАНИЕ', cllightgray);
  b.OnClick := intro;
  setfontsize(15);
  b2 := buttonabc.create(170, 250, 290, 80, 'ИНСТРУКЦИЯ ПО ИЗМЕНЕНИЮ ТЕСТА', clyellow);
  b2.OnClick := instr;
  setbrushstyle(bssolid);
end;

а вот я хотел узнать что делает переменная "y" и что значит y+=20

@BaboshinSD · 03.06.2013, 22:57

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

что делает переменная "y"

Задаёт координату "y" для вывода текста, здесь используется для отступа.

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

что значит y+=20

Эта конструкция увеличивает значение "y" на 20. Всё равно что

Pascal
1
y := y + 20;

@PacificABCNET · 03.06.2013, 23:01 **[ТС]**

спасибо )

@PacificABCNET · 03.06.2013, 23:59 **[ТС]**

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
uses graphABC, abcbuttons;
var
 ot1, ot2, ot3, ot4: buttonabc;
 vopr, otv: text;
 fon: picture;
 proc, protv, allquest: integer;
 otvet: char;
 str: string;
 const n=4;
 
procedure otvety; forward;
procedure otvet1; forward;
procedure otvet2; forward;
procedure otvet3; forward;
procedure otvet4; forward;
 
 
procedure voprosiki;
begin
window.clear;
reset(vopr);
allquest := 0;
while not (eof(vopr)) do
  begin
    readln(vopr,str);
    inc(allquest);
    textout(0,0,str);
  end;
  otvety;
end;
 
procedure otvety;
begin
   reset(otv);    
      setfontsize(12);
      readln(otv,otvet);
      textout(10,50,otvet);
      for var i:=1 to n do
          begin
          readln(otv,otvet);
          textout(10,60+(i*20),inttostr(i)+' - '+otvet);
          end;
     
      textout(10,180,'Ваш ответ:');
   ot1:=new buttonabc(50, 250, 80, 40, '1', clwhite);
   ot2:=new buttonabc(150, 250, 80, 40, '2', clwhite);
   ot3:=new buttonabc(250, 250, 80, 40, '3', clwhite);
   ot4:=new buttonabc(350, 250, 80, 40, '4', clwhite);
   ot1.onclick:=otvet1;
   ot2.onclick:=otvet2;
   ot3.onclick:=otvet3;
   ot4.onclick:=otvet4;
end;
   
procedure otvet1;
 begin
  if otvet='1'
   then
   inc (protv);
   voprosiki;
 end;
 
procedure otvet2;
 begin
  if otvet='2'
   then
   inc (protv);
   voprosiki;
 end;
 
procedure otvet3;
 begin
  if otvet='3'
   then
   inc (protv);
   voprosiki;
 end;
 
procedure otvet4;
 begin
  if otvet='4'
   then
   inc (protv);
   voprosiki;
 end;
 
procedure test;
 begin
  ot1.Destroy; 
  voprosiki;
 end;
 
procedure titl;
 begin
  assign (otv, 'pravilotvet.txt');
  assign (vopr, 'vopros.txt');
  ot1:=buttonabc.create(100, 210, 400, 50, 'Старт теста', clwhite);
  ot1.onclick:=test;
 end;
 
procedure zakrokn(key: integer);
 begin
  if key=vk_ESCAPE then Window.close;
  end;
 begin
  onkeydown:=zakrokn;
  begin
 titl;
  end;
 end.

в общем делаем программу, похожую на ту, что была выше, но варианты ответов и правильный должны быть в отдельном файле, и у нас тут не получается и плюс ко всему, вопросы не накладываются друг на друга и плюс некорректно считываются. вот код, что мы делаем не так?

@Striker · 04.06.2013, 09:24

в общем делаем программу, похожую на ту, что была выше, но варианты ответов и правильный должны быть в отдельном файле, и у нас тут не получается и плюс ко всему, вопросы не накладываются друг на друга и плюс некорректно считываются. вот код, что мы делаем не так?

Я смотрю две головы не могут придумать алгоритм

Если правильно понял, то вот:

Кликните здесь для просмотра всего текста

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
uses
  graphABC, abcbuttons;
 
var
  ot1, ot2, ot3, ot4: buttonabc;
  vopr, otv: text;
  fon: picture;
  proc, protv, allquest: integer;
  otvet, pravotv: char;
  str: string;
 
const
  n = 4;
 
procedure otvety; forward;
 
procedure otvet1; forward;
 
procedure otvet2; forward;
 
procedure otvet3; forward;
 
procedure otvet4; forward;
 
procedure prexit;
var
  s: string;
begin
  s := inttostr(protv);
  Textout(10, 10, 'Количество правильных ответов: ' + s);
  redraw;
end;
 
procedure voprosiki;
begin
  LockDrawing;
  window.clear;
  
  allquest := 0;
  setfontsize(12);
  readln(vopr, str);
  if (str = 'К') then
    prexit
    else
  begin
    inc(allquest);
    textout(0, 0, str);
    redraw;
    otvety;
  end;
end;
 
procedure otvety;
var
  x: integer;
begin
  
  setfontsize(12);
  for var i := 1 to n do
  begin
    readln(otv, str);
    if(str = '/') then
      readln(otv, str);
    if(str [length(str)] in ['1'..'4']) then
    begin
      x := length(str);
      pravotv := str[x];
      delete(str, x, 1);
    end;
    textout(10, 60 + (i * 20), inttostr(i) + ' - ' + str);
    redraw;
    
  end;
  
  
  textout(10, 180, 'Ваш ответ:');
  ot1 := new buttonabc(50, 250, 80, 40, '1', clwhite);
  ot2 := new buttonabc(150, 250, 80, 40, '2', clwhite);
  ot3 := new buttonabc(250, 250, 80, 40, '3', clwhite);
  ot4 := new buttonabc(350, 250, 80, 40, '4', clwhite);
  ot1.onclick := otvet1;
  ot2.onclick := otvet2;
  ot3.onclick := otvet3;
  ot4.onclick := otvet4;
  
end;
 
procedure otvet1;
begin
  if pravotv = '1'
    then
    inc(protv);
  voprosiki;
end;
 
procedure otvet2;
begin
  if pravotv = '2'
    then
    inc(protv);
  voprosiki;
end;
 
procedure otvet3;
begin
  if pravotv = '3'
    then
    inc(protv);
  voprosiki;
end;
 
procedure otvet4;
begin
  if pravotv = '4'
    then
    inc(protv);
  voprosiki;
end;
 
procedure test;
begin
  ot1.Destroy; 
  voprosiki;
end;
 
procedure titl;
begin
  assign(otv, 'pravilotvet.txt');
  assign(vopr, 'vopros.txt');
  reset(otv);
  reset(vopr);
  ot1 := buttonabc.create(100, 210, 400, 50, 'Старт теста', clwhite);
  ot1.onclick := test;
end;
 
procedure zakrokn(key: integer);
begin
  if key = vk_ESCAPE then Window.close;
end;
 
begin
  onkeydown := zakrokn;
  begin
    titl;
  end;
end.

И в файликах добавлены символы.

Новые блоги и статьи Все статьи Все блоги /
Саморегулирующийся социальный контракт для сервера cross-section. Hrethgir 14.08.2026 С кодом конечно таких глубоких размышлений пока не было, впрочем я уже привык к алгоритмизации. Суть предмета записи: снова в диалоге с нейросетью (я взял пока себе ник для учётки админа - Rector). . . .	Часы электронные Uhbif79 12.08.2026 Выкладываю программу часов. Программа позволяет: 1. Использовать системное время и дату, 2. Есть возможность вводить время и дату вручную. 3. Реализованы 2 будильника: начало и конец рабочего дня. . . .	Часы с будильником на основе класса QLCDNumber Uhbif79 12.08.2026 Всем добрый день, выкладываю программу часов с будильником на основе класса QLCDNumber. Здесь я пробовал самостоятельно создавал классы, впервые столкнулся с видимостью переменной одного класса из. . .	Установка MinGW GCC 16.2 и CMake 8Observer8 10.08.2026 VK Видео: https:/ / vkvideo. ru/ video-240781534_456239017 YouTube: eY5-5PyI9NM Текстовая версия
Неделя из жизни имитационной модели склада: мои кривые руки растут, откуда надо anaschu 10.08.2026 Неделя из жизни имитационной модели склада: как я почти написал неправильную логику и что с этим делать Работаю сейчас над учебно-рабочим проектом: строю в AnyLogic имитационную модель процессов. . .	Калькулятор для расчета родства russiannick 07.08.2026 1. Задача: Создать калькулятор для расчета родства. Родственных связей существует 8 ступеней, такие как: p - отец P - мать q - муж Q - жена b - брат B - сестра s - сын S - дочь	Мир по моей воле kumehtar 07.08.2026 Когда-то кажется, что всё просто. Ты весь такой светлый. Причиняешь добро. Борешься за справедливость в этом тёмном мире. Потом начинаешь замечать одну неприятную вещь. Почти каждый хороший. . .	Кредитный калькулятор Maks 05.08.2026 Решение задачи по прикладной информатике средствами 1С. Задача: Напишите приложение-калькулятор, которое помогает рассчитывать параметры кредита для аннуитетного и дифференцированного видов. . .

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120

	Составить программу, которая будет считывать задания с файла 24.05.2013, 14:10. Показов 6748. Ответов 85 Метки нет (Все метки) всем привет) скажите, можно ли составить программу которая будет считывать вопросы с файла? то есть программа считывает заданный файл, в который записаны вопросы с вариантами ответов, а затем выводит этот вопрос и пользователь на него отвечает. реально ли сделать такое? заранее спасибо 0

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120
	28.05.2013, 11:31 [ТС]
	кнопки работают, спасибо но вот фоновая картинка не желает запускаться вначале, на выборе теста или инструкции... почему? 0

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120
	28.05.2013, 11:45 [ТС]
	и Intro почему то все равно не хочет считываться... 0

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120
	28.05.2013, 11:53 [ТС]
	в файле Intro содержится текст на главном экране, находящийся над кнопками. а процедура чтения тогда как будет? 0

@Striker SausageFlat 242 / 221 / 154 Регистрация: 19.08.2012 Сообщений: 499 Записей в блоге: 1
	28.05.2013, 12:11
	Пришлите пожалуйста содержимое данного файлика, я же не экстрасенс. Процедура чтения очень проста - считываем содержимое в строку, а эту строку уже выводим на экран. Примерно как считываете вопросы на экран. 0

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120
	28.05.2013, 12:23 [ТС]
	файл интро содержит простую текстовую строку, типа "данная программа предназначена для тестирования по..." 0

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120
	28.05.2013, 12:34 [ТС]
	ооо все! =) все то, что надо было, готово огромное спасибо 0

@Striker SausageFlat 242 / 221 / 154 Регистрация: 19.08.2012 Сообщений: 499 Записей в блоге: 1
	28.05.2013, 12:36
	Пожалуйста. Рад был помочь. Удачи Вам 0

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120
	03.06.2013, 22:29 [ТС]
	а откуда берется номер строки? как он определяет нужную строку? 0

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120
	03.06.2013, 23:01 [ТС]
	спасибо ) 0