{A ver si esto sirve}
program pequenaajenda;
uses
crt;
type
regajenda = record {El registro de la ajenda} nombre : string[40];
apelli1 : string[40];
apelli2 : string[40];
direcci : string[80];
telefon : word;
movil : longint;
fnacim : string[10];
end;
var
ajenda : array[1..50] of regajenda; {El array de registros 50} cont : integer; {Contador del array} tecla : char; {Para la seleccion del menu} f : file of regajenda; {Para guardar la ajenda}
function entrada(xp, yp : integer;tip : char; td : integer) : string;
var {Esta funcion nos entregara el estring entrado} tre : char;
dat : string[80];
ps : integer;
begin
entrada := ' ';
gotoxy(xp,yp);
ps := 1;
repeat
tre := readkey;
if tip in['n','N'] then {Si tenemos que entrar numeros esta zona} begin
if tre in[#48..#57] then {Valores de los caracteres en decimal}
begin
dat[ps] := tre;
dat[0] := chr(ps);
gotoxy((xp - 1) + ps,yp);write(dat[ps]);
ps := ps + 1;
if ps > td then
ps := td;
end;
end;
if tip in['t','T'] then {Si tenemos que entrar texto esta zona} begin
if tre in[#30..#126,#164,#167] then {Valores de los caracteres en decimal}
begin
dat[ps] := tre;
dat[0] := chr(ps);
gotoxy((xp - 1) + ps,yp);write(dat[ps]);
ps := ps + 1;
if ps > td then
ps := td;
end;
end;
if tre = #8 then
begin
ps := ps - 1;
if ps < 1 then
ps := 1;
dat[0] := chr(ps);
dat[ps] := ' ';
gotoxy((xp - 1) + ps,yp);write(dat[ps]);
end;
until tre = #13;
if (tre = #13) and (ps > 1) then
begin
entrada := copy(dat,1,ps - 1);
end;
end;
procedure mascaraentrada(cual : char); {Pantalla de entrada} begin
if upcase(cual) = 'E' then
begin
gotoxy(3,2);write('*** Entrada Datros Ajenda ***'); end;
if upcase(cual) = 'M' then
begin
gotoxy(3,2);write('*** Ver Datros Ajenda ***'); end;
gotoxy(5,5);write('Nombre : '); gotoxy(5,6);write('1§ Apellido : '); gotoxy(5,7);write('2§ Apellido : '); gotoxy(5,8);write('Direccion : '); gotoxy(5,9);write('N§ Telefon : '); gotoxy(5,10);write('N§ Movil : '); gotoxy(5,11);write('Fecha Nacimiento : '); end;
procedure entrada_datos(h : integer;ne : char); {Entrada asignacion datos} var
fin : boolean;
tec : char;
error, co : integer;
tt : longint;
tomado : string[80];
begin
fin := false;
clrscr;
co := h;
repeat
mascaraentrada('e'); ajenda[co].nombre := entrada(24,5,'t',40);
ajenda[co].apelli1 := entrada(24,6,'t',40);
ajenda[co].apelli2 := entrada(24,7,'t',40);
ajenda[co].direcci := entrada(24,8,'t',80);
tomado := entrada(24,9,'n',10);
val(tomado,tt,error);
if error > 0 then
begin
delete(tomado,error,1);
val(tomado,tt,error);
end;
ajenda[co].telefon := tt;
tomado := entrada(24,10,'n',12);
val(tomado,tt,error);
if error > 0 then
begin
delete(tomado,error,1);
val(tomado,tt,error);
end;
ajenda[co].movil := tt;
ajenda[co].fnacim := entrada(24,11,'t',10);
if ne in['e','E'] then
begin
gotoxy(24,13);write('Desea Entrar Mas Datos [S/N]'); repeat
tec := readkey;
until tec in['s','S','n','N'];
if tec in['s','S'] then
begin
co := co + 1;
if co > 50 then
fin := true;
clrscr;
end;
end
else
fin := true;
until (tec in['n','N']) or (fin = true);
cont := co;
end;
procedure verdatos; {Visualizacion de los datos} var
n : integer;
tn : char;
salir : boolean;
begin
clrscr;
n := 1;
salir := false;
mascaraentrada('m'); repeat
gotoxy(24,5);clreol;
gotoxy(24,6);clreol;
gotoxy(24,7);clreol;
gotoxy(24,8);clreol;
gotoxy(24,9);clreol;
gotoxy(24,10);clreol;
gotoxy(24,11);clreol;
gotoxy(24,13);clreol;
gotoxy(24,5);write(ajenda[n].nombre);
gotoxy(24,6);write(ajenda[n].apelli1);
gotoxy(24,7);write(ajenda[n].apelli2);
gotoxy(24,8);write(ajenda[n].direcci);
gotoxy(24,9);write(ajenda[n].telefon);
gotoxy(24,10);write(ajenda[n].movil);
gotoxy(24,11);write(ajenda[n].fnacim);
gotoxy(24,13);write('Desea Ver Mas Datos [S/N]'); repeat
tn := readkey;
until tn in['n','N','s','S'];
if tn in['n','N'] then
salir := true
else
n := n + 1;
if n > cont then
n := cont;
until (tn = #27) or (salir = true);
end;
procedure modificadatos; {Modificacion de datos} var
tr : char;
sal : boolean;
nn : integer;
begin
clrscr;
nn := 1;
mascaraentrada('m'); repeat
gotoxy(24,5);clreol;
gotoxy(24,6);clreol;
gotoxy(24,7);clreol;
gotoxy(24,8);clreol;
gotoxy(24,9);clreol;
gotoxy(24,10);clreol;
gotoxy(24,11);clreol;
gotoxy(24,13);clreol;
gotoxy(24,5);write(ajenda[nn].nombre);
gotoxy(24,6);write(ajenda[nn].apelli1);
gotoxy(24,7);write(ajenda[nn].apelli2);
gotoxy(24,8);write(ajenda[nn].direcci);
gotoxy(24,9);write(ajenda[nn].telefon);
gotoxy(24,10);write(ajenda[nn].movil);
gotoxy(24,11);write(ajenda[nn].fnacim);
gotoxy(24,14);write('Si Son Los Datos a Modificar Pulse [Enter]'); gotoxy(24,15);write('Sino Otra Tecla'); tr := readkey;
if tr = #13 then
begin
clrscr;
cont := nn;
entrada_datos(nn,' ');
tr := #27;
end;
nn := nn + 1;
until tr = #27;
end;
procedure borraunaajenda; {Borramos uno de la ajenda} var
nomb, ape1, ape2 : string[40];
w, nume, nu : integer;
datos : array[1..50] of regajenda;
encontre : boolean;
begin
clrscr;
nume := 0;
encontre := false;
gotoxy(2,1);write('Borramos Un Elento De La Ajenda'); gotoxy(2,3);write('Nombre : '); gotoxy(2,4);write('1§ Apellido : '); gotoxy(2,5);write('2§ Apellido : '); gotoxy(16,3);readln(nomb);
gotoxy(16,4);readln(ape1);
gotoxy(16,5);readln(ape2);
for nu := 1 to cont do
begin
if (nomb = ajenda[nu].nombre) and (ape1 = ajenda[nu].apelli1) and
(ape2 = ajenda[nu].apelli2) then
begin
encontre := true;
nume := nu;
end;
end;
if encontre = true then
begin
w := 1;
for nu := 1 to cont do
begin
if nu <> nume then
begin
datos[w] := ajenda[nu];
w := w + 1;
end;
end;
for nu := 1 to w - 1 do
ajenda[nu] := datos[nu];
cont := w - 1;
end
else
begin
clrscr;
gotoxy(3,3);write('Dato No Encontrado Intentelo De Nuevo Pulse [Enter]'); readln;
end;
end;
procedure ordenararray; {Ordena la ajenda de menor a mayor} var
temporal : regajenda;
pri, ult : integer;
begin
clrscr;
for pri := 1 to cont do
for ult := cont downto pri do
if ajenda[pri].nombre > ajenda[ult].nombre then
begin
temporal := ajenda[pri];
ajenda[pri] := ajenda[ult];
ajenda[ult] := temporal;
end;
gotoxy(4,3);write('Array Ordenado Pulsa [Enter]'); readln;
end;
procedure salvadatos; {Salvamos al disco} var
il : integer;
as : longint;
begin
assign(f,'c:\tp\Agenda.dat');
{$I-} reset(f); {$I+} if ioresult <> 0 then
begin
rewrite(f);
for il := 0 to cont - 1 do
begin
seek(f,il);
write(f,ajenda[1 + il]);
end;
close(f);
end
else
begin
as := filesize(f);
for il := 0 to cont - 1 do
begin
seek(f,as + il);
write(f,ajenda[1 + il]);
end;
close(f);
end;
clrscr;
writeln(' Datos De Agenda Guardados En [Agenda.dat] Pulse [Enter]'); readln;
end;
procedure cargadatos; {Cargamos del disco} var
ds : integer;
arch : longint;
begin
assign(f,'c:\tp\Agenda.dat');
{$I-} reset(f); {$I+} if ioresult <> 0 then
begin
clrscr;
writeln(' El Archivo [Agenda.dat] No Existe Pulse [Enter]'); readln;
end
else
begin
arch := filesize(f) - 1;
if arch > 49 then
arch := 49;
for ds := 0 to arch do
begin
seek(f,ds);
read(f,ajenda[1 + ds]);
end;
close(f);
end;
end;
procedure menu; {Menu jeneral} var
opci : char;
begin
opci := ' ';
cont := 1;
repeat;
clrscr;
gotoxy(30,2);write('<<<<< MENU GENERAL AGENDA >>>>>'); gotoxy(30,4);write(' 1 = Entrada o Insertar Datos'); gotoxy(30,5);write(' 2 = Visualizacion Datros'); gotoxy(30,6);write(' 3 = Modificacion Datos'); gotoxy(30,7);write(' 4 = Borrado De Una Agenda'); gotoxy(30,8);write(' 5 = Ordenar Agenda'); gotoxy(30,9);write(' 6 = Guardar Agenda'); gotoxy(30,10);write(' 7 = Cargar Agenda'); gotoxy(30,11);write(' 8 = Salir De Ajenda'); gotoxy(36,14);write('Elija Opcion'); tecla := readkey;
case tecla of
#49 : entrada_datos(cont,'e');
#50 : verdatos;
#51 : modificadatos;
#52 : borraunaajenda;
#53 : ordenararray;
#54 : salvadatos;
#55 : cargadatos;
#56 : opci := 'S';
end;
until opci = 'S';
end;
begin {Iniciamos programa} clrscr;
menu;
end.
Crear cuenta