Exemplos de Lógica em Pascal

Fazer um programa para calcular o consumo de um veículo(km por litro). São dados: Quilometragem Inicial, Quilometragem final e Consumo.

Algoritmo Calcula_Consumo;
Real : kmini, kmfim, consumo, kmlitro;
Início
        Leia(kmini, kmfim, consumo);
        kmlitro <- (kmfim-kmini) / consumo;
        imprima(kmlitro);
Fim.

Fazer um algoritmo para calcular valores em reais a partir de valores em dólares(conversão de moeda). São dados: Quantia em dólares e cotação do dólar.

Algoritmo Calcula_Valor_Real;
Real : tovalreal, totdolar, cotdolar;
Início
        Leia(totdolar,cotdolar);
        Totvalreal <- totdolar * cotdolar;
        Imprima(totvalreal);
Fim.

Construir um algoritmo para calcular o valor de uma conta de luz, sendo dados: Nome do Consumidor, Quantidade de KWATS/HORA consumidos. Sabe-se que a taxa(fixa) é de R$ 10,00 e o valor é de R$ 0,15 por KWATS/HORA. Imprima: Nome do consumidor, Consumo e valor da conta.

Algoritmo Conta_de_Luz;
Cadeia : Consumidor;
Real : kwh, valor;
Início
        Leia(consumidor,kwh);
        Valor <- 10 + kwh * 0,15;
        Imprima(consumidor,kwh,valor);
Fim.

Desenvolver um algoritmo para calcular o preço final de um produto, sendo dados: preço normal da mercadoria e taxa de desconto.

Algoritmo Preço_Final;
Real : preço, taxa, desconto;
Início
        Leia(preço,taxa);
        Desconto <- preço – preço * taxa /100;
        Imprima(desconto);
Fim.

Construir um algoritmo para calcular o montante de um capital aplicado, sendo informado: valor do capital e rendimento(%).

Algoritmo Calcula_Montante;
Real : capital, rendimento, montante;
Início
        Leia(capital,rendimento);
        Montante <- capital + capital * rendimento / 100;
        Imprima(montante);
Fim.

