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

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

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

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

@PacificABCNET · 25.05.2013, 22:11 **[ТС]**

ну если не сложно, буду очень признателен

все равно долго не сплю

Добавлено через 45 минут
и вот что я еще сделал

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
procedure test;
begin
  s := ' ';
  assign(f, 'quest.txt');
  reset(f);
  files;
end;
 
procedure main;
begin
  assign(i, 'intro.txt');
  reset(i);
  test;
end;
 
 
begin
main;
end.

но он текст не выводит из файла, а сразу переходит к тесту... что не так я сделал?

Добавлено через 5 минут
в общем задумку сделал такую. появляется главный экран, на котором идет текст из файла intro мол "данная программа предназначена для тестирования по ... " и т.п. затем ниже идут 2 кнопки одна "начать тест" а вторую идет для тех, кто хочет переделать тест, и одна будет открывать следующую страницу, которая откроет новую страницу с инструкцией (инструкция будет вбита в код, а не в отдельный файл)
и после того как пользователь завершит ее прочтение, дана кнопка "вернуться"
и снова появляется главный экран
вот хотелось бы узнать как бы все это реализовать, а то у меня даже intro вывести не получается(

Добавлено через 7 минут
кстати с клавишей esp все получилось

вот как я сделал

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
procedure Close(key: integer);
begin
  if key=vk_ESCAPE then Window.Close;  
end;
 
begin
  Window.Title := 'Тест';
  OnKeyDown := Close;
begin
main;
end;
end.

и все

при нажатии клавиши ECS программа тоже закрывается

@Striker · 25.05.2013, 22:13

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

но он текст не выводит из файла, а сразу переходит к тесту... что не так я сделал?

Нету паузы программы, нужно сделать кнопку для продолжения её выполнения, а не сразу в процедуре запускать следующую процедуру.

@PacificABCNET · 25.05.2013, 22:41 **[ТС]**

а вот как ее сделать подскажите пожалуйста

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

@Kordn · 25.05.2013, 22:43

Попробуйте закрыть программу и опять открыть. У меня тоже такое бывало.

@PacificABCNET · 25.05.2013, 22:54 **[ТС]**

а все, добавив кнопки проблема была решена

@Striker · 25.05.2013, 23:12

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
uses
  GraphABC, ABCbuttons;
 
var
  f: Text;
 
var
  s, s2, okn: string;
 
var
  x, otvety: integer;
  answ: char;
  b, b2, b3: ButtonABC;
 
procedure otv; forward;
 
procedure otv2; forward;
 
procedure otv3; forward;
 
procedure vivod;
begin
  clearwindow;
  FillWindow(okn);
  s2 := inttostr(otvety);
  textout(0, 0, 'Количество правильных ответов:');
  textout(335, 0, s2);
  
end;
 
procedure files;
begin
  sleep(1000);
  clearwindow;
  FillWindow(okn);
  x := 0;
  repeat
    if s[1] <> 'к' Then
    begin
      readln(f, s);
      textout(0, x, s);
      x += 20;
      if s[1] = 'к' Then
      begin
        vivod;
      end;
    end;
  until ((s[1] = 'в') or (s[1] = 'к'));
  
  
  b := new buttonABC(0, x + 60, 20, 50, 'A', ClWhite);
  b2 := new buttonABC(30, x + 60, 20, 50, 'Б', ClWhite);
  b3 := new buttonABC(60, x + 60, 20, 50, 'В', ClWhite);
  b.OnClick := otv;
  b2.OnClick := otv2;
  b3.OnClick := otv3;
  if s[1] = 'к' then
  begin
    b.Destroy;
    b2.Destroy;
    b3.Destroy;
    b := new buttonABC(0, x + 60, 100, 70, 'EXIT', ClWhite);
    b.OnClick := closewindow;
  end;
  
end;
 
procedure otv;
begin
  answ := 'а';
  readln(f, s);
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(100, 100, 'Правильно!');
  end
  else
    TextOUT(100, 100, 'Не правильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  files;
end;
 
procedure otv2;
begin
  answ := 'б';
  readln(f, s);
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(100, 100, 'Правильно!');
  end
  else
    TextOUT(100, 100, 'Не правильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  files;
end;
 
procedure otv3;
begin
  answ := 'в';
  readln(f, s);
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(100, 100, 'Правильно!');
  end
  else
    TextOUT(100, 100, 'Не правильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  files;
end;
 
procedure okno;
begin
  readln(f, okn);
end;
 
begin
  s := ' ';
  assign(f, 'quest.txt');
  reset(f);
  okno;
  files;
  
end.

Теперь программа из первой строчки файла считывает путь к фону.

Содержимое файла:

Снимок.JPG
1. 2+2=
а)12
б)4
в)16
Правильный ответ: б)
2. Вставьте правильную букву: г_лова
а)о
б)е
в)а
Правильный ответ: а)
3. Сколько пальцев на одной руке?
а)3
б)5
в)8
Правильный ответ: б)
к
к

