Pascal/Turbo Pascal - Ayuda con ejercicio en Pascal

   
Vista:

Ayuda con ejercicio en Pascal

Publicado por Elieser eliesergs@gmail.com (4 intervenciones) el 05/01/2015 23:07:12
Saludos, por favor alguien que me ayude con este ejercicio.

La empresa de productos lácteos “Vida y Salud”, es una empresa dedicada a la
elaboración de los siguientes productos lácteos; los cuales se especifican a
continuación:

- Leche Descremada.
- Leche Entera.
- Yogures.
- Helados.

A los fines de realizar sus campañas de ventas y elaborar las adecuadas estrategias
Publicitarias, para así obtener mayores ganancias y posicionarse con ventaja en el
mercado de la elaboración de lácteos, la empresa ha contratado a un especialista en
encuestas para realizar un estudio de mercado, que permita conocer la aceptación del
público en referencia a los diferentes productos fabricados por la empresa.
Dicha encuesta se aplicará a una muestra de 200 personas, tomando en cuenta las siguientes variables:
- Producto.
- Estrato socio‐económico.
- Sexo.
- Edad.

Para que la Gerencia pueda tomar las decisiones pertinentes en lo relacionado a la
elaboración de las campañas de venta y publicidad antes mencionadas; se hace
necesario la elaboración de un sistema automatizado donde se registren los datos
resultantes de la aplicación de las encuestas y que el mismo arroje los resultados
obtenidos en forma clara y precisa.

Para facilitar la comprensión y clasificación de los datos emitidos por el sistema se
definieron las siguientes siglas como estándar de trabajo:

Para los Productos:

- Leche Descremada. (LD).
- Leche Entera. (LE).
- Yogur: (YG).
- Helados: (HE).

Para los estratos socio‐económicos.

- Clase A: (CLA). Clase Alta y Media Alta.
- Clase B: (CLB). Clase Media Típica.
- Clase C: (CLC)‐ Clase Media Baja.

Para sexo.

- Femenino. (F)
- Masculino. (M)

Para edades.

- Juvenil. (EJ)
- Adulto. (AD)
- Adulto Mayor. (ADM)

Dicho Sistema Automatizado, debe cumplir con las siguientes pautas:
Presentar un menú de mantenimiento con las opciones siguientes:

ƒ Incluir
ƒ Consultar
ƒ Modificar
ƒ Eliminar
ƒ Reportes
ƒ Salir del Sistema

• Debe registrar, con la opción Incluir, los siguientes datos:

ƒ Descripción del Producto.
ƒ Total de Personas Encuestadas
ƒ Siglas correspondientes al Producto.
ƒ Estrato Socio‐Económico.
ƒ Edad.
ƒ Sexo.
ƒ Fecha de la Muestra Estadística
ƒ Cantidad de personas que eligen el producto.

• Debe ordenar el registro de la muestra por tipo de producto.
• Mostrar por pantalla, cuando se consulte a un producto por sus siglas, toda la
información referente al mismo.
• Mostrar por pantalla, en la opción Modificar y en la opción Eliminar, un mensaje
de confirmación, donde el usuario ratifica la acción de modificar o eliminar datos
en el sistema.
• Las opciones Consultar, Modificar y Eliminar, harán uso de los mismos datos
registrados en la opción Incluir.
• La opción Reportes, debe generar un cuadro resumen que presente la siguiente
información estadística referente a la encuesta aplicada al producto leche
descremada (LD):
- Cantidad de personas pertenecientes al grupo: Edad Juvenil, Sexo
Femenino, clase A.
- Cantidad de personas pertenecientes al grupo: Edad Juvenil, Sexo Masculino
clase B.
- Cantidad de personas pertenecientes al grupo: Edad Juvenil, Sexo
Femenino, clase C.
- Cantidad de personas pertenecientes al grupo: Adultos, Sexo Femenino,
clase A.
- Cantidad de personas que prefieren al grupo: Adultos, Sexo Masculino, claseA.
- Cantidad de personas que prefieren al grupo: Adultos, Sexo Femenino, claseB.
- Cantidad de personas pertenecientes al grupo: Adultos, Sexo Masculino
clase C.
- Cantidad de personas pertenecientes al grupo: Adultos, Sexo Femenino,
clase C.
- Cantidad de personas pertenecientes al grupo: Adulto Mayor, Sexo
Femenino, clase A.
- Cantidad de personas pertenecientes al grupo: Adulto Mayor, Sexo
Masculino clase B.
- Cantidad de personas pertenecientes al grupo: Adulto Mayor, Sexo
Femenino, clase C

