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 » comercio de productos

Pascal/Turbo Pascal - comercio de productos

Volver
Nuevo Tema
<<>>
 
Vista:

comercio de productos

Publicado por paulett (14 intervenciones) el 13/11/2013 04:57:09
hola quisiera que me ayudes urgente es para una presentacion y estoy renerviosa: mi proyect es un comercio de productos para vender.
yo hice tres registros una lista un vector y dos archivos no de texto; esto me piden....
ingreso compra de tres proveedores especifico por producto: su cantidad; precio, proveedor codigo y una marca en el 1er archivo cargo datos de compra en el 2ª lo copio pero actualizado o sea al precio unitario agrego un 45% y las cantidades k habia antes la sumo de este modifico su stock a medida que entran pedidos chequeo si hay stock y le resto.
en una lista cargo del archivo todos los pedidos mostrando cod. cantidad precio uni y precio total.
en un arreglo quiero cargar los productos que quedaron con stock ,ordenarlos para el que quedó con mayor cant. lo elimino del archivo de forma fisica.
otro arreglo que muestre los productos sin stock para hacer pedidos a los proveedores; solo para mirarlo.
por fa ayudam stoy hace diez dias que trato de hacerlo y no me sale en free pascal.
gracias de antemano.
espero respuesta
besos.
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

comercio de productos

Publicado por ramon (2158 intervenciones) el 13/11/2013 14:38:53
Puedes poner los registros para ayudarte mejor así me basare en algo tuyo.
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

comercio de productos

Publicado por paulett (14 intervenciones) el 13/11/2013 15:02:18
Gracias alli vá los datos que coloqué
prod_compra=record
cod:integer;
cant:integer;
preciouni:real; **//archivo de compra de prod. y tbn para vta actualizado precios y
proveedor:integer; cantidad si hay anterior en stock//**
marca:boolean;
end;

pedidos=record
cod:integer;
cant:integer;
preciounit:real; **//quiero armar un archivo de pedidos para luego volcarlo de for
preciotot:real; ma ordenada en la lista//**
provee:integer;
marca:boolean;
end;

lista=^nodo;
nodo=record
cod:integer;
cant:integer; **/lista para pedidos//***
precio:real;
totalr:integer;
psig:lista
end;

archivo= file of prod_compra;
vector2= array [1..ma] // ma const= 1000 arriba declrare//**

archivo3=file of pedidos
hola quisiera que me ayudes urgente es para una presentacion y estoy renerviosa: mi proyect es un comercio de productos para vender.
yo hice tres registros una lista un vector y dos archivos no de texto; esto me piden....
ingreso compra de tres proveedores especifico por producto: su cantidad; precio, proveedor codigo y una marca en el 1er archivo cargo datos de compra en el 2ª lo copio pero actualizado o sea al precio unitario agrego un 45% y las cantidades k habia antes la sumo de este modifico su stock a medida que entran pedidos chequeo si hay stock y le resto.
en una lista cargo del archivo todos los pedidos mostrando cod. cantidad precio uni y precio total.
en un arreglo quiero cargar los productos que quedaron con stock ,ordenarlos para el que quedó con mayor cant. lo elimino del archivo de forma fisica.
otro arreglo que muestre los productos sin stock para hacer pedidos a los proveedores; solo para mirarlo.
por fa ayudam stoy hace diez dias que trato de hacerlo y no me sale en free pascal.
gracias de antemano.
espero respuesta
besos.
hola quisiera que me ayudes urgente es para una presentacion y estoy renerviosa: mi proyect es un comercio de productos para vender.
yo hice tres registros una lista un vector y dos archivos no de texto; esto me piden....
ingreso compra de tres proveedores especifico por producto: su cantidad; precio, proveedor codigo y una marca en el 1er archivo cargo datos de compra en el 2ª lo copio pero actualizado o sea al precio unitario agrego un 45% y las cantidades k habia antes la sumo de este modifico su stock a medida que entran pedidos chequeo si hay stock y le resto.
en una lista cargo del archivo todos los pedidos mostrando cod. cantidad precio uni y precio total.
en un arreglo quiero cargar los productos que quedaron con stock ,ordenarlos para el que quedó con mayor cant. lo elimino del archivo de forma fisica.
otro arreglo que muestre los productos sin stock para hacer pedidos a los proveedores; solo para mirarlo.
por fa ayudam stoy hace diez dias que trato de hacerlo y no me sale en free pascal.
gracias de antemano.
espero respuesta
besos.
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

comercio de productos

Publicado por ramon (2158 intervenciones) el 13/11/2013 16:29:59
Visto tu planteamiento mira.
Fíjate en estas estructuras veras que son parecidas a las tuyas pero
te aclaro, en el vector que pones puedes cargar 1000 registros de lo que
marque, pero la memoria no sera suficiente para albergar todos y tendrás
problemas.
En este caso trabajaremos con punteros lo cual nos dará toda la memoria del
ordenador sin problemas.
Referente al archivo tendremos solo uno que manejaremos como queramos ya que
en el se encuentran todos los datos de todos los proveedores los stock y las
ventas.
Podremos ordenar como queramos y presentar los datos que en ese momento
interesen.
Confirmarme si te parece bien así o tomo tu ejemplo.

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
stock = record
       cantidad : integer;
          codig : longint;
        end;
 
  productos_ven = record
           codigo    : longint;
           cantidad  : integer;
           precioini : real;
        end;
 
  puntero = ^pro_pedidos;
  pro_pedidos = record
        codigo    : longint;
        cantidad  : integer;
        preciocmp : real;
        precioven : real;
        marca     : string[80];
        stocktot  : stock;
        incre45   : real;
        ventas    : productos_ven;
        sig       : puntero;
       end;
 
   var
     f : file of pro_pedidos;
     datos : pro_pedidos;
     primer, actual, anterior : puntero;
     tecla : char;
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

comercio de productos

Publicado por ramon (2158 intervenciones) el 13/11/2013 18:58:21
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
{Mira seria algo así}
 
program ventasd;
 uses
   crt;
 type
  stock = record
          codig : longint;
       cantidad : integer;
        end;
 
  productos_ven = record
           codigo    : longint;
           cantidad  : integer;
           preciopub : real;
        end;
 
  puntero = ^pro_pedidos;
  pro_pedidos = record
        codigo    : longint;
        cantidad  : integer;
        preciocmp : real;
        precioven : real;
        marca     : boolean;
        stocktot  : stock;
        incre45   : real;
        ventas    : productos_ven;
        sig       : puntero;
       end;
 
   var
     f : file of pro_pedidos;
     datos : pro_pedidos;
     primer, actual, anterior : puntero;
     tecla : char;
     vuscodi : longint;
 
 
   procedure entradad(var en : pro_pedidos);
   var
      impo : real;
   begin
      with en do
      begin
         clrscr;
         vuscodi := 0;
         writeln('  ***** Entrada Proveedor *****');
         writeln;
         write('   Codigo Proveedor   : ');
         readln(codigo);
         vuscodi := codigo;
         write('   Cantidad           : ');
         readln(cantidad);
         stocktot.codig := vuscodi;
         stocktot.cantidad := cantidad;
         write('   Precio Compra Uni. : ');
         readln(preciocmp);
         write('   Marca [S/N]   ');
         repeat
            tecla := upcase(readkey);
         until tecla in['S','N'];
         if tecla = 'S' then
         marca := true
       else
         marca := false;
         writeln;
         write('   El Incremento Al Publico Actual 45% Vale [S/N] ');
         repeat
            tecla := upcase(readkey);
         until tecla in['S','N'];
         if tecla = 'S' then
         incre45 :=  (preciocmp * 45) / 100
       else
          begin
             write('   El Nuevo Importe Por % Sera : ');
             readln(impo);
             incre45 := (preciocmp * impo) / 100;
          end;
           precioven := (preciocmp + incre45);
           ventas.codigo := vuscodi;
           ventas.cantidad := 0;
           ventas.preciopub := precioven;
        end;
      end;
 
 
    procedure asignaapuntero(d : pro_pedidos);
    begin
        if primer = nil then
        begin
           new(actual);
           actual^ := d;
           primer := actual;
           actual^.sig := nil;
        end
     else
         begin
            anterior := actual;
            new(actual);
            actual^ := d;
            anterior^.sig := actual;
            actual^.sig := nil;
         end;
    end;
 
  procedure presenta_entrada(codigocli : longint);
  var
    temp : puntero;
   begin
      if primer <> nil then
      begin
      clrscr;
      writeln('***** Datos De La Compra *****');
      writeln;
      temp := primer;
      while temp <> nil do
      begin
         if temp^.codigo = codigocli then
         begin
         with temp^ do
         begin
         writeln('Cod. : ',codigo,'  Cant. : ',cantidad,'  Prec. : ',
         preciocmp:0:2,'  Increm. : ',incre45:0:2,'  Prec. Publ. : ',
         precioven:0:2);
         end;
         readkey;
         break;
        end;
         temp := temp^.sig;
      end;
    end;
   end;
 
   procedure actualiza_ventas;
   var
     cod : longint;
     bus : puntero;
     cant : integer;
   begin
      write('   Entre Codigo producto : ');
      readln(cod);
      bus := primer;
      while bus <> nil do
      begin
         if bus^.codigo = cod then
         begin
           clrscr;
           writeln(' ***** Ventas *****');
           writeln;
           write('  Entre Cantidad Venta : ');
           readln(cant);
           bus^.ventas.cantidad := bus^.ventas.cantidad + cant;
           bus^.ventas.preciopub := bus^.precioven;
   bus^.stocktot.cantidad := bus^.stocktot.cantidad - bus^.ventas.cantidad;
           if bus^.stocktot.cantidad <= 4 then
           writeln('  ??????? Stock En Minimos ???????');
           break;
         end;
         bus := bus^.sig;
      end;
   end;
 
 
 
 
 
  begin
      clrscr;
      primer := nil;
      entradad(datos);
      asignaapuntero(datos);
      presenta_entrada(vuscodi);
  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

comercio de productos

Publicado por paulett (14 intervenciones) el 13/11/2013 21:01:30
Gracias!!! por responderme.
En mi proyecto debo presentar los sgts puntos:
usar:
- vector aunque sea con una dimension mas pequeña por ejemplo 100.
-listas
-registros
-ordenamiento
-busqueda
-eliminacion
-archivo
-actualizar con archivo
-procedimientos con pasajes por referencia y copia
mi idea para usar todo era
un archivo: de productos que compré.
otro :donde actualizo cantidad segun pedidos habia en stock antes sumo estas cantidades.
lista: cargo los pedidos.
en vector puedo guardar los 100 primeros o 10 si es muy pesado con un stock grande ya que significaría que no se vendió mucho o sea no tiene salida.
lo busco en archivo el de mayor cantidad de productos en stock y elimino en archivo de forma física sólo ese registro o puede ser por cada proveedor ya que tengo 3 proveedores.
el primer archivo me sirve para luego comparar con los del segundo archivo sus precios y si son distintos modificarlos.
Se puede modificar un poco lo que te comenté pero debo presentar estos tipos y estructuras.
por fi se que es largo pero podrías ayudarme es para el lunes que lo tengo que tener y estudiarlo.
muchas gracias!!!
bajé lo que me enviaste para verlo.
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

comercio de productos

Publicado por paulett (14 intervenciones) el 13/11/2013 22:12:16
mas detalles del pgma. :
me piden un menu k me muestre si ingreso un num muestra en pantalla las opciones
x ejem si ingreso 1 me deja mirar los productos originales cargados
2 los registros actualizados para venta
3 actualizar los registro del archivo con los pedidos o sea si piden 5 productos de un mismo codigo entonces tengo k descontar las cantidades del producto pedido.
4lista de los pedidos que ingresaron detallando como lo hiciste
5 muestra los productos con mas cantidades por proveedor.
6elimina el producto menos vendido del archivo por proveedor.
7 salgo del menu.
esto me piden.
cuando lo entregue el tribunal tiene que ver el menu y va poniendo cada opcion.
gracias!!!
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