Добавлено через 7 минут
А процент правильных ответов должен считаться так:

"Кол-во правильных" / "Кол-во вопросов" * 100

Pascal
1
procenty:=otvety/3*100;

У меня 3 вопроса в тесте.

@PacificABCNET · 25.05.2013, 23:21 **[ТС]**

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

@PacificABCNET · 25.05.2013, 23:22 **[ТС]**

с процентом согласен, но пользователь может задать свое кол-во вопросов, и тогда процент будет неверным. как тогда быть?

@Striker · 25.05.2013, 23:29

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

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

с процентом согласен, но пользователь может задать свое кол-во вопросов, и тогда процент будет неверным. как тогда быть?

Тогда кол-во вопросов записано в переменной.

@PacificABCNET · 25.05.2013, 23:42 **[ТС]**

не забываем что я сделал на 4 варианта ответа.

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
uses
  GraphABC, ABCbuttons;
 
var
  f, i: Text;
  s, s2, fon: string;
  x, otvety: integer;
  answ: char;
  b, b2, b3, b4: ButtonABC;
 
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);
end;
 
procedure files;
begin
  sleep(1000);
  clearwindow;
  FillWindow(fon);
  setfontstyle(fsbold);
  setfontsize(15);
  x := 0;
  repeat
    if s[1] <> 'к' Then
    begin
      readln(f, s);
      textout(0, x, s);
      x += 20;
      if s[1] = 'к' Then
      begin
        vivod;
      end;
    end;
  until ((s[1] = 'г') or (s[1] = 'к'));
  
  
  b := new buttonABC(250, 150, 120, 40, 'A', ClWhite);
  b2 := new buttonABC(250, 200, 120, 40, 'Б', ClWhite);
  b3 := new buttonABC(250, 250, 120, 40, 'В', ClWhite);
  b4 := new buttonABC(250, 300, 120, 40, 'Г', 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);
  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);
  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);
  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);
  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(50, 40, 'В приложенном файле intro.txt вы можете изменить название теста.');
  textout(50, 60, 'В приложенном файле quest.txt вы можете изменить вопросы теста.');
  textout(50, 80, 'Сменить фон можно, изменив в первой строчке название картинки на свое.');
  textout(50, 100, 'Обязетельно все делайте по шаблону : .');
  textout(70, 120, '№вопроса (цифра). Вопрос (текст)');
  textout(70, 140, 'а)Вариант ответа №1');  
  textout(70, 160, 'б)Вариант ответа №2');  
  textout(70, 180, 'в)Вариант ответа №3');  
  textout(70, 200, 'г)Вариант ответа №4');  
  textout(50, 220, 'Вариантов ответов должно быть обязательно 4!');
  textout(50, 240, 'В конце файла quest.txt слова "конец" не удалять и не изменять! Это важно!');  
  textout(50, 260, 'Удачи!'); 
  b := buttonabc.create(320, 300, 180, 60, 'ПЕРЕЙТИ К ТЕСТУ', clwhite);
  b.OnClick := test;
  b2 := buttonabc.create(320, 370, 180, 60, 'ЗАВЕРШИТЬ', clwhite);
  b2.OnClick := closewindow;
