[ Foro de Pascal ]

ayuda con este programa

06-Jul-2017 17:14
LISBETH CAROLINA SUAREZ COSTA
0 Respuestas

buen dia alguien que me ayude con este programa que falta solamente generar un listado que contenga los siguientes:

Generar un listado con los siguientes datos:
? Nro. de Cédula de Identidad
? Nombre y Apellido
? Edad
? Nivel salarial

Para generar el listado se debe considerar lo siguiente:
? La Edad del empleado se debe obtener a partir de su fecha de nacimiento y la
fecha actual, tomando como fecha actual el 31/01/2017.
? El nivel salarial del empleado está en función de su sueldo, según se indica en la
siguiente tabla:
Rango de Sueldo
Rango de Sueldo Nivel       salarial
15000 ?Sueldo< 20000         1
20000 ? Sueldo< 25000         2
25000 ? Sueldo < 30000        3

El listado debe presentarse ordenado 1ro por el Nivel Salarial en forma
ascendente y en 2do lugar por el Nro. de Cédula de Identidad en forma
ascendente. Deben presentarse totales de sueldo para cada nivel salarial y el total
general.
A continuación, un ejemplo de lo solicitado:
Datos quese ingresan por teclado:
No. de C.I. Nombre y Apellido Fecha de Nacimiento Sueldo
7777777 José Tovar 15-12-1990 25000
6666666 María Romero 22-03-1988 16000
9999999 Rafael Torres 05-05-1991 23000
5555555 Marco Méndez 12-02-1987 28000

adjunto el programa