esto seria todo...
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

Ayuda con ejercicio en Pascal

Publicado por crack811 (58 intervenciones) el 06/01/2015 01:43:14
Olle suelta algo de dinero y realizamos tu programa, la verdad no te podemos ayudar si no pones de tu ayuda
aunque sea escribe algo de codigo y despues presenta tus dudas o si no danos algo de plata

No me malinterpretes y pienses que no te queremos ayudar pero tu problema es facil si te aplicas
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

Ayuda con ejercicio en Pascal

Publicado por ramon (2072 intervenciones) el 07/01/2015 00:23:40
La ayuda se da sin pedir sino no es ayuda acle el ejemplo y ponlo demuestra tu buena voluntad o calla y observa resultados estos días an sido de descanso para todos.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
4
Comentar

Ayuda con ejercicio en Pascal

Publicado por crack811 (58 intervenciones) el 07/01/2015 01:07:07
Eso no es ayuda, es hacer el trabajo de alguien que no le da por escribir ni una linea de codigo, si te gusta fomentar eso solo estas haciendo a la gente floja

ramon no se que cosa te pico o porque viene los comentarios pero te doy un consejo no te metas en temas de otras personas, si quieres hacerle el trabajo hazlo y se acabo.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
-3
Comentar

Ayuda con ejercicio en Pascal

Publicado por David (139 intervenciones) el 08/01/2015 14:21:56
Estoy de acuerdo contigo, crack811, una cosa es ayudar en algo puntual y otra resolver problemas completos de gente que ni se molesta en intentarlo. Para mí ni siquiera es cuestión de dinero. La cuestión es que si se supone que están aprendiendo y le resuelves todo, no le estás ayudando.
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
Imágen de perfil de xve

Ayuda con ejercicio en Pascal

Publicado por xve (21 intervenciones) el 08/01/2015 20:17:28
No estoy muy deacuerdo contigo crack811, ya que el código que se publica, puede servir de guía para muchos usuarios a desarrollar sus aplicaciones, y el usuario que lo solicita, puede que solo lo utilice de guía, para luego el aprender y mejorarlo.

yo creo que compartir el código es muy bueno para todos... de seguro que a muchos usuarios les servirá para aprender!!!

Pensar que el open source, es todo código publicado, que cualquier puede visualizar y utilizar... Si no publicáramos los códigos, creo que estamos limitando... nos volveríamos como Microsoft....;)
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

Ayuda con ejercicio en Pascal

Publicado por David (139 intervenciones) el 08/01/2015 23:24:14
No se trata de compartir un código, que además para eso está la sección correspondiente. Se trata de que esto es un foro en el que la gente supuestamente tendría que exponer dudas puntuales. Repito, si alguien está aprendiendo y le hacemos todo el trabajo le hacemos un flaco favor, porque no aprenderá. Aprender es esforzarse y aquí hay gente que pregunta por códigos sin haber escrito siquiera una sola línea.
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

Ayuda con ejercicio en Pascal

Publicado por Elieser (4 intervenciones) el 07/01/2015 03:54:18
Saludos, Ramón mucho sabría agradecer tu ayuda. Soy estudiante de Ingeniería Industrial y no entiendo mucho de programación. Lo que sucede es que este ejercicio me lo pidieron en una materia llamada computación.

Mucho sabría agradecer tu apoyo...

Elieser Graterol
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

Ayuda con ejercicio en Pascal

