Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Pascal/Turbo Pascal » Procedimientos y funciones

Pascal/Turbo Pascal - Procedimientos y funciones

Volver
Nuevo Tema
<<>>
 
Vista:

Procedimientos y funciones

Publicado por gregory (2 intervenciones) el 27/10/2014 04:46:04
Buenas me podrian ayudar con este programa

El emperador, desea que el departamento de informática le desarrolle una aplicación en pascal que le permita el control de los productos que mantiene en su almacén.

para ello cuenta con los siguientes datos de los productos:

Codigo: 5 caracteres.
Nombre: 20 caracteres.
Precio: real
Existencia: entero

trabajo a realizar:

a)defina un tipo de datos (registro) que permita almacenar dichos campos.

b)defina un vector suficientemente grande de dichos registros.

c)escriba los subprogramas necesarios para realizar las siguientes operaciones:

*agregar: consiste en introducir nuevos productos con todos sus datos.

*eliminar: consiste en eliminar ¨Logicamente¨ un producto.

*Modificaciones: se introduce el codigo del producto, se muestra y se piden todos sus datos.

*Consultas: Pueden ser de dos tipos, por producto pidiendo el codigo y mostrando todos sus datos; general, mostrando el
listado de todos los productos con sus datos.

*consultas: pueden ser de dos tipos, por producto pidiendo el codigo y mostrando todos sus datos; general, mostrando el listado de todos los productos con sus datos.

*recuperar: permite recuperar un producto previamente eliminado.

*consumos:consiste en introducir el gasto realizado por el producto para un menu

-escriba un programa comandado por un menu con las operaciones del apartado anterior debera tener en cuenta lo siguiente:

*elavorar el programa haciendo uso de procedimientos y funciones

*los consumos no deben ser mayores a las cantidades existentes
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

Procedimientos y funciones

