The Jair has you
¿Quieres reaccionar a este mensaje? Regístrate en el foro con unos pocos clics o inicia sesión para continuar.

Practicas de 2006-2007

Ir abajo

Practicas de 2006-2007 Empty Practicas de 2006-2007

Mensaje por djcloud Jue 08 Nov 2007, 21:43

Los enunciados no se donde andaran, pero por si alguien le sirve el codigo:

Practica 1:

Código:
program prac1 (input,output);

var
    infractor,lugar,hora,minuto:integer; (*Variables para guardar el numero de infractor, el codigo de lugar, y la hora                            y minuto de la infraccion*)
    tipoInfraccion,continuar:char; (*Variables para guardar el tipo de infraccion, y el s o n del si queremos introducir                                        mas infracciones*)

begin

    repeat (*Bucle para cada infraccion*)
        repeat (* Bucle para asegurar un valor positivo en el numero de infractor*)
            writeln; (*Para que quede una fila de espacios entre cada infractor*)
            write('Introduzca el numero de conductor: ');
            readln(infractor);
            if (infractor<0) then
                writeln('El codigo del infractor debe ser positivo')
        until (infractor>=0);

        repeat (* Bucle para asegurar que el tipo de infraccion tiene un valor correcto*)
            write('Introduzca tipo de infraccion (a,b,c,d,e,f): ');
            readln(tipoInfraccion);
            if (tipoInfraccion<>'a') and (tipoInfraccion<>'b') and (tipoInfraccion<>'c') and (tipoInfraccion<>'d                        ') and (tipoInfraccion<>'e') and (tipoInfraccion<>'f') then
                writeln('El tipo de infraccion no es valida');
        until not((tipoInfraccion<>'a') and (tipoInfraccion<>'b') and (tipoInfraccion<>'c') and (tipoInfraccion<>'d'                ) and (tipoInfraccion<>'e') and (tipoInfraccion<>'f'));

        repeat (*Bucle que asegura un codigo de lugar positivo *)
            write ('Introduzca el codigo del lugar de la infraccion: ');
            readln(lugar);
            if (lugar<0) then
                writeln('El codigo del lugar debe ser positivo')
        until (lugar>=0);

        repeat (* Bucle que asegura una hora correcta en formato horas minutos*)
            write('Introduzca la hora de la infraccion (hh mm): ');
            readln(hora,minuto);
            if (hora<0) or (hora>23) or (minuto<0) or (minuto>59) then
                writeln('La hora dada no es valida')
        until not((hora<0) or (hora>23) or (minuto<0) or (minuto>59));
       
        (* A partir de aqui las variables contienen valores adecuados y escribimos la salida del programa *)

        (* Escribimos la infracción dependiendo de la letra que representa el tipo de infracción*)

        if tipoInfraccion='a' then
            writeln('Identificacion-infractor: ',infractor,'  Penalizacion: 30 euros')
        else if tipoInfraccion='b' then
            writeln('Identificacion-infractor: ',infractor,'  Penalizacion: 30 euros y 2 puntos')
        else if tipoInfraccion='c' then
            writeln('Identificacion-infractor: ',infractor,'  Penalizacion: 60 euros y 2 puntos')
        else if tipoInfraccion='d' then
            writeln('Identificacion-infractor: ',infractor,'  Penalizacion: 150 euros y 4 puntos')
        else if tipoInfraccion='e' then
            writeln('Identificacion-infractor: ',infractor,'  Penalizacion: 300 euros y 6 puntos')
        else if tipoInfraccion='f' then
            writeln('Identificacion-infractor: ',infractor,'  Penalizacion: superior a 300 euros y retirada del carnet');
        repeat (* Bucle que pregunta si queremos seguir introducciendo datos hasta que se introduce una s o una n
            mayuscula o minuscula *)
            write('Quiere seguir introducciendo datos? (s/n)');
            readln(continuar)
        until (continuar='s') or (continuar='n') or (continuar='N') or (continuar='S')
    until (continuar='n') or (continuar='N') (*Aqui continuar solo puede valer s o n, si vale n (mayuscula o minuscula)
                          salimos del programa *)
end.

