Pascal/Turbo Pascal - ayuda ejercicios de proyecto final

   
Vista:

ayuda ejercicios de proyecto final

Publicado por Esteban (9 intervenciones) el 11/05/2016 15:46:54
Hola buenas, alguien me podría ayudar con los tres ejercicios que están adjuntados en el archivo.
Gracias de antemano.
Un saludo.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
-1
Responder
Imágen de perfil de xve

ayuda ejercicios de proyecto final

Publicado por xve (21 intervenciones) el 11/05/2016 18:41:06
Hola Esteban, has preguntas concretas si quieres que te podamos ayudar...
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

ayuda ejercicios de proyecto final

Publicado por Alfredo (10 intervenciones) el 11/05/2016 19:14:27
Y tu codigo ??? donde te marca error? Asi no se te puede ayudar
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

ayuda ejercicios de proyecto final

Publicado por ramon (2072 intervenciones) el 12/05/2016 19:16:24
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
{Empezamos con esto pero solo si esta codificado como el archivo texto.txt}
 
program decifrado;
 uses
   crt;
   const
      archiv = '.txt';
      letras : array[1..2,1..26] of char = ((
      'A','B','C','D','E','F','G','H','I','J','K','L','M','N',
      'O','P','Q','R','S','T','U','V','W','X','Y','Z'),
      ('a','b','c','d','e','f','g','h','i','j','k','l','m','n',
      'o','p','q','r','s','t','u','v','w','x','y','z'));
  var
    tex : text;
    j, da : char;
    cont, i : integer;
    eltext : array['A'..'Z'] of integer;
 
   function mas_repetida(nom : string) : char;
   begin
      assign(tex,nom);
   {$I-} reset(tex); {$I+}
   if ioresult <> 0 then
   begin
     writeln('   Archivo ',archiv,' No Encontrado Pulse Una Tecla');
     readkey;
   end
  else
     begin
        fillchar(eltext,sizeof(eltext),0);
        while not eof(tex) do
        begin
           read(tex,j);
           eltext[upcase(j)] := eltext[upcase(j)] + 1;
        end;
        close(tex);
        cont := 0;
        j := ' ';
        for da := 'A' to 'Z' do
        if cont < eltext[da] then
        begin
          cont := eltext[da];
          j := da;
        end;
        mas_repetida := j;
     end;
    end;
 
    function saltos(t : char) : integer;
    begin
       saltos := (ord(t) - ord('E'));
    end;
 
    procedure texto_real;
    var
      salt : integer;
      nombre : string;
    begin
       writeln('   Entre Nombre Archivo Sin Extension');
       writeln;
       write('   nombre : ');
       readln(nombre);
       nombre := nombre + archiv;
       salt := saltos(mas_repetida(nombre));
       assign(tex,nombre);
   {$I-} reset(tex); {$I+}
   if ioresult <> 0 then
   begin
     writeln('   Archivo ',nombre,' No Encontrado Pulse Una Tecla');
     readkey;
   end
  else
     begin
       clrscr;
       writeln('   La Traducion Del Archivo ',nombre,' Es');
       writeln;
       j := ' ';
       while not eof(tex) do
        begin
           read(tex,j);
           if j in['A'..'Z'] then
           write(letras[1,(ord(j) - 64) - salt]);
           if j in['a'..'z'] then
           write(letras[2,(ord(j) - 96) - salt]);
           if j in['.',' ',',',':',';'] then
           write(j);
        end;
       close(tex);
     end;
    end;
 
    begin
      clrscr;
      texto_real;
      readkey;
    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

ayuda ejercicios de proyecto final

Publicado por ramon (2072 intervenciones) el 13/05/2016 17:58:21
Puedes pasar la estructura que creasteis tpImagen para mejor ayudar.
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

ayuda ejercicios de proyecto final

Publicado por Esteban (9 intervenciones) el 13/05/2016 19:39:43
No dispongo de tpImagen. Gracias por la ayuda, saludos
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

ayuda ejercicios de proyecto final

Publicado por Esteban (9 intervenciones) el 17/05/2016 14:42:35
¿Me podría ayudar con el ultimo ejercicio que se encuentra en el archivo?
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

ayuda ejercicios de proyecto final

Publicado por ramon (2072 intervenciones) el 19/05/2016 22:14:56
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
{Mira si esto te ayuda}
 
 program matrizes;
  uses
     crt;
  type
     losdatos = record
          fl : integer;
          cl : integer;
          valor : real;
         end;
 
     datorecor = record
            filas : integer;
         columnas : integer;
            datos : losdatos;
            end;
 
   var
     f : file of datorecor;
     da : datorecor;
     los : losdatos;
     nombre : string;
 
 
   procedure creamatriz(d : datorecor);
   var
     f1, c1 : integer;
     ii : longint;
   begin
      clrscr;
      write('   Entre Solo Nombre Del Fichero : ');
      readln(nombre);
      assign(f,nombre + '.dat');
      rewrite(f);
      clrscr;
      write('  Entre Longitud fila    : ');
      readln(d.filas);
      write('  Entre longitud columna : ');
      readln(d.columnas);
      seek(f,0);
      write(f,d);
      ii := 1;
      for c1 := 1 to d.filas do
        for f1 := 1 to d.columnas do
        begin
        write('  Entre Valor De ',f1,' x ',c1,' : ');
        readln(d.datos.valor);
        d.datos.fl := f1;
        d.datos.cl := c1;
        seek(f,ii);
        write(f,d);
        ii := ii + 1;
        end;
        close(f);
   end;
 
 
 
    procedure analizar_mcv(d : string);
    var
      t : longint;
      li, cont, h,v : integer;
    begin
       assign(f,d + '.dat');
     {$I-} reset(f); {$I+}
     if ioresult <> 0 then
     begin
       writeln('  Error De Archivo O No Existe Pulse Una Tecla');
       readkey;
     end
   else
      begin
         h := 1;
         v := 1;
         li := 0;
         cont := 0;
         seek(f,0);
         read(f,da);
         for t := 1 to filesize(f) - 1 do
         begin
            seek(f,t);
            read(f,da);
            if da.datos.valor <> 0 then
           writeln(' ',da.datos.cl,' ',da.datos.fl,' =  ',da.datos.valor:0:1);
         end;
 
           close(f);
      end;
    end;
 
 
 
   begin
      creamatriz(da);
      clrscr;
      analizar_mcv(nombre);
      readkey;
   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