Publicado por ramon (2158 intervenciones) el 27/10/2014 21:08:14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
{A ver si esto hayuda}
 
 program emperador;
  uses
     crt;
  const
     tama = 10;
 
  type
    string5 = string[5];
    string20 = string[20];
 
    regemper = record
        Codigo : string5;
        Nombre : string20;
        Precio : real;
    Existencia : integer;
        activo : boolean;
      end;
 
  var
    emper : array[1..tama] of regemper;
    cont : integer;
 
  procedure agregar;
  begin;
      cont := cont + 1;
      if cont <= tama then
      begin
      clrscr;
      fillchar(emper[cont],sizeof(emper[cont]),0);
      with emper[cont] do
      begin
      writeln('   ***** Agregar Producto *****');
      writeln;
      write('   Entre Codigo max 5 Caracteres  : ');
      readln(codigo);
      write('   Entre Nombre max 20 Caracteres : ');
      readln(nombre);
      write('   Entre Precio                   : ');
      readln(precio);
      write('   Entre Existencia               : ');
      readln(existencia);
      activo := true;
      end;
    end
 else
     begin
        writeln('Array De Datos Completo Pulse Una Tecla');
        readkey;
     end;
  end;
 
  procedure eliminar;
  var
     codi : string5;
     t : integer;
     tev : char;
  begin
      clrscr;
      writeln('   **** Eliminar Un Producto ****');
      writeln;
      write('   Entre Codigo : ');
      readln(codi);
      for t := 1 to cont do
      if emper[t].activo = true then
      begin
         if emper[t].codigo = codi then
         begin
           writeln('  Esta Seguro Que Quiere Eliminar ',codi,' S/N');
           repeat
               tev := upcase(readkey);
           until tev in['S','N'];
           if tev = 'S' then
           begin
              emper[t].activo := false;
           end;
           break;
         end;
      end;
  end;
 
  procedure Modificaciones;
  var
     codi : string5;
     t : integer;
     camb, esta : boolean;
     tev : char;
     co : string5;
     no : string20;
     pr : real;
     ex : integer;
  begin
     clrscr;
     writeln('  **** Modificacion De Datos ****');
     writeln;
     write('   Entre Codigo : ');
     readln(codi);
     esta := false;
     camb := false;
     for t := 1 to cont do
     begin
        if emper[t].activo = true then
        begin
           if emper[t].codigo = codi then
           begin
              clrscr;
              writeln('  Codigo   Nombre     Precio     Existencias');
              with emper[t] do
              begin
                writeln('  ',codigo,'     ',nombre,'     ',precio:0:2,
                           '     ',existencia);
                writeln;
                co := emper[t].codigo;
                no := emper[t].nombre;
                pr := emper[t].precio;
                ex := emper[t].existencia;
              repeat
               writeln('  Elija Valor A Modificar ');
               writeln;
               writeln('  1 = Codigo');
               writeln('  2 = Nombre');
               writeln('  3 = Precio');
               writeln('  4 = Existencias');
               writeln('  5 = salir Y Guardar');
               writeln('  6 = Salir Sin Cambiar Nada');
               writeln;
               writeln('   Elija Opcion');
               tev := readkey;
               clrscr;
         case tev of
    '1' : begin
             camb := true;
             write('   Entre Codigo Nuevo : ');
             readln(emper[t].codigo);
          end;
    '2' : begin
             camb := true;
             write('   Entre Nombre Nuevo : ');
             readln(emper[t].nombre);
          end;
    '3' : begin
             camb := true;
             write('   Entre Precio Nuevo : ');
             readln(emper[t].precio);
          end;
    '4' : begin
             camb := true;
             write('   Entre Existencia Nuevo : ');
             readln(emper[t].existencia);
          end;
    '5' : if camb = true then
          begin
 
          end
       else
          tev := '6';
       end;
          until tev in['5','6'];
           if tev = '6' then
           begin
              emper[t].codigo := co;
              emper[t].nombre := no;
              emper[t].precio := pr;
              emper[t].existencia := ex;
           end;
              esta := true;
              break;
           end;
        end;
     end;
   end;
   if esta = false then
   begin
     writeln('   Codigo No Encontrado Pulse Una Tecla ');
     readkey;
   end;
  end;
 
  procedure Consultas;
  var
    t : integer;
    tec : char;
    codi : string5;
    encont : boolean;
  begin
     clrscr;
     writeln('   **** Consulta De Datos ****');
     writeln;
     write('   Por Codigo[P]  Ver Todo[T]  Y Nada[N]');
     repeat
         tec := upcase(readkey);
     until tec in['P','T','N'];
   if tec = 'P' then
   begin
       clrscr;
       encont := false;
       writeln('  *** Ver Producto Por Codigo ***');
       writeln;
       write('  Entre Codigo : ');
       readln(codi);
       for t := 1 to cont do
       begin
          if emper[t].activo = true then
          begin
             clrscr;
             if emper[t].codigo = codi then
             begin
                writeln('   Los Datos De ',codi,' Son');
                writeln;
                writeln('  Codigo   Nombre     Precio     Existencias');
                with emper[t] do
                begin
                  writeln('  ',codigo,'     ',nombre,'     ',precio:0:2,
                                                     '     ',existencia);
                  writeln;
                  writeln('   Pulse Una Tecla');
                end;
                readkey;
                encont := true;
                break;
             end;
          end;
       end;
   end;
   if tec = 'T' then
   begin
    writeln('   Los Datos De  Son');
    writeln;
    writeln('  Codigo   Nombre     Precio     Existencias');
    for t := 1 to cont do
    begin
      if emper[t].activo = true then
      begin
        with emper[t] do
        begin
          writeln('  ',codigo,'     ',nombre,'     ',precio:0:2,
                  '     ',existencia);
        end;
       end;
      end;
        writeln;
        writeln('   Pulse Una Tecla');
        readkey;
     end;
  end;
 
  procedure recuperar;
     var
     codi : string5;
     t : integer;
     tev : char;
  begin
      clrscr;
      writeln('   **** Recuperar Un Producto ****');
      writeln;
      write('   Entre Codigo : ');
      readln(codi);
      for t := 1 to cont do
      if emper[t].activo = false then
      begin
         if emper[t].codigo = codi then
         begin
           writeln('  Esta Seguro Que Quiere Recuperar ',codi,' S/N');
           repeat
               tev := upcase(readkey);
           until tev in['S','N'];
           if tev = 'S' then
           begin
              emper[t].activo := true;
           end;
           break;
         end;
      end;
  end;
 
  procedure consumos;
  var
    t : integer;
    consu : integer;
    codi : string5;
    encon : boolean;
  begin
     encon := false;
     writeln('  ***** Entrada De Consumo Del Producto ****');
     writeln;
     write('   Entre codigo Del Producto : ');
     readln(codi);
     for t := 1 to cont do
     begin
         if emper[t].codigo = codi then
         begin
            write('  Entre Consumo : ');
            readln(consu);
            if consu <= emper[t].existencia then
            emper[t].existencia := emper[t].existencia - consu
          else
            begin
            writeln('  Cometio Un Error Gasto Mas De La Existente');
            writeln('  No Se Modifica La Existencia Pulse Una Tecla');
            readkey;
            end;
            encon := true;
            break;
         end;
     end;
       if encon = false then
       begin
          writeln('  Error De Entrada El Codigo No Existe');
          writeln('  Pulse Una Tecla');
          readkey;
       end;
  end;
 
  procedure menu;
  var
    sal : boolean;
    tecla : char;
  begin
     sal := false;
    repeat
      clrscr;
      writeln('  ***** Menu Jeneral *****');
      writeln;
      writeln('  1 = agregar');
      writeln('  2 = eliminar');
      writeln('  3 = Modificaciones');
      writeln('  4 = Consultas');
      writeln('  5 = recuperar');
      writeln('  6 = consumos');
      writeln('  7 = Salir');
      writeln;
      writeln('  <<<< Elija Una Opcion >>>>');
      repeat
          tecla := readkey;
      until tecla in['1','2','3','4','5','6','7'];
    case tecla of
 '1' : begin
          clrscr;
          agregar;
       end;
 '2' : begin
       clrscr;
       eliminar;
       end;
 '3' : begin
       clrscr;
       Modificaciones;
       end;
 '4' : begin
       clrscr;
       Consultas;
       end;
 '5' : begin
       clrscr;
       recuperar;
       end;
 '6' : begin
       clrscr;
       consumos;
       end;
 '7' : sal := true;
    end;
    until sal = true;
  end;
 
 
  begin
      cont := 0;
      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
1
Comentar

Procedimientos y funciones

Publicado por gregory (2 intervenciones) el 29/10/2014 01:28:46
Gracias me ayudo a culminar el que ya yo tenia :)
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