Fazer um algoritmo para calcular o valor do desconto do imposto de renda em um salário bruto até R$ 500 isento(Acima de R$900 – 10% de desconto. Imprimir o valor do desconto e o salário líquido.

Algoritmo Calcula_Imposto_Renda;
Real : salbruto, desconto, salliq;
Início
        Leia(salbruto);
        Se   salbruto <= 900 então
               Desconto <- 0;
        Senão
                Desconto <- Salbruto * 0,1;
        Fim_Se;
Fim.

Exemplo de Programas de Pascal

Uma empresa paga para seus vendedores um valor por km rodado que depende da quilometragem da viagem.

Tabela de Valores de Taxas:
KM Valor
Até 200Km R$ 0.50
Acima de 200 … 600Km R$ 0.40
Acima de 600Km R$ 0.30
Faça um programa que leia o nome do viajante, a quilometragem da viagem e mostre na tela o nome do viajante e o valor a receber

Program Calcula_Kilometragem;
Uses Crt;
Var
     km, valor : real;
     nome : string[40];
Begin
        Textbackground(1);
        Textcolor(15);
        clrscr;
        Write('Digite Nome Viajante: ');
        Readln(nome);
        Write('Digite KM Rodados: ');
        Readln(km);
        If km <= 200 then
            valor := km * 0.50
        else
            if km > 600 then
                valor := km * 0.30
            else
                valor := km * 0.40;
        Write('Nome Viajante: ',nome,' Valor a Receber: ',valor:6:2);
        readkey;
End.

Fezer um programa para calcular o salário de um funcionário. São dados o nome do funcionário, valor hora e quantidade de horas trabalhadas. Calcular e mostrar o Salário Total do Funcionário.

Program Calcula_salario;
Uses crt;
Var
    nomefunc : string[40];
    numhoras, valorhora, TotalGeral : real;
Begin
        clrscr;
        Write('Digite Nome Funcionário: ');
        Readln(nomefunc);
        Write('Digite Número de Horas: ');
        Readln(numhoras);
        Write('Digite Valor Hora: ');
        Readln(valorhora);
        TotalGeral := numhoras * valorhora;
        Write('Nome do Funcion rio: ',nomefunc,' Salário Total: ',totalgeral:6:2);
        readkey;
End.

Fazer um programa para controlar a entrada de funcionários numa empresa. São fornecidos o nome da pessoa e o departamento. Dentro desta empresa existem 4 departamentos(Pessoal, Finaceiro, Jurídico e Comercial).Caso a pessoa for de um dos dptos fazer a respectiva contagem. Ao final mostrar a quantidade de pessoas de cada departamento

Program Entrada;
uses crt;
var
    codigo,cont,cont1,cont2,cont3,cont4 : integer;
    idade,media,somaidade : real;
    nome,departamento : string[40];
begin
        textbackground(1);
        clrscr;
        textcolor(15);
        writeln(' Loucos S/A');
        textcolor(5);
        write('Código: '); readln(codigo);
        write('Nome: '); readln(nome);
        write('Idade: '); readln(idade);
        write('Departamento: '); readln(departamento);
        textcolor(8);
        cont:=cont+1;
        if departamento='Pessoal' then
            writeln('Funcionários do Departamento Pessoal: ',cont1+1)
        else
            if departamento='Financeiro' then
                writeln('Funcionários do Departamento Financeiro: ',cont2+1)
            else
                    if departamento='Jurídico' then
                        writeln('Funcionários do Departamento Jurídico: ',cont3+1)
                    else
                          writeln('Funcion rios do Departamento Comercial: ',cont4+1);
        somaidade:=somaidade+idade;
        media:=somaidade/cont;
        write('Média das Idades: ',media:2:2);
        readkey;
end.

Fazer um programa para calcular o valor do desconto do imposto de renda em um salário. São fornecidos o nome do Funcionário; Salário bruto até R$ 900 é isento; acima de R$ 900 até R$ 1800 desconto de 20%; acima de 1800 desconto de 30%. Mostrar na tela o Nome do Funcionário, Desconto e o Sal rio Líquido

Program Calcula_Salario_Liquido;
Uses Crt;
Var
    nome : string[4];
    saliq, desconto, salbruto : real;
Begin
        Textbackground(1);
        Textcolor(15);
        clrscr;
        Write('Digite Nome Funcinário: ');
        Readln(nome);
        Write('Digite Sal rio Bruto: ');
        Readln(salbruto);
        If salbruto <= 900 then
            desconto := 0
        else
            if  salbruto > 1800 then
                desconto := salbruto * 0.30
            else
                  desconto := salbruto * 0.20;
        Saliq := salbruto - desconto;
        Write('Nome Funcinário: ',nome,' Desconto: ',desconto:6:2,
        ' Sal rio L¡quido: ',saliq:6:2);
        readkey;
End.

Case - Esta Instrção nos permite selecionar uma opção baseada no valorde uma vari vel ou expressão

Sintaxe:
Case <expressão ou variável> of
        <valor1> : Comando_1;
        <valor2> : Comando_1;
        ...
        <valorn> : Comando_n;
End;

Fazer um programa para identificar o sexo e a idade das pessoas da cidade de Indaial. São fornecidos o nome da pessoa, sexo e idade. Caso o sexo digitado for M, F ou I fazer uma contagem dos sexos digitados. Se a idade das pessoas for maior ou igual a 50 enviar uma mensagem do tipo 'Pessoas da Segunda Idade e somar as idades. Se a idade for menor de 50 mostrar uma mensagem do tipo 'Pessoas na flor da idade' e tamb‚m fazer a respectiva somatória das idades. Ao final mostrar a m‚dia das idades e dos sexos.

Program Calc_Sexo;
Uses crt;
Var
    nome : string[40];
    sexo : char;
    idade, somaidades, mediasexo, mediaidade : real;
    contasexo : integer;
Begin
        textcolor(47);
        textbackground(1);
        clrscr;
        writeln(' !! Medias !!');
        textcolor(3);
        write('Digite seu nome: '); readln(nome);
        write('Digite seu sexo (m/f/i): '); readln(sexo);
        write('Digite sua idade: '); readln(idade);
        case sexo of
                'm' : begin
                                writeln('Sexo: Masculino!');
                                contasexo:=contasexo+1;
                                writeln('Masculino:',contasexo);
                        end;
                'f' : begin
                                writeln('Sexo: Feminino');
                                contasexo:=contasexo+1;
                                writeln('Feminino: ',contasexo);
                     end;
                'i' : begin   
                            writeln('Sexo: Indefinido');
                            contasexo:=contasexo+1;
                            writeln('Indefinido: ',contasexo);
                     end;
        end;
        mediasexo:=contasexo;
        if idade >50 then
            begin
                    writeln('Pessoas da segunda idade!');
                    somaidades:=somaidades+idade;
            end
        else
               begin
                       writeln('Pessoas na flor da idade');
                        somaidades:=somaidades+idade;
                end;
        mediaidade:=idade/somaidades;
        writeln('Média sexos: ',mediasexo:6:2);
        writeln('Média idades: ',mediaidade:6:2);
        readkey;
end.

Fazer um programa utilizando a instrução case que calcula a soma(+), ou a multiplicação(*), ou a subtração(-), ou a divisão(/) entre dois números lidos do teclado.

Program Calculadora;
Uses Crt;
Var
    num1, num2 : real;
    sinal : char;
Begin
        textcolor(15);
        Textbackground(1);
        clrscr;
        Write('Digite 1º Número: ');
        Readln(num1);
        Write('Digite 2º Número: ');
        Readln(num2);
        Writeln;
        Write('Digite Sinal de Operação: ');
        sinal:=readkey;
        Writeln(sinal);
        Writeln;
        Case sinal of
                '+': Write('Soma dos valores -> Num1 + Num2: ',num1+num2:6:2);
                '-': Write('Diferença dos valores -> Num1 - Num2:',num1-num2:6:2);
                 '*': Write('Multiplicação dos valores -> Num1 * Num2:',num1*num2:6:2);
                '/': Write('Divisão dos valores -> Num1 / Num2: ',num1/num2:6:2);
        Else
                Write(sinal,' Não é Sinal de Operação');
        end;
        Readkey;
End.

Para -> Realiza um looping(repetição ou laço) a partir de um número determinado de vezes. O looping ser  realizado no m¡nimo uma vez

Sintaxe:
Para X de Y at‚ Z Faça
        Comando1;
        Comando2;
        ...
        ComandoN;
Fim_Para;

Fazer um programa para calcular a m‚dia de 8 alunos de uma determinada turma. São fornecidos o número do contrato, o nome e suas três notas.Para cada aluno digitado mostrar sua média. Ao final mostrar a m‚dia Geral da turma.

Program Media_for;
Uses Crt;
Var
    ctr, x : integer;
    nome : string[40];
    nota1, nota2, nota3, media, somanota, mediageral : real;
Begin
        Textbackground(1);
        Textcolor(15);
        clrscr;
        For x:=1 to 5 do
            begin
                    writeln;
                    Write('Digite Contrato..[',x,']: '); Readln(ctr);
                    Write('Digite Nome aluno[',x,']: '); Readln(nome);
                    Write('Digite Nota1.....[',x,']: '); Readln(nota1);
                    Write('Digite Nota2.....[',x,']: '); Readln(nota2);
                    Write('Digite Nota3.....[',x,']: '); Readln(nota3);
                    writeln;
                    media := (nota1 + nota2 + nota3) /3;
                    somanota := somanota + media;
            end;
        mediageral := somanota /5;
        Write('M‚dia Geral da Turma: ',mediageral:6:2);
        readkey;
End.

A conversão de graus Farenheit para Centígrados é obtida por Cent¡grados = 5 * (Farenheit - 32) /9. Fazer um programa para calcular e mostrar uma tabela de graus cent¡grados em função de graus Farenheit, que variam de 50 a 150.

Program Media_for;
Uses Crt;
Var
    f : integer;
    c : real;
Begin
        Textbackground(1);
        Textcolor(15);
        clrscr;
        For f := 50 to 70 do
            Begin
                    c := 5 * (f - 32) /9;
                    Writeln(c:6:2);
            End;
        readkey;
End.

Solicitar um conjunto de dados contendo a altura e sexo (M,F) de 6 pessoas.
Fazer um programa que calcule e escreva:
- A maior e a menor altura do grupo, indicando qual o sexo de cada um;
- A média da altura das mulheres;
- O número de homens

Program Dados;
Uses Crt;
Var
   alt,  mediaf, menoralt, somaltf, maioralt : real;
   contf, conth, x : integer;
   sexo : char;
Begin
      clrscr;
      menoralt := 3;
      maioralt := 0;
      For x:=1 to 6  do
          Begin
               Write('Digite Sexo (f,m): '); Readln(sexo);
               Write('Digite Altura....: '); Readln(alt);
               If alt > maioralt then
                  maioralt := alt;
               If alt < menoralt then
                  menoralt := alt;
               If sexo = 'f' then
                  Begin
                       somaltf := somaltf + alt;
                       inc(contf);
                  End
               else
                   inc(conth);

          End;
      mediaf := somaltf / contf;
      Writeln('Média Sexo Feminino.: ',mediaf);
      Writeln('Maior Altura........: ',maioralt);
      Writeln('Menor Altura........: ',menoralt);
      Writeln('Quantidade de Homens: ',conth);
End.

Fazer um programa que leia um número indeterminado de valores nome, sobrenome e telefone). Fazer a cocatenação no nome com o sobrenome. Se o nome digitado for igual a 'fim' calcular e mostrar a idade média do grupo de indiv¡duos e a maior idade encontrada