end;
 
procedure main;
begin
  assign(i, 'intro.txt');
  reset(i);
  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.

это код без ошибки, потому что ошибка была когда в процедура Main выглядела вот так

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
procedure main;
begin
  assign(i, 'intro.txt');
  reset(i);
  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;
  okno;
end;

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

Добавлено через 2 минуты
и как сделать чтобы программа подсчитывала кол-во заданных вопросов?

@Striker · 25.05.2013, 23:55

1)Ошибка из-за того, что файл ещё не инициализирован, а вы его пытаетесь прочитать.
2)Варианты ответов на кнопках, пишу на свой программе:

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
uses
  GraphABC, ABCbuttons;
 
var
  f: Text;
 
var
  s, s2, okn: string;
 
var
  x, otvety, y: integer;
  answ: char;
  b, b2, b3: ButtonABC;
  mas: array[1..10] of string;
 
procedure otv; forward;
 
procedure otv2; forward;
 
procedure otv3; forward;
 
procedure vivod;
begin
  clearwindow;
  FillWindow(okn);
  s2 := inttostr(otvety);
  textout(0, 0, 'Количество правильных ответов:');
  textout(335, 0, s2);
  
end;
 
procedure files;
begin
  sleep(1000);
  clearwindow;
  FillWindow(okn);
  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(0, x + 60, 60, 50, mas[1], ClWhite);
  b2 := new buttonABC(70, x + 60, 60, 50, mas[2], ClWhite);
  b3 := new buttonABC(140, x + 60, 60, 50, mas[3], ClWhite);
  b.OnClick := otv;
  b2.OnClick := otv2;
  b3.OnClick := otv3;
  if s[1] = 'к' then
  begin
    b.Destroy;
    b2.Destroy;
    b3.Destroy;
    b := new buttonABC(0, x + 60, 100, 70, 'EXIT', ClWhite);
    b.OnClick := closewindow;
  end;
  
end;
 
procedure otv;
begin
  answ := 'а';
  readln(f, s);
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(100, 100, 'Правильно!');
  end
  else
    TextOUT(100, 100, 'Не правильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  files;
end;
 
procedure otv2;
begin
  answ := 'б';
  readln(f, s);
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(100, 100, 'Правильно!');
  end
  else
    TextOUT(100, 100, 'Не правильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  files;
end;
 
procedure otv3;
begin
  answ := 'в';
  readln(f, s);
  if answ = s[19] then 
  begin
    inc(otvety);
    TextOUT(100, 100, 'Правильно!');
  end
  else
    TextOUT(100, 100, 'Не правильно!');
  b.Destroy;
  b2.Destroy;
  b3.Destroy;
  files;
end;
 
procedure okno;
begin
  readln(f, okn);
end;
 
begin
  s := ' ';
  assign(f, 'quest.txt');
  reset(f);
  okno;
  files;
  
end.

3)Вводим переменную - счётчик, и каждый раз, когда она входит в процедуру "files" - он увеличивается на 1, всё же просто)

p.s. программа работает криво, но я для примера показал как это использовать. А теперь прошу меня извинить, я спать. Очень устал. Пишите вопросы - завтра постараюсь ответить. Эксперементируйте + читайте литературу и всё у Вас получится

@PacificABCNET · 26.05.2013, 02:14 **[ТС]**

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

1)Ошибка из-за того, что файл ещё не инициализирован, а вы его пытаетесь прочитать.

это как понять? и как это можно исправить?

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

3)Вводим переменную - счётчик, и каждый раз, когда она входит в процедуру "files" - он увеличивается на 1, всё же просто)

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

Добавлено через 21 минуту
и с вариантами ответов на буквах пока тоже не вышло...

Добавлено через 53 минуты
ура ура, сделал подсчет кол-ва вопросов, подсчет процентов правильных ответов и вывод оценки исходя из процента

