Pascal/Turbo Pascal - Ayuda Ejercicios de Pascal/Turbo Pascal

{Espero Esto sirva para ayudar }

 program respuestas;

 uses

    crt;

  {1.Desarrolle un programa es pascal que permita leer dos valores distintos,

   determinar cual de los dos valores es el mayor y escribirlo.}

   procedure leerypresentar;

   var

     mayor, val1, val2 : integer;

   begin

       clrscr;

       writeln('Entre 2 Valores numericos');

       writeln;

       write('Valor N§ 1 : ');

       readln(val1);

       write('Valor N§ 2 : ');

       readln(val2);

       if val1 > val2 then

       mayor := val1

     else

       mayor := val2;

       writeln;

       writeln('El Valor Entrado Mayor ES : ',mayor);

       writeln('Pulse Una Tecla');

       readkey;

   end;

   {2.Calcular mediante un programa en pascal haciendo uso de la estructura

      while la suma de los N primeros números naturales.}

   procedure calculonumeros(inic, final : integer);

   var

      n, suma : integer;

   begin

       clrscr;

       n := inic;

       suma := 0;

       writeln('Los Numeros a sumar Son del : ',inic,'  Al : ',final);

       while n < final do

       begin

          suma := suma + n;

          n := n + 1;

       end;

       writeln('La suma de los numeros Naturales es : ',suma);

       writeln;

       writeln('Pulse una Tecla');

       readkey;

   end;

 {3.Desarrolle un programa que permita leer tres valores e imprima cual es el

    mayor y cual es el menor. Recuerde constatar que los tres valores

    introducidos por el teclado sean valores distintos si no que el programa

    presente un mensaje de alerta (detectado valores iguales).}

  procedure mayormenor;

  var

    val1, val2, val3 : integer;

    orden : integer;

   begin

       clrscr;

       writeln('Entre tres Valores Numericos');

       writeln;

       write('Valor N§ 1 : ');

       readln(val1);

       write('Valor N§ 2 : ');

       readln(val2);

       write('Valor N§ 3 : ');

       readln(val3);

      if (val1 = val2) or (val1 = val3) or (val2 = val3) then

      begin

      writeln('Detectado Valores Iguales');

      writeln;

      writeln('Pulsa Una Tecla');

      readkey;

      end

   else

      begin

          if val1 > val2 then

          begin

             orden := val1;

             val1 := val2;

             val2 := orden;

          end;

          if val1 > val3 then

          begin

              orden := val1;

              val1 := val3;

              val3 := orden;

          end;

          if val2 > val3 then

          begin

              orden := val2;

              val2 := val3;

              val3 := orden;

          end;

      end;

      writeln;

      writeln('El Valor Minimo Es : ',val1);

      writeln('El Valor Maximo Es : ',val3);

      writeln('Pulse Una Tecla');

      readkey;

   end;

 {4.Realice un programa que calcule el monto a pagar por el servicio de

   estacionamiento, teniendo en cuenta que por la primera hora de estancia se

   tiene una tarifa de 1000 bolivares y las restantes tienen un costo de

   600 bolivares. Se tiene como datos: hora de entrada, hora de salida,

   iniciada una hora se contabiliza como hora total.}

   procedure estacionamiento;

   const

      hora = 1000;

      resto = 600;

   var

     tiempo, entra, sale : integer;

   begin

       clrscr;

       write('Entre La Hora de Entrada : ');

       readln(entra);

       entra := round(entra);

       write('Entre La Hora de Salida  : ');

       readln(sale);

       sale := round(sale);

       tiempo := (sale - entra);

       if tiempo <= 1 then

       writeln('Devera De Pagar La Cantidad De : ',hora,' bolivares')

     else

       begin

          writeln('Devera De Pagar La Cantidad De : ',

                          hora + (resto * (tiempo - 1)),' bolivares');

       end;

       writeln('Pulse Una Tecla');

       readkey;

   end;

  {5.Dise¤ar un programa que solicite por teclado dos numeros enteros y

  muestre su suma, resta, multiplicacion y division.}

  procedure mates;

  var

     num1, num2 : integer;

   begin

      clrscr;

      writeln('Introdudca dos Numeros Enteros');

      writeln;

      write('Entre N§ 1 : ');

      readln(num1);

      write('Entre N§ 2 : ');

      readln(num2);

      writeln;

      writeln('La Suma De los Dos Numeros Es           : ',num1 + num2);

      writeln('La Resta De Los Dos Numeros Es          : ',num1 - num2);

      writeln('La Multiplicacion De Los Dos Numeros Es : ',num1 * num2);

      writeln('La Division De Los Dos Numeros Es       : ',num1 / num2:8:2);

      writeln;

      writeln('Pulse Una Tecla');

      readkey;

    end;

  {6.Realizar un programa que permita pedir 50 numeros naturales y determine

   e imprima cuantos son pares, impares, positivos y negativos.}

   procedure numerosnatu;

   var

     numeros : array[1..50] of integer;

     t, cont, pares, impares, posit, negat : integer;

   begin

       clrscr;

       cont := 1;

       while cont < 51 do

       begin

          clrscr;

          writeln('Entre 50 Numeros Naturales');

          writeln;

          write('Entre El N§ : ',cont,' : ');

          readln(numeros[cont]);

          cont := cont + 1;

       end;

        pares := 0;

        impares := 0;

        posit := 0;

        negat := 0;

        for t := 1 to 50 do

        if numeros[t] mod 2 = 0 then

        begin

           pares := pares + 1;

           posit := posit + 1;

        end

      else

         begin

            impares := impares + 1;

            negat := negat + 1;

         end;

         writeln;

         for t := 1 to 50 do

         write('  ',numeros[t]);

         writeln;

         writeln('Los Numeros Pares Son     : ',pares);

         writeln('Los Numeros ImPares Son   : ',impares);

         writeln('Los Numeros Positivos Son : ',posit);

         writeln('Los Numeros Negativos Son : ',negat);

         writeln;

         writeln('Pulse Una Tecla');

         readkey;

   end;

   {7.Escriba un programa que dado un numero del 1 al 7 escriba el nombre

      correspondiente al dia de la semana. Tener en cuenta si el usuario

      introduce un numero diferente al 7, mostrar un mensaje.}

   procedure diasemana;

   const

      diase : array[1..7] of string[9] = (

      'Lunes','Martes','Miercoles','Jueves','Viernes',

      'Sabado','Domingo');

   var

      num : integer;

    begin

       clrscr;

       writeln('Entre Un Numero del 1 al 7 ');

       writeln;

       write('El Numero Es : ');

       readln(num);

       if (num < 1) or (num > 7) then

       begin

       writeln('El Numero Entrado No ES Valido');

       writeln('Pulse Una Tecla');

       readkey;

     end

   else

       begin

       writeln;

       writeln('El Dia ES = ',diase[num]);

       writeln;

       writeln('Pulse Una Tecla');

       readkey;

  end;

 end;

  {8.Elabore un programa que solicite por pantalla las horas diarias

   trabajadas de una persona. Si las horas son mayores a 8 el trabajador

   es clase A, si las horas estan entre 6 y 8 es clase B, si las horas

   estan entre 4 y 6 es clase C.}

   procedure clases;

   var

     horas : integer;

   begin

       clrscr;

       writeln('Horas Diarias Trabajadas Por Persona ');

       writeln;

       write('Trabajo Hoy : ');

       readln(horas);

       if horas > 8 then

       writeln('El Trabajador Es Clase A');

       if (horas >= 6) and (horas <= 8) then

       writeln('El Trabajador Es Clase B');

       if (horas >= 4) and (horas < 6) then

       writeln('El Trabajador Es Clase C');

       writeln;

       writeln('Pulse Una Tecla');

       readkey;

   end;

  {9.Se quiere escribir un programa que:

      1º) Pida por teclado la nota de una asignatura.

      2º) En el caso de que la nota sea incorrecta, muestre por pantalla el

           mensaje: "ERROR: Nota incorrecta, debe ser >= 0 y <= 10".

      3º) Repita los pasos 1º y 2º, mientras que, la nota introducida sea

           incorrecta.

      4º) Muestre por pantalla: "", en el caso de que la nota sea

      mayor o igual que 5 y "SUSPENDIDO", en el caso de que la nota sea

      menor que 5.}

  procedure notas;

  var

     nota : integer;

   begin

       clrscr;

       writeln;

       write('Ingrese La Nota Del Alucno : ');

       readln(nota);

       if (nota >= 0) or (nota <= 10) then

       begin

           if nota >= 5 then

           writeln('Esta = APROBADO')

         else

           writeln('Esta = SUSPENDIDO');

       end

     else

        begin

           notas;

        end;

        writeln;

        writeln('Pulse Una Tecla');

        readkey;

   end;

   {10.Una compa¤ia paga a sus vendedores un sueldo fijo mas una comision por

    venta. La compa¤ia fabrica 3 tipos de productos y cada vendedor vende

    los tres tipos.

    Para calcular la comision se considera lo siguiente:

    Por el producto 1 recibe el 5% de comision, si el monto de la venta es

    menor a 100Bs de lo contrario recibe el 6%

    Por el producto 2, recibe el 7% de comision si el monto de la venta es

    mayor a 150Bs

    Por el producto 3, recibe el 8% de comision si el monto de la venta es

    mayor a 200Bs

    Dise¤e un programa que lea el sueldo fijo del vendedor, el monto de

    venta del producto 1, 2 y 3. Calcular la comision por producto, el total

    de comision del vendedor y el sueldo total a recibir.}

   procedure vendedores;

   var

     vende : array[1..3] of real;

     salario : real;

     comi1, comi2, comi3 : real;

     total : real;

     el1, el2, el3 : integer;

   begin

       clrscr;

       writeln('Salario y Comision');

       writeln;

       write('Entre El Salario : ');

       readln(salario);

       write('Entre Importe Venta Articulo 1 : ');

       readln(vende[1]);

       write('Entre Importe Venta Articulo 2 : ');

       readln(vende[2]);

       write('Entre Importe Venta Articulo 3 : ');

       readln(vende[3]);

       clrscr;

       writeln('El Salario Es = ',salario:8:2);

       el1 := 0;

       el2 := 0;

       el3 := 0;

       if vende[1] < 600 then

       begin

          comi1 := ((vende[1] * 5) / 100);

          el1 := 5;

       end

     else

        begin

          comi1 := ((vende[1] * 6) / 100);

          el1 := 6;

        end;

       if vende[2] > 150 then

       begin

       comi2 := ((vende[2] * 7) / 100);

       el2 := 7;

       end;

       if vende[3] > 200 then

       begin

       comi3 := ((vende[3] * 8) / 100);

       el3 := 8;

       end;

       writeln('Las Ventas Fueron De');

       writeln('Articulo 1 = ',vende[1]:8:2,' Comision El ',el1,'% = ',comi1:8:2);

       writeln('Articulo 2 = ',vende[2]:8:2,' Comision El ',el2,'% = ',comi2:8:2);

       writeln('Articulo 3 = ',vende[3]:8:2,' Comision El ',el3,'% = ',comi3:8:2);

       writeln;

       writeln('El Total De Salario Mas Comisiones = ',salario + comi1 +

                                                  comi2 + comi3:8:2);

       writeln('Pulse Una Tecla');

       readkey;

   end;

   begin

      {leerypresentar;

      calculonumeros(1,9);

      mayormenor;

      estacionamiento;

      mates;

      numerosnatu;

      diasemana;

      clases;

      notas;

      vendedores;}

      {Ejecuta estos pocedimientos uno por uno}

   end.

