Pascal/Turbo Pascal - examen aleatorio de opcion multiple

 
Vista:
sin imagen de perfil

examen aleatorio de opcion multiple

Publicado por german (2 intervenciones) el 16/06/2015 06:19:13
hola necesito ayuda en lo siguiente, necesito crear un programa que simule un examen de opción múltiple, pero que las preguntas sean de forma aleatoria, que existan por lo menos 15 preguntas, pero que en el examen me aparezcan solo 10 de forma aleatoria, y que valla sumando de un solo las que son correctas y incorrectas, y que me de una calificación, de antemano muchas gracias, yo e intentado pero no me sale nada, el tema del cual son las preguntas aun no me lo han dado, y lo aran rifado, pero quiero empezar a trabajar en ello, gracias y bendiciones
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

examen aleatorio de opcion multiple

Publicado por ramon (2158 intervenciones) el 16/06/2015 22:16:41
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
{Mira esto}
 
 program examem;
  uses
     crt;
     type
       pregu = record
          preg : string[100];
          resp : string[100];
         end;
 
     const
         preguntas : array[1..15] of pregu = (
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '),
       (preg : ' ';resp : ' '));
 
 
  var
    respuesta : string[100];
    correctas, incorrectas : integer;
    lapre, pp, aleatorio : integer;
    pregunta : array[1..15] of integer;
    f : file of pregu;
    dato : pregu;
 
 
   procedure guardadatos;
   var
      i : integer;
   begin
      assign(f,'Adipreg.dat');
   {$I-} reset(f); {$I+}
      if ioresult <> 0 then
      begin
         rewrite(f);
         for i := 1 to 15 do
         begin
         dato.preg := preguntas[i].preg;
         dato.resp := preguntas[i].resp;
         seek(f,i - 1);
         write(f,dato);
         end;
         close(f);
      end
   else
       begin
          close(f);
          erase(f);
          assign(f,'Adipreg.dat');
          rewrite(f);
         for i := 1 to 15 do
         begin
         dato.preg := preguntas[i].preg;
         dato.resp := preguntas[i].resp;
         seek(f,i - 1);
         write(f,dato);
         end;
         close(f);
       end;
   end;
 
 
   function tamadatos : boolean;
   var
      i : integer;
   begin
      assign(f,'Adipreg.dat');
   {$I-} reset(f); {$I+}
      if ioresult <> 0 then
      begin
         tamadatos := false;
         writeln('   Error de archivo o no existe pulse una tecla');
         readkey;
      end
    else
        begin
           for i := 1 to 15 do
           begin
              seek(f,i - 1);
              read(f,dato);
              preguntas[i].preg := dato.preg;
              preguntas[i].resp := dato.resp;
           end;
              close(f);
              tamadatos := true;
        end;
   end;
 
 
   procedure entrada_preguntas;
   var
      h : integer;
     begin
      for h := 1 to 15 do
      begin
         writeln('  ******* Entrada Preguntas y respuestas ******');
         writeln;
         write('   Pregnta N. ',h,'   : '); readln(preguntas[h].preg);
         write('   Respuesta N. ',h,' : '); readln(preguntas[h].resp);
      end;
      guardadatos;
   end;
 
   procedure cual(var cualtoca : integer);
   var
     esta : boolean;
     t : integer;
   begin
       esta := false;
      aleatorio := random(30) + 1;
       for t := 1 to 15 do
       begin
       if pregunta[t] = aleatorio then
        esta := true;
       end;
       if esta = true then
       cual(cualtoca)
    else
        begin
       cualtoca := aleatorio;
       pregunta[pp] := aleatorio;
       pp := pp + 1;
   end;
  end;
 
 
   procedure lapregunta;
   var
     j : integer;
   begin
      clrscr;
       cual(lapre);
       writeln('    La Pregunta Es : ',preguntas[lapre].preg);
       writeln;
       write('   La Respuesta Es = ');
       readln(respuesta);
       for j := 1 to length(preguntas[lapre].resp) do
       preguntas[lapre].resp[j] := upcase(preguntas[lapre].resp[j]);
       for j := 1 to length(respuesta) do
       respuesta[j] := upcase(respuesta[j]);
       clrscr;
       writeln('    **** La Respuesta ****');
       if preguntas[lapre].resp = respuesta[j] then
       begin
       writeln('   Respuesuta Cierta ');
       end
    else
        begin
          writeln('   Respuesta Negativa ');
        end;
        readkey;
   end;
 
 
   begin
      clrscr;
      fillchar(preguntas,sizeof(preguntas),' ');
      entrada_preguntas;
      randomize;
      pp := 1;
      if tamadatos = true then
      lapregunta
   else
      begin
         writeln('   Falta Archivo De Datos Pulse Una Tecla');
         readkey;
      end;
   end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

