Procedimientos en el lenguaje Pascal ( paso de parámetros )

program compartimentacio_procedural_amb_pas_de_parametres;

(* els paràmetres, en Pascal, es poden passar per valor o per variable *)

uses crt;

var aa,bb,result:real;
var i:integer;

procedure suma(a,b:real;var r+esultat:real);
  begin
    resultat:=a+b;
  end;

procedure multiplica(a,b:real;var resultat:real);
  begin
    resultat:=a*b;
  end;

procedure divideix(a,b:real;var resultat:real);
  begin
    resultat:=a/b;
  end;

procedure resta(a,b:real;var resultat:real);
  begin
    resultat:=a-b;
  end;

begin
  clrscr;
  writeln('entra dos operands reals ');
  readln(aa);readln(bb);
  writeln;

  writeln('1:sumar');
  writeln('2:multiplica');
  writeln('3:divideix');
  writeln('4:resta');
  writeln('0:sortir');

  readln(i);

  case i of
    1:suma(aa,bb,result);
    2:multiplica(aa,bb,result);
    3:divideix(aa,bb,result);
    4:resta(aa,bb,result);
    0:halt;
  end;

  write('el resultat de l'operació és:',result:4:2);

  repeat until keypressed;

end.

Escritura y lectura de un archivo de texto en lenguaje Pascal

PROGRAM EscriuArxiuText(input,data,output);
(*--------------------------------------------------------------------*)
(* Crea un arxiu de text (ascii) a partir de l''entrada per teclat *)
(* Aquest programa est… relacionat amb el programa de lectura de *)
(* lectura LFTEXT.PAS *)
(*--------------------------------------------------------------------*)
uses Crt;
VAR
caracter:char;
NomArxiu:string[30];
arxiu:text;
BEGIN
clrscr;
write('cam¡ i nom de l''arxiu per guardar-lo al disc ? ');readln(NomArxiu);
assign(arxiu,NomArxiu);
rewrite(arxiu);
WHILE NOT eof(input) DO (* eof(INPUT) *)
BEGIN
WHILE NOT eoln(input) DO (* eoln(INPUT) *)
BEGIN
read(caracter);
write(arxiu,caracter);
END;
readln;
writeln(arxiu);
END;
reset(input); (* torna eof a false *)
close(arxiu);
readln;
END.

===

PROGRAM LlegeixArxiuText(data,output);
(*---------------------------------------------------------------------*)
(* Lectura d''un arxiu de disc creat previament amb un editor ascii *)
(* qualsevol *)
(*---------------------------------------------------------------------*)
uses Crt;
VAR
caracter:char;
NomArxiu:string[30];
arxiu:text;
BEGIN
clrscr;
write('cam¡ i nom de l''arxiu ? ');readln(NomArxiu);
assign(arxiu,NomArxiu);
reset(arxiu);
WHILE NOT eof(arxiu) DO
BEGIN
WHILE NOT eoln(arxiu) DO
BEGIN
read(arxiu,caracter);
write(caracter);
END;
write(chr(7)); (* senyal acústi de fi de línia *)
readln(arxiu);
writeln;
END;
close(arxiu);
readln;
END.

Entrando los valores de los coeficientes de una matriz

program prova;
type matriu = array [1..10,1..10] of integer;
var c:matriu;
var i,j,valor:integer;

procedure vegem;
begin
   for i:=1 to 4 do
   for j:=1 to 4 do
     begin
       writeln(i,',',j,':' ,c[i,j]);
     end;
end;

begin
 for i:=1 to 4 do
   for j:=1 to 4 do
     begin
       if (i<=2)  and (j<=2) then
         begin
           writeln(i,',',j);
           readln(valor);
           c[i,j]:=valor;
         end
       else c[i,j]:=0;
     end;

     vegem;
end.

Mínimo y máximo de un conjunto de números

program maxmin;
uses crt;

var x,xx: array [1..10] of real;
var max,min:real;
var i:integer;

begin
  clrscr;


  for i:=1 to 10 do
    begin
      write('x[',i,']=');readln(x[i]);
    end;



  max:=x[1];
  min:=x[1];
  for i:=1 to 10 do
    begin
      if x[i]>max then max:=x[i];
      if x[i]<min then min:=x[i];
    end;


  writeln('el valor m…xim ‚s: ',max);
  writeln('el valor m¡nim ‚s: ',min);

  repeat until keypressed;


end.

Diversas maneras de calcular el factorial de un número entero no negativo

program factorial_1;
uses crt;

var x,num,resultat:integer;

begin
  repeat
    clrscr;
    write('entra un nombre enter ');readln(num);

    x:=num;
    resultat:=1;

    while (x<>1) do
      begin
        resultat:=resultat*x;
        x:=x-1;
      end;

    writeln('el factorial de ',num,'  ‚s  ',resultat);

    delay(1000);
  until keypressed;

end.

program factorial_2;
uses crt;

var x,num:integer;
var resultat:longint;

begin
  repeat
    clrscr;
    write('entra un nombre enter ');readln(num);

    x:=num;
    resultat:=1;

    for x:=num downto 1 do
      begin
        resultat:=resultat*x;
      end;

    writeln('el factorial de ',num,'  ‚s  ',resultat);

    delay(1000);
  until keypressed;

end.

program factorial_3;
uses crt;

var x,num,resultat:integer;

procedure fes;
begin
  while (x<>1) do
    begin
      resultat:=resultat*x;
      x:=x-1;
      fes;
    end;
end;


begin
  repeat
    clrscr;
    write('entra un nombre enter ');readln(num);
    x:=num;
    resultat:=1;
    fes;
    writeln('el factorial de ',num,'  ‚s  ',resultat);
    delay(2000);
  until keypressed;
end.

Registro de datos experimentales en un archivo de disco con el lenguaje Pascal

program enregistra_dues_magnituts_experimentals;
uses crt;
var
 file_name:string[30];
 file_variable:file of real;
 i:integer;
 magnitud_a,magnitud_b:real;
 temps_mesura:integer;

procedure pren_mesures;
 begin
   magnitud_a:=random;
   magnitud_b:=random;
end;


begin

  clrscr;
  randomize;

  writeln('durant quant de temps vols adquirir les dades (1..100) s. - ?');
  readln(temps_mesura);

  writeln('nom del fitxer de disc on les vols guardar ? ');readln(file_name);
  assign(file_variable,file_name);
  rewrite(file_variable);
  for i:=1 to temps_mesura do
    begin
      pren_mesures;
      write(file_variable,magnitud_a,magnitud_b); (* les guarda *)
    end;
  close(file_variable);
  writeln('...dades guardades...');
  repeat until keypressed;
end.

====

program llegeix_fitxer;
uses crt;
var
 file_name:string[30];
 file_variable:file of real;
 i:integer;
 a,b:real;

procedure espera;
begin
  repeat until readkey=chr(67);
end;


begin
  clrscr;
  writeln('nom del fitxer de dades  ? ');readln(file_name);
  assign(file_variable,file_name);
  reset(file_variable);
  i:=0;
  while not eof(file_variable) do
    begin
      i:=i+1;
      read(file_variable,a,b);
      writeln(a:10:2,b:10:2);
      if (i mod 10 = 0) then
        begin
          writeln('prem C per continuar ...');
          espera;
        end;
    end;
  close(file_variable);
  repeat until keypressed;
end.