Categoria: Pascal

image_pdfimage_print

[pascal] Outra calculadora com uso de funções

Program CALCULADORA;
		uses
			crt;
		var
			OPCAO: char;
				X, A, B: real;
			
		PROCEDURE ENTRADA;
		begin
			gotoxy(5,6); write('Entre com um valor para A: '); readln(A);
			gotoxy(5,7); write('Entre com um valor para B: '); readln(B);
		end;
	
		function CALCULO (R, T: REAL; OPERADOR: char):real;
		begin
			Case OPERADOR of
				'+' : CALCULO :=R+T;
				'-' : CALCULO :=R-T;
				'*' : CALCULO :=R*T;
				'/' : CALCULO :=R/T;
			END;
		end;
	
		Procedure SAIDA;
		VAR
			TECLA: char;
		begin
			gotoxy(5,10); write('O resultado equivale a ', X:5:2);
			gotoxy(25,24); writeln('Tecle algo para voltar ao menu');
			TECLA:= readkey;
		end;
	
		procedure ROT_ADICAO;
		begin
			clrscr;
			gotoxy(32, 1); write('Rotina de Adicao');
			ENTRADA;
			x:= Calculo(A, B, '+');
			SAIDA;
		end;
	
		procedure ROT_SUBTRACAO;
		begin
			clrscr;
			gotoxy(30, 1); write('Rotina de Subtração');
			ENTRADA;
			x:= Calculo(A, B, '-');
			SAIDA;
		end;
	
		procedure ROT_MULTIPLICACAO;
		begin
			clrscr;
			gotoxy(28, 1); write('Rotina de Subtração');
			ENTRADA;
			x:= Calculo(A, B, '*');
			SAIDA;
		end;
	
		procedure ROT_DIVISAO;
		begin
			clrscr;
			gotoxy(32, 1); write('Rotina de Subtração');
			ENTRADA;
			x:= Calculo(A, B, '/');
			SAIDA;
		end;
	
		{ P R I N C I P A L }
		BEGIN
			OPCAO:='0';
			while (OPCAO  '5') do begin
				clrscr;
				gotoxy(33, 1); write('Menu principal');
				gotoxy(28, 6); write('1.....................Soma');
				gotoxy(28, 8); write('2............Subtracao');
				gotoxy(28, 10); write('3......Multiplicacao');
				gotoxy(28, 12); write('4................Divisao');
				gotoxy(28, 14); write('5..Fim do programa');
				gotoxy(28, 18); write('Escolha uma opcao ..........: ');
				readln(OPCAO);
				IF (OPCAO  '5') THEN
					case OPCAO OF
						'1': 	ROT_ADICAO;
						'2': ROT_SUBTRACAO;
						'3': ROT_MULTIPLICACAO;
						'4': ROT_DIVISAO;
					eLSE
						gotoxy(27, 25); writeln('Opcao invalida - tecle algo');
						OPCAO := readkey;
					end;
			end;
	
		END.
	
	

[pascal] Calculadora com uso de funções

program CalculadoraF;
USES
CRT;

FUNCTION ADICAO (A, B: REAL) : REAL;
begin
ADICAO:=A+B;
end;

FUNCTION SUBTRACAO (A, B: REAL) : REAL;
begin
SUBTRACAO:=A-B;
end;

FUNCTION MULTIPLICACAO (A, B: REAL) : REAL;
begin
MULTIPLICACAO:=A*B;
end;

FUNCTION DIVISAO (A, B: REAL) : REAL;
begin
DIVISAO:=A/B;
end;

VAR
NUM1, NUM2: real;

BEGIN
clrscr;

write(‘Informe o primeiro numero: ‘); readln(NUM1);
write(‘Informe o segundo numero: ‘); readln(NUM2);
writeln(‘ o resultado da adicao = ‘ , ADICAO(NUM1, NUM2):5:2) ;
writeln(‘ o resultado da subtracao = ‘, SUBTRACAO(NUM1, NUM2):5:2);
writeln(‘ o resultado da multiplicacao = ‘, MULTIPLICACAO(NUM1, NUM2):5:2);
writeln(‘ o resultado da divisao = ‘, DIVISAO(NUM1, NUM2):5:2);
writeln(‘————————————————————–‘);
END.

