Procedimentos :
Declaração
Procedure nome (lista-de-parâmetros);
declaração de variáveis locais;
Begin
comandos;
End;
Mostrando postagens com marcador Exemplos. Mostrar todas as postagens
Mostrando postagens com marcador Exemplos. Mostrar todas as postagens
terça-feira, 11 de maio de 2010
Exemplo Soma de notas
Program Inclusao_prof;
var
media, n1,n2,n3:real;
nome: string;
opc:integer;
Begin
textbackground(green) ;
clrscr;
gotoxy(10,10);
textcolor( blue );
writeln('Nome do Aluno');
readln(nome);
writeln ('Media 1');
readln(n1);
writeln('Media 2');
readln(n2);
writeln('Media 3');
readln(n3);
media:=(n1+n2+n3) /3;
writeln('media=',media,3:3);
IF media >= 7 then
Begin
writeln(' ');
write('Parabéns ',nome ,' você foi aprovado!');
end
ELSE
Begin
writeln(' ');
write(nome ,' Estudar mais, fara a recuperação! ');
writeln(' ');
end;
end.
Exemplo de Juros
Program juros;
var
C,Mn,temp,temp2,I:integer;
N, Contador:integer;
Begin
writeln('Digite quanto em dinheiro irá guarda ');
readln(c);
writeln('Digite taxa');
readln(i);
writeln('Digite quantos Tri ');
readln(n);
temp:= 1 + I;
temp2:= temp;
writeln('tabela');
Mn := c * temp2;
writeln(' No tri 1 voce lucrou R$ ',Mn);
for contador := 2 to N Do
begin
temp := temp2 * temp;
Mn := c *temp2;
writeln('No tri',contador, 'voce lucrou R$ ',Mn);
end;
writeln('fim');
End.
Exemplo com while
Program certidao;
var
nome,dia,hospital, cidade, pai,mae ,testemunhas :string;
opc:integer;
begin
writeln('Digite 1 pra fazer CADASTRO ,2 para sair');readln(opc);
While(opc=1) Do
Begin
writeln(' ');
writeln(' ');
writeln(' Certidão de Narcimento ');
writeln(' ');
writeln('Digite seu nome:');read(nome);
writeln('Narcido no dia: '); readln(Dia);
writeln('Narcido no Hospital:');readln(hospital);
writeln('Na cidade de:');readln(cidade);
writeln('Filho de: Dona ');readln(mae);
writeln('Senhor ');readln(pai);
writeln(' Foram testemunhas: '); readln(testemunhas);
writeln(' ');
writeln(' ');
writeln(' CERTIDÃO DE NARCIMENTO ');
writeln(' N-12.635 ');
writeln(' ');
writeln(' ');
writeln('Eu, Roberto do Santos viera, Oficial de Registro Civil, em virtude da Lei, ect.');
writeln('Certifico do Registro de Narcimento, foi feito o assento de ',nome , '.' );
writeln('Narcido no dia ',dia ,'.');
writeln('No Hospital ',hospital, ',' );
writeln('em ',cidade,',');
writeln('Filho de ' ,pai, ' e ');
writeln(' dona ',mae ,',');
writeln('foram testemunhas: ' ,testemunhas, '.');
writeln(' ');
writeln(' O referido é verdade e dou fé ');
writeln(' Sanharó, de de . ');
writeln(' ');
writeln(' ');
writeln(' Oficial ');
// aki é a opção para novos cadastros
writeln(' ');
writeln(' ');
writeln(' ');
writeln(' ');
writeln(' ');
writeln(' ');
writeln(' Digite 1 para NOVO CADASTRO , 2 sair ');read(opc);
If (opc=2) Then
Begin
writeln(' ');
writeln(' Obrigado pelo uso de mosso software');
writeln(' agradecimentos - Adson Renato - ');
End;
end;
End.
Exemplo para iniciante
Program Atorizacao para dirigir;
var
num:integer;
Begin
writeln('digite a idade');readln(num);
IF num >= 18 then
Begin
write('P');
end
ELSE
Begin
write('Não pode dirigir');
end;
End.
Exemplo N em Algarismo romanos
Program algarismosdojuju;
uses crt;
var N,R,Q : integer;
begin
clrscr;
textbackground(Blue);
textcolor(lightgray);
clrscr;
write('Entre com o valor de N: ');
readln(N);
write('O valor em Algarismos Romanos ‚ : ');
Q:= N div 1000;
R:= N mod 1000;
case Q of
1:write('M');
2:write('MM');
3:write('MMM');
end;
N:= R;
Q:= N div 100;
R:= N mod 100;
case Q of
1:write('C');
2:write('CC');
3:write('CCC');
4:write('CD');
5:write('D');
6:write('DC');
7:write('DCC');
8:write('DCCC');
9:write('CM');
end;
N:=R;
Q:= N div 10;
R:= N mod 10;
case Q of
1:write('X');
2:write('XX');
3:write('XXX');
4:write('XL');
5:write('L');
6:write('LX');
7:write('LXX');
8:write('LXXX');
9:write('XC');
end;
N:=R;
case R of
1:write('I');
2:write('II');
3:write('III');
4:write('IV');
5:write('V');
6:write('VI');
7:write('VII');
8:write('VIII');
9:write('IX');
end;
textcolor(lightgreen+blink);
gotoxy(50,24);
write('Para sair digite algo... ');
readkey;
end.
Exemplo de Tabuada
program tabuada;
uses crt;
var
tab,vi,vf,i,r:integer;
x:string[1];
begin
x:='s';
while x='s' do
begin
textcolor(10);
clrscr;
writeln;
write('Digite o numero da tabuada = ');
readln(tab);
write('Digite o valor inicial da tabuada = ');
readln(vi);
write('Digite o valor final da tabuada = ');
readln(vf);
writeln;
for i:=vi to vf do
begin
r:=tab*i;
writeln(tab,' X ',i,' = ',r);
end;
writeln;
write('Deseja executar novamente? s/n = ');
x:=readkey;
writeln(x);
if x='s' then
begin
writeln;
write('Reiniciando...');
delay(1000);
end
else
begin
writeln;
write('Saindo do programa...');
delay(1000);
end;
end;
end.
Exemplo Medias..
Program pzim;
var
media, n1,n2,n3:real;
Begin
writeln ('digite n1');
readln(n1);
writeln('digite n2');
readln(n2);
writeln('digite n3');
readln(n3);
media:=(n1+n2+n3) /3;
writeln('media=',media,3:3);
readln;
end.
Exemplo Peso
PROGRAM PES;
var
peso, altura, ideal, emag,engor,abso, abso_em, alt_imc, imc:real;
h_m:char;
Begin
textcolor (white);
textbackground (black);
clrscr;
Writeln ('Por favor, Digite o seu sexo: (M/F)');
read (h_m);
writeln ('Por favor, Digite o a sua altura: ');
read (altura);
writeln ('Por favor, Digite o seu peso: ');
read (peso);
If h_m = 'M'
then begin
ideal:=(72*altura)-58;
end
else begin
ideal:=(62.1*altura)-44.7;
end;
emag:=peso-ideal;
engor:=peso-ideal;
abso:=ABS(engor);
abso_em:=abs(emag);
writeln;
writeln ('O peso ideal é:', ideal:3:2);
if ideal
then begin
writeln ('Você precisa emagrecer ', emag:3:2, ' quilogramas');
end
else begin
writeln ('Você precisa engordar ', abso:3:2, ' quilogramas');
end;
{Aqui termina a parte da equação e começa o IMC}
alt_imc:=SQR(altura);
Imc:=peso/alt_imc;
writeln;
writeln ('O seu IMC é ',IMC:2:2);
Writeln;
writeln;
Writeln (' TABELA IMC');
If (IMC<20)
then begin
textbackground (red);
writeln('Abaixo de 20 A pessoa está abaixo do peso');
textbackground (black);
Writeln ('Entre 20 e 25 Peso Normal');
writeln ('Entre 25 e 30 Acima do Peso');
writeln ('Acima de 30 Obesidade');
end
else if (25>IMC) and (IMC>20)
then begin
writeln('Abaixo de 20 A pessoa está abaixo do peso');
textbackground (red);
Writeln ('Entre 20 e 25 Peso Normal');
textbackground (black);
writeln ('Entre 25 e 30 Acima do Peso');
writeln ('Acima de 30 Obesidade');
end
else if (IMC>25) and (IMC<30)
then begin
writeln('Abaixo de 20 A pessoa está abaixo do peso');
Writeln ('Entre 20 e 25 Peso Normal');
textbackground (red);
writeln ('Entre 25 e 30 Acima do Peso');
textbackground (black);
writeln ('Acima de 30 Obesidade');
end
else if (IMC>30)
then begin
writeln('Abaixo de 20 A pessoa está abaixo do peso');
Writeln ('Entre 20 e 25 Peso Normal');
writeln ('Entre 25 e 30 Acima do Peso');
textbackground (red);
writeln ('Acima de 30 Obesidade');
end;
end.
Exemplo Fatorial
program fatpritab;
uses crt;
var
f,i,c,n,r,op:integer;
x:string[1];
begin
x:='s';
while x='s' do
begin
textcolor(10);
clrscr;
writeln;
writeln('MENU DE OPCOES:');
writeln;
writeln('1- Calcular o fatorial de um numero');
writeln('2- Verificar se um numero eh primo');
writeln('3- Gerar a tabuada para valores de -3 a 10');
writeln;
write('Digite a opcao escolhida = ');
readln(op);
if op=1 then
begin
clrscr;
writeln;
write('Digite um numero = ');
readln(n);
writeln;
f:=1;
for i:=n downto f do f:=f*i;
writeln('O fatorial de ',n,' = ',f);
writeln;
write('Deseja executar novamente? s/n = ');
x:=readkey;
writeln(x);
if x='s' then
begin
writeln;
write('Reiniciando...');
delay(1000);
end
else
begin
writeln;
write('Saindo do programa...');
delay(1000);
end;
end;
if op=2 then
begin
clrscr;
writeln;
write('Digite um numero = ');
readln(n);
writeln;
c:=0;
for i:=1 to n do
begin
if n mod i=0 then c:=c+1;
end;
if c=2 then writeln('O numero ',n,' eh primo')
else writeln('O numero ',n,' nao eh primo');
writeln;
write('Deseja executar novamente? s/n = ');
x:=readkey;
writeln(x);
if x='s' then
begin
writeln;
write('Reiniciando...');
delay(1000);
end
else
begin
writeln;
write('Saindo do programa...');
delay(1000);
end;
end;
if op=3 then
begin
clrscr;
writeln;
write('Digite um numero = ');
readln(n);
writeln;
for i:=-3 to 10 do
begin
r:=i*n;
writeln(i,' X ',n,' = ',r);
end;
writeln;
write('Deseja executar novamente? s/n = ');
x:=readkey;
writeln(x);
if x='s' then
begin
writeln;
write('Reiniciando...');
delay(1000);
end
else
begin
writeln;
write('Saindo do programa...');
delay(1000);
end;
end;
end;
end.
Exemplo Equação 2grau.
Program Eq2grau ;
Var a, b, c :integer;
delta, x1, x2 :real;
Begin
write('Insira o valor de A:');
readln(a);
write('Insira o valor de B:');
readln(b);
write('Insira o valor de C:');
readln(c);
if(a>0) then
begin
delta:=((sqr(b))-(4*a*c));
x1:=(-b+sqrt(delta)/(2*a));
x2:=((b-(2*b))-sqrt(delta)/(2*a));
writeln('A equacao possui duas raizes reais e distintas, são elas: X´:',x1 , 'e X´´:',x2);
end
else
begin
if(a=0) then
begin
delta:=((sqr(b))-(4*a*c));
x1:=(-b+sqrt(delta)/(2*a));
writeln('A equacao possui apenas uma raiz real, X:', x1);
end
else
writeln('A equacao naum possui raizes reais');
end;
End.
Exemplo cronometro
Program Pzim ;
var tempo:integer;
Begin
// Solicita o tempo para o cronometro
write ('Digite o tempo que você deseja que o programa cronometre (s): ');
read (tempo);
// Repeticao até o tempo chegar em zero
while (tempo<>0) do
Begin
delay (1000);
clrscr;
writeln ('Cronometrando: ',tempo,' segundos');
tempo := tempo - 1;
End;
writeln ('');
Write (' Tempo esgotado !');
End.
Exemplo de como usar cores
program calcularmedia;
uses crt;
var a,b,m:real;
s,n:char;
begin
repeat
textbackground(blue);
clrscr;
textcolor(white);
gotoxy(15,5);
textbackground(red);
window(20,5,52,7);
clrscr; gotoxy(3,2);
write('Digite a primeira nota: '); textbackground ( black);write(' ');
gotoxy(27,2);
read(a);
window(20,5,52,7);
textbackground(red);
clrscr;
gotoxy(3,2);
write('Agora a segunda nota: '); textbackground ( black);write(' ');
gotoxy(27,2);
read(b);
m:=(a+b)/2;
window(20,5,52,7);
textbackground(black);textcolor(yellow);clrscr;gotoxy(3,2);
write(' Sua nota foi: ');textcolor(lightblue);write(m:2:1);
window(20,10,52,12);textbackground(magenta);textcolor(lightgreen);
gotoxy(8,1);
write('Aperte N para sair.');
s:=readkey;
until(s='n');
end.
Exemplo Cadastro.
program cadastro;
uses crt;
type
fone = record {registro para armazenar diferentes numeros de telefone no cadastro}
residencial: string[8];
celular: string[8];
comercial: string[8];
end;
type
ender = record
logradouro: string[50];{registro para armazenar dados de endereço no cadastro}
numero: integer;
bairro: string[50];
cidade: string[50];
estado: string[50];
cep: string[8];
end;
type
agenda = record {registro principal}
nome: string[50];
rg: string[8];
cpf: string[11];
mail: string[50];
codigo: integer;
situacao: boolean; {campo para validar o cadastro como ativo ou nao}
telefone: fone;
endereco: ender;
end;
var
pessoa: array[1..100] of agenda;
i,j,k: integer;
cod: integer; {variavel para comparar com o codigo de cada registro
para q nao haja codigos iguais, e para buscar o registro}
op: integer;
tecla: char; {variavel que recebe readkey para paralizar a tela e voltar o menu}
procedure cadastrar;
begin
i:=i+1;
clrscr;
writeln('# Dados Pessoais #');
writeln;
write('Codigo: ');
readln(pessoa[i].codigo);
j:=i; {o uso do j é para não alterar o valor de i}
cod:=pessoa[i].codigo;
while (j>1) do
begin
k:=1;
while (k
begin
if (cod=pessoa[k].codigo) then
begin
writeln('Favor digite outro codigo');
write('Codigo: ');
readln(pessoa[i].codigo);
end;
k:=k+1;
end;
j:=j-1;
end;
write('nome: ');
readln(pessoa[i].nome);
write('rg: ');
readln(pessoa[i].rg);
write('cpf: ');
readln(pessoa[i].cpf);
write('E-mail: ');
readln(pessoa[i].mail);
write('logradouro: ');
readln(pessoa[i].endereco.logradouro);
write('numero: ');
readln(pessoa[i].endereco.numero);
write('bairro: ');
readln(pessoa[i].endereco.bairro);
write('cidade: ');
readln(pessoa[i].endereco.cidade);
write('estado: ');
readln(pessoa[i].endereco.estado);
write('cep: ');
readln(pessoa[i].endereco.cep);
write('telefone residencial: ');
readln(pessoa[i].telefone.residencial);
write('telefone comercial: ');
readln(pessoa[i].telefone.comercial);
write('telefone celular: ');
readln(pessoa[i].telefone.celular);
pessoa[i].situacao:=true;
writeln;
writeln('Digite algo para voltar no menu');
tecla:=readkey;
end;
procedure buscar;
begin
clrscr;
if (i=0) then
begin
writeln('Nao ha nenhum cadastro');
end
else
begin
writeln('digite o codigo da pessoa que deseja buscar');
readln(cod);
clrscr;
j:=1; {o uso do j é para não mudar o valor de i}
while (cod<>pessoa[j].codigo)and(j<=100) do
begin
j:=j+1;
end;
if (cod<>pessoa[j].codigo) then
begin
writeln('Nao ha cadastro com esse codigo');
end
else
begin
writeln('# Dados Pessoais #');
writeln;
writeln('Nome: ',pessoa[j].nome);
writeln('RG: ',pessoa[j].rg);
writeln('CPF: ',pessoa[j].cpf);
writeln('E-mail: ',pessoa[i].mail);
writeln('Logradouro: ',pessoa[j].endereco.logradouro);
writeln('Numero: ',pessoa[j].endereco.numero);
writeln('Bairro: ',pessoa[j].endereco.bairro);
writeln('Cidade: ',pessoa[j].endereco.cidade);
writeln('Estado: ',pessoa[j].endereco.estado);
writeln('CEP: ',pessoa[j].endereco.cep);
writeln('Telefone Residencial: ',pessoa[j].telefone.residencial);
writeln('Telefone Comercial: ',pessoa[j].telefone.comercial);
writeln('Telefone Celular: ',pessoa[j].telefone.celular);
writeln('Situacao: ',pessoa[j].situacao);
end;
end;
writeln;
writeln('Digite algo para voltar no menu');
tecla:=readkey;
end;
procedure atualizar;
var
l:integer; {para nao mudar o valor de i, e comparar registro por registro}
begin
clrscr;
if (i=0) then
begin
writeln('Nao ha nenhum cadastro');
end
else
begin
writeln('digite o codigo da pessoa que deseja atualizar cadastro');
readln(cod);
clrscr;
j:=1; {o uso do j é para não mudar o valor de i}
while (cod<>pessoa[j].codigo)and(j<=100) do
begin
j:=j+1;
end;
if(cod<>pessoa[j].codigo) then
begin
writeln('Nao ha cadastro com esse codigo');
end
else
begin
writeln('# Dados Pessoais #');
writeln;
write('codigo: ');
readln(pessoa[j].codigo);
l:=j;
cod:=pessoa[j].codigo;
while (l>1) do
begin
k:=1; {o uso do k é para não mudar o valor de j, pois a condição de parada e o valor de j}
while (k
begin
if (cod=pessoa[k].codigo) then
begin
writeln('Favor digite outro codigo');
write('Codigo: ');
readln(pessoa[i].codigo);
end;
k:=k+1;
end;
l:=l-1;
end;
write('nome: ');
readln(pessoa[j].nome);
write('rg: ');
readln(pessoa[j].rg);
write('cpf: ');
readln(pessoa[j].cpf);
write('E-mail: ');
readln(pessoa[j].mail);
write('logradouro: ');
readln(pessoa[j].endereco.logradouro);
write('numero: ');
readln(pessoa[j].endereco.numero);
write('bairro: ');
readln(pessoa[j].endereco.bairro);
write('cidade: ');
readln(pessoa[j].endereco.cidade);
write('estado: ');
readln(pessoa[j].endereco.estado);
write('cep: ');
readln(pessoa[j].endereco.cep);
write('telefone residencial: ');
readln(pessoa[j].telefone.residencial);
write('telefone comercial: ');
readln(pessoa[j].telefone.comercial);
write('telefone celular: ');
readln(pessoa[j].telefone.celular);
pessoa[j].situacao:=true;
end;
end;
writeln;
writeln('Digite algo para voltar no menu');
tecla:=readkey;
end;
begin
i:=0;
while(op<>4)and(i<=100) do
begin
clrscr;
gotoxy(32,1);
writeln('# MENU #');
gotoxy(16,4);
writeln('1- PARA NOVO CADASTRO');
gotoxy(16,6);
writeln('2- PARA BUSCAR CADASTRO');
gotoxy(16,8);
writeln('3- PARA ATUALIZAR CADASTRO');
gotoxy(16,10);
writeln('4- PARA SAIR');
gotoxy(14,13);
write('
readln(op);
if (op=1) then
cadastrar
else
if (op=2) then
buscar
else
if (op=3) then
atualizar;
end;
readkey;
end.
Exemplo de um breve animação
program animacao;
uses crt;
begin
textcolor(10);
clrscr;
writeln;
write('(Í');
delay(500);
clreol;
write('ÍÍÍ');
delay(500);
clreol;
write('ÍÍÍÍ)');
delay(500);
end.
Exemplo Algarismo romanos
Program algarismos_romanos_1_ao_10 ;
const
I='I';
V='V';
X='X';
var
N:integer;
Begin
for N:= 1 to 10 do
begin
write(N,': ');
if N=1 then write(I);
if N=2 then write(I,I);
if N=3 then write(I,I,I);
if N=4 then write(I,V);
if N=5 then write(V);
if N=6 then write(V,I);
if N=7 then write(V,I,I);
if N=8 then write(V,I,I,I);
if N=9 then write(I,X);
if N=10 then write(X);
writeln;
end;
End.
While com valor definido.
Program Pzim ;
var
n1,n2,n3,cont:integer;
Begin
while (cont<7) do
begin
writeln('Digite a primeira nota ');readln(n1);
writeln('Digite a segunda nota ');readln(n2);
writeln('A soma dos numeros é: ', ((n1+n2)/2));
cont:=cont+1;
end;
End.
Exemplo de For;
Program Pzim ;
var
n:string;
cont:integer;
Begin
writeln('Digite seu nome');
Readln(n);
for cont:=1 to 7 do
begin
writeln(n,' seu nome está sendo repetido 7 vezes');
end;
Exemplo de Repeat
Program Pzim ;
var
nome,sobrenome:string;
ano,dia,mes,esc:integer;
Begin
repeat
writeln('Insira seu nome');
Readln(nome);
writeln('Insira seu Sobrenome');
readln(sobrenome);
writeln('Insira o dia de nascimento');
readln(dia);
writeln('Insira a mes');
readln(mes);
Writeln('Digite o ano de nascimento');
readln(ano);
writeln('Nome: ',nome,' ' ,sobrenome);
writeln('Data de Nascimento ',dia,'/', mes,'/', ano);
writeln('1-Novo ou 2-Sair');
readln(esc);
until (esc=2);
End.
Exemplo While.
Program exp ;
var
a:string;
cont:string;
Begin
cont:='sim';
while (cont='sim') do
begin
writeln('Digite um nome');readln(a);
writeln('Voce digitou o nome: ', a);
writeln('digite sim para continuar ou qualquer tecla para sair');readln(cont);
end;
End.
Assinar:
Postagens (Atom)