Program Valores_Indeterminados;
Uses crt;
Var
nome, sobrenome : string[15];
juncao : string[40];
idade, somaidade, mediaidade, maioridade : real;
cont : integer;
Begin
        textcolor(15);
        Textbackground(1);
        clrscr;
        maioridade := 0;
        Gotoxy(05,05);
        Write('Digite Nome: '); Readln(nome);
        while nome <> 'fim' do
        Begin
                Gotoxy(05,06);
                Write('Digite Sobrenome: '); Readln(sobrenome);
                Gotoxy(05,07);
                Write('Digite Idade: '); Readln(idade);
                If idade > maioridade then
                    Begin
                            maioridade := idade;
                            somaidade := somaidade + Idade;
                            inc(cont);
                    End;
                juncao := concat(nome,' ',sobrenome);
                Gotoxy(05,08);
                Write('Nome Completo: ',juncao);
                readkey;
                clrscr;
                Gotoxy(05,05);
                Write('Digite Nome: '); Readln(nome);
        End;
        if cont <> 0 then
        Begin
                mediaidade := somaidade / cont;
                Gotoxy(05,09);
                write('A média da Idade ‚: ',mediaidade:6:2);
        end
        else
               begin
                        write('O contador não pode ser Zero');
                end;
        Gotoxy(05,10);
        write('A maior Idade ‚: ',maioridade:6:2);
        readkey;
