Pascal/Turbo Pascal - URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por elias (45 intervenciones) el 15/11/2012 03:24:14

Saludos, tengo una duda con un trabajo practico de la Universidad, he avanzado bastante pero me falta hacer una ordenación de datos por número de cédula de identidad que quiero agregar a un procedure ya programado (Procedure Listar), intento con método de la burbuja pero no me funciona...aquí el esqueleto del código(suprimí varios procedures para enfocar lo mas importante)...

Program TRABAJOUNIVERSIDAD;

uses CRT, printer;

const

Max = 1000;
ubicacion='C:\ARCHIVO.dat';

Type

Registro=Record
Nom:String [30];
Ced: String [8];
Carnet:....;
Sexo:......;
Edad: .......;
Dir:....;
Tel:.....;
CentroEst:.....;
Eliminar:.......;

End;

ListaEstu = array [1..Max] of Registro;
Archivo= File of Registro;

Var
K, N, i, j, anio, c, entero, code, hombres, mujeres, mayores, numero, error, cap barq, mer, zul, nueva, fal:

integer;
Tipo: Char;
Lista : ListaEstu;
Aux : Registro;
vale:boolean;

Procedure SumaContadorHM;

End;

Procedure contadoredad;

End;

procedure PulsarUnaTecla;

end; { PulsarUnaTecla }

Procedure ContadorCE;
var

End;

Procedure Incluir(Var Arch:Archivo);
Var Reg:Registro;

c : integer;

Begin

writeln('************** TITULO TRABAJO **************');
WriteLn;

WriteLn( '******************** INCLUIR ********************');
WriteLn;

repeat
Write('Ingrese Cedula : ');
ReadLn(Reg.Ced);
val (Reg.Ced[7], numero, error);
until error= 0;
writeLn('El numero de Cedula ' , Reg.Ced , ' parece ser valida, presione Enter para continuar');
readkey;

repeat
Write('Ingrese Numero de Carnet : ');

repeat
Write('Ingrese Nombres y Apellidos : ');

Repeat
Write('Ingrese Sexo del Estudiante (M/F, en MAYÚSCULA): ');

Write('Ingrese Edad del Estudiante : ');

repeat
Write('Ingrese Direccion : ');

repeat
Write('Ingrese Telefono : ');

val (Reg.tel[11], numero, error);

Write('Ingrese Centro de Estudio ');

Reg.Eliminar:=False;
Reset(Arch);
If FileSize(Arch)<>0
Then Seek(Arch, FileSize(Arch));
Write(Arch, Reg);
Close(Arch);
WriteLn;
WriteLn('***** Presione ENTER para continuar *****');
ReadKey;
Ordenar (Lista);
End;

Procedure Eliminar(Var Arch:Archivo);

End;

Procedure Modif(Var Arch:Archivo);

End;

Procedure Listar(Var Arch:Archivo);
Var Reg:Registro;

Begin

Reset(Arch);
while Not Eof(Arch) Do
Begin
Read(Arch, Reg);
If Reg.Eliminar = False

then

WriteLn;

WriteLn('Cedula : ', Reg.Ced);

WriteLn;

End;
Close(Arch);
WriteLn;
WriteLn('***** Presione ENTER para continuar *****');
ReadKey;
End;

Procedure Consult(Var Arch:Archivo);

End;

Procedure Reporte(Var Arch:Archivo);

End;

Var
Arch:Archivo;
Opcion:Char;
Begin
Assign(Arch, ubicacion);
{$i-}
Reset(Arch);
{$I+}
If IOResult <> 0
Then ReWrite(Arch);
Close(Arch);

Repeat
ClrScr;
writeln('************** TITULO TRABAJO **************');
WriteLn;
WriteLn(' MENU');
WriteLn;
if contadorlapso= 1 then
begin
writeln(' AÑO: ',anio);
writeln(' lapso: ',lapso);
end;
WriteLn;
WriteLn('1 - ');
WriteLn('2 - ');
WriteLn('3 - ');
WriteLn('4 - ');
WriteLn('5 - ');
WriteLn('6 - ');
WriteLn('0 - ');
WriteLn;

Repeat
Opcion:=ReadKey;

Until (Opcion >= '0') And (Opcion <= '6');
Case Opcion of
'1':
'2':
'3':
'4':
'5':
'6':
End;
Until Opcion = '0';

END.

Valora esta pregunta

Me gusta: Está pregunta es útil y esta clara

No me gusta: Está pregunta no esta clara o no es útil

Responder

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por ramon (2158 intervenciones) el 15/11/2012 18:20:31

Mira esto

const

Max = 1000;

type

Registro=Record

Nom:String [30];

Ced: String [8];

Carnet:....;

Sexo:......;

Edad: .......;

Dir:....;

Tel:.....;

CentroEst:.....;

Eliminar:.......;

End;

ListaEstu = array [1..Max] of Registro;

var

Lista : ListaEstu;

 procedure ordena;

var

   tempora :  registro;

   i, u : integer;

 begin

    for i := 1 to max do

       for u := max downto i do

       if lista[i].Carnet  > lista[u].Carnet then

       begin

           temporal := lista[i];

           lista[i] := lista[u];

           lista[u] := temporal;

       end;

     end;