comercio de productos

Publicado por ramon (2158 intervenciones) el 14/11/2013 16:14:39
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
{Vallamos por partes el menú es norma y lo tendrá pero me interesa me comentes si marchamos por buen camino para no perder mucho tiempo en algo que no valga mira esto y coméntame]
 
 program comercio;
  uses
     crt;
 
  const
      ma = 100;
 
  type
 
   prod_compra = record
        cod : integer;
        cant : integer;
        preciouni : real;
        proveedor : integer;
        marca : boolean;
     end;
 
   pedidos = record
        cod : integer;
        cant : integer;
       preciounit : real;
       preciotot : real;
       provee : integer;
       marca : boolean;
     end;
 
          lista = ^nodo;
          nodo = record
              cod : integer;
             cant : integer;
           precio : real;
           totalr : integer;
             psig : lista
          end;
 
     stock = record
            cod : integer;
            cant : integer;
          end;
 
    var
      archivo : file of prod_compra;
      vector2 : array [1..ma] of stock;
     archivo3 : file of pedidos;
     prim, anter, actual : lista;
     regcomp : prod_compra;
     regpedi : pedidos;
     aviercomp, avierpedi : boolean;
 
   procedure salvar_archivo(nomb : string;cual : char);
   begin
      if upcase(cual) = 'C' then
      begin
      assign(archivo,'compra.dat');
   {$I-} reset(archivo); {$I+}
      end;
      if upcase(cual) = 'P' then
      begin
      assign(archivo3,'pedido.dat');
    {$I-} reset(archivo); {$I+}
      end;
    if ioresult <> 0 then
    begin
       if upcase(cual) = 'C' then
       begin
       rewrite(archivo);
       seek(archivo,0);
       write(archivo,regcomp);
       close(archivo);
       end;
       if upcase(cual) = 'P' then
       begin
       rewrite(archivo3);
       seek(archivo3,0);
       write(archivo3,regpedi);
       close(archivo3);
       end;
    end
  else
     begin
        if cual = 'C' then
        begin
           seek(archivo,filesize(archivo));
           write(archivo,regcomp);
           close(archivo);
        end;
          if cual = 'P' then
          begin
            seek(archivo3,filesize(archivo3));
            write(archivo3,regpedi);
            close(archivo3);
         end;
      end;
   end;
 
   procedure carga_archivo(nomb : string;cual : char);
   begin
      if upcase(cual) = 'C' then
      begin
      assign(archivo,'compra.dat');
   {$I-} reset(archivo); {$I+}
      end;
      if upcase(cual) = 'P' then
      begin
      assign(archivo3,'pedido.dat');
    {$I-} reset(archivo); {$I+}
      end;
       if ioresult <> 0 then
       begin
          writeln('   Error De Archivo Pulse Una Tecla ');
          readkey;
          exit;
       end
    else
       begin
       if upcase(cual) = 'C' then
       begin
          seek(archivo,0);
          read(archivo,regcomp);
          aviercomp := true;
       end;
        if upcase(cual) = 'P' then
        begin
           seek(archivo3,0);
           read(archivo3,regpedi);
           avierpedi := true;
        end;
     end;
   end;
 
   procedure entradas_compras(cual : char);
   var
     vale : boolean;
     marc : char;
     begin
        if upcase(cual) = 'C' then
        begin
          writeln('**** Entradas Campras ****');
          writeln;
          with regcomp do
          begin
          write('   Entre Codigo         : ');
          readln(cod);
          write('   Entre Cantidad       : ');
          readln(cant);
          write('   Entre Precio Unidad  : ');
          readln(preciouni);
          write('   Entre Num. Proveedor : ');
          readln(proveedor);
          write('   Marca False[N]/True[S]');
          readln(marc);
          if upcase(marc) = 'S' then
          marca := true
        else
          marca := false;
          end;
        end;
        if upcase(cual) = 'P' then
        begin
          writeln('**** Entradas Ventas ****');
          writeln;
          with regpedi do
          begin
          write('  Entre Codigo         : ');
          readln(cod );
          write('  Entre Cantidad       : ');
          readln(cant);
          write('  Entre Precio Unidad  : ');
          readln(preciounit);
          write('  Entre Precio Total   : ');
          readln(preciotot);
          write('  Entre Num. Proveedor : ');
          readln(provee);
          write('  Marca False[N]/True[S]');
          readln(marc);
          if upcase(marc) = 'S' then
          marca := true
        else
          marca := false;
          end;
        end;
     end;
 
   procedure carca_punteros(d : nodo);
   begin
      if prim = nil then
      begin
         new(actual);
         actual^ := d;
         prim := actual;
         actual^.psig := nil;
      end
    else
        begin
           anter := actual;
           new(actual);
           actual^ := d;
           anter^.psig := actual;
           actual^.psig := nil;
       end;
   end;
 
   procedure muestra_nodos;
   var
     temp : lista;
     begin
        if temp <> nil then
        while temp <> nil do
        begin
           writeln('**** Presetacion de datos ****');
           writeln;
           write('  Codigo : ',temp^.cod,'  Cantidad : ',temp^.cant,
           '  Precio : ',temp^.precio,'  Total : ',temp^.totalr);
           temp := temp^.psig;
        end;
     end;
 
  procedure ordena_archivos_por_codigo(cual : char);
  var
    toma1, temp1 : prod_compra;
    toma2, temp2 : pedidos;
    co1, co2 : longint;
  begin
      if upcase(cual) = 'C' then
      begin
         assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
            for co1 := 0 to filesize(archivo) - 1 do
            begin
               seek(archivo,co1);
               read(archivo,regcomp);
              for co2 := filesize(archivo) - 1 downto co1 do
              begin
                 seek(archivo,co2);
                 read(archivo,toma1);
                 if regcomp.cod > toma1.cod then
                 begin
                    temp1 := regcomp;
                    regcomp := toma1;
                    toma1 := temp1;
                    seek(archivo,co1);
                    write(archivo,regcomp);
                    seek(archivo,co2);
                    write(archivo,toma1);
                 end;
              end;
            end;
            close(archivo);
        end;
      end;
      if upcase(cual) = 'P' then
      begin
        assign(archivo3,'pedido.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          for co1 := 0 to filesize(archivo3) - 1 do
          begin
            seek(archivo3,co1);
            read(archivo3,regpedi);
              for co2 := filesize(archivo3) - 1 downto co1 do
              begin
                 seek(archivo3,co2);
                 read(archivo3,toma2);
                 if regpedi.cod > toma2.cod then
                 begin
                    temp2 := regpedi;
                    regpedi := toma2;
                    toma2 := temp2;
                    seek(archivo3,co1);
                    write(archivo3,regpedi);
                    seek(archivo3,co2);
                    write(archivo3,toma2);
                 end;
              end;
            end;
             close(archivo3);
        end;
      end;
   end;
 
 
 
  begin
     aviercomp := false;
     avierpedi := false;
     prim := nil;
 
 
 
  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

comercio de productos

Publicado por paulett (14 intervenciones) el 14/11/2013 18:08:24
siiiiiiii.....marchamos por buen camino estoy re entusiasmada....Gracias!!!!
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

comercio de productos

Publicado por ramon (2158 intervenciones) el 14/11/2013 19:53:47
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
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
{Espero que esto te ayude a resolver tus dudas}
 
 program comercio;
  uses
     crt;
 
  const
      ma = 100;
 
  type
 
   prod_compra = record
        cod : integer;
        cant : integer;
        preciouni : real;
        proveedor : integer;
        marca : boolean;
     end;
 
   pedidos = record
        cod : integer;
        cant : integer;
       preciounit : real;
       preciotot : real;
       provee : integer;
       marca : boolean;
     end;
 
          lista = ^nodo;
          nodo = record
              cod : integer;
             cant : integer;
           precio : real;
           totalr : integer;
             psig : lista
          end;
 
     stock = record
            cod : integer;
            cant : integer;
          end;
 
    var
      archivo : file of prod_compra;
      vector2 : array [1..ma] of stock;
     archivo3 : file of pedidos;
     prim, anter, actual : lista;
     regcomp : prod_compra;
     regpedi : pedidos;
     aviercomp, avierpedi : boolean;
 
   procedure salvar_archivo(nomb : string;cual : char);
   begin
      if upcase(cual) = 'C' then
      begin
      assign(archivo,'compra.dat');
   {$I-} reset(archivo); {$I+}
      end;
      if upcase(cual) = 'P' then
      begin
      assign(archivo3,'pedido.dat');
    {$I-} reset(archivo); {$I+}
      end;
    if ioresult <> 0 then
    begin
       if upcase(cual) = 'C' then
       begin
       rewrite(archivo);
       seek(archivo,0);
       write(archivo,regcomp);
       close(archivo);
       end;
       if upcase(cual) = 'P' then
       begin
       rewrite(archivo3);
       seek(archivo3,0);
       write(archivo3,regpedi);
       close(archivo3);
       end;
    end
  else
     begin
        if cual = 'C' then
        begin
           seek(archivo,filesize(archivo));
           write(archivo,regcomp);
           close(archivo);
        end;
          if cual = 'P' then
          begin
            seek(archivo3,filesize(archivo3));
            write(archivo3,regpedi);
            close(archivo3);
         end;
      end;
   end;
 
   procedure carga_archivo(nu : longint;cual : char);
   begin
      if upcase(cual) = 'C' then
      begin
      assign(archivo,'compra.dat');
   {$I-} reset(archivo); {$I+}
      end;
      if upcase(cual) = 'P' then
      begin
      assign(archivo3,'pedido.dat');
    {$I-} reset(archivo); {$I+}
      end;
       if ioresult <> 0 then
       begin
          writeln('   Error De Archivo Pulse Una Tecla ');
          readkey;
          exit;
       end
    else
       begin
       if upcase(cual) = 'C' then
       begin
          seek(archivo,nu);
          read(archivo,regcomp);
          aviercomp := true;
       end;
        if upcase(cual) = 'P' then
        begin
           seek(archivo3,nu);
           read(archivo3,regpedi);
           avierpedi := true;
        end;
     end;
   end;
 
   procedure entradas_compras(cual : char);
   var
     vale : boolean;
     marc : char;
     begin
        if upcase(cual) = 'C' then
        begin
          writeln('**** Entradas Campras ****');
          writeln;
          with regcomp do
          begin
          write('   Entre Codigo         : ');
          readln(cod);
          write('   Entre Cantidad       : ');
          readln(cant);
          write('   Entre Precio Unidad  : ');
          readln(preciouni);
          write('   Entre Num. Proveedor : ');
          readln(proveedor);
          write('   Marca False[N]/True[S]');
          readln(marc);
          if upcase(marc) = 'S' then
          marca := true
        else
          marca := false;
          end;
        end;
        if upcase(cual) = 'P' then
        begin
          writeln('**** Entradas Ventas ****');
          writeln;
          with regpedi do
          begin
          write('  Entre Codigo         : ');
          readln(cod );
          write('  Entre Cantidad       : ');
          readln(cant);
          write('  Entre Precio Unidad  : ');
          readln(preciounit);
          write('  Entre Precio Total   : ');
          readln(preciotot);
          write('  Entre Num. Proveedor : ');
          readln(provee);
          write('  Marca False[N]/True[S]');
          readln(marc);
          if upcase(marc) = 'S' then
          marca := true
        else
          marca := false;
          end;
        end;
     end;
 
   procedure carca_punteros(d : nodo);
   begin
      if prim = nil then
      begin
         new(actual);
         actual^ := d;
         prim := actual;
         actual^.psig := nil;
      end
    else
        begin
           anter := actual;
           new(actual);
           actual^ := d;
           anter^.psig := actual;
           actual^.psig := nil;
       end;
   end;
 
   procedure muestra_nodos;
   var
     temp : lista;
     begin
        if temp <> nil then
        while temp <> nil do
        begin
           writeln('**** Presetacion de datos ****');
           writeln;
           write('  Codigo : ',temp^.cod,'  Cantidad : ',temp^.cant,
           '  Precio : ',temp^.precio,'  Total : ',temp^.totalr);
           temp := temp^.psig;
        end;
     end;
 
  procedure ordena_archivos_por_codigo(cual : char);
  var
    toma1, temp1 : prod_compra;
    toma2, temp2 : pedidos;
    co1, co2 : longint;
  begin
      if upcase(cual) = 'C' then
      begin
         assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
            for co1 := 0 to filesize(archivo) - 1 do
            begin
               seek(archivo,co1);
               read(archivo,regcomp);
              for co2 := filesize(archivo) - 1 downto co1 do
              begin
                 seek(archivo,co2);
                 read(archivo,toma1);
                 if regcomp.cod > toma1.cod then
                 begin
                    temp1 := regcomp;
                    regcomp := toma1;
                    toma1 := temp1;
                    seek(archivo,co1);
                    write(archivo,regcomp);
                    seek(archivo,co2);
                    write(archivo,toma1);
                 end;
              end;
            end;
            close(archivo);
        end;
      end;
      if upcase(cual) = 'P' then
      begin
        assign(archivo3,'pedido.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          for co1 := 0 to filesize(archivo3) - 1 do
          begin
            seek(archivo3,co1);
            read(archivo3,regpedi);
              for co2 := filesize(archivo3) - 1 downto co1 do
              begin
                 seek(archivo3,co2);
                 read(archivo3,toma2);
                 if regpedi.cod > toma2.cod then
                 begin
                    temp2 := regpedi;
                    regpedi := toma2;
                    toma2 := temp2;
                    seek(archivo3,co1);
                    write(archivo3,regpedi);
                    seek(archivo3,co2);
                    write(archivo3,toma2);
                 end;
              end;
            end;
             close(archivo3);
        end;
      end;
   end;
 
  procedure busqueda_por_codigo(cual : char);
  var
    busq : longint;
    bus1 : prod_compra;
    bus2 : pedidos;
    cocomp : integer;
  begin
     if upcase(cual) = 'C' then
      begin
         assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          writeln('   Entre Codigo A Buscar : ');
         repeat
        {$I-}  readln(cocomp); {$I+}
        if ioresult <> 0 then
        writeln('  Entre Un Valor Numerico Entero ');
         until ioresult = 0;
          for busq := 0 to filesize(archivo) - 1 do
          begin
             seek(archivo,busq);
             read(archivo,bus1);
             if bus1.cod = cocomp then
             begin
               writeln(' Codigo : ',bus1.cod,'   Cantidad : ',bus1.cant,
               '   Precio Unidad : ',bus1.preciouni:0:2,'   Precio Vendeedor : ',
               bus1.proveedor);
               writeln('   Pulse Una Tecla');
               readkey;
               break;
             end;
          end;
          close(archivo);
        end;
      end;
        if upcase(cual) = 'P' then
        begin
          assign(archivo3,'pedido.dat');
        {$I-} reset(archivo); {$I+}
          if ioresult <> 0 then
          begin
             writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
         writeln('   Entre Codigo A Buscar : ');
         repeat
        {$I-}  readln(cocomp); {$I+}
        if ioresult <> 0 then
        writeln('  Entre Un Valor Numerico Entero ');
         until ioresult = 0;
          for busq := 0 to filesize(archivo3) - 1 do
          begin
             seek(archivo3,busq);
             read(archivo3,bus2);
             if bus2.cod = cocomp then
             begin
               writeln(' Codigo : ',bus2.cod,'   Cantidad : ',bus2.cant,
          '   Precio Unidad : ',bus2.preciounit:0:2,'   Precio Total : ',
              bus2.preciotot:0:2,'   Proveedor : ',bus2.provee);
               writeln('   Pulse Una Tecla');
               readkey;
               break;
             end;
          end;
          close(archivo3);
        end;
    end;
  end;
 
  procedure eliminacion_de_datos(cual : char);
  var
    codig : integer;
    yy, ww, ar : longint;
    bus1 : prod_compra;
    bus2 : pedidos;
    temp1 : file of prod_compra;
    temp2 : file of pedidos;
  begin
     if upcase(cual) = 'C' then
      begin
         assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          writeln('   Entre Codigo A Anular : ');
         repeat
        {$I-}  readln(codig); {$I+}
        if ioresult <> 0 then
        writeln('  Entre Un Valor Numerico Entero ');
         until ioresult = 0;
          for ar := 0 to filesize(archivo) - 1 do
          begin
             seek(archivo,ar);
             read(archivo,bus1);
             if bus1.cod = codig then
             begin
                assign(temp1,'temporal.bbb');
                rewrite(temp1);
                ww := 0;
                for yy := 0 to filesize(archivo) - 1 do
                begin
                if yy <> ar then
                begin
                  seek(archivo,yy);
                  read(archivo,bus1);
                  seek(temp1,ww);
                  write(temp1,bus1);
                  ww := ww + 1;
                end;
               end;
               close(archivo);
               close(temp1);
               erase(archivo);
               rename(temp1,'compra.dat');
               break;
             end;
          end;
        end;
      end;
      if upcase(cual) = 'P' then
      begin
         assign(archivo3,'pedido.dat');
       {$I-} reset(archivo3); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          writeln('   Entre Codigo A Anular : ');
         repeat
        {$I-}  readln(codig); {$I+}
        if ioresult <> 0 then
        writeln('  Entre Un Valor Numerico Entero ');
         until ioresult = 0;
          for ar := 0 to filesize(archivo3) - 1 do
          begin
             seek(archivo3,ar);
             read(archivo3,bus2);
             if bus2.cod = codig then
             begin
                assign(temp2,'tempor4.bbb');
                rewrite(temp2);
                ww := 0;
                for yy := 0 to filesize(archivo3) - 1 do
                begin
                if yy <> ar then
                begin
                  seek(archivo3,yy);
                  read(archivo3,bus2);
                  seek(temp2,ww);
                  write(temp2,bus2);
                  ww := ww + 1;
                end;
               end;
               close(archivo3);
               close(temp2);
               erase(archivo3);
               rename(temp2,'pedido.dat');
               break;
             end;
          end;
        end;
     end;
  end;
 
 
  procedure menu;
  var
   sali : boolean;
   ted : char;
  begin
     sali := false;
    repeat
       clrscr;
       writeln('****** Menu Jeneral ******');
       writeln;
       writeln('    1 = Productos Originales Cargados');
       writeln('    2 = Registros Actualizados Para Venta');
       writeln('    3 = Actualizar Los Registro Del Archivo');
       writeln('    4 = Lista Pedidos Ingresaron Actualizar');
       writeln('    5 = Productos Con Mas Cantidades Por Proveedor');
       writeln('    6 = Elimina El Producto Menos Vendido');
       writeln('    7 = Salir');
       writeln;
       writeln('>>>> Elija Opcion <<<<');
       repeat
          ted := readkey;
       until ted in['1','2','3','4','5','6','7'];
       clrscr;
     case ted of
  '1' : begin
          writeln('Productos Originales Cargados Pulse Una Tecla');
          readkey;
        end;
  '2' : begin
          writeln('Registros Actualizados Para Venta Pulse Una Tecla');
          readkey;
        end;
  '3' : begin
          writeln('Actualizar Los Registro Del Archivo Pulse Una Tecla');
          readkey;
        end;
  '4' : begin
          writeln('Lista Pedidos Ingresaron Actualizar Pulse Una Tecla');
          readkey;
        end;
  '5' : begin
          writeln('Productos Con Mas Cantidades Por Proveedor Pulse Una Tecla');
          readkey;
        end;
  '6' : begin
          writeln('Elimina El Producto Menos Vendido Pulse Una Tecla');
          readkey;
        end;
  '7' : sali := true;
    end;
    until sali = true;
  end;
 
 
 
  begin
     aviercomp := false;
     avierpedi := false;
     prim := nil;
     menu;
  end.
 
{Pon encada lugar del menú lo que quieras  que realice}
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

comercio de productos

Publicado por ramon (2158 intervenciones) el 14/11/2013 22:48:37
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
{Me faltaba ponlo delante del menú}
 
 procedure modificacion_de_datos(cual : char);
  var
    codigo : integer;
    modi1 : prod_compra;
    modi2 : pedidos;
    rd : longint;
    opc, tt : char;
    begin
       if upcase(cual) = 'C' then
       begin
          assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
           clrscr;
           writeln('***** Modificacion de datos *****');
           writeln;
           write('   Entre codigo : ');
           repeat
           {$I-}  readln(codigo); {$I+}
           if ioresult <> 0 then
           writeln('   Entre Un Valor Numerico Entero');
           until ioresult = 0;
           for rd := 0 to filesize(archivo) - 1 do
           begin
              seek(archivo,rd);
              read(archivo,modi1);
              if modi1.cod = codigo then
              begin
             repeat
                 clrscr;
                 writeln('  Menu Modificacion ');
                 writeln;
                 writeln('  1 = codigo');
                 writeln('  2 = cantidad');
                 writeln('  3 = precio unidad');
                 writeln('  4 = proovedor');
                 writeln('  5 = marca');
                 writeln('  6 = fin');
                 writeln;
                 writeln('  Elija Modificacion ');
                 repeat
                    opc := readkey;
                 until opc in['1','2','3','4','5','6'];
                 clrscr;
              case opc of
           '1' : begin
                   write('  codigo : ');
                   readln(modi1.cod);
                 end;
           '2' : begin
                   write('  cantidad : ');
                   readln(modi1.cant);
                 end;
           '3' : begin
                   write('  precio unidad : ');
                   readln(modi1.preciouni);
                 end;
           '4' : begin
                   write('  proveedor : ');
                   readln(modi1.proveedor);
                 end;
           '5' : begin
                   write('  marca : [N]=false [S]=true');
                   repeat
                       tt := upcase(readkey);
                   until tt in['N','S'];
                   if tt = 'S' then
                   modi1.marca := true
                 else
                   modi1.marca := false;
                 end;
             end;
             until opc = '6';
             seek(archivo,rd);
             write(archivo,modi1);
             close(archivo);
             break;
            end;
           end;
        end;
       end;
       if upcase(cual) = 'P' then
       begin
          assign(archivo3,'pedido.dat');
       {$I-} reset(archivo3); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
           clrscr;
           writeln('***** Modificacion de pedidos datos *****');
           writeln;
           write('   Entre codigo : ');
           repeat
           {$I-}  readln(codigo); {$I+}
           if ioresult <> 0 then
           writeln('   Entre Un Valor Numerico Entero');
           until ioresult = 0;
           for rd := 0 to filesize(archivo3) - 1 do
           begin
              seek(archivo3,rd);
              read(archivo3,modi2);
              if modi2.cod = codigo then
              begin
             repeat
                 clrscr;
                 writeln('  Menu Modificacion ');
                 writeln;
                 writeln('  1 = codigo');
                 writeln('  2 = cantidad');
                 writeln('  3 = precio unidad');
                 writeln('  4 = proovedor');
                 writeln('  5 = marca');
                 writeln('  6 = fin');
                 writeln;
                 writeln('  Elija Modificacion ');
                 repeat
                    opc := readkey;
                 until opc in['1','2','3','4','5','6'];
                 clrscr;
              case opc of
           '1' : begin
                   write('  codigo : ');
                   readln(modi2.cod);
                 end;
           '2' : begin
                   write('  cantidad : ');
                   readln(modi2.cant);
                 end;
           '3' : begin
                   write('  precio unidad : ');
                   readln(modi2.preciounit);
                 end;
           '4' : begin
                   write('  proveedor : ');
                   readln(modi2.provee);
                 end;
           '5' : begin
                   write('  marca : [N]=false [S]=true');
                   repeat
                       tt := upcase(readkey);
                   until tt in['N','S'];
                   if tt = 'S' then
                   modi2.marca := true
                 else
                   modi2.marca := false;
                 end;
             end;
             until opc = '6';
             seek(archivo3,rd);
             write(archivo3,modi2);
             close(archivo3);
             break;
            end;
           end;
         end;
       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

comercio de productos

Publicado por paulett (14 intervenciones) el 15/11/2013 00:13:24
Hola lo estoy probando lo compile y lo recorri....me muestra el menu en pantalla con las 7 opciones pero no me deja cargar el archivo con los datos del producto. algo estoy haciendo mal? podrias decirme que puede estar pasando.
para mí los procedimientos estan buenísimos. gracias
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

comercio de productos

Publicado por ramon (2158 intervenciones) el 15/11/2013 00:18:24
Pero as creado el archivo con el programa o lo tienes creado de antes.
dime si te marca algo.
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

comercio de productos

Publicado por paulett (14 intervenciones) el 15/11/2013 00:23:05
ahora veo que me dejaste un msje k faltaba una parte del programa lo estoy poniendo y ahora t comento eso creo que lo va a solucionar.
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

comercio de productos

Publicado por paulett (14 intervenciones) el 15/11/2013 00:59:07
1º cargué el ultimo con menu todo completo.
2º luego lo que me decis que lo ponga antes del procedimiento menu.
lo copie todo antes de ese procedimiento (menu).
3ºlo compile salio todo bien
4º lo recorrí (run)
lo que no me deja es cargar datos de los productos al archivo.
me muestra el menu con las 7 opciones cada vez que ingreso una opcion me dice:

1 Productos Originales Cargados
vuelve al menu
2 Registros Actualizados Para Venta Pulse Una Tecla
vuelve al menu
3 Actualizar Los Registro Del Archivo Pulse Una Tecla
vuelve al menu. todos las otras opciones tbn.
4 Lista Pedidos Ingresaron Actualizar Pulse Una Tecla
5 Productos Con Mas Cantidades Por Proveedor Pulse Una Tecla
6 Elimina El Producto Menos Vendido Pulse Una Tecla........habra algo que lo esta trbando y no deja cargar los datos?
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

comercio de productos

Publicado por ramon (2158 intervenciones) el 15/11/2013 14:32:50
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
{Mira como pongo el proceso de guardar que no lo puse para que tu lo colocaras donde
 quisieras}
 
procedure entradas_compras(cual : char);
   var
     vale : boolean;
     marc : char;
     begin
        if upcase(cual) = 'C' then
        begin
          writeln('**** Entradas Campras ****');
          writeln;
          with regcomp do
          begin
          write('   Entre Codigo         : ');
          readln(cod);
          write('   Entre Cantidad       : ');
          readln(cant);
          write('   Entre Precio Unidad  : ');
          readln(preciouni);
          write('   Entre Num. Proveedor : ');
          readln(proveedor);
          write('   Marca False[N]/True[S]');
          readln(marc);
          if upcase(marc) = 'S' then
          marca := true
        else
          marca := false;
          end;
          salvar_archivo('c');
        end;
        if upcase(cual) = 'P' then
        begin
          writeln('**** Entradas Ventas ****');
          writeln;
          with regpedi do
          begin
          write('  Entre Codigo         : ');
          readln(cod );
          write('  Entre Cantidad       : ');
          readln(cant);
          write('  Entre Precio Unidad  : ');
          readln(preciounit);
          write('  Entre Precio Total   : ');
          readln(preciotot);
          write('  Entre Num. Proveedor : ');
          readln(provee);
          write('  Marca False[N]/True[S]');
          readln(marc);
          if upcase(marc) = 'S' then
          marca := true
        else
          marca := false;
          end;
          salvar_archivo('p');
        end;
     end;
 
{En el menu asi]
 
 case ted of
  '1' : begin
            entradas_compras('c');
        end;
  '2' : begin
          entradas_compras('p');
        end;
  '3' : begin
          writeln('Actualizar Los Registro Del Archivo Pulse Una Tecla');
          readkey;
        end;
  '4' : begin
          busqueda_por_codigo('c');
        end;
  '5' : begin
          writeln('Productos Con Mas Cantidades Por Proveedor Pulse Una Tecla');
          readkey;
        end;
  '6' : begin
          writeln('Elimina El Producto Menos Vendido Pulse Una Tecla');
          readkey;
        end;
  '7' : sali := true;
    end;
{Funciona}
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

comercio de productos

Publicado por paulett (14 intervenciones) el 15/11/2013 19:14:56
Hola Ramon ví lo que enviaste el programa si tenia el procedure entradas_ compras tbn el case ted faltaba el llamado al procedimiento salvar_archivo.
lo puse me da error de parametros; me doy cta. que tiene 2 parametros 'nom' y 'cual´ le puse nom y no me deja.
en el caso ted tambien añadí:
en el 1 entradas_compras('c')
2 entradas_compras ('p')
4 busqueda_por_codigo ('c').
compile el pgma. sin las llamadas de '' salvar_archivo'' y me deja cargar los archivos.
cuando dice marca true/false el s y n con las dos teclas vuelve a mostrarme el menu.
el 2 no salen los registros actualizados me vuelve a pedir datos
el 3 no hace nada
el 4 dice error de archivo
y el 5 no hace nada.
te envio el pgma. k copie a pascal haber si esta bien?.

program comercio;
uses
crt;

const
ma = 100;

type

prod_compra = record
cod : integer;
cant : integer;
preciouni : real;
proveedor : integer;
marca : boolean;
end;

pedidos = record
cod : integer;
cant : integer;
preciounit : real;
preciotot : real;
provee : integer;
marca : boolean;
end;

lista = ^nodo;
nodo = record
cod : integer;
cant : integer;
precio : real;
totalr : integer;
psig : lista
end;

stock = record
cod : integer;
cant : integer;
end;

var
archivo : file of prod_compra;
vector2 : array [1..ma] of stock;
archivo3 : file of pedidos;
prim, anter, actual : lista;
regcomp : prod_compra;
regpedi : pedidos;
aviercomp, avierpedi : boolean;



procedure salvar_archivo(cual : char);
begin
if upcase(cual) = 'C' then
begin
assign(archivo,'compra.dat');
{$I-} reset(archivo); {$I+}
end;
if upcase(cual) = 'P' then
begin
assign(archivo3,'pedido.dat');
{$I-} reset(archivo); {$I+}
end;
if ioresult <> 0 then
begin
if upcase(cual) = 'C' then
begin
rewrite(archivo);
seek(archivo,0);
write(archivo,regcomp);
close(archivo);
end;
if upcase(cual) = 'P' then
begin
rewrite(archivo3);
seek(archivo3,0);
write(archivo3,regpedi);
close(archivo3);
end;
end
else
begin
if cual = 'C' then
begin
seek(archivo,filesize(archivo));
write(archivo,regcomp);
close(archivo);
end;
if cual = 'P' then
begin
seek(archivo3,filesize(archivo3));
write(archivo3,regpedi);
close(archivo3);
end;
end;
end;

procedure carga_archivo(nu : longint;cual : char);
begin
if upcase(cual) = 'C' then
begin
assign(archivo,'compra.dat');
{$I-} reset(archivo); {$I+}
end;
if upcase(cual) = 'P' then
begin
assign(archivo3,'pedido.dat');
{$I-} reset(archivo); {$I+}
end;
if ioresult <> 0 then
begin
writeln(' Error De Archivo Pulse Una Tecla ');
readkey;
exit;
end
else
begin
if upcase(cual) = 'C' then
begin
seek(archivo,nu);
read(archivo,regcomp);
aviercomp := true;
end;
if upcase(cual) = 'P' then
begin
seek(archivo3,nu);
read(archivo3,regpedi);
avierpedi := true;
end;
end;
end;

procedure entradas_compras(cual : char);
var
vale : boolean;
marc : char;
begin
if upcase(cual) = 'C' then
begin
writeln('**** Entradas Campras ****');
writeln;
with regcomp do
begin
write(' Entre Codigo : ');
readln(cod);
write(' Entre Cantidad : ');
readln(cant);
write(' Entre Precio Unidad : ');
readln(preciouni);
write(' Entre Num. Proveedor : ');
readln(proveedor);
write(' Marca False[N]/True[S]');
readln(marc);
if upcase(marc) = 'S' then
marca := true
else
marca := false;
end;
salvar_archivo('c'); ****para que no dé error saque el
end; parametro nom de este procedure*
if upcase(cual) = 'P' then
begin
writeln('**** Entradas Ventas ****');
writeln;
with regpedi do
begin
write(' Entre Codigo : ');
readln(cod );
write(' Entre Cantidad : ');
readln(cant);
write(' Entre Precio Unidad : ');
readln(preciounit);
write(' Entre Precio Total : ');
readln(preciotot);
write(' Entre Num. Proveedor : ');
readln(provee);
write(' Marca False[N]/True[S]');
readln(marc);
if upcase(marc) = 'S' then
marca := true
else
marca := false;
end;
end;
salvar_archivo('p');
end;

procedure carca_punteros(d : nodo);
begin
if prim = nil then
begin
new(actual);
actual^ := d;
prim := actual;
actual^.psig := nil;
end
else
begin
anter := actual;
new(actual);
actual^ := d;
anter^.psig := actual;
actual^.psig := nil;
end;
end;

procedure muestra_nodos;
var
temp : lista;
begin
if temp <> nil then
while temp <> nil do
begin
writeln('**** Presetacion de datos ****');
writeln;
write(' Codigo : ',temp^.cod,' Cantidad : ',temp^.cant,
' Precio : ',temp^.precio,' Total : ',temp^.totalr);
temp := temp^.psig;
end;
end;

procedure ordena_archivos_por_codigo(cual : char);
var
toma1, temp1 : prod_compra;
toma2, temp2 : pedidos;
co1, co2 : longint;
begin
if upcase(cual) = 'C' then
begin
assign(archivo,'compra.dat');
{$I-} reset(archivo); {$I+}
if ioresult <> 0 then
begin
writeln('?????? Error De Archovo Pulse Una Tecla ??????');
readkey;
end
else
begin
for co1 := 0 to filesize(archivo) - 1 do
begin
seek(archivo,co1);
read(archivo,regcomp);
for co2 := filesize(archivo) - 1 downto co1 do
begin
seek(archivo,co2);
read(archivo,toma1);
if regcomp.cod > toma1.cod then
begin
temp1 := regcomp;
regcomp := toma1;
toma1 := temp1;
seek(archivo,co1);
write(archivo,regcomp);
seek(archivo,co2);
write(archivo,toma1);
end;
end;
end;
close(archivo);
end;
end;
if upcase(cual) = 'P' then
begin
assign(archivo3,'pedido.dat');
{$I-} reset(archivo); {$I+}
if ioresult <> 0 then
begin
writeln('?????? Error De Archovo Pulse Una Tecla ??????');
readkey;
end
else
begin
for co1 := 0 to filesize(archivo3) - 1 do
begin
seek(archivo3,co1);
read(archivo3,regpedi);
for co2 := filesize(archivo3) - 1 downto co1 do
begin
seek(archivo3,co2);
read(archivo3,toma2);
if regpedi.cod > toma2.cod then
begin
temp2 := regpedi;
regpedi := toma2;
toma2 := temp2;
seek(archivo3,co1);
write(archivo3,regpedi);
seek(archivo3,co2);
write(archivo3,toma2);
end;
end;
end;
close(archivo3);
end;
end;
end;

procedure busqueda_por_codigo(cual : char);
var
busq : longint;
bus1 : prod_compra;
bus2 : pedidos;
cocomp : integer;
begin
if upcase(cual) = 'C' then
begin
assign(archivo,'compra.dat');
{$I-} reset(archivo); {$I+}
if ioresult <> 0 then
begin
writeln('?????? Error De Archovo Pulse Una Tecla ??????');
readkey;
end
else
begin
writeln(' Entre Codigo A Buscar : ');
repeat
{$I-} readln(cocomp); {$I+}
if ioresult <> 0 then
writeln(' Entre Un Valor Numerico Entero ');
until ioresult = 0;
for busq := 0 to filesize(archivo) - 1 do
begin
seek(archivo,busq);
read(archivo,bus1);
if bus1.cod = cocomp then
begin
writeln(' Codigo : ',bus1.cod,' Cantidad : ',bus1.cant,
' Precio Unidad : ',bus1.preciouni:0:2,' Precio Vendeedor : ',
bus1.proveedor);
writeln(' Pulse Una Tecla');
readkey;
break;
end;
end;
close(archivo);
end;
end;
if upcase(cual) = 'P' then
begin
assign(archivo3,'pedido.dat');
{$I-} reset(archivo); {$I+}
if ioresult <> 0 then
begin
writeln('?????? Error De Archovo Pulse Una Tecla ??????');
readkey;
end
else
begin
writeln(' Entre Codigo A Buscar : ');
repeat
{$I-} readln(cocomp); {$I+}
if ioresult <> 0 then
writeln(' Entre Un Valor Numerico Entero ');
until ioresult = 0;
for busq := 0 to filesize(archivo3) - 1 do
begin
seek(archivo3,busq);
read(archivo3,bus2);
if bus2.cod = cocomp then
begin
writeln(' Codigo : ',bus2.cod,' Cantidad : ',bus2.cant,
' Precio Unidad : ',bus2.preciounit:0:2,' Precio Total : ',
bus2.preciotot:0:2,' Proveedor : ',bus2.provee);
writeln(' Pulse Una Tecla');
readkey;
break;
end;
end;
close(archivo3);
end;
end;
end;

procedure eliminacion_de_datos(cual : char);
var
codig : integer;
yy, ww, ar : longint;
bus1 : prod_compra;
bus2 : pedidos;
temp1 : file of prod_compra;
temp2 : file of pedidos;
begin
if upcase(cual) = 'C' then
begin
assign(archivo,'compra.dat');
{$I-} reset(archivo); {$I+}
if ioresult <> 0 then
begin
writeln('?????? Error De Archovo Pulse Una Tecla ??????');
readkey;
end
else
begin
writeln(' Entre Codigo A Anular : ');
repeat
{$I-} readln(codig); {$I+}
if ioresult <> 0 then
writeln(' Entre Un Valor Numerico Entero ');
until ioresult = 0;
for ar := 0 to filesize(archivo) - 1 do
begin
seek(archivo,ar);
read(archivo,bus1);
if bus1.cod = codig then
begin
assign(temp1,'temporal.bbb');
rewrite(temp1);
ww := 0;
for yy := 0 to filesize(archivo) - 1 do
begin
if yy <> ar then
begin
seek(archivo,yy);
read(archivo,bus1);
seek(temp1,ww);
write(temp1,bus1);
ww := ww + 1;
end;
end;
close(archivo);
close(temp1);
erase(archivo);
rename(temp1,'compra.dat');
break;
end;
end;
end;
end;
if upcase(cual) = 'P' then
begin
assign(archivo3,'pedido.dat');
{$I-} reset(archivo3); {$I+}
if ioresult <> 0 then
begin
writeln('?????? Error De Archovo Pulse Una Tecla ??????');
readkey;
end
else
begin
writeln(' Entre Codigo A Anular : ');
repeat
{$I-} readln(codig); {$I+}
if ioresult <> 0 then
writeln(' Entre Un Valor Numerico Entero ');
until ioresult = 0;
for ar := 0 to filesize(archivo3) - 1 do
begin
seek(archivo3,ar);
read(archivo3,bus2);
if bus2.cod = codig then
begin
assign(temp2,'tempor4.bbb');
rewrite(temp2);
ww := 0;
for yy := 0 to filesize(archivo3) - 1 do
begin
if yy <> ar then
begin
seek(archivo3,yy);
read(archivo3,bus2);
seek(temp2,ww);
write(temp2,bus2);
ww := ww + 1;
end;
end;
close(archivo3);
close(temp2);
erase(archivo3);
rename(temp2,'pedido.dat');
break;
end;
end;
end;
end;
end;


procedure menu;
var
sali : boolean;
ted : char;
begin
sali := false;
repeat
clrscr;
writeln('****** Menu Jeneral ******');
writeln;
writeln(' 1 = Productos Originales Cargados');
writeln(' 2 = Registros Actualizados Para Venta');
writeln(' 3 = Actualizar Los Registro Del Archivo');
writeln(' 4 = Lista Pedidos Ingresaron Actualizar');
writeln(' 5 = Productos Con Mas Cantidades Por Proveedor');
writeln(' 6 = Elimina El Producto Menos Vendido');
writeln(' 7 = Salir');
writeln;
writeln('>>>> Elija Opcion <<<<');
repeat
ted := readkey;
until ted in['1','2','3','4','5','6','7'];
clrscr;
case ted of
'1' : begin
writeln('Productos Originales Cargados Pulse Una Tecla');
entradas_compras('c');***
readkey;
end;
'2' : begin
writeln('Registros Actualizados Para Venta Pulse Una Tecla');
entradas_compras('p'); ****
readkey;
end;
'3' : begin
writeln('Actualizar Los Registro Del Archivo Pulse Una Tecla');
readkey;
end;
'4' : begin
writeln('Lista Pedidos Ingresaron Actualizar Pulse Una Tecla'); busqueda_por_codigo('c');
readkey;
end;
'5' : begin
writeln('Productos Con Mas Cantidades Por Proveedor Pulse Una Tecla');
readkey;
end;
'6' : begin
writeln('Elimina El Producto Menos Vendido Pulse Una Tecla');
readkey;
end;
'7' : sali := true;
end;
until sali = true;
end;



begin
aviercomp := false;
avierpedi := false;
prim := nil;
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

comercio de productos

Publicado por paulett (14 intervenciones) el 15/11/2013 19:55:28
te quería comentar que yo tnb. lo stoy viendo haber si encuentro lo que debe star pasando.
y quiero agradecerte tu ayuda, tu tiempo por que se que son muchos procedimientos...espero tu respuesta.
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

comercio de productos

Publicado por ramon (2158 intervenciones) el 15/11/2013 22:13:33
Disculpa mi despiste el procedure salvar_archivo(cual : char); queda así asido un despiste al
na quitarlo mira el programa queda así}

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
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
program comercio;
  uses
     crt;
 
  const
      ma = 100;
 
  type
 
   prod_compra = record
        cod : integer;
        cant : integer;
        preciouni : real;
        proveedor : integer;
        marca : boolean;
     end;
 
   pedidos = record
        cod : integer;
        cant : integer;
       preciounit : real;
       preciotot : real;
       provee : integer;
       marca : boolean;
     end;
 
          lista = ^nodo;
          nodo = record
              cod : integer;
             cant : integer;
           precio : real;
           totalr : integer;
             psig : lista
          end;
 
     stock = record
            cod : integer;
            cant : integer;
          end;
 
    var
      archivo : file of prod_compra;
      vector2 : array [1..ma] of stock;
     archivo3 : file of pedidos;
     prim, anter, actual : lista;
     regcomp : prod_compra;
     regpedi : pedidos;
     aviercomp, avierpedi : boolean;
 
   procedure salvar_archivo(cual : char);
   begin
      if upcase(cual) = 'C' then
      begin
      assign(archivo,'compra.dat');
   {$I-} reset(archivo); {$I+}
      end;
      if upcase(cual) = 'P' then
      begin
      assign(archivo3,'pedido.dat');
    {$I-} reset(archivo); {$I+}
      end;
    if ioresult <> 0 then
    begin
       if upcase(cual) = 'C' then
       begin
       rewrite(archivo);
       seek(archivo,0);
       write(archivo,regcomp);
       close(archivo);
       end;
       if upcase(cual) = 'P' then
       begin
       rewrite(archivo3);
       seek(archivo3,0);
       write(archivo3,regpedi);
       close(archivo3);
       end;
    end
  else
     begin
        if cual = 'C' then
        begin
           seek(archivo,filesize(archivo));
           write(archivo,regcomp);
           close(archivo);
        end;
          if cual = 'P' then
          begin
            seek(archivo3,filesize(archivo3));
            write(archivo3,regpedi);
            close(archivo3);
         end;
      end;
   end;
 
   procedure carga_archivo(nu : longint;cual : char);
   begin
      if upcase(cual) = 'C' then
      begin
      assign(archivo,'compra.dat');
   {$I-} reset(archivo); {$I+}
      end;
      if upcase(cual) = 'P' then
      begin
      assign(archivo3,'pedido.dat');
    {$I-} reset(archivo); {$I+}
      end;
       if ioresult <> 0 then
       begin
          writeln('   Error De Archivo Pulse Una Tecla ');
          readkey;
          exit;
       end
    else
       begin
       if upcase(cual) = 'C' then
       begin
          seek(archivo,nu);
          read(archivo,regcomp);
          aviercomp := true;
       end;
        if upcase(cual) = 'P' then
        begin
           seek(archivo3,nu);
           read(archivo3,regpedi);
           avierpedi := true;
        end;
     end;
   end;
 
   procedure entradas_compras(cual : char);
   var
     vale : boolean;
     marc : char;
     begin
        if upcase(cual) = 'C' then
        begin
          writeln('**** Entradas Campras ****');
          writeln;
          with regcomp do
          begin
          write('   Entre Codigo         : ');
          readln(cod);
          write('   Entre Cantidad       : ');
          readln(cant);
          write('   Entre Precio Unidad  : ');
          readln(preciouni);
          write('   Entre Num. Proveedor : ');
          readln(proveedor);
          write('   Marca False[N]/True[S]');
          readln(marc);
          if upcase(marc) = 'S' then
          marca := true
        else
          marca := false;
          end;
          salvar_archivo('c');
        end;
        if upcase(cual) = 'P' then
        begin
          writeln('**** Entradas Ventas ****');
          writeln;
          with regpedi do
          begin
          write('  Entre Codigo         : ');
          readln(cod );
          write('  Entre Cantidad       : ');
          readln(cant);
          write('  Entre Precio Unidad  : ');
          readln(preciounit);
          write('  Entre Precio Total   : ');
          readln(preciotot);
          write('  Entre Num. Proveedor : ');
          readln(provee);
          write('  Marca False[N]/True[S]');
          readln(marc);
          if upcase(marc) = 'S' then
          marca := true
        else
          marca := false;
          end;
          salvar_archivo('p');
        end;
     end;
 
   procedure carca_punteros(d : nodo);
   begin
      if prim = nil then
      begin
         new(actual);
         actual^ := d;
         prim := actual;
         actual^.psig := nil;
      end
    else
        begin
           anter := actual;
           new(actual);
           actual^ := d;
           anter^.psig := actual;
           actual^.psig := nil;
       end;
   end;
 
   procedure muestra_nodos;
   var
     temp : lista;
     begin
        if temp <> nil then
        while temp <> nil do
        begin
           writeln('**** Presetacion de datos ****');
           writeln;
           write('  Codigo : ',temp^.cod,'  Cantidad : ',temp^.cant,
           '  Precio : ',temp^.precio,'  Total : ',temp^.totalr);
           temp := temp^.psig;
        end;
     end;
 
  procedure ordena_archivos_por_codigo(cual : char);
  var
    toma1, temp1 : prod_compra;
    toma2, temp2 : pedidos;
    co1, co2 : longint;
  begin
      if upcase(cual) = 'C' then
      begin
         assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
            for co1 := 0 to filesize(archivo) - 1 do
            begin
               seek(archivo,co1);
               read(archivo,regcomp);
              for co2 := filesize(archivo) - 1 downto co1 do
              begin
                 seek(archivo,co2);
                 read(archivo,toma1);
                 if regcomp.cod > toma1.cod then
                 begin
                    temp1 := regcomp;
                    regcomp := toma1;
                    toma1 := temp1;
                    seek(archivo,co1);
                    write(archivo,regcomp);
                    seek(archivo,co2);
                    write(archivo,toma1);
                 end;
              end;
            end;
            close(archivo);
        end;
      end;
      if upcase(cual) = 'P' then
      begin
        assign(archivo3,'pedido.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          for co1 := 0 to filesize(archivo3) - 1 do
          begin
            seek(archivo3,co1);
            read(archivo3,regpedi);
              for co2 := filesize(archivo3) - 1 downto co1 do
              begin
                 seek(archivo3,co2);
                 read(archivo3,toma2);
                 if regpedi.cod > toma2.cod then
                 begin
                    temp2 := regpedi;
                    regpedi := toma2;
                    toma2 := temp2;
                    seek(archivo3,co1);
                    write(archivo3,regpedi);
                    seek(archivo3,co2);
                    write(archivo3,toma2);
                 end;
              end;
            end;
             close(archivo3);
        end;
      end;
   end;
 
  procedure busqueda_por_codigo(cual : char);
  var
    busq : longint;
    bus1 : prod_compra;
    bus2 : pedidos;
    cocomp : integer;
  begin
     if upcase(cual) = 'C' then
      begin
         assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          writeln('   Entre Codigo A Buscar : ');
         repeat
        {$I-}  readln(cocomp); {$I+}
        if ioresult <> 0 then
        writeln('  Entre Un Valor Numerico Entero ');
         until ioresult = 0;
          for busq := 0 to filesize(archivo) - 1 do
          begin
             seek(archivo,busq);
             read(archivo,bus1);
             if bus1.cod = cocomp then
             begin
               writeln(' Codigo : ',bus1.cod,'   Cantidad : ',bus1.cant,
               '   Precio Unidad : ',bus1.preciouni:0:2,'   Precio Vendeedor : ',
               bus1.proveedor);
               writeln('   Pulse Una Tecla');
               readkey;
               break;
             end;
          end;
          close(archivo);
        end;
      end;
        if upcase(cual) = 'P' then
        begin
          assign(archivo3,'pedido.dat');
        {$I-} reset(archivo); {$I+}
          if ioresult <> 0 then
          begin
             writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
         writeln('   Entre Codigo A Buscar : ');
         repeat
        {$I-}  readln(cocomp); {$I+}
        if ioresult <> 0 then
        writeln('  Entre Un Valor Numerico Entero ');
         until ioresult = 0;
          for busq := 0 to filesize(archivo3) - 1 do
          begin
             seek(archivo3,busq);
             read(archivo3,bus2);
             if bus2.cod = cocomp then
             begin
               writeln(' Codigo : ',bus2.cod,'   Cantidad : ',bus2.cant,
          '   Precio Unidad : ',bus2.preciounit:0:2,'   Precio Total : ',
              bus2.preciotot:0:2,'   Proveedor : ',bus2.provee);
               writeln('   Pulse Una Tecla');
               readkey;
               break;
             end;
          end;
          close(archivo3);
        end;
    end;
  end;
 
  procedure eliminacion_de_datos(cual : char);
  var
    codig : integer;
    yy, ww, ar : longint;
    bus1 : prod_compra;
    bus2 : pedidos;
    temp1 : file of prod_compra;
    temp2 : file of pedidos;
  begin
     if upcase(cual) = 'C' then
      begin
         assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          writeln('   Entre Codigo A Anular : ');
         repeat
        {$I-}  readln(codig); {$I+}
        if ioresult <> 0 then
        writeln('  Entre Un Valor Numerico Entero ');
         until ioresult = 0;
          for ar := 0 to filesize(archivo) - 1 do
          begin
             seek(archivo,ar);
             read(archivo,bus1);
             if bus1.cod = codig then
             begin
                assign(temp1,'temporal.bbb');
                rewrite(temp1);
                ww := 0;
                for yy := 0 to filesize(archivo) - 1 do
                begin
                if yy <> ar then
                begin
                  seek(archivo,yy);
                  read(archivo,bus1);
                  seek(temp1,ww);
                  write(temp1,bus1);
                  ww := ww + 1;
                end;
               end;
               close(archivo);
               close(temp1);
               erase(archivo);
               rename(temp1,'compra.dat');
               break;
             end;
          end;
        end;
      end;
      if upcase(cual) = 'P' then
      begin
         assign(archivo3,'pedido.dat');
       {$I-} reset(archivo3); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          writeln('   Entre Codigo A Anular : ');
         repeat
        {$I-}  readln(codig); {$I+}
        if ioresult <> 0 then
        writeln('  Entre Un Valor Numerico Entero ');
         until ioresult = 0;
          for ar := 0 to filesize(archivo3) - 1 do
          begin
             seek(archivo3,ar);
             read(archivo3,bus2);
             if bus2.cod = codig then
             begin
                assign(temp2,'tempor4.bbb');
                rewrite(temp2);
                ww := 0;
                for yy := 0 to filesize(archivo3) - 1 do
                begin
                if yy <> ar then
                begin
                  seek(archivo3,yy);
                  read(archivo3,bus2);
                  seek(temp2,ww);
                  write(temp2,bus2);
                  ww := ww + 1;
                end;
               end;
               close(archivo3);
               close(temp2);
               erase(archivo3);
               rename(temp2,'pedido.dat');
               break;
             end;
          end;
        end;
     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

comercio de productos

Publicado por ramon (2158 intervenciones) el 15/11/2013 22:14:48
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
{Los dos}
 
 procedure modificacion_de_datos(cual : char);
  var
    codigo : integer;
    modi1 : prod_compra;
    modi2 : pedidos;
    rd : longint;
    opc, tt : char;
    begin
       if upcase(cual) = 'C' then
       begin
          assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
           clrscr;
           writeln('***** Modificacion de datos *****');
           writeln;
           write('   Entre codigo : ');
           repeat
           {$I-}  readln(codigo); {$I+}
           if ioresult <> 0 then
           writeln('   Entre Un Valor Numerico Entero');
           until ioresult = 0;
           for rd := 0 to filesize(archivo) - 1 do
           begin
              seek(archivo,rd);
              read(archivo,modi1);
              if modi1.cod = codigo then
              begin
             repeat
                 clrscr;
                 writeln('  Menu Modificacion ');
                 writeln;
                 writeln('  1 = codigo');
                 writeln('  2 = cantidad');
                 writeln('  3 = precio unidad');
                 writeln('  4 = proovedor');
                 writeln('  5 = marca');
                 writeln('  6 = fin');
                 writeln;
                 writeln('  Elija Modificacion ');
                 repeat
                    opc := readkey;
                 until opc in['1','2','3','4','5','6'];
                 clrscr;
              case opc of
           '1' : begin
                   write('  codigo : ');
                   readln(modi1.cod);
                 end;
           '2' : begin
                   write('  cantidad : ');
                   readln(modi1.cant);
                 end;
           '3' : begin
                   write('  precio unidad : ');
                   readln(modi1.preciouni);
                 end;
           '4' : begin
                   write('  proveedor : ');
                   readln(modi1.proveedor);
                 end;
           '5' : begin
                   write('  marca : [N]=false [S]=true');
                   repeat
                       tt := upcase(readkey);
                   until tt in['N','S'];
                   if tt = 'S' then
                   modi1.marca := true
                 else
                   modi1.marca := false;
                 end;
             end;
             until opc = '6';
             seek(archivo,rd);
             write(archivo,modi1);
             close(archivo);
             break;
            end;
           end;
        end;
       end;
       if upcase(cual) = 'P' then
       begin
          assign(archivo3,'pedido.dat');
       {$I-} reset(archivo3); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
           clrscr;
           writeln('***** Modificacion de pedidos datos *****');
           writeln;
           write('   Entre codigo : ');
           repeat
           {$I-}  readln(codigo); {$I+}
           if ioresult <> 0 then
           writeln('   Entre Un Valor Numerico Entero');
           until ioresult = 0;
           for rd := 0 to filesize(archivo3) - 1 do
           begin
              seek(archivo3,rd);
              read(archivo3,modi2);
              if modi2.cod = codigo then
              begin
             repeat
                 clrscr;
                 writeln('  Menu Modificacion ');
                 writeln;
                 writeln('  1 = codigo');
                 writeln('  2 = cantidad');
                 writeln('  3 = precio unidad');
                 writeln('  4 = proovedor');
                 writeln('  5 = marca');
                 writeln('  6 = fin');
                 writeln;
                 writeln('  Elija Modificacion ');
                 repeat
                    opc := readkey;
                 until opc in['1','2','3','4','5','6'];
                 clrscr;
              case opc of
           '1' : begin
                   write('  codigo : ');
                   readln(modi2.cod);
                 end;
           '2' : begin
                   write('  cantidad : ');
                   readln(modi2.cant);
                 end;
           '3' : begin
                   write('  precio unidad : ');
                   readln(modi2.preciounit);
                 end;
           '4' : begin
                   write('  proveedor : ');
                   readln(modi2.provee);
                 end;
           '5' : begin
                   write('  marca : [N]=false [S]=true');
                   repeat
                       tt := upcase(readkey);
                   until tt in['N','S'];
                   if tt = 'S' then
                   modi2.marca := true
                 else
                   modi2.marca := false;
                 end;
             end;
             until opc = '6';
             seek(archivo3,rd);
             write(archivo3,modi2);
             close(archivo3);
             break;
            end;
           end;
         end;
       end;
    end;
 
 
  procedure menu;
  var
   sali : boolean;
   ted : char;
  begin
     sali := false;
    repeat
       clrscr;
       writeln('****** Menu Jeneral ******');
       writeln;
       writeln('    1 = Productos Originales Cargados');
       writeln('    2 = Registros Actualizados Para Venta');
       writeln('    3 = Actualizar Los Registro Del Archivo');
       writeln('    4 = Lista Pedidos Ingresaron Actualizar');
       writeln('    5 = Productos Con Mas Cantidades Por Proveedor');
       writeln('    6 = Elimina El Producto Menos Vendido');
       writeln('    7 = Salir');
       writeln;
       writeln('>>>> Elija Opcion <<<<');
       repeat
          ted := readkey;
       until ted in['1','2','3','4','5','6','7'];
       clrscr;
     case ted of
  '1' : begin
            entradas_compras('c');
        end;
  '2' : begin
          entradas_compras('p');
        end;
  '3' : begin
          writeln('Actualizar Los Registro Del Archivo Pulse Una Tecla');
          readkey;
        end;
  '4' : begin
          busqueda_por_codigo('c');
        end;
  '5' : begin
          writeln('Productos Con Mas Cantidades Por Proveedor Pulse Una Tecla');
          readkey;
        end;
  '6' : begin
          writeln('Elimina El Producto Menos Vendido Pulse Una Tecla');
          readkey;
        end;
  '7' : sali := true;
    end;
    until sali = true;
  end;
 
 
 
  begin
     aviercomp := false;
     avierpedi := false;
     prim := nil;
     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

comercio de productos

Publicado por paulett (14 intervenciones) el 15/11/2013 23:51:16
Ramon puedo introducir datos del producto pero no muestra uno a continuacion de otro. supongamos que ingreso 10 productos no me los deja ver de manera consecutiva.
no me actualiza los precios con un recargo del 45% mas y sumando las cantidades anteriores si hay.
la lista no me muestra.
el vector tampoco
y me dice que ingrese el codigo a eliminar pero no se vé si se elimina; para eliminar no es ingresar codigo por teclado sino el producto con mayor cantidad en stock lo elimino del archivo.
ojala podamos ver en donde estan los errores y asi puedo presentarlo....espero tu respuesta
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

comercio de productos

Publicado por ramon (2158 intervenciones) el 16/11/2013 16:41:11
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
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
{Mira te pongo esto com correciones pero tu tienes que colocar como tu quieras las formas yo
solo te encamino y si tienes dudas las intentare solucionar mira esto}
 
 program comercio;
  uses
     crt;
 
  const
      ma = 100;
      por100 = 45;
  type
 
   prod_compra = record
        cod : integer;
        cant : integer;
        preciouni : real;
       preciovent : real;
        proveedor : integer;
        marca : boolean;
     end;
 
   pedidos = record
        cod : integer;
        cant : integer;
       preciounit : real;
       preciotot : real;
       provee : integer;
       marca : boolean;
     end;
 
          lista = ^nodo;
          nodo = record
              cod : integer;
             cant : integer;
           precio : real;
           totalr : integer;
             psig : lista
          end;
 
     stock = record
            cod : integer;
            cant : integer;
          end;
 
    var
      archivo : file of prod_compra;
      vector2 : array [1..ma] of stock;
     archivo3 : file of pedidos;
     prim, anter, actual : lista;
     regcomp : prod_compra;
     regpedi : pedidos;
     aviercomp, avierpedi : boolean;
 
   procedure salvar_archivo(cual : char);
   begin
      if upcase(cual) = 'C' then
      begin
      assign(archivo,'compra.dat');
   {$I-} reset(archivo); {$I+}
      end;
      if upcase(cual) = 'P' then
      begin
      assign(archivo3,'pedido.dat');
    {$I-} reset(archivo); {$I+}
      end;
    if ioresult <> 0 then
    begin
       if upcase(cual) = 'C' then
       begin
          rewrite(archivo);
          seek(archivo,0);
          write(archivo,regcomp);
          close(archivo);
       end;
     if upcase(cual) = 'P' then
      begin
       rewrite(archivo3);
       seek(archivo3,0);
       write(archivo3,regpedi);
       close(archivo3);
       end;
     end
  else
     begin
         if upcase(cual) = 'C' then
         begin
         seek(archivo,filesize(archivo));
         write(archivo,regcomp);
         close(archivo);
         end;
         if upcase(cual) = 'P' then
         begin
            seek(archivo3,filesize(archivo3));
            write(archivo3,regpedi);
            close(archivo3);
         end;
      end;
   end;
 
   procedure carga_archivo(nu : longint;cual : char);
   begin
      if upcase(cual) = 'C' then
      begin
      assign(archivo,'compra.dat');
   {$I-} reset(archivo); {$I+}
      end;
      if upcase(cual) = 'P' then
      begin
      assign(archivo3,'pedido.dat');
    {$I-} reset(archivo); {$I+}
      end;
       if ioresult <> 0 then
       begin
          writeln('   Error De Archivo Pulse Una Tecla ');
          readkey;
          exit;
       end
    else
       begin
       if upcase(cual) = 'C' then
       begin
          seek(archivo,nu);
          read(archivo,regcomp);
          aviercomp := true;
       end;
        if upcase(cual) = 'P' then
        begin
           seek(archivo3,nu);
           read(archivo3,regpedi);
           avierpedi := true;
        end;
     end;
   end;
 
   procedure entradas_compras(cual : char);
   var
     vale : boolean;
     marc : char;
     begin
        if upcase(cual) = 'C' then
        begin
          writeln('**** Entradas Campras ****');
          writeln;
          with regcomp do
          begin
          write('   Entre Codigo         : ');
          readln(cod);
          write('   Entre Cantidad       : ');
          readln(cant);
          write('   Entre Precio Unidad  : ');
          readln(preciouni);
          preciovent := preciouni + ((preciouni * por100) / 100);
          write('   Entre Num. Proveedor : ');
          readln(proveedor);
          write('   Marca False[N]/True[S]');
          readln(marc);
          if upcase(marc) = 'S' then
          marca := true
        else
          marca := false;
          end;
          salvar_archivo('c');
        end;
        if upcase(cual) = 'P' then
        begin
          writeln('**** Entradas Ventas ****');
          writeln;
          with regpedi do
          begin
          write('  Entre Codigo         : ');
          readln(cod );
          write('  Entre Cantidad       : ');
          readln(cant);
          write('  Entre Precio Unidad  : ');
          readln(preciounit);
          write('  Entre Precio Total   : ');
          readln(preciotot);
          write('  Entre Num. Proveedor : ');
          readln(provee);
          write('  Marca False[N]/True[S]');
          readln(marc);
          if upcase(marc) = 'S' then
          marca := true
        else
          marca := false;
          end;
          salvar_archivo('p');
        end;
     end;
 
   procedure carca_punteros(d : nodo);
   begin
      if prim = nil then
      begin
         new(actual);
         actual^ := d;
         prim := actual;
         actual^.psig := nil;
      end
    else
        begin
           anter := actual;
           new(actual);
           actual^ := d;
           anter^.psig := actual;
           actual^.psig := nil;
       end;
   end;
 
   procedure muestra_nodos;
   var
     temp : lista;
     begin
        writeln('**** Presetacion de datos ****');
        writeln;
        if temp <> nil then
        while temp <> nil do
        begin
           writeln('  Codigo : ',temp^.cod,'  Cantidad : ',temp^.cant,
           '  Precio : ',temp^.precio:0:2,'  Total : ',temp^.totalr);
           temp := temp^.psig;
        end;
     end;
 
  procedure ordena_archivos_por_codigo(cual : char);
  var
    toma1, temp1 : prod_compra;
    toma2, temp2 : pedidos;
    co1, co2 : longint;
  begin
      if upcase(cual) = 'C' then
      begin
         assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
            for co1 := 0 to filesize(archivo) - 1 do
            begin
               seek(archivo,co1);
               read(archivo,regcomp);
              for co2 := filesize(archivo) - 1 downto co1 do
              begin
                 seek(archivo,co2);
                 read(archivo,toma1);
                 if regcomp.cod > toma1.cod then
                 begin
                    temp1 := regcomp;
                    regcomp := toma1;
                    toma1 := temp1;
                    seek(archivo,co1);
                    write(archivo,regcomp);
                    seek(archivo,co2);
                    write(archivo,toma1);
                 end;
              end;
            end;
            close(archivo);
        end;
      end;
      if upcase(cual) = 'P' then
      begin
        assign(archivo3,'pedido.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          for co1 := 0 to filesize(archivo3) - 1 do
          begin
            seek(archivo3,co1);
            read(archivo3,regpedi);
              for co2 := filesize(archivo3) - 1 downto co1 do
              begin
                 seek(archivo3,co2);
                 read(archivo3,toma2);
                 if regpedi.cod > toma2.cod then
                 begin
                    temp2 := regpedi;
                    regpedi := toma2;
                    toma2 := temp2;
                    seek(archivo3,co1);
                    write(archivo3,regpedi);
                    seek(archivo3,co2);
                    write(archivo3,toma2);
                 end;
              end;
            end;
             close(archivo3);
        end;
      end;
   end;
 
  procedure busqueda_por_codigo(cual : char);
  var
    busq : longint;
    bus1 : prod_compra;
    bus2 : pedidos;
    cocomp : integer;
  begin
     if upcase(cual) = 'C' then
      begin
         assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          writeln('   Entre Codigo A Buscar : ');
         repeat
        {$I-}  readln(cocomp); {$I+}
        if ioresult <> 0 then
        writeln('  Entre Un Valor Numerico Entero ');
         until ioresult = 0;
          for busq := 0 to filesize(archivo) - 1 do
          begin
             seek(archivo,busq);
             read(archivo,bus1);
             if bus1.cod = cocomp then
             begin
               writeln(' Codigo : ',bus1.cod,'   Cantidad : ',bus1.cant,
               '   Precio Unidad : ',bus1.preciouni:0:2,'   Precio Vendeedor : ',
               bus1.proveedor);
               writeln('   Pulse Una Tecla');
               readkey;
               break;
             end;
          end;
          close(archivo);
        end;
      end;
        if upcase(cual) = 'P' then
        begin
          assign(archivo3,'pedido.dat');
        {$I-} reset(archivo); {$I+}
          if ioresult <> 0 then
          begin
             writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
         writeln('   Entre Codigo A Buscar : ');
         repeat
        {$I-}  readln(cocomp); {$I+}
        if ioresult <> 0 then
        writeln('  Entre Un Valor Numerico Entero ');
         until ioresult = 0;
          for busq := 0 to filesize(archivo3) - 1 do
          begin
             seek(archivo3,busq);
             read(archivo3,bus2);
             if bus2.cod = cocomp then
             begin
               writeln(' Codigo : ',bus2.cod,'   Cantidad : ',bus2.cant,
          '   Precio Unidad : ',bus2.preciounit:0:2,'   Precio Total : ',
              bus2.preciotot:0:2,'   Proveedor : ',bus2.provee);
               writeln('   Pulse Una Tecla');
               readkey;
               break;
             end;
          end;
          close(archivo3);
        end;
    end;
  end;
 
  procedure eliminacion_de_datos(cual : char);
  var
    codig : integer;
    yy, ww, ar : longint;
    bus1 : prod_compra;
    bus2 : pedidos;
    temp1 : file of prod_compra;
    temp2 : file of pedidos;
  begin
     if upcase(cual) = 'C' then
      begin
         assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          write('   Entre Codigo A Anular : ');
         repeat
        {$I-}  readln(codig); {$I+}
        if ioresult <> 0 then
        writeln('  Entre Un Valor Numerico Entero ');
         until ioresult = 0;
          for ar := 0 to filesize(archivo) - 1 do
          begin
             seek(archivo,ar);
             read(archivo,bus1);
             if bus1.cod = codig then
             begin
                assign(temp1,'temporal.bbb');
                rewrite(temp1);
                ww := 0;
                for yy := 0 to filesize(archivo) - 1 do
                begin
                if yy <> ar then
                begin
                  seek(archivo,yy);
                  read(archivo,bus1);
                  seek(temp1,ww);
                  write(temp1,bus1);
                  ww := ww + 1;
                end;
               end;
               close(archivo);
               close(temp1);
               erase(archivo);
               rename(temp1,'compra.dat');
               break;
             end;
          end;
        end;
      end;
      if upcase(cual) = 'P' then
      begin
         assign(archivo3,'pedido.dat');
       {$I-} reset(archivo3); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
          write('   Entre Codigo A Anular : ');
         repeat
        {$I-}  readln(codig); {$I+}
        if ioresult <> 0 then
        writeln('  Entre Un Valor Numerico Entero ');
         until ioresult = 0;
          for ar := 0 to filesize(archivo3) - 1 do
          begin
             seek(archivo3,ar);
             read(archivo3,bus2);
             if bus2.cod = codig then
             begin
                assign(temp2,'tempor4.bbb');
                rewrite(temp2);
                ww := 0;
                for yy := 0 to filesize(archivo3) - 1 do
                begin
                if yy <> ar then
                begin
                  seek(archivo3,yy);
                  read(archivo3,bus2);
                  seek(temp2,ww);
                  write(temp2,bus2);
                  ww := ww + 1;
                end;
               end;
               close(archivo3);
               close(temp2);
               erase(archivo3);
               rename(temp2,'pedido.dat');
               break;
             end;
          end;
        end;
     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

comercio de productos

Publicado por ramon (2158 intervenciones) el 16/11/2013 16:50:06
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
{Segunda parte}
 
 procedure modificacion_de_datos(cual : char);
  var
    codigo : integer;
    modi1 : prod_compra;
    modi2 : pedidos;
    rd : longint;
    opc, tt : char;
    begin
       if upcase(cual) = 'C' then
       begin
          assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
           clrscr;
           writeln('***** Modificacion de datos *****');
           writeln;
           write('   Entre codigo : ');
           repeat
           {$I-}  readln(codigo); {$I+}
           if ioresult <> 0 then
           writeln('   Entre Un Valor Numerico Entero');
           until ioresult = 0;
           for rd := 0 to filesize(archivo) - 1 do
           begin
              seek(archivo,rd);
              read(archivo,modi1);
              if modi1.cod = codigo then
              begin
             repeat
                 clrscr;
                 writeln('  Menu Modificacion ');
                 writeln;
                 writeln('  1 = codigo');
                 writeln('  2 = cantidad');
                 writeln('  3 = precio unidad');
                 writeln('  4 = proovedor');
                 writeln('  5 = marca');
                 writeln('  6 = fin');
                 writeln;
                 writeln('  Elija Modificacion ');
                 repeat
                    opc := readkey;
                 until opc in['1','2','3','4','5','6'];
                 clrscr;
              case opc of
           '1' : begin
                   write('  codigo : ');
                   readln(modi1.cod);
                 end;
           '2' : begin
                   write('  cantidad : ');
                   readln(modi1.cant);
                 end;
           '3' : begin
                   write('  precio unidad : ');
                   readln(modi1.preciouni);
                 end;
           '4' : begin
                   write('  proveedor : ');
                   readln(modi1.proveedor);
                 end;
           '5' : begin
                   write('  marca : [N]=false [S]=true');
                   repeat
                       tt := upcase(readkey);
                   until tt in['N','S'];
                   if tt = 'S' then
                   modi1.marca := true
                 else
                   modi1.marca := false;
                 end;
             end;
             until opc = '6';
             seek(archivo,rd);
             write(archivo,modi1);
             close(archivo);
             break;
            end;
           end;
        end;
       end;
       if upcase(cual) = 'P' then
       begin
          assign(archivo3,'pedido.dat');
       {$I-} reset(archivo3); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
           clrscr;
           writeln('***** Modificacion de pedidos datos *****');
           writeln;
           write('   Entre codigo : ');
           repeat
           {$I-}  readln(codigo); {$I+}
           if ioresult <> 0 then
           writeln('   Entre Un Valor Numerico Entero');
           until ioresult = 0;
           for rd := 0 to filesize(archivo3) - 1 do
           begin
              seek(archivo3,rd);
              read(archivo3,modi2);
              if modi2.cod = codigo then
              begin
             repeat
                 clrscr;
                 writeln('  Menu Modificacion ');
                 writeln;
                 writeln('  1 = codigo');
                 writeln('  2 = cantidad');
                 writeln('  3 = precio unidad');
                 writeln('  4 = proovedor');
                 writeln('  5 = marca');
                 writeln('  6 = fin');
                 writeln;
                 writeln('  Elija Modificacion ');
                 repeat
                    opc := readkey;
                 until opc in['1','2','3','4','5','6'];
                 clrscr;
              case opc of
           '1' : begin
                   write('  codigo : ');
                   readln(modi2.cod);
                 end;
           '2' : begin
                   write('  cantidad : ');
                   readln(modi2.cant);
                 end;
           '3' : begin
                   write('  precio unidad : ');
                   readln(modi2.preciounit);
                 end;
           '4' : begin
                   write('  proveedor : ');
                   readln(modi2.provee);
                 end;
           '5' : begin
                   write('  marca : [N]=false [S]=true');
                   repeat
                       tt := upcase(readkey);
                   until tt in['N','S'];
                   if tt = 'S' then
                   modi2.marca := true
                 else
                   modi2.marca := false;
                 end;
             end;
             until opc = '6';
             seek(archivo3,rd);
             write(archivo3,modi2);
             close(archivo3);
             break;
            end;
           end;
         end;
       end;
    end;
 
  procedure muestra_entrada_todas(cual : char);
  var
    w : longint;
    ver1 : prod_compra;
    ver2 : pedidos;
    t : integer;
   begin
      if upcase(cual) = 'C' then
      begin
          assign(archivo,'compra.dat');
       {$I-} reset(archivo); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
           clrscr;
           w := 0;
           t := 1;
           repeat
           seek(archivo,w);
           read(archivo,ver1);
           writeln('Cod.:',ver1.cod,'  Cantid.:',ver1.cant,'  Prc.uni:',
           ver1.preciouni:0:2,'  incre.:',ver1.preciovent,
           '  N.Prov.:',ver1.proveedor,'  Ma.:',ver1.marca);
           w := w + 1;
           t := t + 1;
           if t > 22 then
           begin
              writeln('<<<< Pulse Una Tecla Para Segir >>>>');
              readkey;
              t := 1;
           end;
           until w > filesize(archivo) - 1;
           writeln('***** Fin De Presentacion Pulse Una Tecla *****');
           readkey;
           close(archivo);
        end;
      end;
      if upcase(cual) = 'P' then
      begin
         assign(archivo3,'pedido.dat');
       {$I-} reset(archivo3); {$I+}
       if ioresult <> 0 then
       begin
          writeln('?????? Error De Archovo Pulse Una Tecla ??????');
          readkey;
       end
     else
        begin
           clrscr;
           w := 0;
           t := 1;
           repeat
           seek(archivo3,w);
           read(archivo3,ver2);
           writeln('Codigo:',ver2.cod,'  Cantidad:',ver2.cant,'  Prec.unid:',
           ver2.preciounit:0:2,'  Num.Prov.:',ver2.provee,'  Marca:',ver2.marca);
           w := w + 1;
           t := t + 1;
           if t > 22 then
           begin
              writeln('<<<< Pulse Una Tecla Para Segir >>>>');
              readkey;
              t := 1;
           end;
           until w > filesize(archivo3) - 1;
           writeln('***** Fin De Presentacion Pulse Una Tecla *****');
           readkey;
          close(archivo3);
        end;
      end;
   end;
 
 
  procedure menu;
  var
   sali : boolean;
   ted : char;
   nume : integer;
  begin
     sali := false;
    repeat
       clrscr;
       writeln('****** Menu Jeneral ******');
       writeln;
       writeln('    1 = Productos Originales Cargados');
       writeln('    2 = Registros Actualizados Para Venta');
       writeln('    3 = Actualizar Los Registro Del Archivo');
       writeln('    4 = Lista Pedidos Ingresaron Actualizar');
       writeln('    5 = Productos Con Mas Cantidades Por Proveedor');
       writeln('    6 = Elimina El Producto Menos Vendido');
       writeln('    7 = Visualizar Archivos Todo');
       writeln('    8 = Salir');
       writeln;
       writeln('>>>> Elija Opcion <<<<');
       repeat
          ted := readkey;
       until ted in['1','2','3','4','5','6','7','8'];
       clrscr;
     case ted of
  '1' : begin
            write('<<<< Entrada De Datos De Cual [C]=compras [P]=Pedidos: ');
           repeat
           ted := upcase(readkey);
           until ted in['C','P'];
           clrscr;
            entradas_compras(ted);
        end;
  '2' : begin
          writeln('Registros Actualizados Para Venta');
          readkey;
        end;
  '3' : begin
          write('<<<< Modificacion De Datos De Cual [C]=compras [P]=Pedidos: ');
           repeat
           ted := upcase(readkey);
           until ted in['C','P'];
           clrscr;
          modificacion_de_datos(ted);
        end;
  '4' : begin
          busqueda_por_codigo('c');
        end;
  '5' : begin
          writeln('Productos Con Mas Cantidades Por Proveedor Pulse Una Tecla');
          readkey;
        end;
  '6' : begin
          write('<<<< Eliminacion De Datos De Cual [C]=compras [P]=Pedidos: ');
           repeat
           ted := upcase(readkey);
           until ted in['C','P'];
           clrscr;
            eliminacion_de_datos(ted);
        end;
  '7' : begin
           write('  Pulse Archivo A Visualizar : [C]=Compras  [P]=Pedidos');
           repeat
           ted := upcase(readkey);
           until ted in['C','P'];
           clrscr;
           muestra_entrada_todas(ted);
           ted := #0;

        end;
  '8' : sali := true;
    end;
    until sali = true;
  end;
 
 
 
  begin
     aviercomp := false;
     avierpedi := false;
     prim := nil;
     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

comercio de productos

Publicado por paulett (14 intervenciones) el 18/11/2013 14:17:18
Gracias Ramón por todo lo que me ayudaste...¿querí preguntarte para que pones 'break' en el programa; perdon es mi primer año cursando.
y otra si ya tengo un archivo cargado con datos ¿puedo abriendo el archivo cargar al vector sin ingresar por teclado nada al vector ? osea ingresaría datos al archivo. y lo puedo ver en pantalla.gracias.
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

comercio de productos

Publicado por ramon (2158 intervenciones) el 18/11/2013 18:11:16
La sentencia break finaliza la secuencia for de inmediato tan bien funciona de la misma manera
con while y repeat.
Lo otro cuando cargas datos al array sino modificas nada no debes de salvarlo con eso no nidificas
nada.
Osea:

seek(archivo,P);
read(archivo,datos);
Solo carga los datos del registro apuntado por P y tu los muestras con write no hay modificacion
lomismo al cargar ei array.

array[x] := datos;

no se modifica nada para modificar seria

datos := array[x];
seek(archivo,P);
write(archivo,datos);

Así si que cambiamos los datos del archivo sino no.
Pero siempre antes de abandonar cierra el archivo para evitar problemas.
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

comercio de productos

Publicado por paulett (14 intervenciones) el 18/11/2013 18:36:28
y error 106 k significa, Ramón?. despues de hacer 3 pedidos por pantalla me regresa al programa; al menú ¡¡¡no!!! al programa y sale error 106. Gracias; estoy estudiando por que seguro nos hacen los profes hacer algo en la compu.
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

comercio de productos

Publicado por ramon (2158 intervenciones) el 19/11/2013 12:17:43
Estos son los errores 106 dependiendo cuando
surjan.

Mensajes de error del compilador
106 Esta expresión debe ser de tipo carácter.

Mensajes de error en tiempo de ejecución
106 Read y ReadLn generan este error si un valor
numérico le¡do de un fichero de texto no es
conforme al formato numérico correcto.

Suele surgir por error de entrada o de asignación al cargar los datos.
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

comercio de productos

Publicado por paulett (14 intervenciones) el 19/11/2013 12:42:05
Gracias Ramón, gracias a esta medio creado para ayudarnos...si me surge alguna duda volvere a preguntarte; y despues de los examenes kiero aprender algún otro lenguaje; y me comunicaré nuevamente. Hasta la prox.
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