End.

Têm-se disponíveis as informações dos funcionários de uma empresa, cujos dados são: número do vendedor, salario fixo, total de vendas por ele efetuadas, percentual que ele recebe sobre o total de vendas. Para encerrar o programa, ser  fornecido zero como n£mero de vendedor. Escrever um programa para ler os dados anteriores, calcular e mostrar o número e o sal rio total de cada vendedor. No final, imprimir o salário médio da empresa e o valor do maior sal rio total calculado.

Program Salario_Total;
Uses Crt;
Var
    salfixo, totvendas, percentual, saltotal, salmedio, maiorsalario,
    somasal : real;
    numvend, contvend : integer;
Begin
        textcolor(15);
        textbackground(1);
        clrscr;
        maiorsalario := 0;
        Gotoxy(05,05);
        Write('Digite Número Vendedor: '); Readln(numvend);
        while numvend <> 0 do
        Begin
                Gotoxy(05,06);
                Write('Salário Fixo: '); Readln(salfixo);
                Gotoxy(05,07);
                Write('Total de Vendas: '); Readln(totvendas);
                Gotoxy(05,08);    
                Write('Percentual: '); Readln(percentual);
                saltotal := (salfixo + totvendas) * percentual/100;
                Gotoxy(05,09);
                Write('Número Vendedor: ',numvend, ' Total salário: ',saltotal);
                If saltotal > maiorsalario then
                Begin
                        maiorsalario := saltotal;
                end;
                inc(contvend);
                somasal := somasal + saltotal;
                clrscr;
                Gotoxy(05,05);
                Write('Digite Número Vendedor: '); Readln(numvend);
          end;
          salmedio := somasal/contvend;
          Gotoxy(05,10);
          Write('Salário Médio Vendedor: ',salmedio:6:2);
          Gotoxy(05,11);
          Write('Maior Salário: ',maiorsalario:6:2);
          readkey;
end.

Fazer um programa para Concatenar duas Palavras. São fornecidas a 1ª Palvra e a 2ª Palavra.

Program Concatena;
Uses Crt;
Var
    frase : string;
    palavra1 : string;
    palavra2 : string;
Begin
        textcolor(15);
        textbackground(1);
        clrscr;
        Gotoxy(05,05);
        Write('Digite 1ª palavra: '); Readln(palavra1);
        Gotoxy(05,07);
        Write('Digite 2ª palavra: '); Readln(palavra2);
        frase := Concat(palavra1,' ',palavra2);
        Gotoxy(05,08);
        write(frase);
        readkey;
End.

Supondo que a populacao de um pais A seja da ordem de 900000000 de habitantes com uma taxa anual de crescimento de 3% e que a populacao de um pais B seja, aproximadamente 200000000 de habitantes com uma taxa anual de crescimento de 1.5%, fazer um programa que calcule e mostre o numero de anos necessarios para que a populacao do pais B ultrapasse ou se iguale … populacao do pais A, mantidas essas taxas de crescimento

Program populacao;
Uses crt;
Var
    popa, popb : real;
    numanos : integer;
Begin
        textcolor(15);
        textbackground(1);
        clrscr;
        popa := 900000000;
        popb := 200000000;
        numanos := 0;
        while popb <= 900000000 do
                Begin
                        popa := popa + (popa * 3/100);
                        popb := popb + (popb * 1.5/100);
                        inc(numanos);
                end;
        write('Quantidade de Anos: ',numanos);
        readkey;
End.

Construir um programa para calcular e imprimir o valor da raiz quadrada de um numero informado. Continuar com a execucao enquanto nao for digitado 0 para o numero}

Program RaizQuadrada;
Uses Crt;
var
    numero : real;
Begin
        textbackground(1);
        textcolor(15);
        clrscr;
        gotoxy(5,5);
        Write('Digite Numero: ');
        Read(numero);
        Repeat
                gotoxy(5,6);
                Write(sqrt(numero):6:2);
                textbackground(1);
                textcolor(15);
                gotoxy(5,5);
                Write('Digite Numero: ');
                Read(numero);
        Until numero = 0;
End.

Elabore um algoritmo para calcular o fatorial de um numero informado. Deve-se continuar solicitando numeros e calculando seu fatorial enquanto o usuario querer continuar.