La ordenacion es de mayor a menor.

Valora esta respuesta

Me gusta: Está respuesta es útil y esta clara

No me gusta: Está respuesta no esta clara o no es útil

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por Elias (45 intervenciones) el 15/11/2012 21:21:33

Gracias por responder!, bien, hice la prueba, cambie el carnet por variable Ced (de cedula), no logro ver el ordenamiento con writeln, y entiendo que para verlo de menor a mayor solo hay que invertir el signo ">"...es asi?

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por ramon (2158 intervenciones) el 15/11/2012 22:45:36

Si cambias y sera de mayor a menor.
Para verlo as

for t := 1 to 1000 do { o sea las entradas que tengas}
write(' ',lista[t]);

{te presentara todo}

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por Elias (45 intervenciones) el 15/11/2012 23:05:28

Bien, me perdí un poco con la nomenclatura, supongo que la "t "es la "u" del primer codigo de ordenamiento, es decir en el procedure listar colocaría:

Procedure Listar(Var Arch:Archivo);
Var Reg:Registro;

Begin

Reset(Arch);
while Not Eof(Arch) Do
Begin
Read(Arch, Reg);
If Reg.Eliminar = False

then

ordena;
for u := 1 to 1000 do { o sea las entradas que tengas}
write(' ',lista[u]);

End;
Close(Arch);
WriteLn;
WriteLn('***** Presione ENTER para continuar *****');
ReadKey;
End;

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por ramon (2158 intervenciones) el 15/11/2012 23:34:27

Fijate no es lo mismo array que archivo.

const

Max = 1000;

type

Registro=Record

Nom:String [30];

Ced: String [8];

Carnet:....;

Sexo:......;

Edad: .......;

Dir:....;

Tel:.....;

CentroEst:.....;

Eliminar:.......;

End;

ListaEstu = array [1..Max] of Registro;

var

Lista : ListaEstu;

 procedure ordena;

var

   tempora :  registro;

   i, u : integer;

 begin

    for i := 1 to max do

       for u := max downto i do

       if lista[i].Carnet  > lista[u].Carnet then

       begin

           temporal := lista[i];

           lista[i] := lista[u];

           lista[u] := temporal;

       end;

     end;

------------------------ array----------

Procedure Listar(Var Arch:Archivo);

Var Reg:Registro;

Begin

Reset(Arch);

while Not Eof(Arch) Do

Begin

Read(Arch, Reg);

If Reg.Eliminar = False

then

ordena;

for u := 1 to 1000 do { o sea las entradas que tengas}

write(' ',lista[u]);

End;

Close(Arch);

WriteLn;

WriteLn('***** Presione ENTER para continuar *****');

ReadKey;

End;

------------- archivo---------
ojo no es lo mismo

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por Elias (45 intervenciones) el 15/11/2012 23:41:08

Entiendo, soy novato en esto, disculpame, como puedo entonces ver el reporte de personas ordenadas por cedula con la estructura que vengo manejando, entonces no es posible usar ese procedure listar que hice? que me sugieres? Te agradezco mucho la buena disposición.

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por ramon (2158 intervenciones) el 16/11/2012 19:31:09

{Mira esto te te a ayudara asienta lo a tus necesidades ejecútalo para ver resultados}

program archivos;
uses
crt;
const
archi = 'Miarchi.bad';
type
regdatos = record
nombre : string;
numero : integer;
telefo : word;
end;
var
f : file of regdatos;
%

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por ramon (2158 intervenciones) el 16/11/2012 19:36:02

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

{Mira esto te te a ayudara asienta lo a tus necesidades ejecútalo para ver resultados }

 program archivos;

  uses

     crt;

   const

      archi = 'Miarchi.bad';

   type

     regdatos = record

          nombre : string;

          numero : integer;

          telefo : word;

         end;

