Códigos Fonte em .pas

Esta é uma pré-visualização de arquivo. Entre para ver o arquivo original

Códigos Fonte/1.PAS
program um;
const
 regulamento = 50;
 multa = 4;
 pal = 'EXCESSO';
var
 excedente: real;
 vm: real;
 peso: real;
begin
 writeln ('Informe o peso dos peixes pescados: ');
 readln (peso);
 if (peso > 50) then
 begin
 excedente := peso - regulamento;
 vm := excedente * multa;
 writeln (pal, ' de ',excedente:3:2,' kg, multa de R$ ',vm:3:2);
 end
 else
 begin
 excedente := 0;
 vm := 0;
 writeln ('O valor da multa e de R$ ', vm:3:2);
 end;
end.
Códigos Fonte/10.PAS
program dez;
uses CRT;
var
 a, b: real;
begin
 clrscr;
 b:= 0;
 writeln ('Informe um numero: ');
 readln (a);
 if a > 0 then
 begin
 writeln (a:3:2);
 end
 else
 begin
 b := a;
 writeln (b:3:2);
 end;
 writeln ('Pressione um n£mero para sair');
 readln (a);
end.
Códigos Fonte/12.PAS
program trivial;
uses CRT;
var
 a : integer;
begin
 clrscr;
 writeln ('Informe um numero: ');
 readln (a);
 if a > 100 then
 begin
 writeln (a);
 end
 else
 begin
 a := 0;
 writeln (a);
 end;
 writeln ('Pressione uma tecla para sair');
 readln (a);
end.
Códigos Fonte/13.PAS
program treze;
uses CRT;
const
 a = 'm';
 b = 'M';
 c = 'f';
 d = 'F';
var
 sexo : char;
 altura : real;
 peso : real;
begin
 clrscr;
 writeln ('Informe a altura: ');
 readln (altura);
 writeln ('Informe o sexo da pessoa (m para masculino e f para feminino): ');
 readln (sexo);
 if (sexo = a) or (sexo = b) then
 begin
 peso := (72.7*altura) - 58;
 end
 else
 begin
 peso := (62.1*altura) - 44.7;
 end;
 writeln ('Peso ideal ',peso:3:2);
 writeln ('Pressione uma tecla para sair');
 readln (sexo);
end.
Códigos Fonte/14-CASE.PAS
program calculadora;
uses CRT;
var
 a, b, r : real;
 op : integer;
begin
 clrscr;
 writeln ('Informe dois numeros');
 readln (a, b);
 writeln ('Informe a opera‡Æo a ser realizada: ');
 writeln ('1. adi‡Æo');
 writeln ('2. subtra‡Æo');
 writeln ('3. multiplica‡Æo');
 writeln ('4. divisÆo');
 readln (op);
 case op of
 1: r:= a + b;
 2: r:= a - b;
 3: r:= a * b;
 4: r:= a / b;
 end;
 writeln ('O resultado da opera‡Æo escolhida e: ',r:3:2);
 readkey;
end.
Códigos Fonte/2.PAS
program dois;
uses CRT;
const
 sl = 10;
 exc = 50;
 ext = 20;
var
 st, sx, exced, ht: real;
 cpf: string;
begin
 clrscr;
 writeln ('Informe o CPF');
 readln (cpf);
 writeln ('Informe as horas trabalhadas');
 readln (ht);
 if ht > exc then
 begin
 exced := ht - exc;
 st := (exc * sl) + (exced * ext);
 sx := exced * ext;
 end
 else
 begin
 st := ht * sl;
 sx := 0;
 end;
 writeln ('O salario total e de R$ ',st:3:2,' o salario excedente e de R$ ',sx:3:2);
 readln (st);
end.
Códigos Fonte/3.PAS
program tres;
uses CRT;
var
 num : integer;
 x: integer;
begin
 for x:= -32768 to 32767 do
 begin
 writeln (x);
 end;
 writeln ('Digite um n£mero para sair');
 readln (x);
end.
Códigos Fonte/4.PAS
program quatro;
uses CRT;
var
 num1,num2,num3,num4:integer;
begin
 clrscr;
 writeln ('Informe quatro n£meros inteiros: ');
 readln (num1,num2,num3,num4);
 if sqr (num3) >= 1000 then
 begin
 num3 := sqr (num3);
 writeln (num3);
 end
 else
 begin
 writeln (num1,' ',num2,' ',num3,' ',num4);
 num1 := sqr (num1);
 num2 := sqr (num2);
 num3 := sqr (num3);
 num4 := sqr (num4);
 writeln (num1,' ',num2,' ',num3,' ',num4);
 end;
 writeln ('Pressione uma tecla para sair');
 readln (num1);
end.
Códigos Fonte/5.PAS
program cinco;
uses CRT;
var
 num : integer;
begin
 clrscr;
 writeln ('Informe um numero: ');
 readln (num);
 if num mod 2 = 0 then
 begin
 if num >= 0 then
 begin
 writeln ('O numero informado e par e positivo');
 end
 else
 begin
 writeln ('O numero informado e par e negativo');
 end;
 end
 else
 begin
 if num >= 0 then
 begin
 writeln ('O numero informado e impar e positivo');
 end
 else
 begin
 writeln ('O numero informado e impar e negativo');
 end;
 end;
 writeln ('Pressione uma numero para sair');
 readln (num);
end.
Códigos Fonte/6.PAS
program seis;
uses CRT;
const
 ind1 = 0.3;
 ind2 = 0.4;
 ind3 = 0.5;
var
 polui : real;
begin
 clrscr;
 writeln ('Informe o indice de poluicao');
 readln (polui);
 if (polui >= ind1) and (polui < ind2) then
 begin
 writeln ('Paralisar empresas do 1§ grupo');
 end
 else
 begin
 if (polui >= ind2) and (polui < ind3) then
 begin
 writeln ('Paralisar empresas do 1§ e 2§ grupo');
 end
 else
 begin
 if (polui >= ind3) then
 begin
 writeln ('Paralisar empresas do 1§, 2§ e 3§ grupo');
 end;
 end;
 end;
 writeln ('Pressione um numero para sair');
 readln (polui);
end.
Códigos Fonte/Andre_Soares.PAS
{Nome: Andre Soares Carvalho}
{Segunda avaliacao da disciplina Programacao I}
program prova;
uses crt;
type
 funcionario = record
 cpf: integer;
 nome: string[40];
 funcao: integer;
 ip: integer;
 sal_base: real;
 sal: real;
 end;
 cadastrando = array [1..50] of funcionario;
var
 cadastro : cadastrando;
 total : real;
 i : integer;
{Procedimento para cadastro de funcionarios}
procedure funcionarios (var cad: cadastrando; max: integer);
var
 x : integer;