Marcado como: calculadora, clrscr, crt, function

[pascal] programa numero I Feng Shui da personalidade

Fiz esse programinha usando o método 2 do livro “Feng Shui e a Astrologia” de cálculo para obter o numero do I ching da personalidade do individuo. Funcionamento bem simples, o usuario digita o ano do seu nascimento e o programa retorna o numero.

program anoIChing;
		Uses
			CRT;
		var
			cAno: Array [1..4] of char; {ano em caracter, pois readkey só funciona com este}
			iAno: Array [1..4] of integer; {vou converter o caracter para inteiro para fazer conta}
			iChing, iSoma, c: integer; {simples contador}

		{Esse trecho somente PEGA e CONVERTE o que o ano que o usuario digita}
		Procedure entraAno;
		begin
			For c:=1 to 4 Do Begin
				cAno[c]:=readkey;
					Case cAno[c] of
							'0': iAno[c]:=0;
							'1': iAno[c]:=1;
							'2': iAno[c]:=2;
							'3': iAno[c]:=3;
							'4': iAno[c]:=4;
							'5': iAno[c]:=5;
							'6': iAno[c]:=6;
							'7': iAno[c]:=7;
							'8': iAno[c]:=8;
							'9': iAno[c]:=9;
					end;
				write(cAno[c]);
			end;
			
		end;	
		
		{Esse trecho somente IMPRIME o que o ano que o usuario digita}
		Procedure imprimeAno;
		Begin
			For c:=1 to 4 Do Begin
				write(iAno[c]);
			end;
		end;	
		
		{Esse trecho somente SOMA todos os digitos de ano}
		Procedure SomaAno;
		Begin
			iSoma:=0;
			For c:=1 to 4 Do Begin
				iSoma:=iAno[c]+iSoma;
			end;
		end;	
		
		{Esse trecho somente SOMA a SOMA de todos os digitos de ano}
		Procedure obtemIChing;
			var
				d, u, s: integer;
		Begin
			d:=ISoma div 10;
			u:=ISoma mod 10;
			s:=d+u;	
			iChing:=11-s;	
			write('I Ching   ', iChing, '  ');
		end;	


		Procedure descreveIChing;
		Begin
			Case iChing of
				1: 	Begin{agua}
						write('Agua (yin)');			
					End;
				2: 	Begin{Terra}
						 write('Terra (yin)');			
					End;
				3: 	Begin{Arvore}
						write('Arvore (yin)');			
					End;
				4: 	Begin{Arvore}
						write('Terra (yin');			
					End;
				5: 	Begin{Terra}
						 write('Terra (yine yang)');			
					End;
				6: 	Begin{Metal}
						 write('Metal (yiang)');			
					End;
				7: 	Begin{Metal}
						 write('Metal (yiang)');			
					End;
				8: 	Begin{Terra}
						write('Terra (yaing)');			
					End;
				9: 	Begin{Fogo}
						 write('Fogo (yiang)');			
					End;
			end;
		end;


	{  P R I N C I P A L              }
	Begin
		writeln; writeln; writeln;
		Write('Digite o ano de seu nascimento   :  ');entraAno;
		writeln;
		write('o numero que vc digitou foi :   ' ); imprimeAno;		
		writeln;
		writeln;
		somaAno;
		writeln;
		obtemIChing;
		descreveIChing;
		writeln;
		writeln;
		writeln;
		writeln;
		writeln;
	End.


Marcado como: case, procedure, readkey

[pascal] Procedures – Exemplo de subrotina – Calculadora