Program Calc_Fatorial;
Uses Crt;
Var
    fatorial : real;
    contador, numero : integer;
    continua : char;
Begin
        textcolor(15);
        textbackground(1);
        clrscr;
        fatorial := 1;
        numero := 0;
        repeat
                Begin
                        gotoxy(05,05); write('Informe um numero: '); Readln(numero);
                        fatorial := 1;
                        for contador :=1 to numero do
                            Begin
                                    fatorial := fatorial * contador;
                            End;
                        gotoxy(05,06); write('O fatorial ‚: ',fatorial:6:2);
                        gotoxy(05,07); write('Deseja Continuar? (s/n):'); Readln(continua);
                        clrscr;
                End;
        until (continua <> 's');
End.

Foi feito uma pesqusa para saber quanto a preferencia de times de futebol do Bairro Warnow de Indaial. Para cada entrevistado foi solicitado: o time (1 - Vasco da Gama(Glorioso), 2 - Palmeiras), a idade e o sexo. Calcular e mostrar:

- A maior torcida;
- A media da idade de cada torcida;
- O percentual de torcedores do sexo feminino do palmeiras em relacao ao total de mulheres e
- O percentual de torcedores do sexo masculino do Vasco da Gama em relacao ao total de homens.
OBS: Foram entrevistadas 50 pessoas}

Program Times_Futebol;
Uses Crt;
Var
    idade, percf, percm, somapalmeiras, mediavasco,                      mediapalmeiras, somavasco : real;
    totf, totm, contpalmeiras, contvasco, x, time,          totpalmeirasf, totvascom : integer;
    sexo : char;
    maiortorcida : string[15];
Begin
    textcolor(15);
    textbackground(1);
    clrscr;
    For x := 1 to 5 do
        Begin
            gotoxy(05,05);
            Write('Digite Time("1" - Vasco da Gama ou "2" -     Palmeiras: ');
            Readln(time);
            gotoxy(05,06); Write('Digite Sexo (f ou m): ');     Readln(sexo);
            gotoxy(05,07); Write('Digite Idade: ');
            Readln(idade);
            Case time of
                1 : Begin
                        inc(contvasco);
                        somavasco := somavasco + idade;
                        If sexo = 'm' then
                            inc(totvascom);
                    End;
                2 : Begin
                        inc(contpalmeiras);
                        somapalmeiras := somapalmeiras + idade;
                        If sexo = 'f' then
                            inc(totpalmeirasf);
                     End;
            end;
            If sexo = 'f' then
                inc(totf)
            else
                inc(totm);
            clrscr;
        End;
    percf := totpalmeirasf/totf*100;
    percm := totvascom/totm*100;
    If contvasco > contpalmeiras then
        maiortorcida := 'Vasco da Gama'
    else
        maiortorcida := 'Palmeiras';
   
mediavasco := somavasco / contvasco;
mediapalmeiras := somapalmeiras / contpalmeiras;
gotoxy(05,08); Write('Media Idade Vasco....:',mediavasco:6:2);
gotoxy(05,09); Write('Media Idade Palmeiras:',mediapalmeiras:6:2);
gotoxy(05,10); Write('Percentual Feminino do Palmeiras.....: ',percf:6:2);
gotoxy(05,11); Write('Percentual Masculino do Vasco da Gama: ',percm:6:2);
gotoxy(05,12); Write('Maior Torcida: ',maiortorcida);
readkey;
End.

Array

Imagine que nós precisemos declarar 100 variáveis do tipo integer, isso poderia ser feito da seguinte forma:

Var i1,i2,i3,i4,...,i100 : Integer;

Embora isso pareça uma brincadeira (de mal gosto), ‚ possível. Mas podemos também dizer que ‚ um grande incômodo. E se além dessas 100 variáveis, precisarmos também 1000 do tipo Char ou 2000 ou ... . Como podemos ver, as coisas podem se complicar. Mas para quem acessa BBS, coisa de louco, então o cara pode achar MUITO LEGAL. (:-)) 

Arrays Unidimensionais

Turbo Pascal nos fornece um tipo de dado estruturado chamado Array, que nos permite criar um grande número de variáveis de determinado tipo, sem os inconvenientes anteriores.

Exemplo 1:

Type Arranjo = Array[1..100] of Integer;

Var i : Arranjo;

ou

Var i : Array[1..100] of Integer;

Após a declaração acima, teríamos definidas 100 variáveis do tipo Integer, cujos nomes seriam:

i[1] - i[2] - i[3] - . . . - i[100]

Exemplo 2:

Type

faixa = 1..2000;

Arranjo = Array[faixa] Of Char;

Var

Arranjo_simples : Arranjo;

Após as declarações acima, teríamos definidas 2000 variáveis do tipo char com o nome Arranjo_simples.

Fazer um programa que leia 10 numeros inteiros do teclado e os escreve na tela ao contrario do que foram lidos