En esta practica la puta espe nos pelo por meter un if en el bucle lo cual complicaba el anidamiento del codigo en lugar de hacer una lectura primero y hacer un while normal (chorradas vamos)

Practica 2:

Código:
program prac2 (input,output);

uses crt; (*para usar la funcion de limpiar la pantalla *)

function eurosPenalizacion (c:char):integer; (* Devuelve un entero con el
precio de la multa correcpondiente a la sancion c *)
begin
    case c of
        'a','b': eurosPenalizacion:=30;
        'c': eurosPenalizacion:=60;
        'd': eurosPenalizacion:=150;
        'e': eurosPenalizacion:=300;
        'f': eurosPenalizacion:=500;
        'g': eurosPenalizacion:=1200;
        'h': eurosPenalizacion:=3000;
        'i': eurosPenalizacion:=5000
    else
        eurosPenalizacion:=0
    end
end;

function puntosPenalizacion (c:char):integer; (* Devuelve un entero con los
puntos retirados correcpondientes a la sancion c *)
begin
    case c of
        'a': puntosPenalizacion:=0;
        'b','c': puntosPenalizacion:=2;
        'd': puntosPenalizacion:=4;
        'e','f': puntosPenalizacion:=6;
        'g','h','i': puntosPenalizacion:=12
    else
        puntosPenalizacion:=0
    end
end;

function esLetra (c:char):boolean; (*Devuelve true si c es una letra a-z mayuscula o minuscula y false si no lo es*)
begin
    esLetra:=((c>='a') and (c<='z')) or ((c>='A') and (c<='Z'))
end;

function esDigito (c:char):boolean; (*Devuelve true si c es un digito (0-9) y false si no lo es*)
begin
    esDigito:=(c>='0') and (c<='9')
end;

function esEspacio (c:char):boolean; (*Devuelve true si c es un espacio y false en caso contrario*)
begin
    esEspacio:=c=' '
end;

function aMayuscula (c:char):char; (*Devuelve c en mayuscula tanto si se
pasa en mayuscula como minuscula (solo funsiona con letras, llamar a esLetra
antes de pasar el caracter a esta funcion para asegurarse)*)
begin
    if (c>='A') and (c<='Z') then
        aMayuscula:=c
    else
        aMayuscula:=chr(ord(c)-32)
end;

function sonCaracteresIguales (c,d :char):boolean; (*Devuelve true si c y d
son iguales, sin distinguir mayusculas y minusculas*)
begin
    sonCaracteresIguales:=false;
    if c=d then
        sonCaracteresIguales:=true
    else if esLetra(c) and esLetra(d) then
            if aMayuscula(c) = aMayuscula (d) then
              sonCaracteresIguales:=true
end;