Publicado por ramon (2072 intervenciones) el 07/01/2015 23:19:00
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
{Mira esto tengo hecho asta esta puedes empezar a ponerlo a tu nivel esto es solo un ejemplo lo demás te lo iré
poniendo }
 
 program productos_lacteos;
 uses
    crt;
  const
     max = 200;
     Productos : array[1..4] of string[2] = ('LD','LE','YG','HE');
     estratos : array['A'..'C'] of string[3] = ('CLA','CLB','CLC');
     edades : array[1..3] of string[3] = ('EJ','AD','ADM');
     sexo : array[1..2] of char = ('F','M');
 
  type
     datosreg = record
           total : integer;
           eligen : integer;
           end;
      datosencuesta = record
              prod : string[2];
              sigl : string[3];
              estr : string[3];
              sex  : char;
              fech : string[12];
            end;
      regfinal = record
             datoencu : array[1..max] of datosencuesta;
             regd : datosreg;
           end;
  var
    encut : regfinal;
    cont : integer;
 
  procedure incluir(var da : datosencuesta);
  var
    tec : char;
    di, me : string[2];
    ao : string[4];
  begin
    repeat
      clrscr;
      gotoxy(10,2);write('***** Datos Encuestado *****');
      with da do
      begin
      gotoxy(2,3);write('<< Elija Producto >>');
      gotoxy(2,5);write('1 = Leche Descremada');
      gotoxy(2,6);write('2 = Leche Entera');
      gotoxy(2,7);write('3 = Yogur');
      gotoxy(2,8);write('4 = Helados');
      repeat
         tec := readkey;
      until tec in['1','2','3','4'];
    case tec of
 '1' : prod := copy(Productos[1],1,2);
 '2' : prod := copy(Productos[2],1,2);
 '3' : prod := copy(Productos[3],1,2);
 '4' : prod := copy(Productos[4],1,2);
   end;
      clrscr;
      gotoxy(10,2);write('***** Datos Encuestado *****');
      gotoxy(2,3);write('<< Elija Estratos Socio-economicos >>');
      gotoxy(2,5);write('A = Clase Alta y Media Alta');
      gotoxy(2,6);write('B = Clase Media Tipica');
      gotoxy(2,7);write('C = Clase Media Baja');
      repeat
         tec := upcase(readkey);
      until tec in['A','B','C'];
    case tec of
 'A' : sigl := copy(estratos['A'],1,3);
 'B' : sigl := copy(estratos['B'],1,3);
 'C' : sigl := copy(estratos['C'],1,3);
    end;
      clrscr;
      gotoxy(10,2);write('***** Datos Encuestado *****');
      gotoxy(2,3);write('<< Elija Edad >>');
      gotoxy(2,5);write('J = Juvenil');
      gotoxy(2,6);write('A = Adulto');
      gotoxy(2,7);write('M = Adulto Mayor');
      repeat
         tec := upcase(readkey);
      until tec in['J','A','M'];
    case tec of
 'J' : estr := copy(edades[1],1,2);
 'A' : estr := copy(edades[2],1,2);
 'M' : estr := copy(edades[3],1,3);
    end;
      clrscr;
      gotoxy(10,2);write('***** Datos Encuestado *****');
      gotoxy(2,3);write('<< Elija Sexo >>');
      gotoxy(2,5);write('M = Masculino');
      gotoxy(2,6);write('F = Femenino');
      repeat
         tec := upcase(readkey);
      until tec in['M','F'];
    case tec of
 'M' : estr := copy(sexo[1],1,1);
 'F' : estr := copy(sexo[2],1,1);
     end;
     clrscr;
     gotoxy(10,2);write('***** Datos Encuestado *****');
     gotoxy(2,3);write('<< Entre Fecha >>');
     gotoxy(2,5);write(' Dia : ');
     gotoxy(9,5);readln(di);
     gotoxy(2,6);write(' Mes : ');
     gotoxy(9,6);readln(me);
     gotoxy(2,7);write(' A¤o : ');
     gotoxy(9,7);readln(ao);
     fech := di + me + ao;
     fech[0] := chr(8);
   end;
   encut.datoencu[cont] := da;
   cont := cont + 1;
   if cont > 200 then
   cont := 200;
   gotoxy(2,9);write('Desea Entrar Mas Encuestados [S/N]');
   repeat
       tec := upcase(readkey);
   until tec in['S','N'];
   until tec = 'N';
   encut.regd.total := cont - 1;
   clrscr;
   gotoxy(10,2);write('***** Datos Encuestado *****');
   gotoxy(2,3);write('El Prodecto Encuestado Fue');
   gotoxy(2,5);write('1 = Leche Descremada');
   gotoxy(2,6);write('2 = Leche Entera');
   gotoxy(2,7);write('3 = Yogur');
   gotoxy(2,8);write('4 = Helados');
   repeat
       tec := readkey;
   until tec in['1','2','3','4'];
   case tec of
 '1' : encut.regd.eligen := 1;
 '2' : encut.regd.eligen := 2;
 '3' : encut.regd.eligen := 3;
 '4' : encut.regd.eligen := 4;
   end;
 end;
 
 
  procedure menu;
  var
    tecla : char;
    sal : boolean;
  begin
     sal := false;
     repeat
      clrscr;
      textcolor(7);
      gotoxy(20,3);write('*** Menu Jeneral ***');
      gotoxy(20,5);write('[I]ncluir');
      gotoxy(20,6);write('[C]onsultar');
      gotoxy(20,7);write('[M]odificar');
      gotoxy(20,8);write('[E]liminar');
      gotoxy(20,9);write('[R]eportes');
     gotoxy(20,10);write('[S]alir del Sistema');
     textcolor(10);
     gotoxy(21,5);write('I');
     gotoxy(21,6);write('C');
     gotoxy(21,7);write('M');
     gotoxy(21,8);write('E');
     gotoxy(21,9);write('R');
    gotoxy(21,10);write('S');
     textcolor(7);
     gotoxy(20,12);write('<<< Elija Opcion >>>');
     repeat
       tecla := upcase(readkey);
     until tecla in['I','C','M','E','R','S'];
     clrscr;
     case tecla of
  'I' : incluir(encut.datoencu[cont]);
  'C' :;
  'M' :;
  'E' :;
  'R' :;
  'S' : sal := true;
    end;
   until sal = true;
  end;
 
 
 
 begin
    cont := 1;
    menu;
 end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