Esse exemplo faz uma calculadora simples usando um procedimento para cada operação. Também faz uso do Case, uma alternativas a if (s) aninhados.

	program CALCULADORA;
		uses
			CRT;
		var
			opcao: char;

	{ Sub-rotinas de  calculos - Adição }
	Procedure rot_adicao;
		var
			x, a, b: real;
		Begin
			clrscr;
			gotoxy(32, 1); write('Rotina de adição');
			gotoxy(5, 6); write('Entre um valor para   A: '); readln(a);
			gotoxy(5, 7); write('Entre um valor para   b: '); readln(b);
			x:=a+b;
			gotoxy(5,10); write('O resultado equivale a: ', x:6:2);
			gotoxy(25,24); writeln('Pressione  para voltar para o menu ');
			readln;
		end;

	{----------------------------------------------------------------------------------------------------------------------------------------------}	

	{ Sub-rotinas de calculos - Subtração }
	Procedure rot_subtracao;
		var
			x, a, b: real;
		Begin
			clrscr;
			gotoxy(32, 1); write('Rotina de adição');
			gotoxy(5, 6); write('Entre um valor para  A: '); readln(a);
			gotoxy(5, 7); write('Entre um valor para   b: '); readln(b);
			x:=a-b;
			gotoxy(5,10); write('O resultado equivale a:   ', x:6:2);
			gotoxy(25,24); writeln('Pressione  para voltar para o menu ');
			readln;
		end;
	{----------------------------------------------------------------------------------------------------------------------------------------------}	

	{ Sub-rotinas de calculos - Multiplicação}
	Procedure rot_multiplicacao;
		var
			x, a, b: real;
		Begin
			clrscr;
			gotoxy(32, 1); write('Rotina de adição');
			gotoxy(5, 6); write('Entre um valor para  A:   '); readln(a);
			gotoxy(5, 7); write('Entre um valor para   b:   '); readln(b);
			x:=a*b;
			gotoxy(5,10); write('O resultado equivale a: ', x:6:2);
			gotoxy(25,24); writeln('Pressione  para voltar para o menu ');
			readln;
		end;
	{----------------------------------------------------------------------------------------------------------------------------------------------}	

	{ Sub-rotinas dee calculos - Divisão }
	Procedure rot_divisao;
		var
			x, a, b: real;
		Begin
			clrscr;
			gotoxy(32, 1); write('Rotina de adição');
			gotoxy(5, 6); write('Entre um valor para  A:   '); readln(a);
			gotoxy(5, 7); write('Entre um valor para  b:   '); readln(b);
			x:=a/b;
			gotoxy(5,10); write('O resultado equivale a:   ', x:6:2);
			gotoxy(25,24); writeln('Pressione  para voltar para o menu ');
			readln;
		end;
	{----------------------------------------------------------------------------------------------------------------------------------------------}		

	BEGIN { PROGRAMA PRINCIPAL}

	textColor(yellow + blink); { altero a cor da fonte }
	textBackground(BLUE); { altero a cor do plano de fundo }

		clrscr;
		opcao:='0';
		while (opcao  < '5') do Begin
			clrscr;
			gotoxy(33,1);    write('Menu principal');
			gotoxy(22, 6);   write('1  Soma');
			gotoxy(22, 8);   write('2  Subtracao');
			gotoxy(22, 10); write('3 Multiplicacao');
			gotoxy(22, 12); write('4  Divisao');
			gotoxy(22, 14); write('5 Fim de programa');
			gotoxy(22, 18); write(' Escolha uma opcao ......: ');
			readln(opcao);

			Case opcao of
				'1': rot_subtracao;
				'2': rot_subtracao;
				'3': rot_multiplicacao;
				'4': rot_divisao
			Else
				Writeln('Byeee');
			end;
		end;
	END.

[pascal] Units

São rotinas prontas para seremusadas pelo programador. Unidades foram incorporadas com o intuirto deagrupar diversas rotinas básicas.
Uma unit é uma biblioteca de funções, procedimentose constantes. Em seguida estão relacionadas as unidades compilador Free Pascal

  • CRT – variáveis de geração de som, controle de video e teclado
  • DOS – permitem controles de baixo nivel, utilizando recursos do sistema operacional DOS.
  • GRAPH – manipulaçõa de capacidade gráfica de um PC
  • OVERLAY – Gerencia atividades de um programa. (memória)
  • PRINTER – usa a impressora como saída de informação
  • SYSTEM – Rotinas padrão do Pascal. Não precisa ser declarada.

Como utilizar: Uses <unidade>

