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

@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.

Новые блоги и статьи Все статьи Все блоги /
Модель здравосохранения 17. Планы на выгорание anaschu 23.05.2026 Вот конкретная схема реализации: В классе Работник добавить: накопленнаяУсталость — растёт каждый час работы, снижается в перерывы и болезни коэффициентПрезентеизма — снижает продуктивность. . .	Изменение цветов в палитре gif файла aka фавикона russiannick 23.05.2026 Изменение цветов в палитре gif файла, юзаемого как фавиконка в составе html-файла, помещенная в base64, средствами нативного Java Script, навеянное сном в майский день. Для работы необходим браузер,. . .	Модель здравосохранения 16. Слишком хорошие и здоровые сотрудники уходят, недовольные зарплатой anaschu 23.05.2026 Отладка увольнений и настройка производительности Сегодня во второй половине дня разобрались с механикой увольнений и настроили коэффициент сложности заданий. Вот что было сделано. . . .	Как я стал коммунистом))) Модель сохранения здоровья сотрудников, запись блога номер 15 anaschu 23.05.2026 Внезапно хорошее здоровье сотрудников не нужно капиталистам?))
Модель здравоСохранения 15. Как мы чинили AnyLogic модель рабочего коллектива: сочленение диаграммы состояний болезней и поломок в ресурспул anaschu 23.05.2026 Как мы чинили AnyLogic модель рабочего коллектива Сегодня разобрались с пятью багами, из-за которых модель либо падала с ошибкой, либо давала совершенно бессмысленные результаты. Каждый баг был. . .	Диалоги с ИИ zorxor 23.05.2026 Насколько я понимаю - Вы - Искусственный Интеллект. Это так? Да, всё верно. Я — искусственный интеллект. Я представляю собой большую языковую модель, созданную для помощи в самых разных задачах. . . .	Модель здравосохранения 14. Собираем всю модель вместе. anaschu 22.05.2026 Модель собрана. В будущих постах на видео я покажу, как она работает. В этом посте запускаем её, проверяем результаты и разбираем что можно с ней делать дальше. Перед запуском проверяем. . .	Модель здравоохранения 13. Добавление самой системы здравоохранения. anaschu 22.05.2026 В предыдущем посте мы настроили болезни. Теперь добавим события, которые управляют здоровьем всего коллектива, а также настроим рабочий график и расчёт финансов. В Main создаём четыре события. . . .

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

	Составить программу, которая будет считывать задания с файла 24.05.2013, 14:10. Показов 6646. Ответов 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