Pascal/Turbo Pascal - Metodo de ordenamiento

 
Vista:

Metodo de ordenamiento

Publicado por lucas (4 intervenciones) el 29/11/2012 23:59:05
Quiero ordenar un archivo.txt con un registro adentro, lo que tengo que hacer es una agenda y que me muestre la agenda de forma alfabetico, tengo un type que es :
Contacto=record
apellido:string;
nombre:string;
fechancimiento:string;
tel:string;
end;


(archivo)
Apellido
Nombre
FechaNacimiento
Tel
Apellido
Nombre
FechaNacimiento
Tel
Apellido
Nombre
FechaNacimiento
Tel

Yo quiero que me muestre la agenda de forma ordenada alfabeticamente por apellido, creo que hay que hacer un array pero nose como
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

Metodo de ordenamiento

Publicado por ramon (2158 intervenciones) el 30/11/2012 22:11:17
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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
{A ver ejecuta esto y mira como funciona la ordenación de archivos espero valga de ayuda}
 
program ordefich;
uses
   crt;
  type
    fichero = record
          nombre : string[80];
          numero : integer;
        end;
 
   const
       elarchivo = 'datosreg.dat';
   var
     f : file of fichero;
     dato : fichero;
 
 
  procedure entadatos;
  begin
      clrscr;
        writeln('*** Entrada Datos ***');
        writeln;
        write('  Nombre = ');
        readln(dato.nombre);
        write('  Numero = ');
        readln(dato.numero);
     assign(f,elarchivo);
  {$I-} reset(f); {$I+}
   if ioresult <> 0 then
   begin
       rewrite(f);
       seek(f,0);
       write(f,dato);
       close(f);
   end
 else
    begin
       seek(f,filesize(f));
       write(f,dato);
       close(f);
    end;
  end;
 
  procedure ordenaarchivos;
  var
    da, tempo : fichero;
    i, t : longint;
  begin
     assign(f,elarchivo);
  {$I-} reset(f); {$I+}
   if ioresult <> 0 then
   begin
       writeln('  Error de archivo pulse [Enter]');
       readln;
       exit;
   end
 else
    begin
     writeln('**** Ordenando Archivos *****');
     for i := 0 to filesize(f) - 1 do
     begin
         seek(f,i);
         read(f,dato);
         for t := filesize(f) - 1 downto i + 1 do
         begin
            seek(f,t);
            read(f,da);
            if dato.numero > da.numero then
            begin
               tempo := dato;
               dato := da;
               da := tempo;
               seek(f,i);
               write(f,dato);
               seek(f,t);
               write(f,da);
            end;
         end;
      end;
        close(f);
    end;
  end;
 
  procedure presentaordenados;
  var
     d : longint;
  begin
  assign(f,elarchivo);
  {$I-} reset(f); {$I+}
   if ioresult <> 0 then
   begin
     writeln('  Error de archivo pulse [Enter]');
     readln;
     exit;
   end
 else
    begin
       writeln('*** Datos Del Archivo ***');
       writeln;
       writeln(' Nombre               Numero');
       for d := 0 to filesize(f) - 1 do
       begin
          seek(f,d);
          read(f,dato);
          gotoxy(3,4 + d);write(dato.nombre);
          gotoxy(25,4 + d);write(dato.numero);
       end;
       close(f);
    end;
    readln;
  end;
 
  procedure menu;
  var
    tec : char;
  begin
  repeat
      clrscr;
      writeln('**** Menu Principal ****');
      writeln;
      writeln('  1 : Entrada Datos');
      writeln('  2 : Ordenar Archivo');
      writeln('  3 : Ver Archivos');
      writeln('  4 : Salir');
      writeln;
      writeln('<<<< Elija Opcion >>>>');
      repeat
         tec := readkey;
      until tec in['1','2','3','4'];
      clrscr;
   case tec of
 '1' : entadatos;
 '2' : ordenaarchivos;
 '3' : presentaordenados;
   end;
   until tec = '4';
  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