Procedimentos e Funções muito utilizadas em CRT
clrscr – (procedimento) – limpa a tela
gotoxy(coluna, lina) – (procedimento) – posiciona o cursosr em um ponto da tela. Coluna de 1 a 80, linha de 1 a 25.
readkey – (função) – retorna o valor da tecla pressionada. Faz leiturade apenas um caractere (e não é necessário pressionar <ENTER>)

Marcado como: crt, dos, graph, printer, system, unit

[pascal] Tipo Registro / type record

Um exemplo de aplicações prática do tipo registro.
Esse exemplo lê o nome e as 4 notas de 8 alunos. Ordena em crescente pelo o nome e exibe um a um.

		program LEITURA_ORDENACaO_ESCRITA;
		type
		    bimestre = array[1..4] of real;
		    cad_aluno= record
		        nome: string;
		        nota: bimestre;
		end;

		var
		    aluno: array[1..8] of cad_aluno;
		    i, j, atual, proximo: byte;
		    x: cad_aluno;
		BEGIN
		    {Rotima de entrada de dados}
		    writeln('CADASTRO DE ALUNOS');
		    writeln;
		    for j:= 1 to 8 do Begin
		        write('Informe o nome do ', j:2, 'o. aluno   :');  readln(aluno[j].nome);
		        writeln;
		        for i:=1 to 4 do Begin
		            write(' Informe a ', i:2, 'a. nota   :'); readln(aluno[j].nota[i]);
		        end;
		        writeln;
		    end;
		    writeln;

		    {Rotina de ordenação}
		    for atual:=1 to 7 do Begin
		        for proximo:= atual+1 to 8 do Begin
		            if (aluno[atual].nome > aluno[proximo].nome) then Begin
		                x:= aluno[atual];
		                aluno[atual] := aluno[proximo];
		                aluno[proximo] := x;
		            end;
		        end;
		    end;

		    {Rotina de saída  }
		    writeln;
		    for j:= 1 to 8 do Begin
		        writeln('Nome aluno: ', j:2, '  :  ', aluno[j].nome);
		        writeln;
		        for i:= 1 to 4 do Begin
		            writeln('Nota ', i, '  :  ', aluno[j].nota[i]:5:2);
		        end;
		        Writeln;
		        writeln('Tecle  para ver o proximo: '); readln;
		    end;
		    writeln;
		        writeln('Tecle  para encerrar: '); readln;
		END.

[free pascal] Estruturas de dados heterogêneas 1

program LEITURA_ESCRITA;
type
bimestre=array[1..4] of real;
cadaluno = record
nome: string;
nota: bimestre;
end;
var
aluno: cadaluno;
i: byte;
BEGIN
writeln(‘Cadastro de aluno’);
writeln;
write(‘Informe o nome … : ‘); readln(aluno.nome);
writeln;
for i:= 1 to 4 do Begin
write(‘Informe a ‘, i:2, ‘a. nota .. : ‘);
readln(aluno.nota[i]);
end;
writeln;
writeln;
writeln(‘Nome …: ‘, aluno.nome);
writeln;
for i:= 1 to 4 do Begin
writeln(‘Nota ‘, i, ‘   :  ‘, aluno.nota[i]:5:2);
end;
writeln;
writeln(‘Tecle <ENTER> para encerrar: ‘); readln;
END.

[free pascal] Matriz com duas dimensões ex.2

O exemplo abaixo é um programa de agenda. Possui uma tabela com 5 colunas com os dados (nome, endereco, cepo, bairro e telefone) e 10 linhas (com os nomes dos cadastrados).

program AGENDA;
var
dado: array[1..10, 1..5] of string;
i, j, atual, proximo: integer;
x: string;
BEGIN
{Rotina de entrada}
writeln(‘Programa agenda’);
writeln;
for i:=1 to 10 do Begin
write(‘Nome …..:’); readln(dado[i,1]);
write(‘Endereco..:’); readln(dado[i,2]);
write(‘CEP… …..:’); readln(dado[i,3]);
write(‘Bairro…..:’); readln(dado[i,4]);
write(‘Telefone..:’); readln(dado[i,5]);
writeln;
end;

