El programa permite ingresar distancias entre una cantidad dada de obras
e informar al usuario si existe entre las mismas una distancia mayor
a la ingresada por el usuario.

{Secci¢n declarativa}
program distancias;
 
{El programa permite ubicar las distancias de obras en una matriz}
{e informar si existe una distancia mayor entre obras a la pedida}
 
uses
 
crt,dos;
 
type
 
matriz=array [1..30,1..30] of real;
 
var
 
dist:real;          {distancia minima}
mat:matriz;         {matriz que contiene las distancias}
cantobras:integer;  {cantidad de obras}
 
 
procedure cargar(var mat1:matriz;cantobras1:integer);
 
{procedimiento para el ingreso de datos}
 
var
 
i,j,k,l,m:integer;   {contadores}
 
begin
     k:=cantobras1-1;
     l:=cantobras1-1;
     for i:=1 to k do begin
         m:=i;
         m:=m+1;
         for j:=1 to l do begin
             write('Ingrese la distancia (en kms.) de la obra ',i,' a la ',m,' = ');
             readln(mat1[i,j]);
             m:=m+1;
             end;
             l:=l-1;
 
     end;
     writeln;
     writeln('Presione enter para continuar');
     readln;
     clrscr;
     delay(500);
end;
 
 
procedure encontrar(dist1:real;var mat1:matriz;cantobras1:integer);
 
{procedimiento para encontrar distancias mayores a las pedidas}
 
var
 
i,j,k:integer;
 
begin
     k:=cantobras1-1;
     i:=0;
     repeat
           i:=i+1;
           j:=0;
           repeat
               j:=j+1;
           until (mat1[i,j]>dist1) or (j=k);
           k:=k-1;
     until (mat1[i,j]>dist1) or (i=cantobras1-1);
     if mat1[i,j]>dist1 then
        writeln('Existe una distancia mayor a ',dist1:6:2,' kms.')
     else
         writeln('No existe una distancia mayor a ',dist:6:2,' kms.');
     end;
 
{Secci¢n algor¡tmica}
 
begin
     {pr¢logo}
     clrscr;
     writeln('Hola, ingrese la cantidad de obras de la empresa');
     writeln;
     readln(cantobras);    {lectura de cantidad de obras}
     writeln;
     writeln('Ahora ingrese la distancia minima entre obras (kms.)');
     writeln;
     readln(dist);         {distancia minima}
     writeln;
     clrscr;
     cargar(mat,cantobras);{ingreso de distancias}
     encontrar(dist,mat,cantobras);{busqueda de distancias}
     writeln;
     writeln;
     readln;
end.

El programa multiplica matrices de hasta 20×20.

{Secci¢n declarativa}
program matrices;
 
{El programa multiplica matrices de una determinada dimensi¢n}
 
uses
 
crt,dos;
 
type
 
matriz=array [1..20,1..20] of real;       {tipo de matrices}
 
var
 
matA,matB,matC:matriz;                    {matrices}
filA,colA,filB,colB,filC,colC:integer;    {dimensiones de las matrices}
 
procedure cargar(var matA1,matB1:matriz;filA1,colA1,filB1,colB1:integer);
 
{procedimiento para el ingreso de las matrices}
 
var
 
i,j:integer;
 
begin
     writeln('Ahora vamos a ingresar los valores de las matrices');
     writeln;
     for i:=1 to filA1 do begin
         for j:=1 to colA1 do begin
             writeln('Ingrese el coeficiente A',i,j,' y presione enter');
             readln(matA1[i,j]);
         end;
     end;
     clrscr;
     writeln('Ahora lo mismo con la matriz B');
 
     for i:=1 to filB1 do begin
         for j:=1 to colB1 do begin
             writeln('Ingrese el coeficiente B',i,j,' y presione enter');
             readln(matB1[i,j]);
         end;
     end;
     clrscr;
     writeln('Presione enter para multiplicar las matrices');
     readln;
     clrscr;
end;
 
 
procedure multiplicar(var matA1,matB1,matC1:matriz;filA1,colA1,colB1:integer);
 
{procedimiento que multiplica las matrices}
 
var
 
i,j,k:integer;
 
begin
     for i:=1 to filA1 do begin
         for j:=1 to colB1 do begin
             matC1[i,j]:=0;
             for k:=1 to colA1 do begin
                 matC1[i,j]:=matC1[i,j]+matA1[i,k]*matB1[k,j];
             end;
         end;
      end;
end;
 
 
procedure mostrar(var matC1:matriz;filC1,colC1:integer);
 
{procedimiento para mostrar el resultado}
 
var
 
i,j:integer;
 