Program arqarray;
Uses Crt;
Var
    vetor : Array[1..10] of Integer;
    x : Integer;
Begin
    ClrScr;
    For x:=1 to 10 do
        Begin
            Write('vetor[',x,']: ');
            Readln(vetor[x]);
        End;
    ClrScr;
    For x:=10 downto 1 do
        writeln(vetor[x]);
    readkey;
End.

Fazer um programa que leia 10 nomes e idades do teclado e ao final mostre o nome da pessoa com a maior idade.

Program array_Maior_Idade;
Uses Crt;
type
        faixa = 1..10;
Var
    Nomes : Array[faixa] of string[30];
    Idade : Array[faixa] of integer;
    x, maioridade : Integer;
    Nomemaioridade : string[30];
Begin
        textcolor(15);
        textbackground(1);
        ClrScr;
        MaiorIdade := 0;
        For x:=1 to 10 do
            Begin
                    Write('Digite ',x:2,'º Nome: '); Readln(nomes[x]);
                    Write('Digite Idade...: '); Readln(idade[x]);
                    if idade[x] > maioridade then
                        Begin
                                maioridade := idade[x];
                                nomemaioridade := nomes[x];
                        End;
            End;
        ClrScr;
        Writeln('Nome da pessoa com Maior Idade: ',nomemaioridade);
        Writeln('A Maior Idade da Pessoa e.....: ',maioridade,' anos.');
        readkey;
End.

Elaborar um programa para calculo de media de notas de 5 alunos. Sao dados o nome do aluno, nota1, nota2, e nota3. Calcular e mostrar a media de cada aluno, media geral da turma, o nome do aluno com a maior e menor media e sua respectiva media. Tambem e necessario ao final listar todos os nomes e notas dos alunos

Program Array_Media_Alunos;
Uses crt;
type
    faixa = 1..5;
Var
    nome : array[faixa] of string[30];
    nota1: array[faixa] of real;
    nota2: array[faixa] of real;
    nota3: array[faixa] of real;
    menormedia, maiormedia, media, mediageral, somamedia      :real;
    x : integer;
    nomemenormedia, nomemaiormedia : string[30];
Begin
    textcolor(1);
    textbackground(15);
    clrscr;
    maiormedia := 0;
    menormedia := 99;
    somamedia := 0;
    for x:=1 to 5 do
    Begin
        Writeln('Öndice[',x,']');
        Write('Digite Nome.: '); Readln(nome[x]);
        Write('Digite Nota1: '); Readln(nota1[x]);
        Write('Digite Nota2: '); Readln(nota2[x]);
        Write('Digite Nota3: '); Readln(nota3[x]);
        media := (nota1[x] + nota2[x] + nota3[x])/3;
        If media > maiormedia then
        Begin
            maiormedia := media;
            nomemaiormedia := nome[x];
        End;
        If media < menormedia then
        Begin
            menormedia := media;
            nomemenormedia := nome[x];
        End;
        Writeln('Media: ',media:6:2);
        readkey;
        clrscr;
        somamedia := somamedia + media;
    End;
    mediageral := somamedia / x;
    clrscr;
    For x :=1 to 5 do
    Begin
        Writeln('Nome nº',x,']',nome[x]);
        Writeln('Nota1: ',nota1[x]:6:2);
        Writeln('Nota2: ',nota2[x]:6:2);
        Writeln('Nota3: ',nota3[x]:6:2);
    End;
    Writeln('Media Geral: ',mediageral:6:2);
    Writeln('Nome Aluno com Maior Media:      ',nomemaiormedia,'M‚dia: ',maiormedia:6:2);
    Writeln('Nome Aluno com Menor Media: ',nomemenormedia,'M‚dia: ',menormedia:6:2);
    readkey;
End.

PROCEDURES
Definição

Uma das técnicas mais utilizadas e tida como vantajosa na confecção de programas grandes ‚ a modularização. Consiste em dividir o programa em diversos módulos ou sub-programas, de certa forma independentes uns dos outros. Existe um módulo que ‚ o principal, a partir do qual são chamados os outros módulos, esse módulo recebe o nome de programa principal, enquanto que os outros são chamados de sub-programas. No sistema Turbo Pascal, existem dois tipos de sub-programas, a saber:

- Procedures (procedimentos)
- Functions (funções)

A procedure ‚ como se fosse um programa. Ela tem a estrutura praticamente igual a de um programa, como veremos mais adiante. A procedure deve ser ativada(chamada) pelo programa principal ou por uma outra procedure, ou até por ela mesma.

 Declaração de Procedures

Uma procedure tem praticamente a mesma estrutura de um programa, ou seja, ela contém um cabeçalho,  área de declarações e o corpo da procedure. Na  área de declarações, podemos ter as seguintes sub-áreas:

Label - Const - Type - Var - Procedures - Functions.

Devemos salientar que tudo que for declarado dentro das sub-áreas só ser  reconhecido dentro da procedure. Mais para frente, voltaremos a falar sobre isso.

{Fazer um programa que preencha a tela inteira com asterisco(*)}

Program Asterisco; (* cabecalho do programa *)
Uses CRT;
Procedure linha; (* cabecalho da procedure linha *)
Var
    x : integer; (* sub-area Var da procedure linha *)
    y : integer;
Begin (* corpo da procedure linha *)
    for x:=1 to 80 do
        for y:=1 to 25 do
            write('*');
End;

Begin (* corpo do programa principal *)
    ClrScr;
    linha; (* ativacao da procedure linha *)
    readkey;
End.

{Elaborar um programa utilizando passagem de parametros para fazer asoma de dois valores}

Program Somatoria;
Uses CRT;
Var
    x,y:integer;
Procedure soma(x,y:integer);
Begin
        writeln(x+y);
end;
Begin
        ClrScr;
        soma(3,4);
        x:=45;
        y:=34;
        soma(x,y);
        readkey;
end.

{Fazer um programa para a verdureira Mamao Grande de Timbo. Devera ser feita uma tela de apresentacao de produtos vendidos(1 - maracuja, 2 - laranja, 3 - uva, 4 - pessego, 5 - melao, 6 - Mostrar na tela e F - Fim sendo R$ 0,30 a unidade das frutas. SÆo dados a quantidade. Continuar pedindo novas quantidades de cada fruta ate a pessoa digitar F para finalizar o programa. Ao final mostrar a media de cada fruta, preco final e media geral}

program verdureira;
uses crt;
var
    opcao, continua : char;
    quantidade, cont1, cont2, cont3, cont4, cont5 : integer;
    somaracuja, somalaranja, somauva, somapessego, somamelao : real;
    precomaracuja, precolaranja, precouva, precopessego, precomelao : real;
    mediamaracuja, medialaranja, mediauva, mediapessego, mediamelao : real;
    somapreco, somacont : real;
Procedure opcoes; Forward;
Procedure Principal;
Begin
        textcolor(1);
        textbackground(15);
        CLRSCR;
        gotoxy(10,09);
        Write('Verdureira Mamao Grande');
        gotoxy(10,10);
        Write('Tudo a R$ 0,30 a unidade');
        gotoxy(10,11);
        Write('1 - Maracuja');
        gotoxy(10,12);
        Write('2 - Laranja');
        gotoxy(10,13);
        Write('3 - Uva');
        gotoxy(10,14);
        Write('4 - Pessego');
        gotoxy(10,15);
        Write('5 - Melao');
        gotoxy(10,16);
        Write('6 - Mostrar na Tela');
        gotoxy(10,17);
        Write('F - Finaliza o Programa!!');
End;

Procedure maracuja;
Begin
        clrscr;
        Repeat
        Begin
                gotoxy(10,10);
                Write('Quantas Maracujas deseja? ');readln(quantidade);
                inc(cont1);
                somaracuja := somaracuja + quantidade;
                precomaracuja := quantidade * 0.3;
                gotoxy(10,11);
                Write('Deseja Continuar? (s/n) '); Readln(continua);
        end;
        Until (continua = 'n') or (continua = 'N');
        principal;
        opcoes;
End;

Procedure Laranja;
Begin
        clrscr;
        Repeat
                Begin
                        gotoxy(10,10);
                        Write('Quantas Laranjas deseja? ');readln(quantidade);
                        inc(cont2);
                        somalaranja := somalaranja + quantidade;
                        precolaranja := quantidade * 0.3;
                        gotoxy(10,11);
                        Write('Deseja Continuar? (s/n) '); Readln(continua);
                end;
        Until (continua = 'n') or (continua = 'N');
        principal;
        opcoes;
End;

Procedure uva;
Begin
        clrscr;
        Repeat
                Begin
                        gotoxy(10,10);
                        Write('Quantas uvas deseja? ');readln(quantidade);
                        inc(cont3);
                        somauva := somauva + quantidade;
                        precouva := quantidade * 0.3;
                        gotoxy(10,11);
                        Write('Deseja Continuar? (s/n) '); Readln(continua);
                end;
        Until (continua = 'n') or (continua = 'N');
        principal;
        opcoes;
End;

Procedure pessego;
Begin
        clrscr;
        Repeat
                Begin
                        gotoxy(10,10);
                        Write('Quantos pessegos deseja? ');readln(quantidade);
                        inc(cont4);
                        somapessego := somapessego + quantidade;
                        precopessego := quantidade * 0.3;
                        gotoxy(10,11);
                        Write('Deseja Continuar? (s/n) '); Readln(continua);
                end;
        Until (continua = 'n') or (continua = 'N');
        principal;
        opcoes;
End;

Procedure melao;
Begin
        clrscr;
        Repeat
                Begin
                        gotoxy(10,10);
                        Write('Quantas Meloes deseja? ');readln(quantidade);
                        inc(cont5);
                        somamelao := somamelao + quantidade;
                        precomelao := quantidade * 0.3;
                        gotoxy(10,11);
                        Write('Deseja Continuar? (s/n) '); Readln(continua);
                end;
        Until (continua = 'n') or (continua = 'N');
        principal;
        opcoes;
End;

Procedure Mostrar;
Begin
        clrscr;
        if (cont1 <> 0 ) or (cont2 <> 0 ) or (cont3 <> 0 ) or (cont4 <> 0 ) or (cont4 <>          0 ) then
        Begin
                gotoxy(10,10);
                Write('Total Maracuja: ',precomaracuja:6:2,' M‚dia: ',somaracuja/cont1:6:2);
                gotoxy(10,11);
                Write('Total Laranja.: ',precolaranja:6:2,' M‚dia: ',somalaranja/cont2:6:2);
                gotoxy(10,12);
                Write('Total Uva.....: ',precouva:6:2,' M‚dia: ',somauva/cont3:6:2);
                gotoxy(10,13);
                Write('Total Pessego.: ',precopessego:6:2,' M‚dia: ',somapessego/cont4:6:2);
                gotoxy(10,14);
                Write('Total Melao...: ',precomelao:6:2,' M‚dia: ',somamelao/cont4:6:2);
                somapreco := precomaracuja + precolaranja + precouva + precopessego +              precomelao;
                somacont := cont1 + cont2 + cont3 + cont4 + cont5;
                gotoxy(10,15);
                Write('Media Geral: ',somapreco/somacont:6:2);
                Readkey;
                halt;
        end
    else
                gotoxy(10,10);
                Write('Algo est  em branco!! kkkk!!') ;
                readkey;
End;

Procedure Fim;
Begin
Halt;
End;

Procedure opcoes;
Begin
        gotoxy(10,18);
        Write('Digite Opcao: '); Readln(opcao);
        Case opcao of
                '1': maracuja;
                '2': laranja;
                '3': uva;
                '4': pessego;
                '5': melao;
                '6': mostrar;
                'f','F' : Fim;
            else
                    begin
                            gotoxy(10,18);
                            Write('Opcao invalida! - Tecle <enter>...');
                            readkey;
                            gotoxy(10,17);
                            Write('Digite Opcao: '); Readln(opcao);
                    end;
        End;
end;

Begin
        clrscr;
        principal;
        opcoes;
End.

Fazer um programa para controle de uma loja de 1,99. Sao dados o nomedo cliente, cpf, rg e quantidade de mercadorias adquiridas. Calcular e mostrar a maior compra do dia e seu respectivo nome e o seu pre‡o final.Finalizar a compra de mercadorias quando o usuario digitar 'f' na janela de Op‡oes}

Program Loja_199;
Uses crt;
Var
    nome : string[40];
    cpf : string[16];   
    rg : string[14];
    quantidade : integer;
    preco : real;
    maiorpreco : real;
    maiornome : string[40];
    continuar, opcao : char;

Procedure opcoes; forward;

Procedure Incluir;
Begin
    clrscr;
    maiorpreco := 0;
    continuar := 's';
    While (continuar = 's') or (nome = 'S') do
    Begin
        Gotoxy(05,05); Write('Digite Nome: '); Readln(nome);
        Gotoxy(05,06); Write('Digite Cpf: '); Readln(cpf);
        Gotoxy(05,07); Write('Digite rg.: '); Readln(rg);
        Gotoxy(05,08); Write('Digite Quantidade: '); Readln(quantidade);
        preco := preco + (quantidade * 1.99);
        Gotoxy(05,09); Write('Preco Total: ',preco:6:2);
        readkey;
        if preco > maiorpreco then
        Begin
            maiorpreco := preco;
            maiornome := nome;
        end;
        Gotoxy(05,10); Write('Deseja continuar?(s/n): '); Readln(continuar);
        clrscr;
    End;
    opcoes;
End;

Procedure Mostrar;
Begin
    clrscr;
    Gotoxy(05,04); Write('Maior Compra!');
    Gotoxy(05,05); Write('Nome: ',maiornome);
    Gotoxy(05,06); Write('Pre‡o: ',maiorpreco:6:2);
    readkey;
    opcoes;
End;

Procedure fim;
Begin
    halt;
end;

Procedure opcoes;
Begin
    clrscr;
    Gotoxy(05,04); Write('Loja de 1,99');
    Gotoxy(05,05); Write('1 - Incluir');
    Gotoxy(05,06); Write('2 - Mostrar');
    Gotoxy(05,07); Write('3 - Fim');
    Gotoxy(05,08); Write('Digite Opcao: '); readln(opcao);
    case opcao of
    '1' : incluir;
    '2' : mostrar;
    '3' : fim;
    end;
End;

Begin
    textcolor(1);
    textbackground(15);
    clrscr;
    opcoes;
End.