begin
 for x:= 1 to max do
 begin
 writeln ('CADASTRO: ', x);
 writeln ('Informe o nome: ');
 readln (cad[x].nome);
 writeln ('Informe o cpf: ');
 readln (cad[x].cpf);
 repeat
 writeln ('Informe a sua funcao: ');
 writeln ('1. Engenheiro');
 writeln ('2. Contador');
 writeln ('3. operario');
 readln (cad[x].funcao);
 until ((cad[x].funcao >= 1) and (cad[x].funcao <= 3));
 if cad[x].funcao = 1 then
 begin
 cad[x].sal_base := 3500;
 end
 else if cad[x].funcao = 2 then
 begin
 cad[x].sal_base := 2500;
 end
 else
 begin
 cad[x].sal_base := 1200;
 end;
 repeat
 writeln ('Informe o Indice de Produtividade do funcionario');
 readln (cad[x].ip);
 until ((cad[x].ip >= 0) and (cad[x].ip <= 100));
 cad[x].sal := cad[x].sal_base;
 clrscr;
 end;
end;
{Procedimento para calculo do salario}
procedure salario (var cad: cadastrando; max: integer);
var
 x : integer;
begin
 for x:= 1 to max do
 begin
 cad[x].sal := cad[x].sal_base * (1 + (cad[x].ip/100));
 end;
end;
{Procedimento para relatorio}
procedure relatorio (cad: cadastrando; max: integer);
var
 x : integer;
begin
 for x:= 1 to max do
 begin
 writeln ('Dados do funcionario ', x);
 writeln ('CPF: ', cad[x].cpf);
 writeln ('NOME: ',cad[x].nome);
 if cad[x].funcao = 1 then
 begin
 writeln ('FUNCAO: Egenheiro Civil');
 end
 else if cad[x].funcao = 2 then
 begin
 writeln ('FUNCAO: Contador');
 end
 else
 begin
 writeln ('FUNCAO: Operario');
 end;
 writeln ('INDICE DE PRODUTIVIDADE: ',cad[x].ip);
 writeln ('SALARIO BASE: ',cad[x].sal_base:5:2);
 writeln ('SALARIO: ',cad[x].sal:5:2);
 writeln;
 writeln;
 writeln;
 writeln ('Pressione uma tecla para informar os dados do proximo funcionario');
 readkey;
 clrscr;
 end;
end;
{Funcao para calcular o gasto da empresa com salarios}
function
gasto (cad : cadastrando; max: integer): real;
var
 x: integer;
 soma : real;
begin
 soma := 0;
 for x:= 1 to max do
 begin
 soma := soma + cad[x].sal;
 end;
 gasto := soma;
end;
begin
 clrscr;
 i := 50;
 funcionarios (cadastro, i);
 writeln ('Pressione uma tecla para imprimir o relatorio');
 readkey;
 clrscr;
 relatorio (cadastro, i);
 salario (cadastro, i);
 clrscr;
 writeln ('Pressione uma tecla para imprimir um novo relatorio com os salarios atualizados');
 readkey;
 clrscr;
 relatorio (cadastro, i);
 writeln ('Pressione uma tecla para imprimir o total gasto com salarios');
 readkey;
 clrscr;
 total := gasto (cadastro, i);
 writeln ('O gasto total com salarios e de: ',total:5:2);
 writeln ('Pressione uma tecla para sair');
 readkey;
end.
Códigos Fonte/BLABLA.PAS
program produtos;
uses crt;
type
 produto = record
 ident: string[3];
 descr: string[10];
 preco: real;
 quant: integer;
 end;
var
 vet_prod: array [1..3] of produto;
 busca: string;
 i,j: integer;
 aux : produto;
begin
 clrscr;
 writeln ('Cadastro de Produtos');
 for i:= 1 to 3 do
 begin
 with vet_prod[i] do
 begin
 writeln ('Informe a identificacao do produto: ');
 readln (ident);
 writeln ('Informe a descricao do produto: ');
 readln (descr);
 writeln ('Informe o preco? ');
 readln (preco);
 writeln ('Informe a quantidade: ');
 readln (quant);
 end;
 end;
 clrscr;
 writeln ('Informe o identificador do produto que deseja procurar');
 readln (busca);
 for i:= 1 to 3 do
 begin
 if busca = vet_prod[i].ident then
 begin
 writeln ('Produto encontrado');
 end;
 end;
 for i:= 2 to 3 do
 for j:= 3 downto i do
 begin
 if (vet_prod[j].ident < vet_prod[j-1].ident) then
 begin
 aux:= vet_prod[j];
 vet_prod[j] := vet_prod[j-1];
 vet_prod[j-1] := aux;
 end;
 end;
 for i:= 1 to 3 do
 begin
 with vet_prod[i] do
 begin
 if quant > 0 then
 begin
 writeln ('Produto ',i);
 writeln (ident,' ',descr,' ',preco:0:2,' ',quant);
 end;
 end;
 end;
 readkey;
end.
Códigos Fonte/CALCULAD.PAS
program calculadora;
uses crt;
{FUNCOES DA CALCULADORA}
function SOMA (a, b: real; var resultado: real): real;
begin
 resultado := a + b;
end;
function SUBTRACAO (a, b: real; var resultado: real): real;
begin
 resultado := a - b;
end;
function MULTIPLICACAO (a, b: real; var resultado: real): real;
begin
 resultado := a * b;
end;
function DIVISAO (a, b: real; var resultado: real): real;
begin
 resultado:= a / b;
end;
{ESCOLHA DO QUE DESEJA FAZER}
procedure OPCAO;
var
 x, y, resul: real;
 opc, a: integer;
begin
 clrscr;
 a:= 1;
 while (a = 1) do
 begin
 writeln ('*****CALCULADORA*****');
 writeln ('1. SOMAR');
 writeln ('2. SUBTRAIR');
 writeln ('3. MULTIPLICAR');
 writeln ('4. DIVIDIR');
 readln (opc);
 if ((opc < 1) or (opc > 4)) then
 begin
 writeln ('OPCAO INVALIDA');
 writeln ('INFORME A OPCAO NOVAMENTE');
 writeln ('PRESSIONE UMA TECLA PARA COMECAR NOVAMENTE');
 readkey;
 clrscr;
 end
 else
 a := 0;
 end;
 clrscr;
 writeln ('Informe o primeiro valor: ');
 readln (x);
 writeln ('Informe o segundo valor: ');
 readln (y);
 resul:= 0;
 clrscr;
 case opc of
 1: SOMA (x, y, resul);
 2: SUBTRACAO(x, y, resul);
 3: MULTIPLICACAO(x, y, resul);
 4: DIVISAO(x, y, resul);
 end;
 writeln ('O resultado da operacao desejada foi: ',resul:0:2);
end;
{FUNCAO PRINCIPAL}
begin
 OPCAO;
 readkey;
end.
Códigos Fonte/CARACA.PAS
program paulete;
uses crt;
type
 pesquisa = record
 idade : integer;
 sexo : char;
 olhos : integer;
 cabelos : integer;
 end;
 entrevista = array [1..6] of pesquisa;
var
 qtd : integer;
 porcent : real;
 caract : entrevista;
 resp : integer;
 x : integer;
function PORCENTAGEM (vet: entrevista; maxi: integer): real;
var
 a: integer;
 soma : real;
begin
 soma := 0;
 for a:= 1 to maxi do
 if ((vet[a].idade >= 18) and (vet[a].idade <= 35)) then
 if ((vet[a].olhos = 1) and (vet[a].cabelos = 1)) then
 if (upcase(vet[a].sexo) = 'F') then
 soma := soma + 1;
 PORCENTAGEM := soma;
