programa completo
Publicado por Miguel (10 intervenciones) el 16/06/2011 20:51:19
Program gestcomercial;
uses crt,DOS;
TYPE
{===================== TIPO CLIENTE ================================}
cliente=record
NIF:string[10];
rsocial:string[40];
fpago:char;
estado:char;
fecha:string[12];
end;
pCliente=^nodocliente;
nodocliente=record
infoc:cliente;
sig:pCliente;
end;
{====================================================================}
{=================== TIPO PEDIDOS ==================================}
linea=record
nLinea:integer;
numpedido:integer;
cantidad:integer;
ppu:longint;
pt:longint;
end;
pLinea=^nodoLinea ;
nodoLinea=record
infoLinea:linea;
sig:plinea;
end;
{******************************}
pedido=record
npedido:integer;
cifCliente:string[10];
impPedido:longint;
fecha:string[10];
estado:char;
end;
pPedido=^nodoPedido;
nodoPedido=record
infoPedido:pedido;
lineas:pLinea;
sig:pPedido;
end;
{===================== TIPO FACTURAS =====================================}
LINEAF= record
nLineaF:integer;
nfactura:integer;
Cantidad:integer;
ipulF:longint;
itlF:longint;
end;
pLineaF=^nodolineaf;
nodolineaF=record
infolineaF:lineaF;
sig:pLineaf;
end;
{************************************************************************** }
factura=record
nfactura:integer;
cifCliente:string[10];
impFactura:longint; {calculado como suma de importe de lineas}
fecha:string[12];
end;
pFactura=^nodoFactura;
nodoFactura=record
infoFactura:factura;
sig:pFactura;
lineaF:pLineaF;
end;
{************************************************************************}
cuota=record
nfactura:integer;
norden:integer;
importe:longint;
{ vencimiento:fecha;}
end;
pCuota=^nodoCuota;
nodoCuota=record
infoCuota:cuota;
sig:pCuota;
end;
{========================================================================}
VAR
listacliente:pCliente;
c:cliente;
listaPedido:pPedido;
p:pedido;
listalinea:pLinea;
l:linea;
listafactura:pFactura;
f:factura;
listalineaF:plineaF;
lf:lineaF;
listacuota:pCuota;
ct:cuota;
s:string;
opc:integer;
opc2,opc3,opc4:char;
{************************************************************************}
{*======================= CLIENTES =====================================*}
{************************************************************************}
Procedure crealistavaciaC(VAR listacliente:pCliente);
begin
listacliente:=nil;
end;
Function listavaciaC(listacliente:pCliente):boolean;
Begin
listavaciaC:=listacliente=nil;
end;
function anterior(listacliente:pCliente; punttemp:pCliente):pCliente;
var i: pcliente;
begin
i:=listacliente;
if listavaciaC(listacliente) or (punttemp=listacliente)then
anterior:=listacliente
else
begin
while (i^.sig<>punttemp) and not listavaciaC(i^.sig) do
i:= i^.sig;
anterior:=i;
end;
end;
procedure busquedalineal(listacliente:pCliente; c:cliente;
VAR encontrado:boolean;
VAR puntanterior,puntactual:pCliente);
var finbusqueda:boolean;
begin
puntactual:=listacliente;
puntanterior:=nil;
encontrado:=false;
finbusqueda:=false;
While not finbusqueda and not listavaciaC(puntactual) do
if( puntactual^.infoc.nif <= c.nif) then
begin
finbusqueda:=true;
encontrado:=(puntactual^.infoc.nif= c.nif);
end
else
Begin
puntanterior:=puntactual;
puntactual:=puntactual^.sig;
end;
End;
procedure fecha(VAR c:cliente);
var
anio, mes, dia , hdia:word;
cad1,cad2,cad3:string;
begin
getdate(anio,mes,dia,hdia);
str(dia:2,cad1);
str(anio:3,cad3);
str(mes:2,cad2);
c.fecha:=cad3+'/'+cad2+'/'+cad1;
end;
Procedure mostrarlistaC(listacliente:pCliente);
var
op:char;
begin
clrscr;
Repeat
If listavaciaC(listacliente) then
begin
clrscr;
Writeln('No hay mas datos para mostrar');
end
else
While not listavaciaC(listacliente) do
begin
Writeln;
Writeln('NIF/CIF: ',listacliente^.infoc.nif);
Writeln('Razon Social: ',listacliente^.infoc.rsocial);
Writeln('Forma de Pago: ',listacliente^.infoc.fpago);
Writeln('Estado: ',listacliente^.infoc.estado);
Writeln('Fecha: ',listacliente^.infoc.fecha);
listacliente:=listacliente^.sig;
end;
Writeln('Desea continuar? [S/N]');
op:=readkey;
until (op='n');
end;
{**************************************************************************}
procedure insertarListaC(var listacliente:pCliente; c:cliente);
var punttemp,puntanterior:pCliente;
nodo: pCliente;
begin
punttemp:=listacliente;
new(nodo);
nodo^.infoc.nif:=c.nif;
nodo^.infoc.rsocial:=c.rsocial;
nodo^.infoc.fpago:=c.fpago;
nodo^.infoc.estado:=c.estado;
nodo^.infoc.fecha:=c.fecha;
if listavaciaC(listacliente) then
begin
nodo^.sig:=nil;
listacliente:=nodo;
end
else
begin
while (punttemp^.infoc.rsocial < c.rsocial) and (punttemp<>NIL) do
punttemp:=punttemp^.sig;
if punttemp=nil then
begin
puntanterior:=anterior(listacliente,punttemp);
puntanterior^.sig:=nodo;
nodo^.sig:=NIL;
end
else
begin
puntanterior:=anterior(listacliente,punttemp);
if punttemp=listacliente then
begin
nodo^.sig:=puntanterior;
listacliente:=nodo;
end
else
begin
nodo^.sig:=puntanterior^.sig;
puntanterior^.sig:=nodo;
end;
end;
end;
end;
Procedure CargarClientes(VAR listacliente:pCliente);
var
f:text;
c:cliente;
begin
assign(f,'clientes.txt');
{$I-}
reset(f);
{$I+}
if IOResult = 0 then
While not eof(f)do
begin
readln(f,c.NIF);
readln(f,c.Rsocial);
readln(f,c.fpago);
readln(f,c.estado);
readln(f,c.fecha);
insertarListaC(listacliente,c);
mostrarListaC(listacliente);
end
else
writeln('El archivo que trata de cargar no existe...');
End;
Procedure anadircliente(VAR listacliente:pCliente; VAR c:cliente);
VAR
encontrado:boolean;
puntanterior,puntactual:pCliente;
begin
busquedalineal(listacliente,c,encontrado,puntanterior,puntactual);
If not encontrado then
insertarlistac(listacliente,c)
else
begin
clrscr;
Writeln('Ya existe un registro para:');
Writeln('NIF: ',c.nif);
Writeln('Razon social: ',c.rsocial);
end;
End;
Function busquedabaja(listacliente:pCliente; c:cliente):boolean;
var
encontrado:boolean;
begin
encontrado:=false;
While(listacliente<>nil) and not encontrado do
begin
If listacliente^.infoc.nif=c.nif then
begin
encontrado:=true;
listacliente^.infoc.estado:='B';
end;
listacliente:=listacliente^.sig;
end;
busquedabaja:=encontrado;
end;
{*****************************************************************************}
procedure guardaclientes2(c:cliente);
var
f:text;
begin
assign(f,'clientes.txt');
{$I-}
append(f);
{$I+}
writeln(f,c.nif);
writeln(f,c.rsocial);
writeln(f,c.fpago);
writeln(f,c.estado);
writeln(f,c.fecha);
writeln;
close(f);
end;
Procedure BajasCliente(VAR listacliente:pCliente; VAR c:cliente);
begin
clrscr;
Writeln('============== BAJAS CLIENTES ================');
Writeln('Introduzca el numero de NIF que desee dar de baja: ');
if listavaciaC(listacliente) then
begin
Writeln('No hay Clientes dados de Alta');
end
else
begin
write('NIF/CIF: ');
readln(c.nif);
If busquedabaja(listacliente,c)then
mostrarlistaC(listacliente);
c.estado:='B';
guardaclientes2(c);
end;
end;
procedure guardaclientes(c:cliente);
var
f:text;
begin
assign(f,'clientes.txt');
{$I-}
rewrite(f);
{$I+}
close(f);
end;
esta es la primera parte del codigo( te lo mando en tres partes ya que es muy largo) si pudiese encontrar el fallo seria de muchisima ayuda ya que es un autentico quebradero de cabeza...
gracias
uses crt,DOS;
TYPE
{===================== TIPO CLIENTE ================================}
cliente=record
NIF:string[10];
rsocial:string[40];
fpago:char;
estado:char;
fecha:string[12];
end;
pCliente=^nodocliente;
nodocliente=record
infoc:cliente;
sig:pCliente;
end;
{====================================================================}
{=================== TIPO PEDIDOS ==================================}
linea=record
nLinea:integer;
numpedido:integer;
cantidad:integer;
ppu:longint;
pt:longint;
end;
pLinea=^nodoLinea ;
nodoLinea=record
infoLinea:linea;
sig:plinea;
end;
{******************************}
pedido=record
npedido:integer;
cifCliente:string[10];
impPedido:longint;
fecha:string[10];
estado:char;
end;
pPedido=^nodoPedido;
nodoPedido=record
infoPedido:pedido;
lineas:pLinea;
sig:pPedido;
end;
{===================== TIPO FACTURAS =====================================}
LINEAF= record
nLineaF:integer;
nfactura:integer;
Cantidad:integer;
ipulF:longint;
itlF:longint;
end;
pLineaF=^nodolineaf;
nodolineaF=record
infolineaF:lineaF;
sig:pLineaf;
end;
{************************************************************************** }
factura=record
nfactura:integer;
cifCliente:string[10];
impFactura:longint; {calculado como suma de importe de lineas}
fecha:string[12];
end;
pFactura=^nodoFactura;
nodoFactura=record
infoFactura:factura;
sig:pFactura;
lineaF:pLineaF;
end;
{************************************************************************}
cuota=record
nfactura:integer;
norden:integer;
importe:longint;
{ vencimiento:fecha;}
end;
pCuota=^nodoCuota;
nodoCuota=record
infoCuota:cuota;
sig:pCuota;
end;
{========================================================================}
VAR
listacliente:pCliente;
c:cliente;
listaPedido:pPedido;
p:pedido;
listalinea:pLinea;
l:linea;
listafactura:pFactura;
f:factura;
listalineaF:plineaF;
lf:lineaF;
listacuota:pCuota;
ct:cuota;
s:string;
opc:integer;
opc2,opc3,opc4:char;
{************************************************************************}
{*======================= CLIENTES =====================================*}
{************************************************************************}
Procedure crealistavaciaC(VAR listacliente:pCliente);
begin
listacliente:=nil;
end;
Function listavaciaC(listacliente:pCliente):boolean;
Begin
listavaciaC:=listacliente=nil;
end;
function anterior(listacliente:pCliente; punttemp:pCliente):pCliente;
var i: pcliente;
begin
i:=listacliente;
if listavaciaC(listacliente) or (punttemp=listacliente)then
anterior:=listacliente
else
begin
while (i^.sig<>punttemp) and not listavaciaC(i^.sig) do
i:= i^.sig;
anterior:=i;
end;
end;
procedure busquedalineal(listacliente:pCliente; c:cliente;
VAR encontrado:boolean;
VAR puntanterior,puntactual:pCliente);
var finbusqueda:boolean;
begin
puntactual:=listacliente;
puntanterior:=nil;
encontrado:=false;
finbusqueda:=false;
While not finbusqueda and not listavaciaC(puntactual) do
if( puntactual^.infoc.nif <= c.nif) then
begin
finbusqueda:=true;
encontrado:=(puntactual^.infoc.nif= c.nif);
end
else
Begin
puntanterior:=puntactual;
puntactual:=puntactual^.sig;
end;
End;
procedure fecha(VAR c:cliente);
var
anio, mes, dia , hdia:word;
cad1,cad2,cad3:string;
begin
getdate(anio,mes,dia,hdia);
str(dia:2,cad1);
str(anio:3,cad3);
str(mes:2,cad2);
c.fecha:=cad3+'/'+cad2+'/'+cad1;
end;
Procedure mostrarlistaC(listacliente:pCliente);
var
op:char;
begin
clrscr;
Repeat
If listavaciaC(listacliente) then
begin
clrscr;
Writeln('No hay mas datos para mostrar');
end
else
While not listavaciaC(listacliente) do
begin
Writeln;
Writeln('NIF/CIF: ',listacliente^.infoc.nif);
Writeln('Razon Social: ',listacliente^.infoc.rsocial);
Writeln('Forma de Pago: ',listacliente^.infoc.fpago);
Writeln('Estado: ',listacliente^.infoc.estado);
Writeln('Fecha: ',listacliente^.infoc.fecha);
listacliente:=listacliente^.sig;
end;
Writeln('Desea continuar? [S/N]');
op:=readkey;
until (op='n');
end;
{**************************************************************************}
procedure insertarListaC(var listacliente:pCliente; c:cliente);
var punttemp,puntanterior:pCliente;
nodo: pCliente;
begin
punttemp:=listacliente;
new(nodo);
nodo^.infoc.nif:=c.nif;
nodo^.infoc.rsocial:=c.rsocial;
nodo^.infoc.fpago:=c.fpago;
nodo^.infoc.estado:=c.estado;
nodo^.infoc.fecha:=c.fecha;
if listavaciaC(listacliente) then
begin
nodo^.sig:=nil;
listacliente:=nodo;
end
else
begin
while (punttemp^.infoc.rsocial < c.rsocial) and (punttemp<>NIL) do
punttemp:=punttemp^.sig;
if punttemp=nil then
begin
puntanterior:=anterior(listacliente,punttemp);
puntanterior^.sig:=nodo;
nodo^.sig:=NIL;
end
else
begin
puntanterior:=anterior(listacliente,punttemp);
if punttemp=listacliente then
begin
nodo^.sig:=puntanterior;
listacliente:=nodo;
end
else
begin
nodo^.sig:=puntanterior^.sig;
puntanterior^.sig:=nodo;
end;
end;
end;
end;
Procedure CargarClientes(VAR listacliente:pCliente);
var
f:text;
c:cliente;
begin
assign(f,'clientes.txt');
{$I-}
reset(f);
{$I+}
if IOResult = 0 then
While not eof(f)do
begin
readln(f,c.NIF);
readln(f,c.Rsocial);
readln(f,c.fpago);
readln(f,c.estado);
readln(f,c.fecha);
insertarListaC(listacliente,c);
mostrarListaC(listacliente);
end
else
writeln('El archivo que trata de cargar no existe...');
End;
Procedure anadircliente(VAR listacliente:pCliente; VAR c:cliente);
VAR
encontrado:boolean;
puntanterior,puntactual:pCliente;
begin
busquedalineal(listacliente,c,encontrado,puntanterior,puntactual);
If not encontrado then
insertarlistac(listacliente,c)
else
begin
clrscr;
Writeln('Ya existe un registro para:');
Writeln('NIF: ',c.nif);
Writeln('Razon social: ',c.rsocial);
end;
End;
Function busquedabaja(listacliente:pCliente; c:cliente):boolean;
var
encontrado:boolean;
begin
encontrado:=false;
While(listacliente<>nil) and not encontrado do
begin
If listacliente^.infoc.nif=c.nif then
begin
encontrado:=true;
listacliente^.infoc.estado:='B';
end;
listacliente:=listacliente^.sig;
end;
busquedabaja:=encontrado;
end;
{*****************************************************************************}
procedure guardaclientes2(c:cliente);
var
f:text;
begin
assign(f,'clientes.txt');
{$I-}
append(f);
{$I+}
writeln(f,c.nif);
writeln(f,c.rsocial);
writeln(f,c.fpago);
writeln(f,c.estado);
writeln(f,c.fecha);
writeln;
close(f);
end;
Procedure BajasCliente(VAR listacliente:pCliente; VAR c:cliente);
begin
clrscr;
Writeln('============== BAJAS CLIENTES ================');
Writeln('Introduzca el numero de NIF que desee dar de baja: ');
if listavaciaC(listacliente) then
begin
Writeln('No hay Clientes dados de Alta');
end
else
begin
write('NIF/CIF: ');
readln(c.nif);
If busquedabaja(listacliente,c)then
mostrarlistaC(listacliente);
c.estado:='B';
guardaclientes2(c);
end;
end;
procedure guardaclientes(c:cliente);
var
f:text;
begin
assign(f,'clientes.txt');
{$I-}
rewrite(f);
{$I+}
close(f);
end;
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
Procedure Altascliente(VAR listacliente:pCliente; VAR c:cliente);
var
op:char;Begin
Repeat
clrscr;
Writeln('_____________ ALTAS DE CLIENTES______________');
Writeln('Introduzca los Datos Pedidos:');
Write('NIF/CIF: ');
readln(c.nif);
Write('Razon Social: ');
readln(c.rsocial);
Write('Forma de Pago: ');
readln(c.fpago);
Write('Estado: ');
c.estado:='A';
Write('Fecha: ');
fecha(c);
Write(c.fecha);
anadircliente(listacliente, c);
guardaclientes2(c);
Writeln('Desea continuar ? (S/N)');
op:=readkey;
until (op='n') or (op='N');
end;
esta es la primera parte del codigo( te lo mando en tres partes ya que es muy largo) si pudiese encontrar el fallo seria de muchisima ayuda ya que es un autentico quebradero de cabeza...
gracias
Valora esta pregunta
0