begin
     for i:=1 to filC1 do begin
         writeln;
         for j:=1 to colC1 do begin
             write(matC1[i,j]:10:3);
         end;
     end;
     writeln;
     writeln;
     writeln('Presione enter para terminar');
     readln;
     delay(500);
end;
 
{Secci¢n algor¡tmica}
 
begin
     {pr¢logo}
     clrscr;
     repeat
           writeln('Hola, el programa multiplica matrices');
           writeln;
           writeln('Ingrese la cantidad de filas de la matriz A y seguido de un');
           writeln('espacio la cantidad de columnas y presione enter');
           readln(filA,colA);     {lectura de dimensi¢n de matriz A}
           writeln;
           writeln('Ingrese la cantidad de filas de la matriz B y seguido de un');
           writeln('espacio la cantidad de columnas y presione enter');
           readln(filB,colB);     {lectura de dimensi¢n de matriz B}
           if (colA<>filB) then begin
              writeln;
              writeln('Error de dimension');      {caso de error de dimensi¢n}
              delay(1000);
              clrscr;
           end;
     until colA=filB;
     filC:=filA;
     colC:=colB;
     clrscr;
     cargar(matA,matB,filA,colA,filB,colB);        {ingreso de matrices}
     multiplicar(matA,matB,matC,fila,colA,colB);   {multiplicaci¢n de matrices}
     mostrar(matC,filC,colC);                      {exhibici¢n de resultado}
end.

El programa ordena en forma ascendente y exhibe en pantalla la cantidad
de metros cúbicos de hormigón en una cantidad dada de obras.

{Secci¢n declarativa}
program Obras;
 
{El programa ordena en forma ascendente la cantidad de metros c£bicos}
{de hormig¢n de una determinada cantidad de obras de una empresa}
 
uses
 
crt,dos;
 
type
 
vector=array [1..40] of real;
 
var
 
vec:vector;      {vector que contiene los mts. c£bicos}
nobras:integer;  {numero de obras}
 
 
 
procedure cargar(nobras1:integer;var vec1:vector);
 
{procedimiento para el ingreso de los valores}
 
var
 
i:integer;       {contador interno}
 
begin
     clrscr;
     for i:=1 to nobras1 do
     begin
     writeln('Ingrese los metros c£bicos de la obra numero ',i);
     readln(vec[i]);
     end;
     writeln;
     writeln('Presione enter para continuar');
     readln;
     clrscr;
end;
 
procedure escribir(var vec1:vector;nobras1:integer);
 
var
 
i:integer;       {contador interno}
 
begin
   writeln('Metros c£bicos de las obras (en orden ascendente)');
   writeln;
   for i:=1 to nobras do
       writeln(vec1[i]:8:2);
       writeln;
       writeln('Presione enter para terminar');
       readln;
       clrscr;
end;
 
 
 
procedure ordenar(var vec1:vector;nobras1:integer);
 
{procedimiento para el ordenamiento de los valores}
 
var
 
i,p,j:integer;     {contadores internos}
aux:real;          {lugar auxiliar}
 
begin
 
     i:=0;
     repeat
           i:=i+1;
     until (vec1[i]=0) or (i>nobras1);
     p:=i-1;
     for i:=1 to p-1 do
         for j:=1 to p-i do
             if vec1[j]>vec1[j+1] then
             begin
             aux:=vec1[j];
             vec1[j]:=vec1[j+1];
             vec1[j+1]:=aux;
             end;
     writeln('Obras ordenadas');
     delay(1000);
     clrscr;
end;
 
{Secci¢n algor¡tmica}
 
begin
     {Pr¢logo}
     clrscr;
     writeln('Este programa permite ordenar la cantidad de metros c£bicos');
     writeln('de hormig¢n en las obras de la empresa');
     writeln;
     writeln;
     writeln;
     writeln;
     writeln('Ingrese la cantidad de obras (MAX=40)');
     readln(nobras);      {lectura de datos}
     clrscr;
     cargar(nobras,vec);  {carga de los mts. c£bicos de las obras}
     ordenar(vec,nobras); {ordenamiento de los valores}
     escribir(vec,nobras);{exhibici¢n de los valores ordenados}
     writeln;
     writeln('Gracias por utilizar mi programa');
     delay(500);          {pausa}
end.

El programa permite ingresar, ordenar, suprimir y añadir
numeros de legajos para luego mostrarlos en pantalla.

{Secci¢n declarativa}
program legajos;
 
{El programa permite ingresar una lista de legajos, ordenarlos, a¤adir o suprimir}
{legajos y mostrar en pantalla los mismos}
 
