Pascal/Turbo Pascal - Programa que sirva como agenda.

   
Vista:

Programa que sirva como agenda.

Publicado por Naye (5 intervenciones) el 09/04/2012 22:56:06
Serian tan amables de ayudarme hacer un programa en Pascal que sirva como agenda, mostrando nombre, telefono, correo y direccion? Muchas gracias!
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
información
Otras secciones de LWP con contenido de Pascal/Turbo Pascal
- Código fuente de Pascal/Turbo Pascal
- Cursos de Pascal/Turbo Pascal
- Temas de Pascal/Turbo Pascal
- Chat de Pascal/Turbo Pascal
información
Códigos de Pascal/Turbo Pascal
- Serpiente
- Matrix
- Codificar una cadena

Programa que sirva como agenda.

Publicado por ramon (2072 intervenciones) el 11/04/2012 17:13:02
{Espero esta te sirva aunque sea un poquito cutre}

program agenda;
uses
crt, dos;
type
datosagenda = record
nombreape : string[80];
telefono : string[18];
correo : string[30];
direccion : string[40];
end;

var
datos : datosagenda;
f : file of datosagenda;
cont : integer;
tecla : char;


function textoentra(x, y, long : integer) : string;
var
tec : char;
dat : string;
nu : integer;
begin
nu := 1;
fillchar(dat,256,' ');
dat[0] := chr(255);
textoentra := ' ';
repeat
tec := readkey;
if tec in[#40..#126,#164,#165,#32,#167] then
begin
dat[nu] := tec;
dat[0] := chr(nu);
gotoxy(x + nu,y);write(dat[nu]);
nu := nu + 1;
if nu > long then
nu := long;
end;
if tec = #8 then
begin
nu := nu - 1;
if nu < 1 then
nu := 1;
dat[nu] := ' ';
dat[0] := chr(nu);
gotoxy(x + nu,y);write(dat[nu]);
end;
until (tec = #13) or (tec = #27);
if tec = #13 then
begin
textoentra := copy(dat,1,length(dat));
end;
end;

procedure entradas;
var
te : char;
begin
clrscr;
textcolor(15);
gotoxy(2,1);write('**** Entrada Datos ****');
textcolor(8);
gotoxy(2,3);write('NOMBRE Y APELLIDO : ');
gotoxy(2,4);write('TELEFONO : ');
gotoxy(2,5);write('CORREO : ');
gotoxy(2,6);write('DIRECCION : ');
textcolor(15);
gotoxy(2,3);write('NOMBRE Y APELLIDO : ');
datos.nombreape := textoentra(21,3,80);
gotoxy(2,4);write('TELEFONO : ');
datos.telefono := textoentra(21,4,18);
gotoxy(2,5);write('CORREO : ');
datos.correo := textoentra(21,5,30);
gotoxy(2,6);write('DIRECCION : ');
datos.direccion := textoentra(21,6,40);
gotoxy(2,8);write('Datos Correctos [S/N]');
repeat
te := readkey;
until te in['s','S','n','N'];
if te in['s','S'] then
begin
assign(f,'agenda.dat');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
rewrite(f);
seek(f,0);
write(f,datos);
close(f);
end
else
begin
seek(f,filesize(f));
write(f,datos);
close(f);
end;
end;
end;

procedure anulacion;
var
temp : file of datosagenda;
pp, g, n : longint;
nom : string[80];
encont : boolean;
begin
clrscr;
gotoxy(2,1);write('Anular Registo De Persona');
gotoxy(2,3);write('NOMBRE Y APELLIDO : ');
nom := textoentra(21,3,80);
assign(f,'agenda.dat');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
halt(1);
end;
n := 0;
encont := false;
repeat
seek(f,n);
read(f,datos);
if datos.nombreape = nom then
begin
encont := true;
end
else
begin
n := n + 1;
end;
until (encont = true) or (n > filesize(f) - 1);
if encont = true then
begin
assign(temp,'tempor.kat');
reset(temp);
rewrite(temp);
pp := 0;
for g := 0 to filesize(f) - 1 do
begin
if g <> n then
begin
seek(temp,pp);
seek(f,g);
read(f,datos);
write(temp,datos);
pp := pp + 1;
end;
end;
close(f);
erase(f);
close(temp);
rename(temp,'agenda.dat');
end;
end;

procedure ordenar_por;
var
pri, seg : longint;
inter, tomad : datosagenda;
begin
assign(f,'agenda.dat');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
exit;
end
else
begin
clrscr;
gotoxy(2,3);write('ORDENANDO AGENDA ESPERE');
for pri := 0 to filesize(f) - 1 do
begin
seek(f,pri);
read(f,datos);
for seg := filesize(f) - 1 downto pri do
begin
seek(f,seg);
read(f, tomad);
if datos.nombreape > tomad.nombreape then
begin
inter := datos;
datos := tomad;
tomad := inter;
seek(f,pri);
write(f,datos);
seek(f,seg);
write(f,tomad);
end;
end;
end;
end;
close(f);
clrscr;
gotoxy(3,3);write('AGENDA ORDENADA PULSE UNA TECLA');
readkey;
clrscr;
end;

procedure presentar;
var
tiene, cop : longint;
tcd : char;
begin
assign(f,'agenda.dat');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
exit;
end
else
begin
cop := 0;
tiene := filesize(f) - 1;
repeat
clrscr;
seek(f,cop);
read(f,datos);
gotoxy(1,1);write('AGENDA N§ = ',cop + 1,' DE = ',tiene + 1);
gotoxy(2,3);write('NOMBRE = ',datos.nombreape);
gotoxy(2,4);write('TELEFONO = ',datos.telefono);
gotoxy(2,5);write('CORREO = ',datos.correo);
gotoxy(2,6);write('DIRECCION = ',datos.direccion);
gotoxy(2,8);write('PULSE TECLAS [ ',chr(24),' ',chr(25),
' ] PARA [+/-] O [ESC] = FIN');
tcd := readkey;
if tcd = #80 then
begin
cop := cop + 1;
if cop > tiene then
cop := tiene;
end;
if tcd = #72 then
begin
cop := cop - 1;
if cop < 0 then
cop := 0;
end;
until tcd = #27;
close(f);
end;
end;

procedure modificar;
var
modifi : datosagenda;
nomodif : string[80];
ty : longint;
encont : boolean;
nn : integer;
ente : char;
begin
assign(f,'agenda.dat');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
exit;
end
else
begin
clrscr;
gotoxy(2,1);write('Modificacion de Datos');
gotoxy(2,4);write('Entre Nombre y Apellido : ');
nomodif := ' ';
nomodif := textoentra(27,4,80);
if nomodif > ' ' then
begin
ty := 0;
encont := false;
repeat
seek(f,ty);
read(f,datos);
if datos.nombreape = nomodif then
begin
encont := true;
end
else
begin
ty := ty + 1;
end;
until (encont = true) or (ty > filesize(f) - 1);
if encont = true then
begin
clrscr;
nomodif := ' ';
nn := 1;
gotoxy(2,2);write(nn,' : ',datos.nombreape);
nn := nn + 1;
gotoxy(2,3);write(nn,' : ',datos.telefono);
nn := nn + 1;
gotoxy(2,4);write(nn,' : ',datos.correo);
nn := nn + 1;
gotoxy(2,5);write(nn,' : ',datos.direccion);
gotoxy(2,7);write('Elija Opcion [1/2/3/4]');
repeat
ente := readkey;
until ente in[#49..#52];
clrscr;
case ente of
#49 : begin
gotoxy(2,8);write('Entre Nuevo Nombre : ');
nomodif := textoentra(22,8,80);
datos.nombreape := copy(nomodif,1,length(nomodif));
end;
#50 : begin
gotoxy(2,8);write('Entre Nuevo Telefono : ');
nomodif := textoentra(24,8,18);
datos.telefono := copy(nomodif,1,length(nomodif));
end;
#51 : begin
gotoxy(2,8);write('Entre Nuevo Correo : ');
nomodif := textoentra(22,8,30);
datos.correo := copy(nomodif,1,length(nomodif));
end;
#52 : begin
gotoxy(2,8);write('Entre Nueva Direccion : ');
nomodif := textoentra(25,8,40);
datos.direccion := copy(nomodif,1,length(nomodif));
end;
end;
clrscr;
writeln('NOMBRE Y APELLIDO : ',datos.nombreape);
writeln('TELEFONO N§ : ',datos.telefono);
writeln('CORREO ELECTRONICO : ',datos.correo);
writeln('DIRECCION : ',datos.direccion);
writeln;
writeln('SON LOS DATOS CORRECTOS [S/N]');
repeat
ente := readkey;
until ente in['s','S','n','N'];
if ente in['s','S'] then
begin
seek(f,ty);
write(f,datos);
close(f);
end
else
begin
close(f);
end;
end;
end;
end;
end;

procedure menu;
var
final : boolean;
begin
final := false;
repeat
clrscr;
gotoxy(1,1);write('****** MENU GENERAL AGENDA ******');
gotoxy(3,3);write(' 1 = NUEVA ENTRADA');
gotoxy(3,4);write(' 2 = PRESENTA DATOS');
gotoxy(3,5);write(' 3 = MODIFIAR DATOS');
gotoxy(3,6);write(' 4 = ORDENAR AGENDA');
gotoxy(3,7);write(' 5 = SALIR DE AGENDA');
gotoxy(3,9);write(' <<<< ELIJA OPCION >>>>');
tecla := readkey;
case tecla of
#49 : entradas;
#50 : presentar;
#51 : modificar;
#52 : ordenar_por;
#53 : final := true;
end;
until final = true;
end;

begin
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