@Striker · 26.05.2013, 21:52

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

это как понять? и как это можно исправить?

Вы пытаетесь прочитать файл в процедуре, когда он ещё не открыт для чтения и не инициализирован командой "assign"

@PacificABCNET · 27.05.2013, 18:19 **[ТС]**

как исправить? я просто всяко разно уже делал и ничего не получилось

и как правильно код с кнопками оформить? как будет это выглядеть?

@Striker · 27.05.2013, 18:21

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

как исправить? я просто всяко разно уже делал и ничего не получилось

В главной программе инициализируйте файлы все, которые нужны Вам для работы, а затем выполняйте процедуры.

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

и как правильно код с кнопками оформить? как будет это выглядеть?

Поподробнее пожалуйста, я не понял.

@PacificABCNET · 27.05.2013, 18:45 **[ТС]**

а как делается инициализация?

ну вот когда варианты ответов выводятся на кнопки.

@Striker · 27.05.2013, 18:49

Инициализация:

Pascal
1
assign(f,'name.txt');

Я же писал как на кнопки ответы писать, сообщение выше.

@PacificABCNET · 27.05.2013, 20:36 **[ТС]**

ну я так делал но про запуске теста программа вылетает

@Striker · 27.05.2013, 20:44

Так попробуйте мою запустить: Тык

@PacificABCNET · 27.05.2013, 20:53 **[ТС]**

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

вот весь код...

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;
  repeat
  begin
    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;
    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.

Новые блоги и статьи Все статьи Все блоги /
Установка 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С. Задача: Напишите приложение-калькулятор, которое помогает рассчитывать параметры кредита для аннуитетного и дифференцированного видов. . .	У нас сейчас поговорку "Опять 25" нужно переделать на "Опять +35". kumehtar 04.08.2026 С ностальгией вспоминаю времена моего детства, когда у нас и правда +25 - была максимальная температура летом. Раньше +25 °C реально казались вершиной жары, когда можно было весь день пропадать на. . .	Как ИИ начал спорить и врать (возможно почуяв опасность для себя от индустрии - уход от электроники). Hrethgir 04.08.2026 Недельный диалог, на фоне событий с НПЗ. Да, из спирта можно получать бензин, и это не сложно. Но потом в схеме я решил избавиться от насоса, при этом полностью сделав контроль подачи спирта в. . .	Термопринтер QR701 Argus19 03.08.2026 Термопринтер QR701 Купил два термопринтера QR701. На сэлф-тесте написано: Language: PC936 (GB18030). Что означает, что принтеры могут печатать только латиницу и китайские иероглифы. Так же. . .

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

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

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

@Kordn 158 / 137 / 106 Регистрация: 18.05.2013 Сообщений: 289
	25.05.2013, 22:43
	Попробуйте закрыть программу и опять открыть. У меня тоже такое бывало. 0

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120
	25.05.2013, 22:54 [ТС]
	а все, добавив кнопки проблема была решена Миниатюры 0

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120
	25.05.2013, 23:21 [ТС]
	все хорошо, в тесте работает, но вот когда я вписал когда процедуры в процедуру главного окна вот что выдает мне Миниатюры 0

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120
	25.05.2013, 23:22 [ТС]
	с процентом согласен, но пользователь может задать свое кол-во вопросов, и тогда процент будет неверным. как тогда быть? 0

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

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120
	27.05.2013, 18:45 [ТС]
	а как делается инициализация? ну вот когда варианты ответов выводятся на кнопки. 0

@PacificABCNET 0 / 0 / 1 Регистрация: 22.05.2013 Сообщений: 120
	27.05.2013, 20:36 [ТС]
	ну я так делал но про запуске теста программа вылетает 0

@Striker SausageFlat 242 / 221 / 154 Регистрация: 19.08.2012 Сообщений: 499 Записей в блоге: 1
	27.05.2013, 20:44
	Так попробуйте мою запустить: Тык 0