program Una_tec;
  uses
     crt;
  type
    nominadeemplea = record
 
                    civ: longint;
                 nombr : string[10];
                 apell : string[10];
                  fechn: string[10];
                  edad : longint;
                 Sueld : real;
                 nivel : integer;
                  tsn1 : real;
                  tsn2 : real;
                  tsn3 : real;
                  tsge : real;
                 end;
 
   const
      emplea = 6;
  var
    datosempl : array[1..emplea] of  nominadeemplea;
    t, cont : integer;
    tec : char;
    com : real;
    nivelreg : array[1..emplea] of real;
    oremple : longint;
 
  procedure incluir;
  begin
      clrscr;
      writeln('**** Entrada De Datos Del Empleado ****');
      writeln;
      write('     Cedula de Identidad del Empleado     : ');
      readln(datosempl[cont].civ);
      clrScr;
      write('     Nombre del Empleado      : ');
      readln(datosempl[cont].nombr);
      clrScr;
      write('     Apellido del Empleado   : ');
      readln(datosempl[cont].apell);
      clrScr;
      writeln(' --Ingrese Fecha de Nacimiento del Empleado-- ');
      writeln(' <<<Por favor que se en formato dd/mm/aaaa>>> ');
      write('          Digite la fecha por favor           : ');
      readln(datosempl[cont].fechn);
      write('     Ingrese la Edad del Empleado        :');
      readln(datosempl[cont].edad);
      clrScr;
      write('     Ingrese el Sueldo Actual del Empleado      : ');
      readln(datosempl[cont].Sueld);
      clrScr;
      writeln('              <<<Ingrese el nivel salarial del empleado>>>        ');
      writeln;
      writeln(' Recuerde: Que si sueldo se encuentra entre:[15000,..,19999.99] oprimir "1"   ');
      writeln(' Recuerde: Que si sueldo se encuentra entre:[20000,..,24999.99] oprimir "2"   ');
      writeln(' Recuerde: Que si sueldo se encuentra entre:[25000,..,29999.99] oprimir "3"   ');
      writeln;
      write('                     Digite el nivel por favor:');
      readln(datosempl[cont].nivel);
   end;
 
   
  procedure modificar(codi : longint);
  var
    pul : char;
    modi : boolean;
  begin
     modi := false;
     for t := 1 to cont do
     begin
        if datosempl[t].civ = codi then
        begin
           modi := true;
           break;
        end;
     end;
      if modi = true then
      begin
         repeat
         clrscr;
         writeln('**** Modificacion De Datos ****');
         writeln;
         writeln('  1 = Cedula del Empleado');
         writeln('  2 = Nombre');
         writeln('  3 = Apellido');
         writeln('  4 = Fecha de Nacimiento');
         writeln('  5 = Edad');
         writeln('  6 = Sueldo ');
         writeln('  7 = Nivel Salarial');
         writeln('  8 = Salir');
         repeat
             pul := readkey;
         until pul in[#49..#56];
      case pul of
     #49 : begin
           write('  Cedula de Identidad     : ');
           readln(datosempl[t].civ);
           end;
     #50 : begin
           write('  Ingrese Nombre        : ');
           readln(datosempl[t].nombr);
           end;
     #51 : begin
           write('  Ingrese Apellido     : ');
           readln(datosempl[t].apell);
           end;
     #52 : begin
           write('  Ingrese Fecha de Nacimiento     : ');
           readln(datosempl[t].fechn);
           end;
     #53 : begin
           write('  Ingrese Edad         : ');
           readln(datosempl[t].edad);
           end;
     #54 : begin
           write('  Ingrese Sueldo       : ');
           readln(datosempl[t].Sueld);
           end;
     #55 : begin
           write('  Ingrese Nivel Salarial     : ');
           readln(datosempl[t].nivel);
           end;
      end;
    until pul = #56;
    end
   else
      begin
         clrscr;
         writeln('  Error Opcion NO DISPONIBLE, Pulse [Enter]');
         readln;
      end;
  end;
 
  procedure eliminar(codi : longint);
  var
    pul : char;
    borra : boolean;
    corre : integer;
  begin
     borra := false;
     for t := 1 to cont do
     if datosempl[t].civ = codi then
     begin
        borra := true;
        break;
     end;
     if borra = true then
     begin
        clrscr;
        writeln('<<<<<<<< Anular Registro del Empleado >>>>>>>>>>');
        writeln;
        writeln('  Codigo Vendedor     = ',datosempl[t].civ);
        writeln;
        writeln('Desea Anular Este Empleado [S/N]');
        repeat
           pul := upcase(readkey);
        until pul in['S','N'];
        if pul = 'S' then
        begin
           fillchar(datosempl[t],sizeof(datosempl[t]),0);
           corre := 1;
           for corre := t to cont do
           if datosempl[corre].civ > 0 then
           begin
              datosempl[corre] := datosempl[corre - 1];
           end;
            cont := cont - 1;
        end;
     end
   else
      begin
         clrscr;
         writeln('  Error Opcion NO DISPONIBLE, Pulse [Enter]');
         readln;
      end;
  end;
 
  procedure ordenaarray(por : char);
  var
    temp : nominadeemplea;
    g, r : integer;
    bontem : real;
  begin
     if upcase(por) = 'N' then  {Ordenado de menor a mayor nivel}
     begin
        for g := 1 to cont do
          for r := cont downto g + 1 do
          if datosempl[g].nivel > datosempl[r].nivel then
          begin
             temp := datosempl[g];
             datosempl[g] := datosempl[r];
             datosempl[r] := temp;
             bontem := nivelreg[g];
             nivelreg[g] := nivelreg[r];
             nivelreg[r] := bontem;
          end;
       end;
   end;
 
  procedure menu;
  var
    tee : char;
    sas : boolean;
  begin
     sas := false;
   repeat
      clrscr;
      writeln('******* Menu General *********');
      writeln;
      writeln('   1 = INGRESAR');
      writeln('   2 = MODIFICAR');
      writeln('   3 = ELIMINAR');
      writeln('   4 = ORDENAR REGISTRO');
      writeln('   5 = SALIR');
      writeln;
      writeln('<<<<< Elija Opcion >>>>>');
      repeat
         tee := readkey;
      until tee in[#49..#54];
  case tee of
 #49 : begin
         clrscr;
         cont := cont + 1;
         if cont > emplea then
         cont := emplea;
         incluir;
        end;
 #50 : begin
          clrscr;
          write('   Ingrese cedula del empleado : ');
          readln(oremple);
          consultar(oremple);
       end;
 #51 : begin
          clrscr;
          write('   Ingrese cedula del empleado : ');
          readln(oremple);
          modificar(oremple);
       end;
 #52 : begin
          clrscr;
          write('   Ingrese cedula del empleado : ');
          readln(oremple);
          eliminar(oremple);
       end;
 #53 : begin
          clrscr;
          writeln(' Ordenar Por nivel y por cedula de identidad presioe[N]');
          repeat
             tec := upcase(readkey);
          until tec in['N'];
          ordenaarray(tec);
       end;
 #54 : sas := true;
   end;
   until sas = true;
  end;
 
 
   begin
       cont := 0;
       menu;
   end.





(No se puede continuar esta discusión porque tiene más de dos meses de antigüedad. Si tienes dudas parecidas, abre un nuevo hilo.)