{Mira a ver si esto te ayuda}

 program ordena;

  uses

     crt;

  type

     regestudiante = record

                 ncedu : longint;

                 end;

   const

      archivo = 'alumnos.dat';

  var

    f : file of regestudiante;

    datos : array[1..2] of regestudiante;

     h, m : longint;

  procedure ordenaarchivo(nom : string);

  var

    tem : regestudiante;

  begin

      assign(f,nom);

   {$I-} reset(f); {$I+}

   if ioresult <> 0 then

   begin

      writeln('  Archivo no Encontrado Pulse [Enter]');

      readln;

      exit;

   end

 else

     begin

        for h := 0 to filesize(f) - 1 do

        begin

          seek(f,h);

          read(f,datos[1]);

          for m := filesize(f) - 1 downto h + 1 do

          begin

             seek(f,m);

             read(f,datos[2]);

             if datos[2].ncedu < datos[1].ncedu then

             begin

                tem := datos[2];

                datos[2] := datos[1];

                datos[1] := tem;

                seek(f,h);

                write(f,datos[1]);

                seek(f,m);

                write(f,datos[2]);

             end;

          end;

        end;

       close(f);

     end;

  end;

{A ver si esto nos pone en camino}

program  fabricado;

  uses

    crt;

  const

     tantopor : array[1..5] of integer = (3,3,2,3,4);

     motivo : array[1..5] of string[30] = ('Corte de Cuero',

     'Perforado y Apertura de Ojales','Costura Cuero',

     'Corte de Suelas','Costura y pegado de suelas');

     empleados : array[1..12] of string[8] = ('Andres','Juana','Pedro',

    'Manuel','Alfredo','Martin','Ambrosio','Jesus','Maria','Juanito',

    'Pascuala','Sofia');

  type

     lineas = array[1..5] of word;

     string8 = string[8];

     regemple = record

              nomb : string[12];

              line : integer;

              fabr : longint;

            end;

  var

    lin : lineas;

    produc : array[1..5,1..12] of integer;

    dato : boolean;

    tec : char;

    zapatosproducidos : longint;

    montonarea : array[1..5] of longint;

    lineaemp : array[1..5] of regemple;

   procedure marcadorempleado(x, y : integer; act : boolean);

   begin

          if act = true then

          begin

          gotoxy(x,y);write('ÚÄÄÄÄÄÄÄÄ¿');

          gotoxy(x,y + 1);write('³');

          gotoxy(x + 9,y + 1);write('³');

          gotoxy(x,y + 2);write('ÀÄÄÄÄÄÄÄÄÙ');

          end

       else

          begin

           gotoxy(x,y);write('          ');

           gotoxy(x,y + 1);write(' ');

           gotoxy(x + 9,y + 1);write(' ');

           gotoxy(x,y + 2);write('          ');

          end;

    end;

    procedure entradafabricacion(quien, li : integer);

    var

      por, cant : integer;

    begin

       clrscr;

       writeln('**** Linea N§ : ',li,' Datos De Fabricacion Del Empleado = ',

                         empleados[quien],' ****');

       writeln;

       write(' Cantidad De Fabricacion : ');

       readln(cant);

       produc[li,quien] := produc[li,quien] + cant;

    end;

   procedure entradaproduccion;

   var

      lin, i : integer;

      elec : char;

   begin

       gotoxy(3,2);write('<<< Entrada Produccion Eleja Empleado >>>');

       gotoxy(3,4);write('*** Entre Linea De Produccion De [1 A 5] ***');

      repeat

         elec := readkey;

      until elec in['1'..'5'];

      case elec of

   '1' : lin := 1;

   '2' : lin := 2;

   '3' : lin := 3;

   '4' : lin := 4;

   '5' : lin := 5;

     end;

       gotoxy(3,4);clreol;

       for i := 1 to 12 do

       begin

       gotoxy(11,4 + i * 2);write(empleados[i]);

       end;

       i := 1;

    repeat

       marcadorempleado(10,3 + i * 2,true);

       repeat

       tec := readkey;

       until tec in[#72,#80,#13];

       marcadorempleado(10,3 + i * 2,false);

       if tec = #72 then

       begin

          i := i - 1;

          if i < 1 then

          i := 1;

       end;

       if tec = #80 then

       begin

          i := i + 1;

          if i > 12 then

          i := 12;

       end;

    until tec = #13;

    entradafabricacion(i,lin);

   end;

   procedure datosfa;

   var

     fin : char;

     salir : boolean;

   begin

      salir := false;

      dato := true;

      repeat

      entradaproduccion;

      clrscr;

      writeln('>>> Desea Continuar [S/N] <<<');

      repeat

         fin := upcase(readkey);

      until fin in['S','N'];

      if fin in['S'] then

      clrscr

    else

      salir := true;

      until salir = true;

   end;

   procedure presentacion;

   var

     p, uu, vis : integer;

   begin

       if dato = true then

       begin

          for vis := 1 to 5 do

            for uu := 1 to 12 do

            begin

            if produc[vis,uu] > 0 then

            begin

                zapatosproducidos := zapatosproducidos + produc[vis,uu];

                montonarea[vis] := montonarea[vis] + produc[vis,uu]

            end;

          end;

          writeln(' Total Fabricados = ',zapatosproducidos);

          writeln(' Por Zona ');

          for uu := 1 to 5 do

          begin

          if montonarea[uu] > 0 then

          writeln(motivo[uu],'  =  ',montonarea[uu]);

          end;

          for uu := 1 to 5 do

            for p := 2 to 12 do

            begin

               if produc[uu,p - 1] < produc[uu,p] then

               begin

                   lineaemp[uu].nomb := empleados[p];

                   lineaemp[uu].line := uu;

                   lineaemp[uu].fabr := produc[uu,p];

               end;

            end;

            for uu := 1 to 5 do

            if lineaemp[uu].fabr > 0 then

            writeln(lineaemp[uu].nomb,'  ',motivo[lineaemp[uu].line],'  ',

                           lineaemp[uu].fabr);

          readln;

       end

     else

        begin

          clrscr;

          writeln('  Datos No Cargados Pulse [Enter]');

          readln;

        end;

   end;

   procedure menu;

   var

     trs : char;

   begin

      repeat

      clrscr;

      writeln(' ***** Menu Jeneral *****');

      writeln;

      writeln('  1 = Entradas');

      writeln('  2 = Resultados');

      writeln('  3 = Salir');

      writeln;

      writeln(' <<< Elije Opcion >>>');

       repeat

      trs := readkey;

      until trs in['1','2','3'];

    case trs of

  '1' : begin  clrscr; datosfa; end;

  '2' : begin  clrscr; presentacion; end;

    end;

      until trs = '3';

   end;

   begin

       clrscr;

       dato :=  false;

       menu;

   end.

PROGRAM mayores;

        USES CRT;

        VAR a,b,c:integer;

BEGIN

ClrScr;

write ('Ingrese el primer numero     ');     readln(a);

write ('Ingrese el segundo numero    ');     readln(b);

write ('Ingrese el tercer numero     ');     readln(c);

writeln('');

if(a>b)and(a>c)then

write('El mayor es   ',a)

else

if(b>a)and(b>c)then

write('El mayor es   ',b)

else

write('El mayor es   ',c);

readkey;

end.