Pascal/Turbo Pascal - Como se hace un programa de listas en turbo pascal? Por favor

   
Vista:

Como se hace un programa de listas en turbo pascal? Por favor

Publicado por Mar (5 intervenciones) el 06/06/2013 06:09:04
Necesito saber como es un programa de listas por favor
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

Como se hace un programa de listas en turbo pascal? Por favor

Publicado por ramon (2072 intervenciones) el 07/06/2013 16:26:27
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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
{Mira esto es un programa de listas simplemente enlazadas espero te ayude}
 
 program listasme;
 uses
    crt;
    type
      lista = ^listas;
      listas = record
               numimpares : longint;
               numaleatorios : longint;
               multiplosde10 : longint;
               sig : lista;
              end;
 
    var
     prime, anter, actu : lista;
 
 
   procedure inicioa_nil;
   begin
      prime := nil;
   end;
 
   procedure entramosdatos(cual : char);
   begin
       cual := upcase(cual);
      if prime = nil then
      begin
         new(actu);
       case cual of
 'I' : begin
           write('Introduzca Numeros Impares : ');
           readln(actu^.numimpares);
         end;
  'A' : begin
            write('Introduzca Numeros Aleatorios : ');
            readln(actu^.numaleatorios);
           end;
  'M' : begin
            write('Introduzca Numeros Multiplis De 10 : ');
            readln(actu^.multiplosde10);
           end;
       end;
         prime := actu;
         actu^.sig := nil;
       end
   else
      begin
          anter := actu;
          new(actu);
       case cual of
 'I' : begin
            write('Introduzca Numeros Impares : ');
            readln(actu^.numimpares);
         end;
  'A' : begin
            write('Introduzca Numeros Aleatorios : ');
            readln(actu^.numaleatorios);
           end;
  'M' : begin
            write('Introduzca Numeros Multiplis De 10 : ');
            readln(actu^.multiplosde10);
           end;
       end;
          anter^.sig := actu;
          actu^.sig := nil;
      end;
 end;
 
 
  procedure modificarelemento(cual : char; numero : longint);
    var
      ver : lista;
    begin
       cual := upcase(cual);
       ver := prime;
       while ver <> nil do
       begin
          with ver^ do
          begin
       case cual of
    'I' : if numimpares = numero then
          begin
             write('Modificar Numeros Impares : ');
             readln(ver^.numimpares);
             break;
          end;
    'A' : if numaleatorios = numero then
          begin
            write('Modificar Numeros Aleatorios : ');
            readln(ver^.numaleatorios);
            break;
          end;
    'M' : if multiplosde10 = numero then
          begin
            write('Modificar Numeros Multiplis De 10 : ');
            readln(ver^.multiplosde10);
            break;
          end;
      end;
    end;
       ver := ver^.sig;
     end;
   end;
 
  procedure ordenamenormayor(cual : char);
  var
    temp : listas;
    sige, ard : lista;
  begin
     cual := upcase(cual);
     ard := prime;
     sige := prime^.sig;
     while ard <> nil do
     begin
        while sige <> nil do
        begin
     case cual of
   'I' : begin
          if ard^.numimpares > sige^.numimpares then
          begin
           temp.numimpares := ard^.numimpares;
           ard^.numimpares := sige^.numimpares;
           sige^.numimpares := temp.numimpares;
        end
      else
         begin
            sige := sige^.sig;
         end;
       end;
   'A' : begin
          if ard^.numaleatorios > sige^.numaleatorios then
          begin
           temp.numaleatorios := ard^.numaleatorios;
           ard^.numaleatorios := sige^.numaleatorios;
           sige^.numaleatorios := temp.numaleatorios;
        end
      else
         begin
            sige := sige^.sig;
         end;
       end;
  'M' : begin
          if ard^.multiplosde10 > sige^.multiplosde10 then
          begin
           temp.multiplosde10 := ard^.multiplosde10;
           ard^.multiplosde10 := sige^.multiplosde10;
           sige^.multiplosde10 := temp.multiplosde10;
        end
      else
         begin
            sige := sige^.sig;
         end;
       end;
      end;
         ard := ard^.sig;
         sige := ard^.sig;
     end;
   end;
 end;
 
   procedure insertafinal(cual : char; nu : longint);
    var
      pt : lista;
    begin
        new(pt);
    case cual of
  'I' : pt^.numimpares := nu;
  'A' : pt^.numaleatorios := nu;
  'M' : pt^.multiplosde10 := nu;
    end;
        actu^.sig := pt;
        pt^.sig := nil;
        actu := pt;
   end;
 
   procedure borraprimerodelista(cual : char);
   var
     borra : lista;
   begin
       cual := upcase(cual);
       borra := prime;
    case cual of
  'I' : borra := borra^.sig;
  'A' : borra := borra^.sig;
  'M' : borra := borra^.sig;
    end;
  end;
 
 procedure buscarelemento(cual : char; nu : longint);
 var
   existen : integer;
   busca : lista;
 begin
     existen := 0;
     cual := upcase(cual);
     busca := prime;
     while busca <> nil do
     begin
     case cual of
  'I' : if busca^.numimpares = nu then
        begin
          writeln('   ',busca^.numimpares);
          existen := existen + 1;
        end;
  'A' : if busca^.numaleatorios = nu then
        begin
          writeln('   ',busca^.numaleatorios);
          existen := existen + 1;
        end;
  'M' : if busca^.multiplosde10 = nu then
        begin
          writeln('   ',busca^.multiplosde10);
          existen := existen + 1;
        end;
    end;
        busca := busca^.sig;
    end;
     writeln;
     writeln('    Se Repiten : ',existen);
     writeln;
     writeln('   ***** Pulse Una [Tecla] *****');
     readkey;
 end;
 
 
 procedure menu;
 var
   sal : boolean;
   tecc, tecla : char;
   nu : longint;
 begin
     sal := false;
     repeat
       clrscr;
       writeln('           **** Menu General ****');
       writeln;
       writeln('           1 = Crear listas');
       writeln('           2 = Modificar elemento de una lista');
       writeln('           3 = Ordenar de menor a mayor una lista');
       writeln('           4 = Buscar un elemento en la lista');
       writeln('           5 = Incluir un elemento al final de la lista');
       writeln('           6 = Borrar un elemento en la lista');
       writeln('           7 = Vaciar una lista');
       writeln('           8 = Salir');
       writeln;
       writeln('           <<<< Elija Opcion >>>>');
       repeat
           tecla := readkey;
       until tecla in['1','2','3','4','5','6','7','8'];
       clrscr;
    case tecla of
  '1' : begin
            writeln('   Crear Lista De Numeros [I]=Impares ',
            ' [A]=Aleatorios  [M]=Multiplos');
            repeat
            tecc := upcase(readkey);
            until tecc in['I','A','M'];
            entramosdatos(tecc);
        end;
  '2' : begin
            writeln('   Modificar Lista De Numeros [I]=Impares ',
            ' [A]=Aleatorios  [M]=Multiplos');
            repeat
            tecc := upcase(readkey);
            until tecc in['I','A','M'];
            writeln;
            writeln('   Entre Numero A Modificar : ');
            readln(nu);
            modificarelemento(tecc,nu);
         end;
  '3' : begin
          writeln('   Ordena Lista De Numeros [I]=Impares ',
            ' [A]=Aleatorios  [M]=Multiplos');
          repeat
            tecc := upcase(readkey);
          until tecc in['I','A','M'];
          ordenamenormayor(tecc);
        end;
  '4' : begin
           writeln('   Buscar Elemento en Lista De Numeros [I]=Impares ',
            ' [A]=Aleatorios  [M]=Multiplos');
            repeat
            tecc := upcase(readkey);
            until tecc in['I','A','M'];
            writeln;
            writeln('   Entre Numero A Buscar : ');
            readln(nu);
            buscarelemento(tecc,nu);
        end;
  '5' : begin
            writeln('   Inserta En Lista De Numeros [I]=Impares ',
            ' [A]=Aleatorios  [M]=Multiplos');
            repeat
            tecc := upcase(readkey);
            until tecc in['I','A','M'];
            writeln;
            writeln('   Entre Numero A Insertar : ');
            readln(nu);
            insertafinal(tecc,nu);
        end;
  '6' : begin
            writeln('   Borrado Elemento En Lista De Numeros [I]=Impares ',
            ' [A]=Aleatorios  [M]=Multiplos');
            repeat
            tecc := upcase(readkey);
            until tecc in['I','A','M'];
            borraprimerodelista(tecc);
        end;
  '7' :;
  '8' : sal := true;
   end;
   until sal = true;
 end;
 
 
   begin
      inicioa_nil;
      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