{Ordenação e troca de elementos}
for atual:=1 to 9 do Begin
for proximo:=atual+1 to 10 do Begin
{troca nome}
x:=dado[atual,1];
dado[atual, 1]:= dado[proximo,1];
dado[proximo, 1]:=x;
{troca endereco}
x:=dado[atual,2];
dado[atual, 2]:= dado[proximo,2];
dado[proximo, 2]:=x;
{troca CEP}
x:=dado[atual,3];
dado[atual, 3]:= dado[proximo,3];
dado[proximo, 3]:=x;
{troca Bairro}
x:=dado[atual,4];
dado[atual, 4]:= dado[proximo,4];
dado[proximo, 4]:=x;
{troca Telefone}
x:=dado[atual,5];
dado[atual, 5]:= dado[proximo,5];
dado[proximo, 5]:=x;
end;
end;

{Saida de dados}
for i:=1 to 10 do Begin
for j:=1 to 5 do Begin
writeln(dado[i,j]);
end;
writeln;
end;

writeln(‘Tecle <ENTER> para encerrar: ‘); readln;
END.

[free pascal] Exemplo de matriz com duas dimensões

O exemplo abaixo se trata de uma tabela, onde são inseridas e exibidas 4 notas de 8 alunos.

program NOTA_ALUNO;
var
notas: array [1..8, 1..4] of real;
i,j: integer;
BEGIN
writeln(‘Leitura e aporesentação de notas’);
writeln;
for i:=1 to 8 do Begin
writeln;
writeln(‘Entre as notas do ‘, i:2, ‘o. aluno’);
for j:=1 to 4 do begin
writeln(‘Nota ‘, j:2, ‘: ‘);
readln(notas[i,j]);
end;
end;
writeln;
for i:=1 to 8 do Begin
write(‘As notas do aluno ‘, i:2, ‘são:  ‘);
for j:=1 to 4 do Begin
write(notas[i,j]:5:2, ‘  ‘);
writeln;
end;
end;
writeln;
writeln(‘Tecle <enter> para encerrar: ‘); readln;
END.

Marcado como: array, for, matriz

[free pascal] Métodos de Pesquisa 2: Pesquisa binária

Dividir e conquistar é o lema desse método. Ordena os dados para localiza-lo posteriormente usando o método de pesquisa binária.

{
1. Iniciar um contador, pedir a leitura de dez nomes e colocalos em ordem alfabetica
2. Criar um looping que efetue a pesquisa enquanto o usuario desejar
Durante a fase de pesquisa, deve ser solicitada a informação a ser pesquisada.
Essa informação deve ser comparada, utilizando o método de pesquisa binária
Sendo igual, mostra; caso contrário, avança para o próximo. Senão achar em toda lista, informar que não existe o lelemneto pesquisado; se existir, deve mostra-lo
3. Encerrar a pesquisa quando desejando
}

program PESQUISA_BINARIA;
var
nome: array [1..10] of string;
i, j: integer;
comeco, final, meio: integer;
pesq, resp, x: string;
acha: boolean;
BEGIN
writeln(‘Pesquisa binaria de nomes: ‘);
writeln;
for i:=1 to 10 do
begin
write(‘Digite o ‘, i:2, ‘o nome: ‘); readln(nome[i]);
end;

{Ordenando os nomes }
for i:= 1 to 9 do
for j:= i+1 to 10 do
if (nome[i] > nome[j]) then
begin
x:= nome[i];
nome[i]:=nome[j];
nome[j]:=x;
end;
{Pesquisando..}
resp:=’sim’;
while (resp=’sim’) or (resp=’SIM’) do
begin
writeln;
write(‘Entre o nome a ser pesquisado: ‘); readln(pesq);
comeco:=1;
final:=10;
acha:=false;
while (comeco <=final) and (acha=false) do
begin
meio:=(comeco+final) div 2;
if (pesq=nome[meio]) then
acha:=true
else
if (pesq < nome[meio]) then
final:=meio-1
else
comeco:=meio+1;
end;

if (acha=true) then
writeln(pesq, ‘ foi localizado na posicao ‘, meio:2)
else
writeln(pesq, ‘ não foi localizado’);
writeln;
write(‘Deseja continuar? sim/nao: ‘);
readln(resp);
end;

END.