2
Comentar

Ayuda con ejercicio en Pascal

Publicado por ramon (2072 intervenciones) el 08/01/2015 22:30:25
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
¨{Algo mas espero te sirva de ayuda}
 
procedure ordenaarray;
  var
    tempo : datosencuesta;
    h, t : integer;
  begin
     for t := 1 to cont - 1 do
       for h := cont - 1 downto t + 1 do
       if encut.datoencu[t].prod > encut.datoencu[h].prod then
       begin
          tempo := encut.datoencu[t];
          encut.datoencu[t] := encut.datoencu[h];
          encut.datoencu[h] := tempo;
       end;
  end;
 
  procedure consulta;
  var
     consu : string[2];
     h : integer;
     te : char;
  begin
     clrscr;
     gotoxy(10,2);write('*** Consultas ***');
     gotoxy(2,4);write('<<< Elija Sigla >>>');
     gotoxy(2,6);write(' 1 = LD');
     gotoxy(2,7);write(' 2 = LE');
     gotoxy(2,8);write(' 3 = YG');
     gotoxy(2,9);write(' 4 = HE');
     repeat
         te := readkey;
     until te in['1','2','3','4'];
    case te of
 '1' : consu := copy(Productos[1],1,2);
 '2' : consu := copy(Productos[2],1,2);
 '3' : consu := copy(Productos[3],1,2);
 '4' : consu := copy(Productos[4],1,2);
   end;
     clrscr;
     for h := 1 to cont - 1 do
     begin
     if encut.datoencu[h].prod = consu then
     begin
        write('*** Consultas ***');
        writeln;
        writeln(encut.datoencu[h].prod);
        writeln(encut.datoencu[h].sigl);
        writeln(encut.datoencu[h].estr);
        writeln(encut.datoencu[h].sex);
        writeln(encut.datoencu[h].fech);
        writeln;
        writeln('   Pulse Una Tecla');
        readkey;
        clrscr;
       end;
     end;
  end;
 
 
 
{Esto se repite para que veas la colocación en el menu}
  procedure menu;
  var
    tecla : char;
    sal : boolean;
  begin
     sal := false;
     repeat
      clrscr;
      textcolor(7);
      gotoxy(20,3);write('*** Menu Jeneral ***');
      gotoxy(20,5);write('[I]ncluir');
      gotoxy(20,6);write('[C]onsultar');
      gotoxy(20,7);write('[M]odificar');
      gotoxy(20,8);write('[E]liminar');
      gotoxy(20,9);write('[R]eportes');
     gotoxy(20,10);write('[S]alir del Sistema');
     textcolor(10);
     gotoxy(21,5);write('I');
     gotoxy(21,6);write('C');
     gotoxy(21,7);write('M');
     gotoxy(21,8);write('E');
     gotoxy(21,9);write('R');
    gotoxy(21,10);write('S');
     textcolor(7);
     gotoxy(20,12);write('<<< Elija Opcion >>>');
     repeat
       tecla := upcase(readkey);
     until tecla in['I','C','M','E','R','S'];
     clrscr;
     case tecla of
  'I' : begin
           incluir(encut.datoencu[cont]);
           ordenaarray;
         end;
  'C' : consulta;
  'M' :;
  'E' :;
  'R' :;
  'S' : sal := true;
    end;
   until sal = true;
  end;
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
2
Comentar