function sonCadenasIguales (s1,s2:string):boolean; (*Devuelve true si s1 y
s2 son iguales letra a letra (sin distinguir mayusculas y minusculas*)
var i:integer;
    iguales:boolean;
begin
    if length(s1)<>length(s2) then
        iguales:=false
    else
    begin
        i:=1;
        iguales:=true;
        while ((i<=length(s1)) and iguales) do
        begin
              iguales:=sonCaracteresIguales(s1[i],s2[i]);
              i:=i+1
        end
    end;
    sonCadenasIguales:=iguales
end;

procedure leerConductor(var conductor :string); (*Lee un nuevo codigo de conductor y devuelve en la variable conductor*)
      function codigoCorrecto(s:string):boolean; (* Devuelve true si el codigo s
es correcto (tiene solo letras numeros y espacios*)
      var i:integer;
          valido:boolean;
    begin
      valido:=true;
      i:=1;
      while (i<=length(s)) and valido do
      begin
          if not (esLetra(s[i]) or esDigito(s[i]) or esEspacio(s[i])) then
            valido:=false;
          i:=i+1
      end;
      codigoCorrecto:=valido
      end;

begin
    write('Introduzca el identificador del conductor: ');
    readln (conductor);
    while not codigoCorrecto(conductor) do
    begin
    writeln('El codigo solo puede contener letras, numeros y espacios.');
        write('Introduzca un codigo correcto: ');
        readln (conductor);
    end
end;

procedure leerInfraccion(var c:char); (*Lee y valida el tipo de infraccion y
la devuelve en c *)
    function letraCorrecta (letra:char):boolean; (*Devuelve true si letra es
a,b,c,d,e,f,g,h,i y false en caso contrario*)
    begin
        if esLetra(letra) then
            if (letra>='a') and (letra <='i') then
                letraCorrecta:=true
            else
                letraCorrecta:=false
        else
            letraCorrecta:=false
    end;
begin
    write('Introduzca el tipo de infraccion: ');
    readln(c);
    while not letraCorrecta(c) do
    begin
        writeln('El tipo de infraccion introducido no es correcto.');
        writeln('Debe ser: a, b, c, d, e, f, g, h o i.');
        write('Introducza el tipo de infraccion: ');
        readln(c)
    end
end;

procedure leerLugar(var n:integer); (* Lee y valida el codigo de infraccion
y lo devuelve en n*)
begin
    write('Introduzca el codigo de lugar: ');
    readln(n);
    while (n<0) do
    begin
        writeln('El numero introducido debe ser positivo');
        write ('Introduzca el codigo de lugar: ');
        readln(n)
    end
end;

procedure leerHora(var s1:string); (* lee la hora y la valida, la devuelve
en s1*)

    function aNumero (decenas,unidades:char):integer; (* Devuelve un entero con
el equivalente a decenas*10+unidades  *)
    begin
        aNumero:=(ord(decenas)-48) * 10 + (ord(unidades) - 48)
    end;

    var ok:boolean;

begin
    repeat
    write ('Introduzca la hora de la infraccion (hh:mm): ');
    readln(s1);
    ok:=true;
    if length(s1)<>5 then
    begin
        writeln('La hora es incorrecta');
        ok:=false
    end
    else if s1[3]<>':' then
    begin
        writeln('La hora debe ir separada por : ');
        ok:=false
    end
    else
        if esDigito (s1[1]) and  esDigito (s1[2]) and esDigito (s1[4]) and
esDigito (s1[5]) then
        begin
            if (aNumero(s1[1],s1[2])>23) or (aNumero(s1[4],s1[5])>59) then
            begin
                writeln('La hora debe estar entre las 00:00 y las 23:59');
                ok:=false
            end
        end
        else
            begin
                writeln('La hora debe ser numerica');
                ok:=false
            end
    until ok;
end;

   
var codLugar,numInfracciones,importe,puntos,infraccionesTotal,importeTotal,infTipoI : integer; (* codigos y contadores*)
hora,ultimoConductor,conductorActual:string;
continuarConductor,continuarInfraccion,infraccion:char; (*tipo de
nifraccion y variables para continuar introduciendo infracciones y
conductores *)
begin
    infraccionesTotal:=0;
    importeTotal:=0;
    infTipoI:=0;
    ultimoConductor:='';   

    repeat (*Bucle para introducir distintos conductores*)
      clrscr; (*para limpiar la pantalla*)
      leerConductor(conductorActual);
      if not sonCadenasIguales(conductorActual,ultimoConductor) then
      begin (* Si cambian de ocnductor se ponen los contadores de conductor a 0 *)
                  numInfracciones:=0;
                  importe:=0;
              puntos:=0;
      end;
      ultimoConductor:=conductorActual;
      repeat (* Bucle para introducir todas las infraacines de un conductor *)
              leerInfraccion(infraccion);
          leerLugar(codLugar);
          leerHora(hora);            (* leemos todos los datos*)

          numInfracciones:=numInfracciones + 1;
          importe:=importe + eurosPenalizacion(infraccion);
          puntos:=puntos + puntosPenalizacion(infraccion);
          infraccionesTotal:=infraccionesTotal + 1;
          importeTotal:=importeTotal + eurosPenalizacion(infraccion);
          (* sumamos a todos los contadores esta infraccion*)
          if infraccion='i' then
                  infTipoI:=infTipoI + 1;

          repeat (* Bucle que pregunta si queremos seguir introducciendo
datos hasta que se introduce una s o una n mayuscula o minuscula *)
              write('Quiere introducir otra infraccion? (s/n): ');
              readln(continuarInfraccion)
          until (aMayuscula(continuarInfraccion)='N') or
(aMayuscula(continuarInfraccion)='S');

      until aMayuscula(continuarInfraccion)='N';
      (* Fin del bucle de infracciones *)

      writeln ('Ident-conductor    Num-Infracciones  Importe total    Total Puntos');
      writeln (conductorActual,'                    ', numInfracciones, '              ', importe,'                ',puntos);
      (*Mostramos los totales de infracciones de este conductor*)

      repeat (* Bucle que pregunta si queremos seguir introducciendo datos
hasta que se introduce una s o una n mayuscula o minuscula *)
          write('Quiere introducir otro conductor? (s/n): ');
          readln(continuarConductor)
      until (aMayuscula(continuarConductor)='N') or
(aMayuscula(continuarConductor)='S');

    until aMayuscula(continuarConductor)='N';
    (* fin bucle conductores *)

    writeln ('Numero total infracciones      Importe global        Total tipo "i" ');
    writeln (infraccionesTotal,'                                ', importeTotal, '                        ', infTipoI);
    (*mostramos los totales de todos los conductores introducidos*)

end.


djcloud
djcloud
Amo del foro
Amo del foro

Cantidad de envíos : 389
Edad : 39
Fecha de inscripción : 11/10/2007

Volver arriba Ir abajo

Practicas de 2006-2007 Empty Re: Practicas de 2006-2007

Mensaje por djcloud Jue 08 Nov 2007, 21:43

practica 3:

Código:
Practica 3:

[code]program prac3 (input,output,fSalida,fInfrac,fPenal);

uses crt; (*para usar la funcion de limpiar la pantalla *)

const ficheroSalida = 'salida.txt'; (* Los nombres de los archivos, para  *)
const ficheroPenal = 'penali.dat';  (* poder cambiar de archivo facilmente*)
const ficheroInfraccion = 'infrac.dat';

Type TyInfrac= record  (* infraccion *)
    Ident: string[10]; (*NIF del conductor *)
    Infrac: char; (* código de la infracción*)
    Lugar: string[7]; (* los dos primeros caracteres identifican el lugar y los 5 números siguientes identifican el distrito *)
    Hora, Min: integer; (* hora de la infracción en horas y minutos *)
end; (* TyInfrac *)
Type TyPenal= record  (* Penalizacion *)
    tipo: char; (*tipo de infracción *)
    multa: integer; (*cantidad de multa asociada al tipo*)
    puntos: integer; (* puntos que supone el tipo de infracción *)
    retirada: boolean; (* indica si hay retirada del carné o no *)
    juzgado: boolean; (*indica si se juzga por lo penal o no *)
end; (*TyPenal*)
Type
arrayPenal= array ['a'..'i'] of TyPenal; (* Declaro estos 2 tipos, para
que no me de problemas al pasarlo como argumento, ya que sino dentro de
los modulos toma el array como de indice numerico y no lo puedo
recorrer de la 'a' a la 'i' *)
Type arrayEnteros = array ['a'..'i'] of integer;

(*****************************************************************************
******************************************************************************
******************************************************************************
                                Funciones
******************************************************************************
******************************************************************************
*****************************************************************************)

function aMayuscula (c:char):char; (*Devuelve c en mayuscula tanto si se
pasa en mayuscula como minuscula (solo funciona con letras, llamar a esLetra
antes de pasar el caracter a esta funcion para asegurarse)*)
begin
    if (c>='A') and (c<='Z') then
        aMayuscula:=c
    else
        aMayuscula:=chr(ord(c)-32)
end;

function esLetra (c:char):boolean;
(*Devuelve true si c es una letra a-z mayuscula o minuscula y false si no lo es*)
begin
    esLetra:=((c>='a') and (c<='z')) or ((c>='A') and (c<='Z'))
end;

function sonCaracteresIguales (c,d :char):boolean; (*Devuelve true si c y d
son iguales, sin distinguir mayusculas y minusculas*)
begin
    sonCaracteresIguales:=false;
    if c=d then
        sonCaracteresIguales:=true
    else if esLetra(c) and esLetra(d) then
            if aMayuscula(c) = aMayuscula (d) then
              sonCaracteresIguales:=true
end;

function sonCadenasIguales (s1,s2:string):boolean; (*Devuelve true si s1 y
s2 son iguales letra a letra (sin distinguir mayusculas y minusculas*)
var j:integer;
    iguales:boolean;
begin
    if length(s1)<>length(s2) then
        iguales:=false
    else
    begin
        j:=1;
        iguales:=true;
        while ((j<=length(s1)) and iguales) do
        begin
              iguales:=sonCaracteresIguales(s1[j],s2[j]);
              j:=j+1
        end
    end;
    sonCadenasIguales:=iguales
end;

function rellenarLongitud (s:string;n:integer):string;
(* Rellena la cadena s con los espacios necesarios al principio para que
  alcance la longitud n, se usa para hacer el formato de los
  datos y que queden bien alineados por columnas en la salida *)
begin
    while (length(s)
          s:=' '+s;
    rellenarLongitud:=s
end;

function enteroACadena (n,long:integer):string;
(* devuelve el entero n en una cadena, rellena de espacios al principio
  hasta alcanzar una longitud long, se usa para hacer el formato de los
  datos y que queden bien alineados por columnas en la salida *)
var s:string;
begin
    str(n,s);
    s:=rellenarLongitud(s,long);
    enteroACadena:=s
end;

(*****************************************************************************
******************************************************************************
******************************************************************************
                            Procedimientos
******************************************************************************
******************************************************************************
*****************************************************************************)

procedure cargarPenalizaciones (var fPen : file of TyPenal;var infracc: arrayPenal);
(* Devuelve en infracc las penalizaciones actuales del archivo fPen *)
var j : char;
begin
    reset(fPen);
    j:='a';
    while not EOF (fPen) and (j<='i') do
    begin
          read(fPen,infracc[j]);
          j:=succ(j)
    end;
    close (fPen);
end;

          (***********************************************************
            ***********************************************************
                                      Menu1
            ***********************************************************
            ***********************************************************)
procedure menu1 (var fPen : file of TyPenal;var fInf: file of TyInfrac; var fSal:text);
    (* Hace la opcion 1 del menu. Genera un archivo fSal de texto con un resumen
      de las infracciones de fInf teniendo en cuenta los valores de las
      penalizaciones de fPen. No devuelve nada. *)

function formatearInfraccion
(id:string;infrac:arrayEnteros;importe:integer;puntos:integer;retirada:boolean;juzgado:boolean):string;
          (* devuelve todos los datos pasados por parametro en un string, con
            un formato especifico, para que la salida quede bien alineada *)
    var s:string;
    var j:char;
    begin
        s:=rellenarLongitud(id,10)+'  ';
        for j:='a' to 'i' do
            s:=s+enteroACadena(infrac[j],2)+'  ';
        s:=s+'  '+enteroACadena(importe,5)+'  '+enteroACadena(puntos,5)+'  ';
        if retirada then
            s:=s+'X '
        else
            s:=s+'  ';
        if juzgado then
            s:=s+'X';
        formatearInfraccion:=s ;
    end;

var conductor:TyInfrac;  (* para almacenar el conductor que estemos leyendo del archivo *)

identAnterior:string; (* identificador del ultimo conductor, para
comprobar si seguimos con las infracciones del mismo conductor o no *)
    infracciones : arrayPenal;  (* Array con las penalizaciones actuales *)
    sumaInfracciones:arrayEnteros;  (* Array donde se cuenta el numero de infracciones de cada tipo que tiene un conductor *)
    j:char; (* para control de bucle*)

juzgado,retirada,primero:boolean; (* indican si se juzgara al
conductor, se le retirara carnet, y si es el primer conductor*)
    sumaPuntos,sumaImporte,totalPuntos,totalImporte,totalInfracciones,totalInfractores:integer; (* contadores *)
begin
    (*Inicializacion de variables*)
    totalPuntos:=0;
    totalImporte:=0;
    totalInfracciones:=0;
    totalInfractores:=0;
    primero:=false;
    sumaPuntos:=0;
    sumaImporte:=0;
    juzgado:=false;   
    for j:='a' to 'i' do
        sumaInfracciones[j]:=0;
    retirada:=false;
    identAnterior:='';
    primero:=true;

    cargarPenalizaciones (fPen,infracciones);
    reset(fInf);rewrite(fSal);
    writeln(fSal,'Ident-Cond  a  b  c  d  e  f  g  h  i  Importe Puntos  R J');
    while not EOF(fInf) do (* Recorro el archivo fInf *)
    begin
        read(fInf,conductor);
        totalInfracciones:=totalInfracciones+1;
        if not sonCadenasIguales(identAnterior,conductor.Ident) then
        (* Si el identificador del conductor actual no es el mismo del anterior
            es que hemos cambiado de conductor, y hay que escribirlo en el archivo
            sumar contadores, e inicializar variables para el nuevo conductor *)
        begin
            if not primero then
            (* porque sino al empezar el identAnterior como '' no coincide con
                el nombre actual, y lo imprime la primera vez *)
            begin
                  writeln(fSal,formatearInfraccion(identAnterior,sumaInfracciones,sumaImporte,sumaPuntos,retirada,juzgado));
                  totalInfractores:=totalInfractores+1;
                  totalPuntos:=totalPuntos+sumaPuntos;
                  totalImporte:=totalImporte+sumaImporte
            end
            else
                primero:=false;
            sumaPuntos:=0;
            sumaImporte:=0;
            juzgado:=false;
            retirada:=false;
            identAnterior:=conductor.Ident;
            for j:='a' to 'i' do
                sumaInfracciones[j]:=0;
        end;
        if infracciones[conductor.Infrac].Juzgado then
            juzgado:=true;
        if infracciones[conductor.Infrac].Retirada then
            retirada:=true;
        sumaInfracciones[conductor.Infrac]:=sumaInfracciones[conductor.Infrac]+1;
        sumaImporte:=sumaImporte+infracciones[conductor.Infrac].Multa;
        sumaPuntos:=sumaPuntos+infracciones[conductor.Infrac].Puntos;
    end;
    (* escribimos el ultimo infractor *)
    writeln(fSal,formatearInfraccion(identAnterior,sumaInfracciones,sumaImporte,sumaPuntos,retirada,juzgado));
    totalInfractores:=totalInfractores+1;
    totalPuntos:=totalPuntos+sumaPuntos;
    totalImporte:=totalImporte+sumaImporte;
    writeln(fSal);
    writeln(fSal);

writeln (fSal,'Total: Infractores: ',totalInfractores,' Infracciones:
',totalInfracciones,' Importe: ',totalImporte,' Puntos: ',totalPuntos);
    close(fInf);close(fSal);
end;

              (*******************************************************
                *******************************************************
                                      Menu2
                *******************************************************
                *******************************************************)
procedure menu2 (var fPen : file of TyPenal);
    (* Hace la parte 2 del menu. Muestra las penalizaciones actuales de fPen
      y permite modificarlas. NO devuelve nada *)
    function formatearPenalizacion (pen:TyPenal):string;
            (* Devuelve en una cadena la penalizacion pen formateada para
              que quede bien alineada en pantalla *)
    var s:string;
    begin
        s:=' '+pen.tipo+'    '+enteroACadena(pen.multa,5)+'  '+enteroACadena(pen.puntos,5)+'      ';
        if pen.retirada then
            s:=s+'X        '
        else
            s:=s+'        ';
        if pen.juzgado then
            s:=s+'X';
        formatearPenalizacion:=s
    end;

    procedure validarMulta (var multa:integer);
    (* Lee y valida una multa y lo devuelve en multa*)
    begin
        write('Introduzca el precio de la multa (euros): ');
        readln(multa);
            while (multa<0) do
        begin
            writeln('El numero introducido debe ser positivo');
            write ('Introduzca el precio de la multa (euros):  ');
            readln(multa)
        end
    end;

    procedure validarPuntos (var puntos:integer);
    (* Lee y valida los puntos y lo devuelve en puntos*)
    begin
        write('Introduzca la cantidad de puntos que se retiran: ');
        readln(puntos);
            while (puntos<0) do
        begin
            writeln('El numero introducido debe ser positivo');
            write ('Introduzca la cantidad de puntos que se retiran: ');
            readln(puntos)
        end
    end;

    procedure validarRetirar (var retirada:boolean);
    (* Lee y valida si se retira el carnet y lo devuelve en retirada*)
    var ret:char;
    begin
        repeat
              write('Conlleva la sancion retirada del carnet? (s/n): ');
              readln(ret)
        until (ret='n') or (ret='s');
        if ret='s' then
            retirada:=true
        else
            retirada:=false
    end;

    procedure validarJuzgar (var juzga:boolean);
    (* Lee y valida si se juzga por esta penalizacion y lo devuelve en juzga*)
    var juz:char;
    begin
        repeat
              write('Se juzga la sancion por lo penal? (s/n): ');
              readln(juz)
        until (juz='n') or (juz='s');
        if juz='s' then
            juzga:=true
        else
            juzga:=false
    end;

var j ,continuar:char;  (* para control de bucle y leer que penalizacion se quiere cambiar*)
var infracc : arrayPenal; (* array con las penalizaciones actuales *)
begin
    cargarPenalizaciones (fPen,infracc);
    repeat
          clrscr;
          writeln ('Penalizaciones Actuales:');
          writeln ('Tipo  Multa  Puntos  Retirada  Juzgado');
          for j:='a' to 'i' do
                writeln(formatearPenalizacion(infracc[j]));
          write ('Que penalizacion desea cambiar? (0 para no cambiar ninguna): ');
          readln (j);
          while ((j<'a') or (j>'i')) and (j<>'0') do
          begin
        writeln('La penalizacion debe ser a,b,c,d,e,f,g,h,i o 0');
            write ('Que penalizacion desea cambiar? (0 para no cambiar ninguna): ');
            readln (j);
          end;
          if j<>'0' then
          begin
              validarMulta(infracc[j].multa);
              validarPuntos(infracc[j].puntos);
              validarRetirar(infracc[j].retirada);
              validarJuzgar(infracc[j].juzgado);
              repeat
                  write('Quiere cambiar otra penalizacion? (s/n): ');
                  readln(continuar)
              until continuar in ['n','N','s','S']
          end
          else (* si ha elegido 0 forzamos a salir *)
              continuar:='n'
    until continuar in['n','N'];
    rewrite(fPen);
    for j:='a' to 'i' do
        write (fPen,infracc[j]);
    close (fPen);
end;

(*****************************************************************************
******************************************************************************
******************************************************************************
                            Programa principal
******************************************************************************
******************************************************************************
*****************************************************************************)

var fSalida : text;  (* fichero de texto salida *)
    fInfrac : file of TyInfrac; (* fichero de infracciones *)
    fPenal : file of TyPenal;    (* fichero de penalizaciones *)
    opcionMenu:char;  (* para almacenar la opcion elegida por el usuario *)

begin  (* programa principal *)
    assign (fInfrac,ficheroInfraccion);
    assign (fPenal,ficheroPenal);
    assign (fSalida,ficheroSalida);
    clrscr;
    repeat  (* para el menu *)
        writeln('1. Obtener fichero resumen ',ficheroSalida);
        writeln('2. Cambio de las penalizaciones en ',ficheroPenal);
        writeln('3. Salir');
        writeln;
        write('Elija una opcion: ');
        readln(opcionMenu);
        if opcionMenu='1' then
        begin
          menu1(fPenal,fInfrac,fSalida);
          clrscr;
          writeln ('Resumen de las infracciones generado correctamente en ',ficheroSalida);
          writeln
        end
        else if opcionMenu='2' then
        begin
          menu2(fPenal);
          clrscr;
          writeln ('Penalizaciones en ',ficheroPenal,' acualizadas correctamente');
          writeln
        end
    until opcionMenu='3';
end.
[/code]
djcloud
djcloud
Amo del foro
Amo del foro

Cantidad de envíos : 389
Edad : 39
Fecha de inscripción : 11/10/2007

Volver arriba Ir abajo

Volver arriba

- Temas similares

 
Permisos de este foro:
No puedes responder a temas en este foro.