examen aleatorio de opcion multiple

Publicado por luis (1 intervención) el 01/11/2017 02:03:24
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
program tareafinal;
uses crt
TYPE
tipopregu=record
   preg:string[100];
   resp:string[100];
  end;
const
  preguntas:array[1..11] of pregu=(
  (preg:'Capital de antolin del campo?';resp:'paraguachi'),
  (preg:'Capital de arismendi?';resp:'la asuncion'),
  (preg:'Capital de antonio diaz?';resp:'san juan'),
  (preg:'Capital de garcia?';resp:'el valle'),
  (preg:'Capital de gomez?';resp:'santa ana'),
  (preg:'Capital de maneiro?';resp:'pampatar'),
  (preg:'Capital de marcano?';resp:'juan griego'),
  (preg:'Capital de mariño?';resp:'porlamar'),
  (preg:'Capital de macanao?';resp:'boca del rio'),
  (preg:'Capital de tubores?';resp:'punta de piedras'),
  (preg:'Capital de villalba?';resp:'coche') );
 
  Var
   respuesta:string[100];
   correctas,incorrectas:integer;
   lapre,pp,aleatorio:integer;
   pregunta:array[1..11] of integer;
   f: file of pregu;
   dato:pregu;
 
   procedure guardadatos;
   var
   i:integer;
   begin
   assing(f,'Adipreg.dat');
   {SI-} reset(f); {SI+}
     if ioresult<> o then
     begin
    rewrite(f);
    for i:=1 to 11 do
    begin
    dato.preg:=preguntas[i]:pregu;
    dato.preg:=preguntas[i]:resp;
    seek(f,i-1);
    write(f,dato);
    end;
    close(f);
   end
 else
   begin
   close(f);
   erase(f);
   assign(f,'Adipreg.dat');
   rewrite(f);
   for i:=1 to 11 do
   begin
   dato.preg:= preguntas[i].preg;
   dato.preg:= preguntas[i].resp;
   seek(f,i-1);
  write(f,dato);
  end;
  close(f);
  end;
  end;
 
  function tamadatos: boolean;
  var
  i:integer;
  begin
  assign(f,'Adipreg.dat');
  {SI-} reset(f); {SI+}
  if ioresult <> o then
  begin
   tamadatos:= false;
    writeln('Error de archivo o no existe pulse una tecla');
    readkey;
   end
  else
    begin
      for i:= 1 to 11 do
      begin
       seek(f,i-1);
       read(f,dato);
       preguntas[i].preg:=dato.preg;
       preguntas[i].preg:=dato.resp;
      end;
       close(f);
       tamadatos:=true;
      end;
     end;
 
     procedure entrada_preguntas;
     var
      h:integer;
      begin
      for h:=1 to 11 do
      begin
       writeln('***** Entrada de Preguntas y respuestas *****');
        writeln('Pregunta N. ',h,' :');readln(preguntas[h].preg);
         writeln('Respuesta N. ',h,' :');readln(preguntas[h].resp);
        end;
        guardadatos;
        end;
 
   procedure cual(var cualtoca:integer);
   var
   esta:boolean;
   t:integer;
  begin
   esta:=false;
   aleatorio:=random(30)+1;
   for t:=1 to 11 do
   begin
   if pregunta[t]=aleatorio then
   esta:=true;
   end;
   if esta=true then
   cual(cualtoca)
  else
    begin
    cualtoca:=aleatorio;
    pregunta[pp]:=aleatorio;
    pp:=pp+1;
   end;
  end;
  procedure lapregunta;
  var
  j:integer;
  begin
  clrscr;
  cual(lapre);
  writeln('La pregunta Es:',preguntas[lapre].preg);
  writeln('La Respuesta Es=');
  readln(respuesta);
  for j:=1 to length(preguntas[lapre].resp)do
  preguntas[lapre].resp[j]:=upcase(preguntas[lapre].resp[j]);
  clrscr;
  writeln('*** La Respuesta ***');
  if preguntas[lapre].resp=respuesta[j] then
  begin
  writeln(' Respuesta Cierta');
  end
 else
    begin
     writeln('Respuesta Negativa');
     end;
     readkey;
    end;
    begin
     clrscr;
     fillchar(preguntas,sizeof(preguntas),'');
     entrada_preguntas;
     randomize;
     pp:=1;
     if tamadatos= true then
     lapregunta
    else
      begin
      writeln('Falta Archivo De Datos Pulse Una Tecla');
      readkey;
     end;
    end.


Me dio error por?
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar