Bueno aca les dejo mi trabajo final para la materia algoritmo y estructuras de datos , el cual esta realizado en lenguaje Turbo Pascal 7.0 .
En el codifuente se aclara de quien fue tomada la estructura del programa , nosotros le agregamos las unit, los arboles binarios de busqueda, los arboles AVL, y algunas modificaciones en el almacenamiento del archivo, asi que agradesco a Eduardo Chongkan por haber subido su programa en la webdelprogramador.
Este trabjo fue realizado con el fin de dar de alta , baja , consulta de socios, tambien listarlos por numero de socio y apellido y nombre(anda un poco mal xD).
Almacena la informacion en un archivo cliente.dat el cual despues se puede reutilizarse en caso de cerrar el programa tan solo con escribir cliente, o sino se puede almacenar con otro nombre tan solo escribir el nombre en el inicio.
El programa acepta pantalla completa en winXP pero en versiones como Vista no...(que le vamos hacer en la facultad todo es win lamentablemte.)
Posee:
-Arboles Binarios de Busqueda
-Arboles AVL
-Archivos
-Unit para visualizar
-Unit para AVL
Descarga
El programas se encuentra subido a mi disco virtual FreeDrive por si lo quieren descargar
Codigo Fuente de todo lo comentado
Arbol AVL
UNIT AVL; { Se indica el nombre de la unidad }INTERFACE { Comienza la interface }
type
{*************Arbol AVL DNI **************}
t_ele=record
dni: string[10];
pos: integer;
end;
ap=^nodo_avl;
nodo_avl = record
ele : t_ele;
izq : ap;
der : ap;
altura : integer;
end;
arbol = ^nodo_avl;
{***************Arbol AVL AYN ************}
t_ele2=record
nom: string[25];
pos: integer;
end;
ap2=^nodo2_avl;
nodo2_avl = record
ele : t_ele2;
izq : ap2;
der : ap2;
altura : integer;
end;
arbol2 = ^nodo2_avl;
var
{Declaraciones de Variables Arboles : Tipo }
x : t_ele;
x2 : t_ele2;
ar : arbol;
ar2 : arbol2;
{ Se define la "cabecera" del procedimiento }
{*********************************** AVL de D.N.I******************************}
function altura(p:ap):integer; {Funcion determina cual es la altura del arbol }
function max(a,b:integer):integer; {Funcion determina cual es el mayor de dos elementos }
procedure rotar_s_izq(var a:ap); {Procedure para efectuar una rotacion simple a izq}
procedure rotar_s_der(var a:ap); {Procedure para efectuar una rotacion simple a izq}
procedure rotar_d_izq(var a:ap); {Procedure para efectuar una rotacion doble a izq}
procedure rotar_d_der(var a:ap); {Procedure para efectuar una rotacion doble a der}
{*********************************** AVL de AYN********************************}
function altura2(p:ap2):integer; {Funcion determina cual es la altura del arbol }
function max2(a,b:integer):integer; {Funcion determina cual es el mayor de dos elementos }
procedure rotar_s_izq2(var a:ap2); {Procedure para efectuar una rotacion simple a izq}
procedure rotar_s_der2(var a:ap2); {Procedure para efectuar una rotacion simple a der}
procedure rotar_d_izq2(var a:ap2); {procedure para efectuar una rotacion doble a izq}
procedure rotar_d_der2(var a:ap2); {procedure para efectuar una rotacion doble a der}
IMPLEMENTATION { Comienza la implementacion }
uses crt; { Se va a utilizar la unidad crt }
{ Desarrollo del procedimiento }
{--------------------Procedimientos y Funciones Arboles------------------------}
{*********************************** AVL de D.N.I******************************}
{Funcion determina cual es la altura del arbol }
function altura(p:ap):integer;
begin
if p = nil then
altura := -1
else
altura := p^.altura;
end;
{Funcion determina cual es el mayor de dos elementos }
function max(a,b:integer):integer;
begin
if a > b then
max := a
else
max := b;
end;
{Procedure para efectuar una rotacion simple a izq}
procedure rotar_s_izq(var a:ap);
var b:ap;
begin
b:=a^.izq;
a^.izq:=b^.der;
b^.der:=a;
a^.altura := max(altura(a^.izq),altura(a^.der)) +1;
b^.altura := max(altura(b^.izq),a^.altura)+1;
a:=b;
end;
{Procedure para efectuar una rotacion simple a izq}
procedure rotar_s_der(var a:ap);
var b:ap;
begin
b:=a^.der;
a^.der:=b^.izq;
b^.izq:=a;
a^.altura := max(altura(a^.der),altura(a^.izq)) +1;
b^.altura := max(altura(b^.der),a^.altura)+1;
a:=b;
end;
{Procedure para efectuar una rotacion doble a izq}
procedure rotar_d_izq(var a:ap);
begin
rotar_s_der(a^.izq);{rota entre c y b}
rotar_s_izq(a);{rota entre a y b}
end;
{Procedure para efectuar una rotacion doble a der}
procedure rotar_d_der(var a:ap);
begin
rotar_s_izq(a^.der);{rota entre c y b}
rotar_s_der(a);{rota entre a y b}
end;
{*********************************** AVL de AYN********************************}
{Funcion determina cual es la altura del arbol }
function altura2(p:ap2):integer;
begin
if p = nil then
altura2 := -1
else
altura2 := p^.altura;
end;
{Funcion determina cual es el mayor de dos elementos }
function max2(a,b:integer):integer;
begin
if a > b then
max2 := a
else
max2 := b;
end;
{Procedure para efectuar una rotacion simple a izq}
procedure rotar_s_izq2(var a:ap2);
var b:ap2;
begin
b := a^.izq;
a^.izq := b^.der;
b^.der := a;
a^.altura := max2(altura2(a^.izq),altura2(a^.der)) +1;
b^.altura := max2(altura2(b^.izq),a^.altura)+1;
a := b;
end;
{Procedure para efectuar una rotacion simple a der}
procedure rotar_s_der2(var a:ap2);
var b:ap2;
begin
b:=a^.der;
a^.der:=b^.izq;
b^.izq:=a;
a^.altura := max2(altura2(a^.der),altura2(a^.izq)) +1;
b^.altura := max2(altura2(b^.der),a^.altura)+1;
a:=b;
end;
{procedure para efectuar una rotacion doble a izq}
procedure rotar_d_izq2(var a:ap2);
begin
rotar_s_der2(a^.izq);{rota entre c y b}
rotar_s_izq2(a); {rota entre a y b}
end;
{procedure para efectuar una rotacion doble a der}
procedure rotar_d_der2(var a:ap2);
begin
rotar_s_izq2(a^.der);{rota entre c y b}
rotar_s_der2(a); {rota entre a y b}
end;
{-------------------- Fin Procedimientos y Funciones Arboles-------------------}
end. { Fin de la unidad }
Unit para Visualizar
UNIT Pantalla; { Se indica el nombre de la unidad }
INTERFACE { Comienza la interface }
{ Se define la "cabecera" del procedimiento }
procedure Imprime( x, y, color: integer; msg: string );
IMPLEMENTATION { Comienza la implementacion }
uses crt; { Se va a utilizar la unidad crt }
{ Desarrollo del procedimiento }
procedure Imprime( x, y, color: integer; msg: string );
begin
textcolor( color );
gotoxy( x, y );
write( msg );
end;
end. { Fin de la unidad }
Programa Principal
{******************************************************************************}
{ Programa basado en el Codigo Fuente del Programa hecho por Eduardo Chongkan }
{ Integrantes: }
{ Guillaume Ariel }
{ Martinez Vilar Enrique Gabriel }
{ Ronconi Luciano }
{******************************************************************************}
Program Club ;
Uses Crt,Dos,PANTALLA,AVL;
Type
Persona = Record
N_soc : integer; {Numero de socio}
AYN : string[25]; {Apellido y Nombre}
Dir : string[25]; {Direccion}
Dir_cobro : string[25]; {Direccion de cobro}
dni : string[10]; {numero de documento}
Concepto : string[10]; {Tipo : Idividual o Familiar}
Cuota : real; {Cuota}
Cuotas_pagas : integer; {Meses que pago la Cuota}
Activo : 0..1; {Si esta activo o dado de baja}
end;
Var
{Declaraciones de Variables Archivo : Tipo }
archivo : file of persona;
cliente : persona;
{Declaraciones de Variables Registro : Tipo }
dir ,ayn ,dir_cobro ,concepto ,dni : string;
dir2,ayn2,dir_cobro2,concepto2,dni2 : string;
Cuota,cuota2 : real;
cuotas_pagas,cuotas_pagas2,n_soc,n_soc2 : integer;
activo : 0..1;
{Declaraciones de Variables Estadisticas : Tipo }
conts,conti,contf,contd,conta,contalta,contbaja : word;
{Declaraciones de Variables Getdate : Tipo }
dia,mes,ano : word;
{Declaraciones de Variables Generales : Tipo }
opcion : char;
tam,car,dow,i : word;
dat,num,numero,pos,a,b : integer;
letra : string;
{Declaraciones de Variables Generales : Tipo }
S :string;
Resul :integer;
{*************************Procedure Cuadro Principal***************************}
procedure cuadro;
begin
Imprime(25, 6 ,red, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»' );
Imprime(25, 7 ,red, 'º º' );
Imprime(25, 8 ,red, 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' );
Imprime(25, 9 ,red, 'º º' );
Imprime(25, 10 ,red, 'º º' );
Imprime(25, 11 ,red, 'º º' );
Imprime(25, 12 ,red, 'º º' );
Imprime(25, 13 ,red, 'º º' );
Imprime(25, 14 ,red, 'º º' );
Imprime(25, 15 ,red, 'º º' );
Imprime(25, 16 ,red, 'º º' );
Imprime(25, 17 ,red, 'º º' );
Imprime(25, 18 ,red, 'º º' );
Imprime(25, 19 ,red, 'º º' );
Imprime(25, 20 ,red, 'º º' );
Imprime(25, 21 ,red, 'º º' );
Imprime(25, 22 ,red, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ[ ]ͼ' );
normvideo;
end;
{***************************Procedure Cuadro Modificar*************************}
procedure cuadro_mod;
begin
Imprime(50, 4 ,red, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»' );
Imprime(50, 5 ,red, 'º º' );
Imprime(50, 6 ,red, 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' );
Imprime(50, 7 ,red, 'º º' );
Imprime(50, 8 ,red, 'º º' );
Imprime(50, 9 ,red, 'º º' );
Imprime(50, 10 ,red, 'º º' );
Imprime(50, 11 ,red, 'º º' );
Imprime(50, 12 ,red, 'º º' );
Imprime(50, 13 ,red, 'º º' );
Imprime(50, 14 ,red, 'º º' );
Imprime(50, 15 ,red, 'º º' );
Imprime(50, 16 ,red, 'º º' );
Imprime(50, 17 ,red, 'º º' );
Imprime(50, 18 ,red, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ[ ]ͼ' );
normvideo;
Imprime(53, 5 ,lightblue, 'Selecionar Opcion' );
normvideo;
Imprime(53, 7 ,white, 'A) Nombre y Apellido' );
Imprime(53, 9 ,white, 'B) Direccion' );
Imprime(53, 11 ,white, 'C) Direccion de cobro' );
Imprime(53, 13 ,white, 'D) Concepto' );
Imprime(53, 15 ,green, 'E) Volver' );
normvideo;
gotoxy (76,18);
readln (opcion);
end;
{Procedure para insertar Nodo por DNI}
procedure insertardni(x:t_ele;var a:arbol);
begin
if a = nil then
begin
new(a);{se crea un arbol con un nodo}
if a = nil then
writeln('Memoria Llena')
else
begin
a^.ele.dni := x.dni;
a^.ele.pos := x.pos;
a^.izq := nil;
a^.der := nil;
a^.altura := 0;
end;
end{if a = nil}
else
begin
if x.dni <> a^.ele.dni then
begin
insertardni(x,a^.der);
if altura(a^.der) - altura(a^.izq) = 2 then
begin
if x.dni > a^.der^.ele.dni then
rotar_s_der(a)
else
rotar_d_der(a)
end
else
a^.altura := max(altura(a^.der),altura(a^.izq)) + 1
end;
end;
end;
end;
{Procedure para insertar Nodo por AYN}
procedure insertarnom(x:t_ele2;var a:arbol2);
begin
if a = nil then
begin
new(a);{se crea un arbol con un nodo}
if a = nil then
writeln('Memoria Llena')
else
begin
a^.ele.nom := x.nom;
a^.ele.pos := x.pos;
a^.izq := nil;
a^.der := nil;
a^.altura := 0;
end;
end{if a = nil}
else
begin
if x.nom <> a^.ele.nom then
begin
insertarnom(x,a^.der);
if altura2(a^.der) - altura2(a^.izq) = 2 then
begin
if x.nom > a^.der^.ele.nom then
rotar_s_der2(a)
else
rotar_d_der2(a)
end
else
a^.altura := max2(altura2(a^.der),altura2(a^.izq)) + 1
end;
end;
end;
end;
{Funcion para buscar en el arbol }
function buscardni(x:string;var a:arbol):integer;
begin
if a = nil then
buscardni:= -1
else
begin
if x <> a^.ele.dni then
buscardni:=buscardni(x,a^.der)
else
buscardni:= a^.ele.pos;
end;
end;
end;
{Funcion para buscar en el arbol }
function buscarnom(x:string;var a:arbol2):integer;
begin
if a = nil then
buscarnom:= -1
else
begin
if x <> a^.ele.nom then
buscarnom:=buscarnom(x,a^.der)
else
buscarnom:= a^.ele.pos;
end;
end;
end;
{************************Procedure Nuevo Socio*********************************}
procedure nuevo;
begin
assign(archivo,'cliente.dat');
reset(archivo);
Seek(archivo,filesize(archivo));
with cliente do
begin
clrscr;
textbackground (lightblue);
Imprime(1,1,white,' .: Ingrese Datos para Nuevo Socio :. ' );
normvideo;
getdate(ano,mes,dia,dow);
dia := dia;
mes := mes;
ano := ano;
Imprime(1,3,white,'Apellido y Nombre: [ ][25] Fecha: [ / / ]' );
gotoxy(67,3);
if dia < letra ="'i')or" letra ="'I')" letra ="'f')or" letra ="'F')"> -1 then
begin
seek(archivo,pos);
read(archivo,cliente);
with cliente do
begin
if activo = 0 then
begin
clrscr;
imprime(3,6,white,'Se encontro el Socio Numero : ');
gotoxy(33,6);
textcolor (lightblue);
writeln(n_soc);
imprime(3,8,white,'Apellido y Nombre : ');
gotoxy(23,8);
textcolor (lightblue);
writeln(AYN);
imprime(3,10,white,'Cuotas Pagas :');
gotoxy(18,10);
textcolor (lightblue);
writeln(cuotas_pagas);
imprime(3,12,white,'Direccion : ');
gotoxy(15,12);
textcolor (lightblue);
writeln(dir);
imprime(3,14,white,'Direccion de Cobro : ');
gotoxy(24,14);
textcolor (lightblue);
writeln(dir_cobro);
imprime(3,16,white,'Concepto : ');
gotoxy(14,16);
textcolor (lightblue);
writeln(concepto);
imprime(3,18,white,'D.N.I :');
gotoxy(11,18);
textcolor (lightblue);
writeln(dni);
imprime(28,20,green,'Desea darlo de Alta(S/N)');
gotoxy(40,22);
readln(opcion);
if (opcion = 's') or (opcion = 'S') then
begin
clrscr;
imprime(16,22,white,'*** EL Socio ha sido dado de Alta con Exito ***');
Activo:=1;
contalta:=contalta+1;
contbaja := contbaja - 1;
seek(archivo,filepos(archivo)-1);
write(archivo,cliente);
end
else{If opcion = n}
begin
clrscr;
imprime(28,12,white,'*** Accion Cancelada ***');
end;
end {If activo = 1}
else
begin
clrscr;
imprime(21,12,white,'*** Socio se encuetra dado de Alta ***');
end;
end;
end;
if pos = -1 then
nuevo;
readkey;
end;
{***************************Procedure Modificar AYN****************************}
Procedure modificarayn;
begin
assign(archivo,'cliente.dat');
reset(archivo);
clrscr;
textcolor (white);
textbackground (lightblue);
imprime(1,1,white,' .: Modificar Socio :. ');
normvideo;
imprime(13,12,white,'Ingrese Apellido Y Nombre: [ ][25] ');
gotoxy(41,12);
textcolor (lightblue);
readln (ayn);
pos := buscarnom(ayn,ar2);
if pos <> -1 then
begin
seek(archivo,pos);
read(archivo,cliente);
with cliente do
begin
if activo = 1 then
begin
clrscr;
imprime(3,6,white,'Se encontro el Socio Numero : ');
gotoxy(33,6);
textcolor (lightblue);
writeln(n_soc);
imprime(3,8,white,'Apellido y Nombre : ');
gotoxy(23,8);
textcolor (lightblue);
writeln(AYN);
imprime(3,10,white,'Cuotas Pagas :');
gotoxy(18,10);
textcolor (lightblue);
writeln(cuotas_pagas);
imprime(3,12,white,'Direccion : ');
gotoxy(15,12);
textcolor (lightblue);
writeln(dir);
imprime(3,14,white,'Direccion de Cobro : ');
gotoxy(24,14);
textcolor (lightblue);
writeln(dir_cobro);
imprime(3,16,white,'Concepto : ');
gotoxy(14,16);
textcolor (lightblue);
writeln(concepto);
imprime(3,18,white,'D.N.I :');
gotoxy(11,18);
textcolor (lightblue);
writeln(dni);
n_soc2:=n_soc;
ayn2:=ayn;
dir2:=dir;
dir_cobro2:=dir_cobro;
dni2:=dni;
concepto2:=concepto;
cuota2:=cuota;
cuotas_pagas2:=cuotas_pagas;
repeat
cuadro_mod;
case upcase(opcion) of
'A' : begin
clrscr;
imprime(13,12,white,'Nuevo Apellido y Nombre : [ ][25]');
textcolor(lightblue);
gotoxy(26,12);
readln(AYN);
x2.nom:=AYN;
x2.pos:=(filepos(archivo)-1);
insertarnom(x2,ar2);
n_soc:=n_soc2;
dir:=dir2;
dir_cobro:=dir_cobro2;
dni:=dni2;
concepto:=concepto2;
cuota:=cuota2;
cuotas_pagas:=cuotas_pagas2;
activo:=1;
seek(archivo,filepos(archivo)-1);
write(archivo,cliente);
clrscr;
end;
'B' : begin
clrscr;
imprime(20,10,white,'Nueva Direccion : [ ][25]');
textcolor(lightblue);
gotoxy(39,10);
readln(dir);
n_soc:=n_soc2;
ayn:=ayn2;
dir_cobro:=dir_cobro2;
dni:=dni2;
concepto:=concepto2;
cuota:=cuota2;
cuotas_pagas:=cuotas_pagas2;
activo:=1;
seek(archivo,filepos(archivo)-1);
write(archivo,cliente);
clrscr;
end;
'C' : begin
clrscr;
imprime(20,10,white,'Nueva Direccion de Cobro: [ ][25]');
textcolor(lightblue);
gotoxy(47,10);
readln(dir_cobro);
n_soc:=n_soc2;
ayn:=ayn2;
dir:=dir2;
dni:=dni2;
concepto:=concepto2;
cuota:=cuota2;
cuotas_pagas:=cuotas_pagas2;
activo:=1;
seek(archivo,filepos(archivo)-1);
write(archivo,cliente);
clrscr;
end;
'D' : begin
clrscr;
imprime(10,10,white,'Nuevo Concepto: [ ](Familiar/Individual)');
textcolor(lightblue);
gotoxy(27,10);
readln(concepto);
n_soc:=n_soc2;
ayn:=ayn2;
dir:=dir2;
dir_cobro:=dir_cobro2;
dni:=dni2;
cuota:=cuota2;
cuotas_pagas:=cuotas_pagas2;
activo:=1;
seek(archivo,filepos(archivo)-1);
write(archivo,cliente);
clrscr;
end;
end;
until upcase(opcion) = 'E'
end{If activo = 1}
else
begin
clrscr;
imprime(25,15,white,'*** El Socio se encuentra dado de Baja ***');
readkey;
end;
end;
end;
if pos = -1 then {socio no existe}
begin
clrscr;
imprime(30,15,white,'*** El Socio no Existe ***');
readkey;
end;
end;
{***************************Procedure Modificar DNI***************************}
Procedure modificardni;
begin
assign(archivo,'cliente.dat');
reset(archivo);
clrscr;
textbackground (lightblue);
imprime(1,1,white,' .: Modificar Socio :. ');
normvideo;
imprime(11,12,white,'Ingrese D.N.I: [ ][10] ');
gotoxy(27,12);
textcolor (lightblue);
readln (dni);
pos := buscardni(dni,ar);
if pos <> -1 then
begin
seek(archivo,pos);
read(archivo,cliente);
with cliente do
begin
if activo = 1 then
begin
clrscr;
imprime(3,6,white,'Se encontro el Socio Numero : ');
gotoxy(33,6);
textcolor (lightblue);
writeln(n_soc);
imprime(3,8,white,'Apellido y Nombre : ');
gotoxy(23,8);
textcolor (lightblue);
writeln(AYN);
imprime(3,10,white,'Cuotas Pagas :');
gotoxy(18,10);
textcolor (lightblue);
writeln(cuotas_pagas);
imprime(3,12,white,'Direccion : ');
gotoxy(15,12);
textcolor (lightblue);
writeln(dir);
imprime(3,14,white,'Direccion de Cobro : ');
gotoxy(24,14);
textcolor (lightblue);
writeln(dir_cobro);
imprime(3,16,white,'Concepto : ');
gotoxy(14,16);
textcolor (lightblue);
writeln(concepto);
imprime(3,18,white,'D.N.I :');
gotoxy(11,18);
textcolor (lightblue);
writeln(dni);
n_soc2:=n_soc;
ayn2:=ayn;
dir2:=dir;
dir_cobro2:=dir_cobro;
dni2:=dni;
concepto2:=concepto;
cuota2:=cuota;
cuotas_pagas2:=cuotas_pagas;
repeat
cuadro_mod;
case upcase(opcion) of
'A' : begin
clrscr;
imprime(13,12,white,'Nuevo Apellido y Nombre : [ ][25]');
textcolor(lightblue);
gotoxy(26,12);
readln(AYN);
x2.nom:=AYN;
x2.pos:=(filepos(archivo)-1);
insertarnom(x2,ar2);
n_soc:=n_soc2;
dir:=dir2;
dir_cobro:=dir_cobro2;
dni:=dni2;
concepto:=concepto2;
cuota:=cuota2;
cuotas_pagas:=cuotas_pagas2;
activo:=1;
seek(archivo,filepos(archivo)-1);
write(archivo,cliente);
clrscr;
end;
'B' : begin
clrscr;
imprime(20,10,white,'Nueva Direccion : [ ][25]');
textcolor(lightblue);
gotoxy(39,10);
readln(dir);
n_soc:=n_soc2;
ayn:=ayn2;
dir_cobro:=dir_cobro2;
dni:=dni2;
concepto:=concepto2;
cuota:=cuota2;
cuotas_pagas:=cuotas_pagas2;
activo:=1;
seek(archivo,filepos(archivo)-1);
write(archivo,cliente);
clrscr;
end;
'C' : begin
clrscr;
imprime(20,10,white,'Nueva Direccion de Cobro: [ ][25]');
textcolor(lightblue);
gotoxy(47,10);
readln(dir_cobro);
n_soc:=n_soc2;
ayn:=ayn2;
dir:=dir2;
dni:=dni2;
concepto:=concepto2;
cuota:=cuota2;
cuotas_pagas:=cuotas_pagas2;
activo:=1;
seek(archivo,filepos(archivo)-1);
write(archivo,cliente);
clrscr;
end;
'D' : begin
clrscr;
imprime(10,10,white,'Nuevo Concepto: [ ](Familiar/Individual)');
textcolor(lightblue);
gotoxy(27,10);
readln(concepto);
n_soc:=n_soc2;
ayn:=ayn2;
dir:=dir2;
dir_cobro:=dir_cobro2;
dni:=dni2;
cuota:=cuota2;
cuotas_pagas:=cuotas_pagas2;
activo:=1;
seek(archivo,filepos(archivo)-1);
write(archivo,cliente);
clrscr;
end;
end;
until upcase(opcion) = 'E'
end{If activo = 1}
else
begin
clrscr;
imprime(25,15,white,'*** El Socio se encuentra dado de Baja ***');
readkey;
end;
end;
end;
if pos = -1 then {socio no existe}
begin
clrscr;
imprime(30,15,white,'*** El Socio no Existe ***');
readkey;
end;
end;
{****************************Procedure Consulta DNI****************************}
procedure consultadni;
VAR
a:integer;
begin
clrscr;
textbackground (lightblue);
imprime(1,1 ,white,' .: Busqueda de Socio por D.N.I :. ');
normvideo;
imprime(1,3 ,white,'Ingrese Numero de D.N.I del Socio: [ ][10]');
gotoxy(37,3);
textcolor (lightblue);
readln (dni);
pos := buscardni(dni,ar);
if pos <> -1 then
begin
seek(archivo,pos);
read(archivo,cliente);
with cliente do
begin
if activo = 0 then
begin
clrscr;
normvideo;
imprime(3,6,white,'Socio Numero : ');
gotoxy(18,6);
textcolor (lightblue);
writeln(n_soc);
imprime(3,8,white,'Apellido y Nombre : ');
gotoxy(23,8);
textcolor (lightblue);
writeln(AYN);
imprime(3,10,white,'Cuotas Pagas : ');
gotoxy(18,10);
textcolor (lightblue);
writeln(cuotas_pagas);
imprime(3,12,white,'Direccion : ');
gotoxy(15,12);
textcolor (lightblue);
writeln(dir);
imprime(3,14,white,'Direccion de cobro : ');
gotoxy(24,14);
textcolor (lightblue);
writeln(dir_cobro);
imprime(3,16,white,'Concepto :' );
gotoxy(14,16);
textcolor (lightblue);
writeln(concepto);
imprime(3,18,white,'D.N.I : ');
gotoxy(14,18);
textcolor (lightblue);
writeln(dni);
imprime(3,20,white,'Estado : ');
imprime(14,20,lightblue,'Inactivo');
end{If activo = 0}
else
begin
clrscr;
imprime(3,6,white,'Socio Numero : ');
gotoxy(18,6);
textcolor (lightblue);
writeln(n_soc);
imprime(3,8,white,'Apellido y Nombre : ');
gotoxy(23,8);
textcolor (lightblue);
writeln(AYN);
imprime(3,10,white,'Cuotas Pagas : ');
gotoxy(18,10);
textcolor (lightblue);
writeln(cuotas_pagas);
imprime(3,12,white,'Direccion : ');
gotoxy(15,12);
textcolor (lightblue);
writeln(dir);
imprime(3,14,white,'Direccion de cobro : ');
gotoxy(24,14);
textcolor (lightblue);
writeln(dir_cobro);
imprime(3,16,white,'Concepto :' );
gotoxy(14,16);
textcolor (lightblue);
writeln(concepto);
imprime(3,18,white,'D.N.I : ');
gotoxy(14,18);
textcolor (lightblue);
writeln(dni);
imprime(3,20,white,'Estado : ');
imprime(14,20,lightblue,'Activo');
end; {Else}
end;{With }
end;{If pos <> 0}
if pos = -1 then
begin
clrscr;
imprime(30,12,white,'*** Socio no Existe ***');
end;
readkey;
end;
{****************************Procedure Consulta AYN****************************}
procedure consultanom;
VAR
a:integer;
begin
clrscr;
textbackground (lightblue);
imprime(1,1,white,' .: Busqueda de Socio por Apellido y Nombre :. ');
normvideo;
imprime(1,3,white,'Ingrese Apellido y Nombre del Socio: [ ][25');
gotoxy(39,3);
textcolor (lightblue);
readln (ayn);
pos := buscarnom(ayn,ar2);
if pos <> -1 then
begin
seek(archivo,pos);
read(archivo,cliente);
with cliente do
begin
if activo = 0 then
begin
clrscr;
normvideo;
imprime(3,6,white,'Socio Numero : ');
gotoxy(18,6);
textcolor (lightblue);
writeln(n_soc);
imprime(3,8,white,'Apellido y Nombre : ');
gotoxy(23,8);
textcolor (lightblue);
writeln(AYN);
imprime(3,10,white,'Cuotas Pagas : ');
gotoxy(18,10);
textcolor (lightblue);
writeln(cuotas_pagas);
imprime(3,12,white,'Direccion : ');
gotoxy(15,12);
textcolor (lightblue);
writeln(dir);
imprime(3,14,white,'Direccion de cobro : ');
gotoxy(24,14);
textcolor (lightblue);
writeln(dir_cobro);
imprime(3,16,white,'Concepto : ');
gotoxy(14,16);
textcolor (lightblue);
writeln(concepto);
imprime(3,18,white,'D.N.I : ');
gotoxy(14,18);
textcolor (lightblue);
writeln(dni);
imprime(3,20,white,'Estado : ');
imprime(14,20,lightblue,'Inactivo');
end{If activo = 0}
else
begin
clrscr;
imprime(3,6,white,'Socio Numero : ');
gotoxy(18,6);
textcolor (lightblue);
writeln(n_soc);
imprime(3,8,white,'Apellido y Nombre : ');
gotoxy(23,8);
textcolor (lightblue);
writeln(AYN);
imprime(3,10,white,'Cuotas Pagas : ');
gotoxy(18,10);
textcolor (lightblue);
writeln(cuotas_pagas);
imprime(3,12,white,'Direccion : ');
gotoxy(15,12);
textcolor (lightblue);
writeln(dir);
imprime(3,14,white,'Direccion de cobro : ');
gotoxy(24,14);
textcolor (lightblue);
writeln(dir_cobro);
imprime(3,16,white,'Concepto : ');
gotoxy(14,16);
textcolor (lightblue);
writeln(concepto);
imprime(3,18,white,'D.N.I : ');
gotoxy(14,18);
textcolor (lightblue);
writeln(dni);
imprime(3,20,white,'Estado : ');
imprime(14,20,lightblue,'Activo');
end; {Else}
end;{With }
end;{If pos <> 0}
if pos = -1 then
begin
clrscr;
imprime(30,12,white,'*** Socio no Existe ***');
end;
readkey;
end;
{******************Procedure Alta-Modificaciones-Consulta**********************}
Procedure socios;
begin
repeat
clrscr;
Imprime(25, 4 ,red, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»' );
Imprime(25, 5 ,red, 'º º' );
Imprime(25, 6 ,red, 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' );
Imprime(25, 7 ,red, 'º º' );
Imprime(25, 8 ,red, 'º º' );
Imprime(25, 9 ,red, 'º º' );
Imprime(25, 10 ,red, 'º º' );
Imprime(25, 11 ,red, 'º º' );
Imprime(25, 12 ,red, 'º º' );
Imprime(25, 13 ,red, 'º º' );
Imprime(25, 14 ,red, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ[ ]ͼ' );
Imprime(28, 5 ,lightblue, 'Selecionar Opcion' );
Imprime(28, 7 ,white, 'A) Alta' );
Imprime(28, 9 ,white, 'B) Modificar' );
Imprime(28, 11 ,white, 'C) Consulta' );
Imprime(28, 13 ,green, 'D) Volver' );
gotoxy (51,14);
readln (opcion);
case upcase(opcion) of
'A' : alta;
'B' : begin
repeat
clrscr;
normvideo;
assign(archivo,'cliente.dat');
reset(archivo);
Imprime(25, 10 ,red, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»' );
Imprime(25, 11 ,red, 'º º' );
Imprime(25, 12 ,red, 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' );
Imprime(25, 13 ,red, 'º º' );
Imprime(25, 14 ,red, 'º º' );
Imprime(25, 15 ,red, 'º º' );
Imprime(25, 16 ,red, 'º º' );
Imprime(25, 17 ,red, 'º º' );
Imprime(25, 18 ,red, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ[ ]ͼ' );
Imprime(28, 11 ,lightblue, 'Selecionar Opcion' );
Imprime(28, 13 ,white, 'A) D.N.I' );
Imprime(28, 15 ,white, 'B) Apellido y Nombre' );
Imprime(28, 17 ,green, 'C) Volver' );
gotoxy (51,18);
readln (opcion);
case upcase(opcion) of
'A' :modificardni;
'B' :modificarayn;
end
until upcase(opcion) = 'C'
end;
'C' : begin
repeat
clrscr;
normvideo;
assign(archivo,'cliente.dat');
reset(archivo);
Imprime(25, 10 ,red, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»' );
Imprime(25, 11 ,red, 'º º' );
Imprime(25, 12 ,red, 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' );
Imprime(25, 13 ,red, 'º º' );
Imprime(25, 14 ,red, 'º º' );
Imprime(25, 15 ,red, 'º º' );
Imprime(25, 16 ,red, 'º º' );
Imprime(25, 17 ,red, 'º º' );
Imprime(25, 18 ,red, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ[ ]ͼ' );
Imprime(28, 11 ,lightblue, 'Selecionar Opcion' );
Imprime(28, 13 ,white, 'A) D.N.I' );
Imprime(28, 15 ,white, 'B) Apellido y Nombre' );
Imprime(28, 17 ,green, 'C) Volver' );
gotoxy (51,18);
readln (opcion);
case upcase(opcion) of
'A' :consultadni;
'B' :consultanom;
end
until upcase(opcion) = 'C'
end;
end
until upcase(opcion) = 'D'
end;
{****************************Procedure Baja DNI********************************}
procedure bajadni;
begin
clrscr;
textbackground (lightblue);
Imprime(1, 1 ,white, ' .: Dar de Baja un Socio por D.N.I :. ' );
normvideo;
Imprime(37, 3 ,green, 'Ingrese Numero de D.N.I del Socio: [ ][10]' );
gotoxy(37,3);
textcolor (lightblue);
readln (dni);
pos := buscardni(dni,ar);
if pos <> - 1 then
begin
seek(archivo,pos);
read(archivo,cliente);
with cliente do
begin
if activo = 1 then
begin
clrscr;
imprime(3,6,white,'Socio Numero : ');
gotoxy(18,6);
textcolor (lightblue);
writeln(n_soc);
imprime(3,8,white,'Apellido y Nombre : ');
gotoxy(23,8);
textcolor (lightblue);
writeln(AYN);
imprime(3,10,white,'Cuotas Pagas : ');
gotoxy(18,10);
textcolor (lightblue);
writeln(cuotas_pagas);
imprime(3,12,white,'Direccion : ');
gotoxy(15,12);
textcolor (lightblue);
writeln(dir);
imprime(3,14,white,'Direccion de cobro : ');
gotoxy(24,14);
textcolor (lightblue);
writeln(dir_cobro);
imprime(3,16,white,'Concepto :' );
gotoxy(14,16);
textcolor (lightblue);
writeln(concepto);
imprime(3,18,white,'D.N.I : ');
gotoxy(14,18);
textcolor (lightblue);
writeln(dni);
imprime(20,20,green,'Desea darlo de Baja(S/N)');
gotoxy(20,22);
readln(opcion);
if (opcion = 's') or (opcion = 'S') then
begin
clrscr;
imprime(20,15,white,'*** EL Socio ha sido dado de Baja con Exito ***');
Activo:=0;
contalta := contalta - 1;
contbaja := contbaja + 1;
seek(archivo,filepos(archivo)-1);
write(archivo,cliente);
end
else{si opcion = n}
begin
clrscr;
imprime(32,15,white,'*** Accion Cancelada ***');
end;
end {Si activo = 1}
else
begin
clrscr;
imprime(20,15,white,'*** Socio se encuetra dado de Baja ***');
end;
end; {Termina cuando encuentra archivo}
end;
if pos = -1 then
begin
clrscr;
imprime(20,15,white,'*** Socio no Existe ***');
end;
readkey;
end;
{****************************Procedure Baja AYN********************************}
procedure bajanom;
begin
clrscr;
textbackground (lightblue);
imprime(1,1,white,' .: Dar de Baja un Socio por Apellido y Nombre :. ');
normvideo;
imprime(1,3,white,'Ingrese Apellido y Nombre del Socio: [ ][25]');
gotoxy(39,3);
textcolor (lightblue);
readln (AYN);
pos := buscarnom(AYN,ar2);
if pos <> - 1 then
begin
seek(archivo,pos);
read(archivo,cliente);
with cliente do
begin
if activo = 1 then
begin
clrscr;
imprime(3,6,white,'Socio Numero : ');
gotoxy(18,6);
textcolor (lightblue);
writeln(n_soc);
imprime(3,8,white,'Apellido y Nombre : ');
gotoxy(23,8);
textcolor (lightblue);
writeln(AYN);
imprime(3,10,white,'Cuotas Pagas : ');
gotoxy(18,10);
textcolor (lightblue);
writeln(cuotas_pagas);
imprime(3,12,white,'Direccion : ');
gotoxy(15,12);
textcolor (lightblue);
writeln(dir);
imprime(3,14,white,'Direccion de cobro : ');
gotoxy(24,14);
textcolor (lightblue);
writeln(dir_cobro);
imprime(3,16,white,'Concepto :' );
gotoxy(14,16);
textcolor (lightblue);
writeln(concepto);
imprime(3,18,white,'D.N.I : ');
gotoxy(14,18);
textcolor (lightblue);
writeln(dni);
imprime(20,20,green,'Desea darlo de Baja(S/N)');
gotoxy(20,22);
readln(opcion);
if (opcion = 's') or (opcion = 'S') then
begin
clrscr;
imprime(20,15,white,'*** EL Socio ha sido dado de Baja con Exito ***');
Activo:=0;
contalta := contalta - 1;
contbaja := contbaja + 1;
seek(archivo,filepos(archivo)-1);
write(archivo,cliente);
end
else{si opcion = n}
begin
clrscr;
imprime(32,15,white,'*** Accion Cancelada ***');
end;
end {Si activo = 1}
else
begin
clrscr;
imprime(20,15,white,'*** Socio se encuetra dado de Baja ***');
end;
end; {Termina cuando encuentra archivo}
end;
if pos = -1 then
begin
clrscr;
imprime(20,15,white,'*** Socio no Existe ***');
end;
readkey;
end;
{************************Procedure Listar Por Nombre de Socio******************}
procedure listarnom(var ar:arbol2);
var a:word;
begin
if ar <> nil then
begin
listarnom(ar^.izq);
begin
assign(archivo,'cliente.dat');
reset(archivo);
seek(archivo,ar^.ele.pos);
read(archivo,cliente);
with cliente do
begin
if activo = 1 then
begin
writeln(' ');
textcolor(green);
gotoxy(1,a);
write (n_soc);
gotoxy(3,a);
write (' º ',ayn);
gotoxy(21,a);
write (' º ',dir);
gotoxy(37,a);
write (' º ',dir_cobro);
gotoxy(54,a);
write (' º ',concepto);
gotoxy(68,a);
write (' º ' ,cuotas_pagas,' ');
a := a+1;
end
end;
end;
listarnom(ar^.der);
end;{If}
end;
{************************Procedure Lista Por Numero de Socio*******************}
procedure lista;
var a:word;
begin
clrscr;
textbackground (lightblue);
Imprime(1, 1,white, ' .: Lista de Socios del Club :. ' );
normvideo;
textbackground (lightgray);
Imprime(1, 2,red, 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ' );
Imprime(1, 3,red, '# º ApellidoyNombre º Direccion º Dir.de Cobro º Concepto ºCuotas Pagas' );
Imprime(1, 4,red, 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ' );
normvideo;
assign(archivo,'cliente.dat');
reset(archivo);
a:= 5;
while not eof(archivo) do
begin
read(archivo,cliente);
with cliente do
begin
a := a+1;
car:= filepos(archivo);
gotoxy(1,a);
if activo = 1 then
begin
textcolor(green);
writeln (n_soc);
gotoxy(3,a);
write ('º ',ayn);
gotoxy(21,a);
write ('º ',dir);
gotoxy(37,a);
write ('º ',dir_cobro);
gotoxy(54,a);
write ('º ',concepto);
gotoxy(68,a);
write ('º ' ,cuotas_pagas);
end
else
begin
textcolor(green);
writeln (n_soc);
Imprime(3, a,green, 'º El socio se encuntra dado de baja' );
end;
end;
end;
Readkey;
end;
{****************************Procedure Imputacion por DNI**********************}
procedure imputaciondni; {Para que se imprima se debe agregar el comando lst a los writln}
var a:word;
begin
clrscr;
textbackground (lightblue);
imprime(1,1,white,' .: Imputacion de Pago por D.N.I :. ');
normvideo;
imprime(1,3,white,'Ingrese Numero de D.N.I del Socio: [ ][10]');
gotoxy(37,3);
textcolor (lightblue);
readln (dni);
pos := buscardni(dni,ar);
if pos <> -1 then
begin
seek(archivo,pos);
read(archivo,cliente);
with cliente do
begin
if activo = 1 then
begin
a:= 6;
textbackground (lightblue);
imprime(1,1,white,' .: Imputacion de Pago :. ');
normvideo;
textbackground (lightgray);
imprime(1,2,red,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
imprime(1,3,red,'# Socio º Nombre º Direccion º Cuotas pagas º D.N.I ');
imprime(1,4,red,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
imprime(1,5,red,'');
normvideo;
car := filepos(archivo) ;
if activo = 1 then
begin
if cuotas_pagas = 0 then
begin
normvideo;
textcolor(white);
gotoxy(1,a);
writeln (n_soc);
gotoxy(9,a);
write ('º ',ayn);
gotoxy(28,a);
write ('º ',dir);
gotoxy(51,a);
write ('º ',cuotas_pagas);
gotoxy(67,a);
write ('º ',dni);
gotoxy(25,16);
write ('Fecha de Emision:');
gotoxy(43,16);
getdate(ano,mes,dia,dow);
dia := dia;
mes := mes;
ano := ano;
write ('[',dia,'/',mes,'/',ano,']');
Seek (archivo,car);
imprime(17,20,green,' Ingrese Meses que usted decea pagar : (1..12)');
gotoxy(35,22);
readln(cuotas_pagas);
textcolor (white);
if cuotas_pagas > 0 then
begin
if cuotas_pagas <= 12then begin seek(archivo,filepos(archivo)-1); write(archivo,cliente); clrscr; imprime(30,13,white,'*** Pago Efectuado ***'); readkey; end else begin clrscr; imprime(25,15,white,'*** Supera los pagos de este Ano ***'); readkey; end; end else {si escribis 0 al imputar un pago} begin clrscr; imprime(30,13,white,'*** Accion cancelada ***'); readkey; end; end else {si ya posee pagos efectuados...} begin normvideo; textcolor(white); gotoxy(1,a); writeln (n_soc); gotoxy(8,a); write ('º ',ayn); gotoxy(28,a); write ('º ',dir); gotoxy(51,a); write ('º ',cuotas_pagas); gotoxy(67,a); write ('º ',dni); gotoxy(25,16); write ('Fecha de Emision:'); gotoxy(43,16); getdate(ano,mes,dia,dow); dia := dia; mes := mes; ano := ano; write ('[',dia,'/',mes,'/',ano,']'); Seek (archivo,car); imprime(15,20,green,' Ingrese Meses que usted decea pagar : (1..12)'); textcolor(lightblue); gotoxy(35,22); readln(num); if (num + cuotas_pagas) <= 12 then begin cuotas_pagas := cuotas_pagas + num; seek(archivo,filepos(archivo)-1); write(archivo,cliente); clrscr; imprime(30,15,white,'*** Pago Efectuado ***'); readkey; clrscr; end else {si es mayor a 12 las cuotas} begin clrscr; imprime(25,15,white,'*** Supera los pagos de este Ano ***'); readkey; end; end; end; end else{si esta inactivo o no existe} begin if activo = 0 then begin clrscr; imprime(30,12,white,'*** Socio se encuetra dado de Baja ***'); readkey; end; end; end; end; if pos = -1 then begin clrscr; imprime(30,12,white,'*** Socio no Existe ***'); readkey end; end; {****************************Procedure Imputacion por AYN**********************} procedure imputacionnom; {Para que se imprima se debe agregar el comando lst a los writln} var a:word; begin clrscr; textbackground (lightblue); imprime(1,1,white,' .: Imputacion de Pago por Apellido y Nombre :. '); normvideo; imprime(1,3,white,'Ingrese Apellido y Nombre del Socio: [ ][25]'); gotoxy(39,3); textcolor (lightblue); readln (AYN); pos := buscarnom(AYN,ar2); if pos <> -1 then
begin
seek(archivo,pos);
read(archivo,cliente);
with cliente do
begin
if activo = 1 then
begin
a:= 6;
textbackground (lightblue);
imprime(1,1,white,' .: Imputacion de Pago :. ');
normvideo;
textbackground (lightgray);
imprime(1,2,red,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
imprime(1,3,red,'# Socio º Nombre º Direccion º Cuotas pagas º D.N.I ');
imprime(1,4,red,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
imprime(1,5,red,'');
normvideo;
car := filepos(archivo) ;
normvideo;
car := filepos(archivo) ;
if activo = 1 then
begin
if cuotas_pagas = 0 then
begin
normvideo;
textcolor(white);
gotoxy(1,a);
writeln (n_soc);
gotoxy(9,a);
write ('º ',ayn);
gotoxy(28,a);
write ('º ',dir);
gotoxy(51,a);
write ('º ',cuotas_pagas);
gotoxy(67,a);
write ('º ',dni);
gotoxy(25,16);
write ('Fecha de Emision:');
gotoxy(43,16);
getdate(ano,mes,dia,dow);
dia := dia;
mes := mes;
ano := ano;
write ('[',dia,'/',mes,'/',ano,']');
Seek (archivo,car);
imprime(17,20,green,' Ingrese Meses que usted decea pagar : (1..12)');
gotoxy(35,22);
readln(cuotas_pagas);
textcolor (white);
if cuotas_pagas > 0 then
begin
if cuotas_pagas <= 12then begin seek(archivo,filepos(archivo)-1); write(archivo,cliente); clrscr; imprime(30,13,white,'*** Pago Efectuado ***'); readkey; end else begin clrscr; imprime(25,15,white,'*** Supera los pagos de este Ano ***'); readkey; end; end else {si escribis 0 al imputar un pago} begin clrscr; imprime(30,13,white,'*** Accion cancelada ***'); readkey; end; end else {si ya posee pagos efectuados...} begin normvideo; textcolor(white); gotoxy(1,a); writeln (n_soc); gotoxy(8,a); write ('º ',ayn); gotoxy(28,a); write ('º ',dir); gotoxy(51,a); write ('º ',cuotas_pagas); gotoxy(67,a); write ('º ',dni); gotoxy(25,16); write ('Fecha de Emision:'); gotoxy(43,16); getdate(ano,mes,dia,dow); dia := dia; mes := mes; ano := ano; write ('[',dia,'/',mes,'/',ano,']'); Seek (archivo,car); imprime(15,20,green,' Ingrese Meses que usted decea pagar : (1..12)'); textcolor(lightblue); gotoxy(35,22); readln(num); if (num + cuotas_pagas) <= 12 then begin cuotas_pagas := cuotas_pagas + num; seek(archivo,filepos(archivo)-1); write(archivo,cliente); clrscr; imprime(30,15,white,'*** Pago Efectuado ***'); readkey; clrscr; end else {si es mayor a 12 las cuotas} begin clrscr; imprime(25,15,white,'*** Supera los pagos de este Ano ***'); readkey; end; end; end; end else{si esta inactivo o no existe} begin if activo = 0 then begin clrscr; imprime(30,12,white,'*** Socio se encuetra dado de Baja ***'); readkey; end; end; end; end; if pos = -1 then begin clrscr; imprime(30,12,white,'*** Socio no Existe ***'); readkey end; end; {***************************Procedure Estadistica******************************} procedure estadistica; begin clrscr; begin contbaja:=0; contalta:=0; conts:=0; conta:=0; contd:=0; conti:=0; contf:=0; getdate(ano,mes,dia,dow); dia := dia; mes := mes; ano := ano; assign(archivo,'cliente.dat'); reset(archivo); begin while not eof(archivo) do begin read(archivo,cliente); with cliente do begin if cuotas_pagas <>= mes then
conta := conta +1 ;
letra := concepto[1];
if (Letra ='i')or (Letra ='I') then
conti:=conti+1;
if (Letra ='f')or (Letra ='F') then
contf:=contf+1;
if (activo = 1) then
contalta:=contalta + 1
else
contbaja:=contbaja + 1;
conts:=n_soc;
end;
end;
end;
end;
repeat
normvideo;
Imprime(25, 5 ,red, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»' );
Imprime(25, 6 ,red, 'º º' );
Imprime(25, 7 ,red, 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' );
Imprime(25, 8 ,red, 'º º' );
Imprime(25, 9 ,red, 'º º' );
Imprime(25, 10 ,red, 'º º' );
Imprime(25, 11 ,red, 'º º' );
Imprime(25, 12 ,red, 'º º' );
Imprime(25, 13 ,red, 'º º' );
Imprime(25, 14 ,red, 'º º' );
Imprime(25, 15 ,red, 'º º' );
Imprime(25, 16 ,red, 'º º' );
Imprime(25, 17 ,red, 'º º' );
Imprime(25, 18 ,red, 'º º' );
Imprime(25, 19 ,red, 'º º' );
Imprime(25, 20 ,red, 'º º' );
Imprime(25, 21 ,red, 'º º' );
Imprime(25, 22 ,red, 'º º' );
Imprime(25, 23 ,red, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ[ ]ͼ' );
Imprime(28, 6 ,lightblue, 'Estadisticas del Club ' );
textcolor (white);
gotoxy(27,8);
writeln ('Total Socios : ',conts);
gotoxy(27,10);
writeln ('Socios Individuales : ',conti);
gotoxy(27,12);
writeln ('Socios Familiares : ',contf);
gotoxy(27,14);
writeln ('Socios al Dia : ',conta);
gotoxy(27,16);
writeln ('Socios Deudores : ',contd);
gotoxy(27,18);
writeln ('Socios Activos : ',contalta);
gotoxy(27,20);
writeln ('Socios Inactivos : ',contbaja);
Imprime(28,22 ,green, 'A) Volver' );
gotoxy (55,23);
readln (opcion);
until upcase (opcion) = 'A';
end;
{**************************Procedure Limpieza de Base de Datos*****************}
Procedure limpieza;
var a,b:word;
begin
repeat
clrscr;
Imprime(25, 4 ,red, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»' );
Imprime(25, 5 ,red, 'º º' );
Imprime(25, 6 ,red, 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' );
Imprime(25, 7 ,red, 'º º' );
Imprime(25, 8 ,red, 'º º' );
Imprime(25, 9 ,red, 'º º' );
Imprime(25, 10 ,red, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ[ ]ͼ' );
Imprime(30, 5 ,lightblue, 'Limpiar Archivo' );
Imprime(27, 7 ,white, 'A) Socios.TXT' );
Imprime(27, 9 ,green, 'B) Volver' );
gotoxy (45,10);
readln (opcion);
case upcase(opcion) of
'A': begin
assign(archivo,'cliente.dat');
rewrite(archivo);
clrscr;
Imprime(28, 5 ,red, 'Limpiando Base de Datos...' );
Imprime(28, 6 ,red, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»' );
Imprime(28, 7 ,red, 'º º' );
Imprime(28, 8 ,red, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍ[ %]ͼ' );
a := 29;
b := 0;
repeat
gotoxy(a,7);
textbackground (lightblue);
write(' ');
delay(15);
normvideo;
a := a+1;
gotoxy(44,8);
write(b/20*100:0:0);
b := b+1;
ar :=nil;
ar2:=nil;
until b = 21;
Imprime(35, 10 ,green, 'Volver...' );
gotoxy(43,10);
readkey;
end;
end;
until upcase(opcion) = 'B' ;
end;
{**********************Cuerpo Principal****************************************}
BEGIN
{Encontrar archivo}
repeat
imprime(10,13,white,'Si no sabe el nombre del archivo se generara con el nombre ingresado' );
imprime(20,15,green,'Introducir nombre de archivo : ' );
gotoxy(25,17);
readln (S);
assign (archivo,S);
{$I-}
rewrite (archivo);
resul:=IOResult;
{$I+}
if resul<> 0 then
imprime(20,15,green,'*** El archivo no se ha encontrado ***' );
until resul=0;
ar:= nil;
ar2:=nil;
while not eof(archivo) do
begin
read(archivo,cliente);
with cliente do
begin
x.dni:=dni;
x.pos:=n_soc - 1; {arbol por dni (insercion)}
insertardni(x,ar);
x2.nom := ayn;
x2.pos := n_soc - 1; {arbolpornombre(insercion)}
insertarnom(x2,ar2);
end;
end;{Fin encontrar archivo}
repeat
normvideo;
clrscr;
cuadro;
Imprime(28, 7 ,lightblue, 'Seleccionar Opcion' );
Imprime(28, 9 ,white, 'A) AMC de Socios' );
Imprime(28, 11 ,white, 'B) Baja de Socios' );
Imprime(28, 13 ,white, 'C) Listado de Socios' );
Imprime(28, 15 ,white, 'D) Imputacion de Pago' );
Imprime(28, 17 ,white, 'E) Estadistica' );
Imprime(28, 19 ,white, 'F) Limpiar Datos' );
Imprime(28, 21 ,green, 'G) Salir' );
gotoxy(51,22);
readln (opcion);
case upcase(opcion) of
'A': socios;
'B': begin
repeat
clrscr;
assign(archivo,'cliente.dat');
reset(archivo);
Imprime(25, 10 ,red, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»' );
Imprime(25, 11 ,red, 'º º' );
Imprime(25, 12 ,red, 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' );
Imprime(25, 13 ,red, 'º º' );
Imprime(25, 14 ,red, 'º º' );
Imprime(25, 15 ,red, 'º º' );
Imprime(25, 16 ,red, 'º º' );
Imprime(25, 17 ,red, 'º º' );
Imprime(25, 18 ,red, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ[ ]ͼ' );
Imprime(28, 11 ,lightblue, 'Selecionar Opcion' );
Imprime(28, 13 ,white, 'A) D.N.I' );
Imprime(28, 15 ,white, 'B) Apellido y Nombre' );
Imprime(28, 17 ,green, 'C) Volver' );
gotoxy (51,18);
readln (opcion);
case upcase(opcion) of
'A' :bajadni;
'B' :bajanom;
end
until upcase(opcion) = 'C'
end;
'C': begin
repeat
clrscr;
Imprime(25, 10 ,red, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»' );
Imprime(25, 11 ,red, 'º º' );
Imprime(25, 12 ,red, 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' );
Imprime(25, 13 ,red, 'º º' );
Imprime(25, 14 ,red, 'º º' );
Imprime(25, 15 ,red, 'º º' );
Imprime(25, 16 ,red, 'º º' );
Imprime(25, 17 ,red, 'º º' );
Imprime(25, 18 ,red, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ[ ]ͼ' );
Imprime(28, 11 ,lightblue, 'Selecionar Opcion' );
Imprime(28, 13 ,white, 'A) Numero de Socio' );
Imprime(28, 15 ,white, 'B) Apellido y Nombre' );
Imprime(28, 17 ,green, 'C) Volver' );
gotoxy (51,18);
readln (opcion);
case upcase(opcion) of
'A' : lista;
'B' :begin
a := 5;
clrscr;
textbackground (lightblue);
Imprime(1, 1,white, ' .: Lista de Socios del Club ordenada por Apellido y Nombre :. ' );
normvideo;
textbackground (lightgray);
Imprime(1, 2,red, 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ' );
Imprime(1, 3,red, '# º ApellidoyNombre º Direccion º Dir.de Cobro º Concepto º Cuotas' );
Imprime(1, 4,red, 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ' );
normvideo;
listarnom(ar2);
readkey;
end;
end
until upcase(opcion) = 'C'
end;
'D': begin
repeat
clrscr;
assign(archivo,'cliente.dat');
reset(archivo);
Imprime(25, 10 ,red, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»' );
Imprime(25, 11 ,red, 'º º' );
Imprime(25, 12 ,red, 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' );
Imprime(25, 13 ,red, 'º º' );
Imprime(25, 14 ,red, 'º º' );
Imprime(25, 15 ,red, 'º º' );
Imprime(25, 16 ,red, 'º º' );
Imprime(25, 17 ,red, 'º º' );
Imprime(25, 18 ,red, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ[ ]ͼ' );
Imprime(28, 11 ,lightblue, 'Selecionar Opcion' );
Imprime(28, 13 ,white, 'A) D.N.I' );
Imprime(28, 15 ,white, 'B) Apellido y Nombre' );
Imprime(28, 17 ,green, 'C) Volver' );
gotoxy (51,18);
readln (opcion);
case upcase(opcion) of
'A' :imputaciondni;
'B' :imputacionnom;
end
until upcase(opcion) = 'C'
end;
'E': estadistica;
'F': limpieza;
'G': begin
clrscr;
Imprime( 36, 6 ,white, 'Autores: ' );
Imprime( 32, 8 ,lightblue, 'Guillaume Ariel; ' );
Imprime( 25, 10 ,lightblue, 'Martinez Vilar Enrique Gabriel ;' );
Imprime( 32, 12 ,lightblue, 'Ronconi Luciano; ' );
Imprime( 25, 14 ,white, 'Universidad Tecnologica Nacional ' );
Imprime( 19, 16 ,white, 'Facultad Regional de Concepcion del Uruguay; ' );
end;
end
until upcase (opcion) = 'G';
close(archivo);
END.