uses
crt,dos;
 
 
type
vector=array [1..50] of integer;         {vector que contiene los legajos}
 
 
const
a=50;  {limite del vector}
 
 
var
nlv:integer;     {numero de legajos en el vector}
opc:integer;     {opcion para operar el vector}
vec:vector;      {vector que contiene los legajos}
 
 
 
procedure cargar(nlv1:integer;var vec1:vector);
 
{procedimiento para el ingreso de legajos}
 
var
 
i:integer;       {contador}
 
begin
     clrscr;
     for i:=1 to nlv1 do
     begin
     writeln('Ingrese el legajo numero ',i);
     readln(vec1[i]);
     end;
     writeln;
     writeln('Presione enter para continuar');
     readln;
     clrscr;
end;
 
 
 
Procedure modificar (var vec1:vector;var nlv1:integer;a1:integer);
 
{procedimiento para modificar la lista}
 
var
 
   opc:char ;     {opcion de incorporar o suprimir numero de legajo}
   leg:integer;   {numero de legajo que se incorpora o se suprime}
   pos,i:integer; {representa el indice del vector}
 
begin
 
  repeat
    writeln;
    writeln;
    writeln;
    writeln('           1.A¤adir');
    writeln('           2.Suprimir');
    writeln('           3.Volver');
    writeln;
    writeln;
    writeln('Ingrese una opcion y presione enter');
    writeln;
    readln(opc);
 
    case opc of
 
    '1':begin
        clrscr;
        writeln ('Ingrese el numero de legajo que desea a¤adir');
        writeln;
        readln (leg);
        i:=0;
        repeat
          i:=i+1;
        until (leg<(vec1[i])) or (i>nlv1);
        nlv1:=nlv1+1;
        pos:=i;
        for i:=nlv1 downto pos do
        begin
         vec1[i]:= vec1[i-1]
        end;
        vec1[pos]:=leg;
        clrscr;
        end;
    '2':begin
          clrscr;
          writeln('Ingrese el numero de legajo que desea suprimir');
          writeln;
          readln(leg);
          i:=0;
          repeat
            i:=i+1;
          until leg = vec1[i];
          pos:=i;
          for i:=pos to nlv1 do
            begin
            vec1[i]:= vec1[i+1];
            clrscr;
            end;
          nlv1:=nlv1-1;
          end;
    end;
  until(opc='3');
  clrscr;
end;
 
 
 
 
procedure escribir(var vec1:vector;nlv1:integer);
 
{procedimiento para la exhibicion de la lista}
 
var
 
i:integer;       {contador interno}
 
begin
 
   for i:=1 to nlv1 do
       writeln('Legajo ',i,' = ',vec1[i]);
       writeln;
       writeln('Presione enter para continuar');
       readln;
       clrscr;
end;
 
 
 
procedure ordenar(var vec1:vector;nlv1:integer);
 
{procedimiento para ordenar la lista}
 
var
 
i,p,j:integer;     {contadores internos}
aux:integer;       {auxiliar}
 
begin
 
     i:=0;
     repeat
           i:=i+1;
     until (vec1[i]=0) or (i>nlv1);
     p:=i-1;
     for i:=1 to p-1 do
         for j:=1 to p-i do
             if vec1[j]>vec1[j+1] then
             begin
             aux:=vec1[j];
             vec1[j]:=vec1[j+1];
             vec1[j+1]:=aux;
             end;
     writeln('Legajos ordenados');
     delay(1000);
     clrscr;
end;
 
 
{Secci¢n algor¡tmica}
 
begin
     {pr¢logo}
     clrscr;
     writeln('Hola, este programa permite operar con legajos');
     writeln('Ingrese el numero de legajos que va a usar (MAX=50)');
     writeln;
     readln(nlv);    {lectura del numero de legajos en el vector}
     clrscr;
     repeat
           writeln;
           writeln;
           writeln;
           writeln('                1.Cargar');
           writeln('                2.Ordenar');
           writeln('                3.Modificar');
           writeln('                4.Mostrar');
           writeln('                5.Terminar');
           writeln;
           writeln;
           writeln;
           writeln;
           writeln;
           writeln('Ingrese una opcion y presione enter');
           writeln;
           readln(opc);
           clrscr;
           case opc of
                1:cargar(nlv,vec);             {carga de datos}
                2:ordenar(vec,nlv);            {ordenamiento de datos}
                3:modificar(vec,nlv,a);        {supresion o a¤adidura de legajos}
                4:escribir(vec,nlv);           {exhibici¢n de lista}
 
           end;
     until opc=5;
     writeln('Gracias por utilizar mi programa');
     delay(1000);    {pausa}
 
end.