var

      f : file of regdatos;

      datos : regdatos;

      h : longint;

      sal : char;

   procedure entradas;

   begin

      clrscr;

      write('  Entre nombre : ');

      readln(datos.nombre);

      write('  Entre numero : ');

      readln(datos.numero);

      write('  Entre telefono : ');

      readln(datos.telefo);

      assign(f,archi);

   {$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;

  procedure presentaarchi;

var

    j : longint;

  begin

      assign(f,archi);

   {$I-} reset(f); {$I+}

   if ioresult <> 0 then

   begin

       writeln('   Error de archivo pulse [Enter]');

       readln;

end

 else

    begin

       for j := 0 to filesize(f) - 1 do

       begin

          seek(f,j);

          read(f,datos);

          writeln(datos.nombre,'       ',datos.numero,'      ',datos.telefo);

       end;

        close(f);

        writeln('  pulse [Enter]');

        readln;

    end;

  end;

  procedure ordenaarchivo;

var

    dato2, temp : regdatos;

    v, n : longint;

  begin

      assign(f,archi);

   {$I-} reset(f); {$I+}

   if ioresult <> 0 then

   begin

       writeln('   Error de archivo pulse [Enter]');

       readln;

end

 else

    begin

        for v := 0 to filesize(f) - 1 do

          for n := filesize(f) - 1 downto v + 1 do

          begin

          seek(f,v);

          read(f,datos);

          seek(f,n);

          read(f,dato2);

          if datos.nombre > dato2.nombre then

          begin

             temp := datos;

             datos := dato2;

             dato2 := temp;

             seek(f,v);

             write(f,datos);

             seek(f,n);

             write(f,dato2);

          end;

       end;

     end;

       close(f);

  end;

  begin

     repeat

         clrscr;

         entradas;

         writeln('  Desea entrar mas datos [S/N]');

        repeat

         sal := upcase(readkey);

       until sal in['N','S'];

     until sal = 'N';

     clrscr;

     writeln(' archivos  sin ordenar ');

     presentaarchi;

     writeln(' ordenando archivos de menor a mayor por nombre ');

     ordenaarchivo;

     writeln(' archivos ordenandos de menor a mayor por nombre ');

     presentaarchi;

  end.

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por elias (45 intervenciones) el 17/11/2012 12:37:46

Muchas gracias! He logrado que funcione el ordenamiento en parte, con la codificación original y tu ayuda, es posible enviarte e código a un correo para que por favor lo revises y me sugieras como resolver el problema?

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por ramon (2158 intervenciones) el 17/11/2012 12:59:15

Puedes pasarlo por esta te lo revisare y te lo del bolvere por el mismo cauce.
No hay problema.

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por elias (45 intervenciones) el 17/11/2012 13:07:23

Lo q ocurre es que deseo evitar alguna copia del código...es un trabajo de la Universidad y hay mucho hermetismo con el tema...Se puede enviar en privado o algo asi?

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por ramon (2158 intervenciones) el 17/11/2012 15:59:18

Lo siento pero personal mente tengo por costumbren realizar todo aquí y no de otra forma,
ten en cuenta que me dedico a ayudar con la programación en pascal para todos los que
lo necesiten por tanto no debo de ocultar ningún dato que pueda servir como aprendizaje o
enseñanza lo siento disculpa pero es como se suele decir mi pequeña manía.

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por ELIAS (45 intervenciones) el 18/11/2012 19:34:37

Amigo, estoy muy agradecido, me ha estado funcionando el código que colgaste, una duda, como sería el procedimiento de borrar un registro y que pueda apreciarlo al ordenar nuevamente (es decir, el registro ya no lo vería con el ordenamiento)

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por romon (2158 intervenciones) el 18/11/2012 22:04:39

{A y lo tienes}

 procedure anularegistro(cual : longint);

var

    tempo : file of regdatos;

    n : longint;

    das : regdatos;

    begin

       assign(f,archi);

   {$I-} reset(f); {$I+}

   if ioresult <> 0 then

    begin

        writeln('   Archivo No Encontrado Pulse [Enter]');

        readln;

end

 else

    begin

       assign(tempo,'temporal.ttt');

       rewrite(tempo);

       for h := 0 to filesize(f) - 1 do

       begin

           seek(f,h);

           read(f,das);

           if das.numero = cual then

           begin

end

        else

           begin

               seek(tempo,n);

               write(tempo,das);

               n := n + 1;

           end;

       end;

        close(f);

        close(tempo);

        erase(f);

        rename(tempo,archi);

   end;

  end;

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por ELIAS (45 intervenciones) el 18/11/2012 23:00:42

Gracias!, es posible adaptar ese codigo en este procedure?

Procedure Eliminar(Var Arch:Archivo);

Var

Reg:Registro;

Ced:String;

Encontre:Boolean;

Begin

GOTOXY(20,20);Write('Ingrese Cedula del estudiante a borrar : ');

ReadLn(Ced);

Reset(Arch);

Encontre:=False;

While Not Eof(Arch) And (Not Encontre) Do

Begin

Read(Arch, Reg);

If (Reg.Ced = Ced) And (Not Reg.Eliminar)

Then Encontre:=True;

End;

If Encontre

then Begin

Seek(Arch, FilePos(Arch)-1);

Reg.Eliminar:=True;

Begin

if Upcase(Reg.sexo)='M' then

Begin

hombres:= hombres - 1;

End;

if Upcase(Reg.sexo)='F' then

Begin

mujeres:= mujeres - 1;

End;

End;

Begin

if ( Reg.Edad >= 30 ) then

Begin

mayores:= mayores - 1;

End;

End;

GotoXY  (33, 22);

Write ('Registro Borrado');

PulsarUnaTecla;

Write(Arch, Reg);

End;

Close(Arch);

End;

Valora esta respuesta

Comentar

URGENTE - ORDENAR REGISTRO POR CEDULA IDENTIDAD

Publicado por elias (45 intervenciones) el 19/11/2012 15:48:00

Favor dejar sin efecto lo anterior, pude adaptarlo a mi codigo,

, Gracias...Ahora trato de hacer funcionar un reporte que totaliza alumnos por centro de estudio, mayores de 30 años, por sexo, Masculino o Femenino. ¿Alguna Idea que tengas a bien aportarme?

Valora esta respuesta

Comentar

Ayuda 2 programas!!

PASCAL RECURSIVIDAD