Ayuda con ejercicio en Pascal

Publicado por Elieser (4 intervenciones) el 08/01/2015 23:35:55
Muchas Gracias Ramon...
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

Ayuda con ejercicio en Pascal

Publicado por ramon (2072 intervenciones) el 09/01/2015 13:26:59
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
¨{Mas del programa}
 
 procedure modificar;
  var
     tes : char;
     nume, u, w : integer;
     modi : array[1..50] of integer;
     tomo : string[2];
     cambi : string[12];
  begin
     clrscr;
     gotoxy(10,2);write('***** Modificar Datos *****');
     gotoxy(2,4);write('Poducto 1 = LD');
     gotoxy(2,5);write('Poducto 2 = LE');
     gotoxy(2,6);write('Poducto 3 = YG');
     gotoxy(2,7);write('Poducto 4 = HE');
     gotoxy(2,9);write('>>> Elija Producto A Modificar <<<');
     repeat
         tes := readkey;
     until tes in['1','2','3','4'];
     case tes of
  '1' : tomo := 'LD';
  '2' : tomo := 'LE';
  '3' : tomo := 'YG';
  '4' : tomo := 'HE';
    end;
      for w := 1 to cont - 1 do
      if encut.datoencu[w].prod = tomo then
      modi[w] := w;
    clrscr;
    u := 1;
    gotoxy(10,2);write('*** Productos Encontrados Son ***');
    for w := 1 to cont - 1 do
    begin
       gotoxy(2,3 + u);write('N.',w,' = ',encut.datoencu[w].prod);
       u := u + 1;
    end;
   repeat
        tes := readkey;
   until (tes in['1'..char((u - 1) + 48)]) or (tes = #27);
   clrscr;
   gotoxy(10,2);write('**** El Producto Selecionado Es ****');
   gotoxy(2,4);write('N. 1 = ',encut.datoencu[ord(tes) - 48].prod);
   gotoxy(2,5);write('N. 2 = ',encut.datoencu[ord(tes) - 48].sigl);
   gotoxy(2,6);write('N, 3 = ',encut.datoencu[ord(tes) - 48].estr);
   gotoxy(2,7);write('N. 4 = ',encut.datoencu[ord(tes) - 48].sex);
   gotoxy(2,8);write('N. 5 = ',encut.datoencu[ord(tes) - 48].fech);
   gotoxy(10,10);write('<<< Elija Dato De Modificacion >>>');
   repeat
        tes := readkey;
   until tes in['1','2','3','4','5'];
   clrscr;
     case tes of
  '1' : begin gotoxy(2,4);write(encut.datoencu[ord(tes) - 48].prod);
              nume := 1; end;
  '2' : begin gotoxy(2,4);write(encut.datoencu[ord(tes) - 48].sigl);
              nume := 2; end;
  '3' : begin gotoxy(2,4);write(encut.datoencu[ord(tes) - 48].estr);
              nume := 3; end;
  '4' : begin gotoxy(2,4);write(encut.datoencu[ord(tes) - 48].sex);
              nume := 4; end;
  '5' : begin gotoxy(2,4);write(encut.datoencu[ord(tes) - 48].fech);
              nume := 5; end;
    end;
    with encut.datoencu[ord(tes) - 48] do
    begin
    if nume = 1 then
    begin
      gotoxy(2,3);write('<< Elija Producto >>');
      gotoxy(2,5);write('1 = Leche Descremada');
      gotoxy(2,6);write('2 = Leche Entera');
      gotoxy(2,7);write('3 = Yogur');
      gotoxy(2,8);write('4 = Helados');
      repeat
         tes := readkey;
      until tes in['1','2','3','4'];
    case tes of
 '1' : cambi := copy(Productos[1],1,2);
 '2' : cambi := copy(Productos[2],1,2);
 '3' : cambi := copy(Productos[3],1,2);
 '4' : cambi := copy(Productos[4],1,2);
      end;
        cambi[0] := chr(2);
     end;
   if nume = 2 then
   begin
      gotoxy(2,3);write('<< Elija Estratos Socio-economicos >>');
      gotoxy(2,5);write('A = Clase Alta y Media Alta');
      gotoxy(2,6);write('B = Clase Media Tipica');
      gotoxy(2,7);write('C = Clase Media Baja');
      repeat
         tes := upcase(readkey);
      until tes in['A','B','C'];
    case tes of
 'A' : cambi := copy(estratos['A'],1,3);
 'B' : cambi := copy(estratos['B'],1,3);
 'C' : cambi := copy(estratos['C'],1,3);
    end;
   end;
   if nume = 3 then
   begin
      gotoxy(2,3);write('<< Elija Edad >>');
      gotoxy(2,5);write('J = Juvenil');
      gotoxy(2,6);write('A = Adulto');
      gotoxy(2,7);write('M = Adulto Mayor');
      repeat
         tes := upcase(readkey);
      until tes in['J','A','M'];
    case tes of
 'J' : cambi := copy(edades[1],1,2);
 'A' : cambi := copy(edades[2],1,2);
 'M' : cambi := copy(edades[3],1,3);
    end;
      cambi[0] := chr(3);
   end;
   if nume = 4 then
   begin
      gotoxy(2,3);write('<< Elija Sexo >>');
      gotoxy(2,5);write('M = Masculino');
      gotoxy(2,6);write('F = Femenino');
      repeat
         tes := upcase(readkey);
      until tes in['M','F'];
    case tes of
 'M' : cambi := copy(sexo[1],1,1);
 'F' : cambi := copy(sexo[2],1,1);
     end;
       cambi[0] := chr(1);
   end;
   if nume = 5 then
   begin
     gotoxy(2,3);write('<< Entre Fecha >>');
     gotoxy(2,5);write('Dia/Mes/A¤o : ');
     gotoxy(16,5);readln(cambi);
    end;
   end;
    gotoxy(10,9);write('Acepta El Cambio [S/N]');
    repeat
        tes := upcase(readkey);
    until tes in['S','N'];
    if tes = 'S' then
    begin
   case nume of
 1 : encut.datoencu[ord(tes) - 48].prod := copy(cambi,1,length(cambi));
 2 : encut.datoencu[ord(tes) - 48].sigl := copy(cambi,1,length(cambi));
 3 : encut.datoencu[ord(tes) - 48].estr := copy(cambi,1,length(cambi));
 4 : encut.datoencu[ord(tes) - 48].sex := cambi[1];
 5 : encut.datoencu[ord(tes) - 48].fech := copy(cambi,1,length(cambi));
   end;
  end;
  end;
 
 
  procedure menu;
  var
    tecla : char;
    sal : boolean;
  begin
     sal := false;
     repeat
      clrscr;
      textcolor(7);
      gotoxy(20,3);write('*** Menu Jeneral ***');
      gotoxy(20,5);write('[I]ncluir');
      gotoxy(20,6);write('[C]onsultar');
      gotoxy(20,7);write('[M]odificar');
      gotoxy(20,8);write('[E]liminar');
      gotoxy(20,9);write('[R]eportes');
     gotoxy(20,10);write('[S]alir del Sistema');
     textcolor(10);
     gotoxy(21,5);write('I');
     gotoxy(21,6);write('C');
     gotoxy(21,7);write('M');
     gotoxy(21,8);write('E');
     gotoxy(21,9);write('R');
    gotoxy(21,10);write('S');
     textcolor(7);
     gotoxy(20,12);write('<<< Elija Opcion >>>');
     repeat
       tecla := upcase(readkey);
     until tecla in['I','C','M','E','R','S'];
     clrscr;
     case tecla of
  'I' : begin
           incluir(encut.datoencu[cont]);
           ordenaarray;
         end;
  'C' : consulta;
  'M' : modificar;
  'E' :;
  'R' :;
  'S' : sal := true;
    end;
   until sal = true;
  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

Ayuda con ejercicio en Pascal

Publicado por ramon (2072 intervenciones) el 10/01/2015 13:40:53
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
{Mas del programa}
 
procedure eliminar;
  var
    tes : char;
    p, z : integer;
    ele : string[2];
    posi : array[1..200] of integer;
    tempo : regfinal;
  begin
     clrscr;
     gotoxy(10,2);write('***** Eliminacion De Datos *****');
     gotoxy(2,4);write('Poducto 1 = LD');
     gotoxy(2,5);write('Poducto 2 = LE');
     gotoxy(2,6);write('Poducto 3 = YG');
     gotoxy(2,7);write('Poducto 4 = HE');
     gotoxy(2,9);write('>>> Elija Producto A Eliminar <<<');
     repeat
        tes := readkey;
     until tes in['1','2','3','4'];
    case tes of
  '1' : ele := 'LD';
  '2' : ele := 'LE';
  '3' : ele := 'YG';
  '4' : ele := 'HE';
    end;
     p := 1;
     for z := 1 to cont - 1 do
     begin
        if encut.datoencu[z].prod = ele then
        begin
            posi[p] := z;
            p := p + 1;
        end;
     end;
     clrscr;
     gotoxy(10,2);write('**** Los Datos Encontrados Son ****');
     for z := 1 to p - 1 do
     begin
        gotoxy(2,3 + z);write('N. ',z,' = ',encut.datoencu[posi[z]].prod);
     end;
      gotoxy(10,(3 + z) + 2);write('??? Cual Desea Eliminar [Esc = Ninguno] ???');
     repeat
      tes := readkey;
     until (tes in['1'..chr(z + 48)]) or (tes = #27);
     if tes in['1'..chr(z + 48)] then
     begin
        for z := 1 to cont - 1 do
        begin
        if z <> posi[ord(tes) - 48] then
        begin
        tempo.datoencu[p] := encut.datoencu[z];
        p := p + 1;
        end;
       end;
        for z := 1 to p - 1 do
        begin
        encut.datoencu[z] := tempo.datoencu[z];
        end;
        cont := z;
     end;
  end;
 
 
  procedure menu;
  var
    tecla : char;
    sal : boolean;
  begin
     sal := false;
     repeat
      clrscr;
      textcolor(7);
      gotoxy(20,3);write('*** Menu Jeneral ***');
      gotoxy(20,5);write('[I]ncluir');
      gotoxy(20,6);write('[C]onsultar');
      gotoxy(20,7);write('[M]odificar');
      gotoxy(20,8);write('[E]liminar');
      gotoxy(20,9);write('[R]eportes');
     gotoxy(20,10);write('[S]alir del Sistema');
     textcolor(10);
     gotoxy(21,5);write('I');
     gotoxy(21,6);write('C');
     gotoxy(21,7);write('M');
     gotoxy(21,8);write('E');
     gotoxy(21,9);write('R');
    gotoxy(21,10);write('S');
     textcolor(7);
     gotoxy(20,12);write('<<< Elija Opcion >>>');
     repeat
       tecla := upcase(readkey);
     until tecla in['I','C','M','E','R','S'];
     clrscr;
     case tecla of
  'I' : begin
           incluir(encut.datoencu[cont]);
           ordenaarray;
         end;
  'C' : consulta;
  'M' : modificar;
  'E' : eliminar;
  'R' :;
  'S' : sal := true;
    end;
   until sal = true;
  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

Ayuda con ejercicio en Pascal

Publicado por ramon (2072 intervenciones) el 14/01/2015 12:54:17
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
{Y el reporte espero sirva suerte}
 
 procedure reporte;
  var
    tec : char;
    sal : boolean;
    repo : array[1..3,1..5] of integer;
    g, h : integer;
  begin
     g := 1;
     h := 1;
     sal := false;
     fillchar(repo,sizeof(repo),0);
    repeat
        if encut.datoencu[h].prod = 'LD' then
        begin
      if encut.datoencu[h].estr = 'EJ' then
      begin
          if (encut.datoencu[h].sex = 'F') and
             (encut.datoencu[h].sigl = estratos['A']) then
             repo[1,1] := repo[1,1] + 1;
          if (encut.datoencu[h].sex = 'M') and
             (encut.datoencu[h].sigl = estratos['B']) then
             repo[1,2] := repo[1,2] + 1;
          if (encut.datoencu[h].sex = 'F') and
             (encut.datoencu[h].sigl = estratos['C']) then
             repo[1,3] := repo[1,3] + 1;
      end;
      if encut.datoencu[h].estr ='AD' then
      begin
         if (encut.datoencu[h].sex = 'F') and
             (encut.datoencu[h].sigl = estratos['A']) then
             repo[2,1] := repo[2,1] + 1;
         if (encut.datoencu[h].sex = 'M') and
             (encut.datoencu[h].sigl = estratos['A']) then
             repo[2,2] := repo[2,2] + 1;
         if (encut.datoencu[h].sex = 'F') and
             (encut.datoencu[h].sigl = estratos['B']) then
             repo[2,3] := repo[2,3] + 1;
         if (encut.datoencu[h].sex = 'M') and
             (encut.datoencu[h].sigl = estratos['C']) then
             repo[2,4] := repo[2,4] + 1;
         if (encut.datoencu[h].sex = 'F') and
             (encut.datoencu[h].sigl = estratos['C']) then
             repo[2,5] := repo[2,5] + 1;
      end;
        if encut.datoencu[h].estr = 'ADM' then
        begin
           if (encut.datoencu[h].sex = 'F') and
             (encut.datoencu[h].sigl = estratos['A']) then
             repo[3,1] := repo[3,1] + 1;
           if (encut.datoencu[h].sex = 'M') and
             (encut.datoencu[h].sigl = estratos['B']) then
             repo[3,2] := repo[3,2] + 1;
           if (encut.datoencu[h].sex = 'F') and
             (encut.datoencu[h].sigl = estratos['C']) then
             repo[3,3] := repo[3,3] + 1;
        end;
     end;
     h := h + 1;
     if h > cont - 1 then
     sal := true;
    until sal = true;
    clrscr;
    gotoxy(10,2);write('**** Reporte De ',Productos[1],' ****');
    gotoxy(1,4);write('EJ/F/A = ',repo[1,1]);
    gotoxy(1,5);write('EJ/M/B = ',repo[1,2]);
    gotoxy(1,6);write('EJ/F/C = ',repo[1,3]);
    gotoxy(1,7);write('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
    gotoxy(1,8);write('AD/F/A = ',repo[2,1]);
    gotoxy(1,9);write('AD/M/A = ',repo[2,2]);
    gotoxy(1,10);write('AD/F/B = ',repo[2,3]);
    gotoxy(1,11);write('AD/M/C = ',repo[2,4]);
    gotoxy(1,12);write('AD/F/C = ',repo[2,5]);
    gotoxy(1,13);write('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
    gotoxy(1,14);write('ADM/F/A = ',repo[3,1]);
    gotoxy(1,15);write('ADM/M/B = ',repo[3,2]);
    gotoxy(1,16);write('ADM/F/C = ',repo[3,3]);
    gotoxy(10,18);write('<<<< Pulse Una Tecla >>>>');
    readkey;
  end;
 
 
  procedure menu;
  var
    tecla : char;
    sal : boolean;
  begin
     sal := false;
     repeat
      clrscr;
      textcolor(7);
      gotoxy(20,3);write('*** Menu Jeneral ***');
      gotoxy(20,5);write('[I]ncluir');
      gotoxy(20,6);write('[C]onsultar');
      gotoxy(20,7);write('[M]odificar');
      gotoxy(20,8);write('[E]liminar');
      gotoxy(20,9);write('[R]eportes');
     gotoxy(20,10);write('[S]alir del Sistema');
     textcolor(10);
     gotoxy(21,5);write('I');
     gotoxy(21,6);write('C');
     gotoxy(21,7);write('M');
     gotoxy(21,8);write('E');
     gotoxy(21,9);write('R');
    gotoxy(21,10);write('S');
     textcolor(7);
     gotoxy(20,12);write('<<< Elija Opcion >>>');
     repeat
       tecla := upcase(readkey);
     until tecla in['I','C','M','E','R','S'];
     clrscr;
     case tecla of
  'I' : begin
           incluir(encut.datoencu[cont]);
           ordenaarray;
         end;
  'C' : consulta;
  'M' : modificar;
  'E' : eliminar;
  'R' : reporte;
  'S' : sal := true;
    end;
   until sal = true;
  end;
 
 
 
 begin
    cont := 1;
    menu;
 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

Ayuda con ejercicio en Pascal

Publicado por obom (4 intervenciones) el 29/01/2015 20:40:27
gronnyobom@gmail.com conectame a este correo y nos ponemos de acuerdo.....
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

Ayuda con ejercicio en Pascal

Publicado por obom (4 intervenciones) el 29/01/2015 20:51:31
crack811 - Saludos, espero hacer un contacto ...comunicate y nos ponemos de acuerdo.... gronnyobom@gmail.com
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

Ayuda con ejercicio en Pascal

Publicado por Chipiplin chipiplin@me.com (1 intervención) el 09/02/2015 05:29:43
Que tal amigo, podrías contactarme para hablar del programa, mi correo es chipiplin@me.com, espero tu pronta respuesta ya que me urge realizar dicho programa
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