end;
function QUANTIDADE (vet: entrevista; maxi: integer): integer;
var
 a, soma: integer;
begin
 soma := 0;
 for a:= 1 to maxi do
 if ((vet[a].olhos = 1) or (vet[a].olhos = 3)) then
 soma := soma + 1;
 QUANTIDADE := soma;
end;
{PROCEDIMENTO PARA ORDENAۂO CRESCENTE}
procedure ORDENA (var vet : entrevista; maxi: integer);
var
 aux, y, z: integer;
 sex : char;
begin
 for z:= 2 to maxi do
 for y:=maxi downto z do
 if (vet[y].idade < vet[y-1].idade )then
 begin
 aux:= vet[y].idade;
 vet[y].idade := vet[y-1].idade;
 vet[y-1].idade := aux;
 aux:= vet[y].olhos;
 vet[y].olhos := vet[y-1].olhos;
 vet[y-1].olhos := aux;
 aux := vet[y].cabelos;
 vet[y].cabelos := vet[y-1].cabelos;
 vet[y-1].cabelos := aux;
 sex := vet[y].sexo;
 vet[y].sexo := vet[y-1].sexo;
 vet[y-1].sexo := sex;
 end;
end;
begin
 resp := 0;
 x := 0;
 clrscr;
 while (x <> -1) do
 begin
 repeat
 resp := resp +1;
 clrscr;
 writeln ('Informe a idade: ');
 readln (caract[resp].idade);
 if caract[resp].idade = -1 then
 begin
 x := -1;
 break;
 end
 else if ((caract[resp].idade = 0) or (caract[resp].idade < -1)) then
 begin
 writeln ('Idade incorreta.');
 writeln ('Pressione uma tecla para informar a idade novamente.');
 readkey;
 end
 else
 begin
 {ESCOLHA DA COR DOS OLHOS}
 repeat
 clrscr;
 writeln ('Escolha a op‡Æo da cor dos olhos. ');
 writeln ('1. Verdes');
 writeln ('2. Azuis');
 writeln ('3. Castanhos');
 readln (caract[resp].olhos);
 if ((caract[resp].olhos < 1) or (caract[resp].olhos > 3)) then
 begin
 writeln ('Op‡Æo incorreta');
 writeln ('Pressione uma tecla para informar novamente');
 readkey;
 end;
 until ((caract[resp].olhos >= 1) and (caract[resp].olhos <= 3));
 {ESCOLHA DA COR DO CABELO}
 repeat
 clrscr;
 writeln ('Escolha a op‡Æo da cor dos cabelos. ');
 writeln ('1. Louros');
 writeln ('2. Castanhos');
 writeln ('3. Pretos');
 readln (caract[resp].cabelos);
 if ((caract[resp].cabelos < 1) or (caract[resp].cabelos > 3)) then
 begin
 writeln ('Op‡Æo invalida');
 writeln ('Pressione uma tecla para informar novamente');
 readkey;
 end;
 until ((caract[resp].cabelos >= 1) and (caract[resp].cabelos <= 3));
 {ESCOLHA DO SEXO}
 repeat
 clrscr;
 writeln ('Informe o sexo: [M]asculino ou [F]eminino');
 readln (caract[resp].sexo);
 if ((upcase(caract[resp].sexo) <> 'M') and (upcase(caract[resp].sexo) <> 'F')) then
 begin
 writeln ('Op‡Æo invalida');
 writeln ('Pressione
uma tecla para informar novamente');
 readkey;
 end;
 until ((upcase(caract[resp].sexo) = 'M') or (upcase(caract[resp].sexo) = 'F'))
 end;
 until ((caract[resp].idade = 0) or (caract[resp].idade < -1))
 end;
 writeln ('Pressione uma tecla para sair');
 resp := resp -1;
 ORDENA (caract, resp);
 {ITEM I}
 writeln ('Maior idade: ', caract[resp].idade);
 {ITEM II}
 porcent := PORCENTAGEM (caract, resp);
 porcent := (porcent * 100) / resp;
 writeln ('Porcentagem: ',porcent:0:2);
 {ITEM III}
 qtd := QUANTIDADE (caract, resp);
 writeln ('Quantidade de indiv¡duos que possuem olhos verdes ou castanhos. ', qtd);
 readkey;
end.
Códigos Fonte/case_proc..pas
Program Pzim ;
 
 const
 pi=3.14;
 
 procedure triangulo (x,y : real);
 
 var area : real;
 
 begin
 writeln ('_________ Figura escolhida: Triangulo _______________');
	 writeln (' Por favor, informe a base do triangulo:');
 readln (x);
 writeln ('Informe agora a altura do mesmo');
 readln (y);
 area:=x*y*(1/2);
 writeln ('A area do triangulo é de ', area:2:2);
 
 end;
 
 procedure circulo (x : real);
 
 var area : real;
 
 begin
 
 writeln ('_________ Figura escolhida: Circulo _______________');
	 writeln ('Por favor informe o raio do Circulo');
 readln (x);
 area:= pi*(x*x);
 writeln ('A area do circulo é de ', area:2:2);
 end;
 
 procedure quadrado (x,y : real);
 var
 area:real;
 begin
 writeln ('_________ Figura escolhida: Quadrado _______________');
	 writeln (' Por favor, informe a base do Quadrado:');
 readln (x);
 writeln ('Informe agora a altura do mesmo');
 readln (y);
 area:=x*y;
 writeln ('A area do triangulo é de ', area:2:2);
 end; 
 
 procedure esfera (x:real);
 var
 vol : real;
 begin
 writeln ('_________ Figura escolhida: Esfera _______________');
	 writeln ('Por favor informe o raio da Esfera:');
 readln (x);
 vol:=(4/3)*pi*(x*x*x);
 
 writeln ('O volume da esfera é de ', vol:2:2);
 end; 
 var
 op : char;
 raio,bas,alt : real;
 
 
 Begin
 writeln ('Informe o numero correspondente com a figura que deseja saber a área');
 writeln ('1- Triangulo.');
 writeln ('2- Circulo.'); 
 writeln ('3- Quadrado.');
 writeln ('4 -Esfera');
 readln (op);
 clrscr;
 
 case op of
 '1' : triangulo (bas,alt);
 '2' : circulo (raio);
 '3' :quadrado (bas,alt);
 '4' : esfera (raio);
 end;
End.
 
 
 
 
Códigos Fonte/CORES.PAS
program bobo;
uses crt;
var
 a: string;
begin
 clrscr;
 textbackground (white);
 clrscr;
 textcolor (black);
 write ('UFES');
 textcolor (red);
 writeln ('-CCA');
 textcolor (101);
 writeln ('Campus Alegre');
 readkey;
end.
Códigos Fonte/DEBUG.PAS
program bobo;
uses crt;
var
 i, a: integer;
begin
 clrscr;
 for i:= 1 to 5 do
 begin
 a := i * 2;
 end;
 readkey;
end.
{Debug para fazer o debug aperta ctrl+f8 (no for por exemplo), e depois aperte ctrl+f7 e insira as variaveis que deseja debuggar, depois compila normal}
Códigos Fonte/OLAMUNDO.PAS
program teste;
uses crt;
var
 a: string;
begin
 clrscr;
 a:= 'oi mundo';
 writeln (a);
 writeln ('Pressione uma tecla para sair');
 readln;
end.
Códigos Fonte/ORDEN1.PAS
program ordenacao;
uses crt;
const
 max = 5;
type
 vetor = array [1..5] of integer;
var
 vet: vetor;
 x : integer;
{PROCEDIMENTO PARA ORDENAۂO CRESCENTE}
procedure ORDENA (var vet : vetor; maxi: integer);
var
 aux, y: integer;
begin
 for x:= 2 to max do
 for y:=maxi downto x do
 if (vet[y] > vet[y-1] )then
 begin
 aux:= vet[y];
 vet[y] := vet[y-1];
 vet[y-1] := aux;
 end;
end;
begin
 clrscr;
 for x:= 1 to max do
 readln (vet[x]);
 ORDENA (vet, max);
 for x:= 1 to max do
 writeln (vet[x]);
 readkey;
end.
Códigos Fonte/ORDENACA.PAS
program ordenacao;
uses crt;
const
 max = 5;
type
 vetor = array [1..5] of integer;
var
 vet: vetor;
 x : integer;
{PROCEDIMENTO PARA ORDENAۂO CRESCENTE}
procedure ORDENA (var vet : vetor; maxi: integer);
var
 aux, y: integer;
begin
 for x:= 2 to max do
 for y:=maxi downto x do
 if (vet[y] < vet[y-1] )then
 begin
 aux:= vet[y];
 vet[y] := vet[y-1];
 vet[y-1] := aux;
 end;
end;
begin
 clrscr;
 for x:= 1 to max do
 readln (vet[x]);
 ORDENA (vet, max);
 for x:= 1 to max do
 writeln (vet[x]);
 readkey;
end.
Códigos Fonte/PAULA.PAS
Program calculadora2 ;
uses CRT;
var
 num1,num2:real;
 resp:char; {pra poder rodar forever ate o usuario querer sair}
 n: integer;
function SOMA (a,b:real):real;
begin
 writeln (' A soma dos numeros e',a+b:0:2);
end;
function SUBTRAIR(a,b:real):real;
begin
 writeln (' A subtração dos numeros e',a-b:0:2);
end;
function MULTIPLICAO(a,b:real):real;
begin
 writeln (' A multiplicação numeros e',a*b:0:2);
end;
function DIVISAO(a,b:real):real;
begin
 writeln (' A sivisão dos numeros e',a/b:0:2);
end;
Begin
 clrscr;
 resp := 's';
 while resp = 's' do
 begin
 writeln ('Informe 2 valores:');
 readln (num1,num2);
 writeln ('Qual operação deseja realizar?');
 writeln ('1 - soma.');
 writeln ('2 - subtração');
 writeln ('3 - multiplicação');
 writeln ('4 - divisão');
 readln (n);
 case n of
 1: SOMA (num1,num2);
 2: SUBTRAIR(num1,num2);
 3: MULTIPLICAO(num1,num2);
 4: DIVISAO(num1,num2);
 else writeln ('Operação Incorreta');
 end;
 writeln ('Deseja realizar outra operação?');
 readln (resp);
 clrscr;
 end;
end.
Códigos Fonte/PROCEDUR.PAS
program teste;
uses crt;
var
 n1, n2: integer;
procedure PROC(x: integer; var y: integer);
begin
 x:=1;
 y:=1;
end;
begin
 clrscr;
 n1:= 0;
 n2:= 0;
 proc (n1, n2);
 writeln (n1);
 writeln (n2);
 readkey;
end.
Códigos Fonte/RECURSIV.PAS
program teste;
uses crt;
var
 n: integer;
function FAT(n: integer) : integer;
begin
 if n = 0 then
 FAT:= 1
 else
 FAT := n * FAT(n-1)
end;
begin
 clrscr;
 n := FAT(4);
 writeln (n);
 readkey;
end.
Códigos Fonte/REPAT2.PAS
program repet1;
uses crt;
var
 resul, num1, num2 : real;
begin
 clrscr;
 writeln ('Informe um n£mero: ');
 readln (num1);
 repeat
 writeln ('Informe um n£mero: ');
 readln (num2);
 if num2 = 0 then
 begin
 writeln ('VALOR INVµLIDO');
 end;
 until num2 <> 0;
 resul := num1 / num2;
 writeln ('O resultado da divisÆo ‚: ', resul:0:2);
 readkey;
end.
Códigos Fonte/REPEAT1.PAS
program repet1;
uses crt;
var
 resul, num1, num2 : real;
begin
 clrscr;
 writeln ('Informe um n£mero: ');
 readln (num1);
 repeat
 writeln ('Informe um n£mero: ');
 readln (num2);
 until num2 <> 0;
 resul := num1 / num2;
 writeln ('O resultado da divisÆo ‚: ', resul:0:2);
 readkey;
end.
Códigos Fonte/REPEAT10.PAS
program repeat9;
uses crt;
var
 nota1, nota2, media: real;
 aprov : integer;
 op : char;
begin
 aprov := 0;
 repeat
 clrscr;
 writeln ('Informe a nota1: ');
 readln (nota1);
 writeln ('Informe a nota2: ');
 readln (nota2);
 media := nota1/2 + nota2/2;
 if media >= 7 then
 begin
 aprov := aprov + 1;
 end;
 writeln ('Calcular a media de outro aluno [S]im ou [N]ao');
 readln (op);
 until ((op = 'N') or (op = 'n'));
 writeln ('A quantidade de alunos aprovados
e: ',aprov);
 readkey;
end.
Códigos Fonte/REPEAT11.PAS
program repeat11;
uses crt;
const
 senha = 'teste';
var
 senha_infor: string;
 tent : integer;
begin
 tent:= 0;
 clrscr;
 repeat
 writeln ('Informe a senha: ');
 readln (senha_infor);
 tent := tent + 1;
 until senha_infor = senha;
 clrscr;
 writeln ('Acesso Permitido');
 writeln ('Quantidade de tentativas: ',tent);
 readkey;
end.
Códigos Fonte/REPEAT12.PAS
program repeat12;
uses crt;
var
 gol_gremio, gol_inter, vit_inter, vit_gremio, empate, tot_jogos, x : integer;
begin
 gol_gremio := 0;
 gol_inter := 0;
 vit_inter := 0;
 vit_gremio := 0;
 empate := 0;
 tot_jogos := 0;
 x := 1;
 clrscr;
 while (x=1) do
 begin
 writeln ('Informe quantos gols o Gremio fez: ');
 readln (gol_gremio);
 writeln ('Informe quants gols o Inter fez: ');
 readln (gol_inter);
 if gol_gremio > gol_inter then
 begin
 vit_gremio := vit_gremio + 1;
 writeln ('Gremio vencedor');
 end
 else if gol_inter > gol_gremio then
 begin
 vit_inter := vit_inter + 1;
 writeln ('Inter vencedor');
 end
 else
 begin
 empate:= empate + 1;
 writeln ('Empate');
 end;
 tot_jogos := tot_jogos + 1;
 repeat
 writeln ('Novo GRENAL 1. Sim 2. Nao');
 readln (x);
 case x of
 1 : x:= 1;
 2 : x:= 0;
 else
 begin
 writeln ('Opcao invalida');
 end;
 end;
 clrscr;
 until ((x=1) or (x=0));
 end;
 writeln ('Foram feitos',tot_jogos,' grenais');
 writeln ('O numero de vitorias do Inter e de: ',vit_inter);
 writeln ('O numero de vitorias do Gremio e de: ',vit_gremio);
 writeln ('O numero de empates e de: ',empate);
 if vit_gremio > vit_inter then
 begin
 writeln ('Gremio venceu mais GRENAIS');
 end
 else if vit_inter > vit_gremio then
 begin
 writeln ('Inter venceu mais GRENAIS');
 end
 else
 writeln ('Nao houve vencedores');
 readkey;
end.
Códigos Fonte/REPEAT13.PAS
program repeat13;
uses crt;
var
 altura, maior_altura : real;
 nome, nome_maior : string [15];
 x : integer;
begin
 x := 1;
 writeln ('Informe o nome da candidata');
 readln (nome[15]);
 if (upcase(nome[15]) <> 'FIM') then
 writeln (nome[15]);
 begin
 repeat
 writeln ('Informe a altura da candidata');
 readln (altura);
 if x = 1 then
 begin
 maior_altura := altura;
 nome_maior := nome;
 end;
 if altura > maior_altura then
 begin
 maior_altura := altura;
 nome_maior := nome;
 end;
 writeln ('Qual o nome da candidata: ');
 readln (nome[15]);
 until upcase(nome[15]) = 'FIM';
 end;
 readkey;
end.
Códigos Fonte/REPEAT15.PAS
program repeat15;
uses crt;
var
 x : integer;
begin
 clrscr;
 x:= 0;
 repeat
 x:= x + 1;
 writeln (x);
 until (x=10);
 readkey;
end.
Códigos Fonte/REPEAT16.PAS
program repeat16;
uses crt;
var
 x : integer;
begin
 clrscr;
 x := 0;
 while (x < 10) do
 begin
 x := x + 1;
 writeln (x);
 end;
 readkey;
end.
Códigos Fonte/REPEAT17.PAS
program repeat17;
uses crt;
var
 n, fat, x : integer;
begin
 clrscr;
 fat := 1;
 writeln ('Informe o valor de N.');
 readln (n);
 for x:= 1 to n do
 begin
 fat := fat * x;
 end;
 writeln ('O fatorial de ',n,' e de ',fat);
 readkey;
end.
Códigos Fonte/REPEAT18.PAS
program repeat18;
uses crt;
var
 x, y, z, soma: integer;
begin
 clrscr;
 writeln ('Informe um valor.');
 readln (x);
 writeln ('Informe um valor.');
 readln (y);
 writeln ('Informe um valor.');
 readln (z);
 if ((x <= y + z) and (y <= x + z) and (z <= x + y)) then
 begin
 soma:= x + y + z;
 writeln ('Perimetro de ',soma);
 end
 else
 writeln ('Nao e um triangulo');
 readkey;
end.
Códigos Fonte/REPEAT19.PAS
program repeat19;
uses crt;
var
 x, soma : integer;
begin
 soma := 0;
 clrscr;
 for x:= 100 to 200 do
 begin
 if (x mod 2 = 0) then
 begin
 soma := soma + x;
 end;
 end;
 writeln (soma);
 readkey;
end.
Códigos Fonte/REPEAT2.PAS
program repet1;
uses crt;
var
 resul, num1, num2 : real;
begin
 clrscr;
 writeln ('Informe um n£mero: ');
 readln (num1);
 repeat
 writeln ('Informe um n£mero: ');
 readln (num2);
 if num2 = 0 then
 begin
 writeln ('VALOR INVµLIDO');
 end;
 until num2 <> 0;
 resul := num1 / num2;
 writeln ('O resultado da divisÆo ‚: ', resul:0:2);
 readkey;
end.
Códigos Fonte/REPEAT20.PAS
program repeat20;
uses crt;
var
 x, idade, soma : integer;
 media : real;
begin
 soma := 0;
 x := 0;
 clrscr;
 repeat
 writeln ('Informe uma idade');
 readln (idade);
 if (idade = 0) then
 begin
 break;
 end;
 soma := idade + soma;
 x := x + 1;
 until (idade = 0);
 media := soma / x;
 writeln (media:0:2);
 readkey;
end.
Códigos Fonte/REPEAT3.PAS
program repet1;
uses crt;
var
 resul, num1, num2 : real;
begin
 num2 := 0;
 clrscr;
 writeln ('Informe um n£mero: ');
 readln (num1);
 while num2 = 0 do
 begin
 writeln ('Informe um n£mero: ');
 readln (num2);
 if num2 = 0 then
 begin
 writeln ('VALOR INVµLIDO');
 end;
 end;
 resul := num1 / num2;
 writeln ('O resultado da divisÆo ‚: ', resul:0:2);
 readkey;
end.
Códigos Fonte/REPEAT5.PAS
program select5;
uses crt;
var
 av1, av2: real;
 med : real;
begin
 clrscr;
 repeat
 writeln ('Informe a nota da av1: ');
 readln (av1);
 if ((av1 > 10) or (av1 < 0)) then
 begin
 writeln ('Nota invalida.');
 end;
 until ((av1 <= 10) and (av1 >= 0));
 clrscr;
 repeat
 writeln ('Informe a nota da av2: ');
 readln (av2);
 if ((av2 > 10) or (av2 <0)) then
 begin
 writeln ('Nota invalida.');
 end;
 until ((av2 <= 10) and (av2 >= 0));
 med := av1/2 + av2/2;
 writeln ('A m‚dia ‚: ', med:0:2);
 readkey;
end.
Códigos Fonte/REPEAT6.PAS
program select5;
uses crt;
var
 av1, av2: real;
 med : real;
 x : integer
begin
 x := 1;
 while (x = 1) do
 begin
 clrscr;
 repeat
 writeln ('Informe a nota da av1: ');
 readln (av1);
 if ((av1 > 10) or (av1 < 0)) then
 begin
 writeln ('Nota invalida.');
 end;
 until ((av1 <= 10) and (av1 >= 0));
 clrscr;
 repeat
 writeln ('Informe a nota da av2: ');
 readln (av2);
 if ((av2 > 10) or (av2 <0)) then
 begin
 writeln ('Nota invalida.');
 end;
 until ((av2 <= 10) and (av2 >= 0));
 clrscr;
 med := av1/2 + av2/2;
 writeln ('A m‚dia ‚: ', med:0:2);
 writeln ('Deseja calcular novamente? 1. sim ou 2. nÆo');
 readln (x);
 readkey;
end.
Códigos Fonte/REPEAT7.PAS
program select5;
uses crt;
var
 av1, av2: real;
 med : real;
 x : integer;
begin
 x := 1;
 while (x = 1) do
 begin
 clrscr;
 repeat
 writeln ('Informe a nota da av1: ');
 readln (av1);
 if ((av1 > 10) or (av1 < 0)) then
 begin
 writeln ('Nota invalida.');
 end;
 until ((av1 <= 10) and (av1 >= 0));
 clrscr;
 repeat
 writeln ('Informe a nota da av2: ');
 readln (av2);
 if ((av2 > 10) or (av2 <0)) then
 begin
 writeln ('Nota invalida.');
 end;
 until ((av2 <= 10) and (av2 >= 0));
 clrscr;
med := av1/2 + av2/2;
 writeln ('A m‚dia ‚: ', med:0:2);
 repeat
 writeln ('Deseja calcular novamente? 1. sim ou 2. nÆo');
 readln (x);
 until ((x = 1) or (x = 2));
 end;
 readkey;
end.
Códigos Fonte/REPEAT8.PAS
program select21;
uses crt;
var
 lado : array [1..3] of real;
 x, op : integer;
begin
 clrscr;
 repeat
 for x:= 1 to 3 do
 begin
 writeln ('Informe as medidas dos lados de um triangulo.');
 readln (lado[x]);
 end;
 writeln ('Os dados informados estao corretos?');
 writeln ('1. sim / 2. nao');
 readln (op);
 clrscr;
 until op = 1;
 if (lado[1] = lado[2]) and (lado[2] = lado[3]) then
 begin
 writeln ('Triƒngulo Equil tero');
 end
 else if (lado[1] = lado[2]) or (lado[2] = lado[3]) or (lado[1] = lado[3]) then
 begin
 writeln ('Triƒngulo Is¢sceles');
 end
 else
 writeln ('Triƒngulo Escaleno');
 readkey;
end.
Códigos Fonte/REPEAT9.PAS
program repeat9;
uses crt;
var
 nota1, nota2, media: real;
 aprov : integer;
 op : char;
begin
 aprov := 0;
 repeat
 clrscr;
 writeln ('Informe a nota1: ');
 readln (nota1);
 writeln ('Informe a nota2: ');
 readln (nota2);
 media := nota1/2 + nota2/2;
 if media >= 7 then
 begin
 aprov := aprov + 1;
 end;
 writeln ('Calcular a media de outro aluno [S]im ou [N]ao');
 readln (op);
 until ((op = 'N') or (op = 'n'));
 writeln ('A quantidade de alunos aprovados e: ',aprov);
 readkey;
end.
Códigos Fonte/SELEC10.PAS
program selecao10;
uses crt;
var
 num : array [1..3] of integer;
 x, y, aux: integer;
begin
 clrscr;
 for x:= 1 to 3 do
 begin
 writeln ('Informe um n£mero: ');
 readln (num[x]);
 end;
 clrscr;
 for x:= 1 to 3 do
 for y:= 3 downto x do
 begin
 if num[x] > num[y] then
 begin
 aux := num[y];
 num[y] := num[x];
 num [x] := aux;
 end;
 end;
 for x:= 1 to 3 do
 writeln (num[x]);
 readkey;
end.
end.
Códigos Fonte/SELEC11.PAS
program selecao11;
uses crt;
const
 senha_valid = 1234;
var
 senha_infor : integer;
begin
 clrscr;
 repeat
 writeln ('Informe a senha: ');
 readln (senha_infor);
 if senha_infor <> senha_valid then
 begin
 writeln ('Acesso negado, tente novamente');
 end
 else
 writeln ('Acesso permitido');
 until senha_infor = senha_valid;
 readkey;
end.
Códigos Fonte/SELECAO1.PAS
program selecao1;
uses crt;
var
 op : integer;
begin
 clrscr;
 writeln ('Informe o codigo de origem do prouto');
 readln (op);
 case op of
 1: writeln ('Sul');
 2: writeln ('Norte');
 3: writeln ('Leste');
 4: writeln ('Oeste');
 5, 6: writeln ('Nordeste');
 7,8,9: writeln ('Sudeste');
 10: writeln ('Centro-Oeste');
 11: writeln ('Noroeste');
 else
 writeln ('Importado');
 end;
 writeln ('Pressione uma tecla para sair');
 readkey;
end.
Códigos Fonte/SELECAO2.PAS
program selecao2;
uses crt;
var
 p1, p2, opt, media: real;
 op : char;
begin
 repeat
 clrscr;
 writeln ('Informe a nota da p1: ');
 readln (p1);
 writeln ('Informe a nota da p2: ');
 readln (p2);
 until (((p1>=0) and (p1<=10)) and ((p2>=0) and (p2<=10)));
 repeat
 writeln ('O aluno fez a prova optativa? (s p/ sim e n p/ nao)');
 readln (op);
 case op of
 's': begin
 repeat
 writeln ('Informe a nota da prova optativa: ');
 readln (opt);
 until (opt>=0);
 end;
 'n': opt:= -1;
 else
 writeln ('Opcao invalida.');
 end;
 if opt < 0 then
 begin
 writeln ('Nota incorreta, favor repetir o processo.');
 end;
 until ((op = 's') or (op = 'n'));
 if (op = 's') then
 begin
 if (p1>p2) then
 begin
 p2:= opt;
 end
 else
 if (p2>p1) then
 begin
 p1:= opt;
 end
 else
 p2 := opt;
 end;
 media := (p1 + p2)/2;
 if (media>=6) then
 begin
 writeln ('Aprovado');
 end
 else if (media < 3) then
 begin
 writeln ('Reprovado');
 end
 else
 begin
 writeln ('Exame Final');
 end;
 readkey;
end.
Códigos Fonte/SELECAO3.PAS
program selecao3;
uses crt;
var
 p1, p2: real;
 media: real;
begin
 clrscr;
 repeat
 writeln ('Informe a nota da p1: ');
 readln (p1);
 if (p1 < 0) or (p1 > 10) then
 begin
 writeln ('Nota invalida');
 writeln ('Pressione uma tecla para inserir a nota novamente');
 readkey;
 clrscr;
 end;
 until ((p1 >= 0) and (p1 <=10));
 repeat
 writeln ('Informe a nota da p2: ');
 readln (p2);
 if (p2 < 0) and (p2 > 10) then
 begin
 writeln ('Nota invalida');
 writeln ('Pressione uma tecla para inserir a nota novamente');
 readkey;
 clrscr;
 end;
 until ((p2 >= 0) and (p2 <= 10));
 media := (p1 + p2)/2;
 clrscr;
 writeln ('A m‚dia do aluno ‚: ',media:0:2);
 if media > 6 then
 begin
 writeln ('Parab‚ns! Vocˆ foi aprovado');
 end
 else
 begin
 writeln ('Vocˆ foi Reprovado! Estude mais...');
 end;
 readkey;
end.
Códigos Fonte/SELECAO5.PAS
program selecao4;
uses crt;
var
 num: real;
begin
 clrscr;
 writeln ('Informe um n£mero: ');
 readln (num);
 clrscr;
 if num < 0 then
 begin
 writeln ('N£mero Negativo');
 end
 else if (num > 0) then
 begin
 writeln ('N£mero Positivo');
 end
 else
 begin
 writeln ('N£mero neutro');
 end;
 readkey;
end.
Códigos Fonte/SELECAO7.PAS
program selecao7;
uses crt;
var
 a, b: real;
begin
 clrscr;
 writeln ('Informe um n£mero: ');
 readln (a);
 repeat
 writeln ('Informe um n£mero: ');
 readln (b);
 clrscr;
 if a=b then
 begin
 writeln ('Os n£meros informados sÆo iguais, informe um n£mero novamente');
 end;
 until a<>b;
 if a > b then
 begin
 writeln ('O maior n£mero ‚: ',a:0:2);
 end
 else
 begin
 writeln ('O maior n£mero ‚: ',b:0:2);
 end;
 readkey;
end.
Códigos Fonte/SELECAO8.PAS
program selecao8;
uses crt;
const
 atual = 2011;
var
 ano: integer;
begin
 clrscr;
 writeln ('Informe o seu ano de nascimento:');
 readln (ano);
 if atual - ano >= 18 then
 begin
 writeln ('J  pode votar');
 end
 else
 begin
 writeln ('Ainda nÆo pode votar');
 end;
 readkey;
end.
Códigos Fonte/SELECAO9.PAS
program selecao9;
uses crt;
const
 preco1 = 0.3;
 preco2 = 0.25;
 duzia = 12;
var
 total: real;
 quant: integer;
begin
 clrscr;
 writeln ('Informe a quantidade de ma‡as que deseja comprar: ');
 readln (quant);
 if quant >= duzia then
 begin
 total := quant * preco2;
 end
 else
 begin
 total := quant * preco1;
 end;
 clrscr;
 writeln ('O pre‡o a pagar ‚ de: ',total:0:2);
 readkey;
end.
Códigos Fonte/SELECT12.PAS
program selecao12;
uses crt;
var
 altura: real;
 sexo : char;
 peso : real;
begin
 clrscr;
 writeln ('Informe a altura: ');
 readln (altura);
 writeln ('Informe o sexo - (m) masculino e (f) feminino');
 readln (sexo);
 peso := 0;
 case sexo of
 'm', 'M' : peso := (72.7 * altura) - 58;
 'f', 'F' : peso := (62.1 * altura) - 44.7;
 end;
 writeln ('O peso ideal ‚: ', peso:0:2);
 readkey;
end.
Códigos Fonte/SELECT13.PAS
program selecao13;
uses crt;
var
 num : integer;
begin
 clrscr;
 writeln ('Informe um n£mero inteiro: ');
 readln (num);
 if num mod 2 = 0 then
 begin
 writeln ('N£mero par');
 end
 else
 writeln ('N£mero ¡mpar');
 readkey;
end.
Códigos Fonte/SELECT14.PAS
program selecao14;
uses
crt;
var
 gremio, inter: integer;
begin
 clrscr;
 writeln ('Informe os gols marcados pelo Grˆmio.');
 readln (gremio);
 writeln ('Informe os gols marcados pelo Inter.');
 readln (inter);
 if gremio = inter then
 begin
 writeln ('EMPATE');
 end
 else if gremio > inter then
 begin
 writeln ('GREMIO VENCEDOR');
 end
 else
 writeln ('INTER VENCEDOR');
 readkey;
end.
Códigos Fonte/SELECT15.PAS
program selecao15;
uses crt;
var
 qtd_lado : integer;
 medida_lado : real;
 area, perimetro : real;
begin
 clrscr;
 writeln ('Informe a quantidade de lados do pol¡gono');
 readln (qtd_lado);
 writeln ('Informe a medida do lado (em cm)');
 readln (medida_lado);
 if qtd_lado = 3 then
 begin
 perimetro := medida_lado * 3;
 writeln ('TRIANGULO, de perimetro: ',perimetro:0:2);
 end
 else if qtd_lado = 4 then
 begin
 area := medida_lado * medida_lado;
 writeln ('QUADRADO, de  rea: ', area:0:2);
 end
 else if qtd_lado = 5 then
 begin
 writeln ('PENTµGONO');
 end
 else if qtd_lado > 5 then
 begin
 writeln ('POLÖGONO NÇO IDENTIFICADO');
 end
 else
 writeln ('NÆo ‚ um Pol¡gono');
 readkey;
end.
Códigos Fonte/SELECT17.PAS
program selecao17;
uses crt;
var
 num1, num2, resul: real;
 op : integer;
begin
 clrscr;
 writeln ('Informe um numero');
 readln (num1);
 writeln ('Informe um numero');
 readln (num2);
 writeln ('Informe a op‡Æo desejada.');
 writeln ('1. Adi‡Æo');
 writeln ('2. Subtra‡Æo');
 writeln ('3. DivisÆo');
 writeln ('4. Multiplica‡Æo');
 readln (op);
 case op of
 1 : resul := num1 + num2;
 2 : resul := num1 - num2;
 3 : resul := num1 / num2;
 4 : resul := num1 * num2;
 end;
 writeln ('Resultado da opera‡Æo desejada ‚: ',resul:0:2);
 readkey;
end.
Códigos Fonte/SELECT18.PAS
program selecao18;
uses crt;
var
 num: array [1..3] of integer;
 x, y, aux : integer;
begin
 clrscr;
 for x:=1 to 3 do
 begin
 writeln ('Informe um numero');
 readln (num[x]);
 end;
 aux := num[1];
 for x:= 1 to 3 do
 begin
 if (aux < num[x]) then
 aux := num[x] ;
 end;
 writeln ('O maior n£mero ‚: ', aux);
 readkey;
end.
Códigos Fonte/SELECT19.PAS
program select19;
uses crt;
var
 num : array [1..3] of integer;
 x, y, aux, soma : integer;
begin
 clrscr;
 for x:=1 to 3 do
 begin
 writeln ('Informe um numero: ');
 readln (num[x]);
 end;
 for x:=1 to 3 do
 for y:= 3 downto x do
 begin
 if num[x] > num[y] then
 begin
 aux := num[x];
 num[x] := num[y];
 num[y] := aux;
 end;
 end;
 soma := num[3] + num[2];
 writeln (soma);
 readkey;
end.
Códigos Fonte/SELECT20.PAS
program select20;
uses crt;
var
 num : array [1..3] of integer;
 x, y, aux: integer;
begin
 clrscr;
 for x:= 1 to 3 do
 begin
 writeln ('Informe um numero: ');
 readln (num[x]);
 end;
 for x:= 1 to 3 do
 for y:= x to 3 do
 begin
 if num[x] < num[y] then
 begin
 aux := num[x];
 num[x] := num[y];
 num[y] := aux;
 end;
 end;
 for x:= 1 to 3 do
 writeln (num[x]);
 readkey;
end.
Códigos Fonte/SELECT21.PAS
program select21;
uses crt;
var
 lado : array [1..3] of real;
 x : integer;
begin
 clrscr;
 for x:= 1 to 3 do
 begin
 writeln ('Informe as medidas dos lados de um triangulo.');
 readln (lado[x]);
 end;
 if (lado[1] = lado[2]) and (lado[2] = lado[3]) then
 begin
 writeln ('Triƒngulo Equil tero');
 end
 else if (lado[1] = lado[2]) or (lado[2] = lado[3]) or (lado[1] = lado[3]) then
 begin
 writeln ('Triƒngulo Is¢sceles');
 end
 else
 writeln ('Triƒngulo Escaleno');
 readkey;
end.
Códigos Fonte/SELECT22.PAS
program select22;
uses crt;
var
 idade_h : array [1..2] of integer;
 idade_m : array [1..2] of integer;
 maior_h, maior_m, menor_h, menor_m : integer;
 soma, x, y: integer;
 prod : real;
begin
 clrscr;
 for x:=1 to 2 do
 begin
 writeln ('Informe a Idade de um homem: ');
 readln (idade_h[x]);
 writeln ('Informe a Idade de uma mulher: ');
 readln (idade_m[x]);
 end;
 if idade_h[1] > idade_h[2] then
 begin
 maior_h := idade_h[1] ;
 menor_h := idade_h[2];
 end
 else
 begin
 maior_h := idade_h[2];
 menor_h := idade_h[1];
 end;
 if idade_m[1] > idade_m[2] then
 begin
 maior_m := idade_m[1] ;
 menor_m := idade_m[2];
 end
 else
 begin
 maior_m := idade_m[2];
 menor_m := idade_m[1];
 end;
 soma := maior_h + menor_m;
 prod := exp (ln(menor_h)*maior_m);
 clrscr;
 writeln (soma,' ',prod:0:2);
 readkey;
end.
Códigos Fonte/SELECT23.PAS
program select23;
uses crt;
var
 angulo: array [1..3] of integer;
 x, y, R, O, A: integer;
begin
 R := 0;
 O := 0;
 A := 0;
 clrscr;
 for x:= 1 to 3 do
 begin
 writeln ('Informe o angulo do triangulo. ');
 readln (angulo[x]);
 end;
 for x:= 1 to 3 do
 begin
 if angulo[x] = 90 then
 begin
 R:= 1;
 end;
 if angulo [x] > 90 then
 begin
 O:= 1;
 end;
 end;
 if R = 1 then
 begin
 writeln ('Triハgulo Retangulo');
 end
 else if O = 1 then
 begin
 writeln ('Triハgulo Obtusハgulo');
 end
 else
 writeln ('Triハgulo Acutハgulo');
 readkey;
end.
Códigos Fonte/SIMPLES1.PAS
program selecao1;
uses crt;
const
 pi = 3.14;
var
 area: real;
 raio: real;
begin
 clrscr;
 writeln ('Informe o raio do c¡rculo');
 readln (raio);
 area := pi * (raio*raio);
 writeln ('A  rea ‚ de: ',area:0:2);
 writeln ('Pressione uma tecla para sair');
 readkey;
end.
Códigos Fonte/SIMPLES2.PAS
program simples2;
uses crt;
var
 tempf, tempc: real;
begin
 clrscr;
 writeln ('Informe a temperatura em Fahrenheit: ');
 readln (tempf);
 tempc := ((5*tempf) - (32*5))/9;
 writeln ('A temperatura em graus Celsius ‚: ',tempc:0:2);
 writeln ('Pressione uma tecla para sair');
 readkey;
end.
Códigos Fonte/SIMPLES3.PAS
program simples3;
uses crt;
var
 tempc, tempf: real;
begin
 clrscr;
 writeln ('Informe a temperatura em graus Celsius: ');
 readln (tempc);
 tempf := ((tempc/5)*9)+32;
 writeln ('A temperatura em graus Fahrenheit ‚: ',tempf:0:2);
 writeln ('Pressione uma tecla para sair');
 readkey;
end.
Códigos Fonte/SIMPLES4.PAS
program simples4;
uses crt;
const
 pot = 18;
var
 larg, comp, potencia, area,total: real;
begin
 clrscr;
 writeln ('Informe a largura e o comprimento do c“modo');
 readln (larg,comp);
 area := larg * comp;
 writeln ('Informe a potˆncia da lampada: ');
 readln (potencia);
 total := (area*pot)/potencia;
 total := round (total);
 writeln ('a quantidade de lƒmpadas necess rias ‚: ', total:0:2);
 writeln ('Pressione uma tecla para sair');
 readkey;
end.
Códigos Fonte/SIMPLES5.PAS
program simples5;
uses crt;
const
 caixa = 1.5;
var
 comp, larg, alt, lado1, lado2, caixas: real;
begin
 clrscr;
 writeln ('Informe o comprimento, largura e altura da cozinha: ');
 readln (comp, larg, alt);
 lado1 := comp*alt*2;
 lado2 := larg*alt*2;
 caixas := (lado1 + lado2)/caixa;
 writeln ('A quantidade de caixas necess rias ‚ de: ', caixas:0:2);
 writeln ('Pressione uma tecla para sair');
 readkey;
end.
Códigos Fonte/SIMPLES6.PAS
program simples6;
uses crt;
const
 comb = 1.9;
var
 inicio, fim, lit_comb, lucro, renda, media, gasto: real;
begin
 clrscr;
writeln ('Informe com quantos km come‡ou o dia: ');
 readln (inicio);
 writeln ('Informe com quantos km terminou o dia: ');
 readln (fim);
 inicio := fim - inicio;
 writeln ('Informe a quantidade de combustivel gasto: ');
 readln (lit_comb);
 gasto := lit_comb * comb;
 writeln ('Informe o valor total recebido dos passageiros: ');
 readln (renda);
 lucro := renda - gasto;
 media := inicio/lit_comb;
 writeln ('O lucro (l¡quido) ‚ de: ', lucro:0:2,' E a m‚dia de consumo ‚ de: ',media:0:2);
 readkey;
end.
Códigos Fonte/SIMPLES7.PAS
program simples7;
uses crt;
var
 consumo, comprimento, tam_pista, combust, parada: real;
 reab_desej, voltas: integer;
begin
 clrscr;
 writeln ('Informe o comprimento da pista (em metros):');
 readln (comprimento);
 writeln ('Informe a quantidade de reabastecimentos desejados: ');
 readln (reab_desej);
 writeln ('Informe a quantidade de voltas na pista');
 readln (voltas);
 writeln ('Informe o consumo do carro em km/l: ');
 readln (consumo);
 tam_pista := comprimento/1000;
 combust := ((tam_pista*voltas)/reab_desej)/consumo;
 writeln ('O n£mero m¡nimo de litros necess rios ‚ de: ',combust:0:2);
 writeln ('Pressione uma tecla para sair');
 readkey;
end.
Códigos Fonte/SOM.PAS
program bobo;
uses crt;
var
 i, a: integer;
begin
 clrscr;
 for i:= 1 to 1000 do
 begin
 sound (random(i));
 delay (5);
 end;
 readkey;
 nosound;
end.
Códigos Fonte/VETOR.PAS
program um;
uses CRT;
type
 vetornota = array [1..40,1..4] of real;
 vetormedia = array [1..40] of real;
var
 nota : vetornota;
 media : vetormedia;
 lin, col : integer;
begin
 clrscr;
 for lin:= 1 to 3 do
 media[lin] := 0;
 for lin:= 1 to 3 do
 for col:= 1 to 4 do
 begin
 writeln ('Informe as notas do aluno', lin);
 readln (nota[lin][col]);
 media[lin] := media[lin] + nota[lin][col];
 end;
 for lin := 1 to 3 do
 begin
 media[lin] := media[lin]/4;
 end;
 clrscr;
 for lin := 1 to 3 do
 begin
 writeln (' ');
 for col:= 1 to 4 do
 begin
 write (nota[lin][col]:5:2,' ');
 end;
 write (media[lin]:5:2,' ');
 end;
 readkey;
end.