Linguagem de programação PASCAL

1) Informatizar uma loja de brinquedos. Durante muito tempo, toda a administração da loja desde a sua inauguração sempre foi feita em cadernos e fichas de papel.

a. Elabore um programa informatizar o cadastro dos brinquedos onde deverão ser armazenadas as seguintes informações para todos os 1200 tipos de brinquedos existentes no estoque da loja:

Código do brinquedo, Nome, Faixa Etária, Quantidade, Preço Unitário de Compra.

Este programa deverá executar as seguintes tarefas:

1. Cadastrar os brinquedos.

2. Listar os brinquedos indicados para crianças cuja a faixa etária seja 10 anos.

3. Listar os brinquedos que o preço de compra seja maior que R$ 1.000,00.

4. Calcular e mostrar o valor que foi gasto para comprar todos os brinquedos que estão armazenados no estoque.

b. Elabore um programa para cadastrar os 200 funcionários desta loja. O programa deverá armazenar as seguintes informações de cada funcionário: Matricula, Nome completo, CPF, Telefone com DDD, Sexo, Salário Bruto, Tempo de trabalho na loja.

Este programa deverá executar as seguintes tarefas:

1. Cadastrar os funcionários.

2. Listar todos os funcionários que tenham mais de 10 anos de loja.

3. Listar todos o total de funcionários de cada sexo [M/F].

4. Calcular e exibir o valor total necessário para pagar o salário bruto de todos os funcionários desta loja.

c. Elabore um programa para cadastrar todos os 10.000 clientes, para que seja realizada com antecedência a entrega de folhetos com as promoções mais importantes da loja. Para isto o programa deverá armazenar as seguintes informações de cada cliente: CPF, Nome completo, Endereço Completo (Rua, Numero, CEP, Bairro, Cidade, Estado, UF.

Este programa deverá executar as seguintes tarefas:

1. Cadastrar os Clientes.

2. Listar todos os clientes que moram na cidade do Rio de Janeiro.

2) Elabore um programa para cadastrar 200 elementos (números) do tipo inteiro onde deverá executar as seguintes tarefas com estes elementos:

a. Procedimento para cadastrar os elementos utilizando um procedimento.

b. Utilizar uma função para calcular a media da soma de todos os elementos cadastrados e retornar o resustado por passagem de parâmetro por valor par dentro do corpo do programa que o chamou.

c. Procedimento para todos os elementos cadastrados.

d. Criar uma função para calcular a soma dos elementos pares cadastrados para dentro do corpo principal do programa.

e. Procedimento para calcular a soma dos elementos pares e impares separadamente, e retornar para dentro do programa através de uma passagem de parâmetros por referencia as respostas.

f. Procedimento para listar todos os elementos cadastrados em ordem crescente.

Obs. Mas tarde, estarei postando as respostas destes exercícios.

terça-feira, 23 de outubro de 2012

Video aula de algoritmo e de pascal

Estas video aulas estão no youtube, e tem um material muito bom para quem quer aprender a programar: algoritmo, pascal, c, java, delphi e outros. Este professor do vídeo tem um material muito bom. Vale apena conferir.

exemplos:

http://www.youtube.com/watch?v=f1v101iiKks
http://www.youtube.com/watch?v=BJLCfFls2-M
http://www.youtube.com/watch?v=Fqq3Bi4YEX4

As video aulas tem numero iniciando com o número:

aula 946 e vai ate a aula 1239 de Algorit e log

Nestas aulas ele dá exemplos inciciando com algorítmo e passa o mesmo exercício para pascal, c e java

Vale apena.

Esta é uma dica de material para estudo de linguagens de programação. Espero que eu tenha ajudado.

segunda-feira, 22 de outubro de 2012

Programas para cadastramento e ordenação de 5 alunos

Exemplo 1 de 2:

program cad_alunos;
uses crt;

var
mat : array [1..5] of integer;
nome : array [1..5] of string [30];
notas : array [1..5,1..3] of real;
media : array [1..5] of real;
i,j,k,l : integer;
soma : real;
aux_mat : string [30];
aux_nota : real;

begin
soma:=0;
clrscr;
writeln ('Cadastramento de Alunos');
writeln;
{*** Cadastramento de Alunos ***}
for i:= 1 to 5 do
begin
write ('Matricula: '); readln (mat);
write ('Nome : '); readln (nome);
for i:= 1 to 5 do
begin
writeln ('Notas do ',i,'o. trimestre: ');
for l:= 1 to 3 do
begin
write ('Informe a ',l,'a. nota: '); readln (nota[i,l]);
soma:= soma + nota[i,l];
end;
media[i]:= soma / 3;
end;

{*** Ordenacao dos alunos Cadastrados ***}
for i:= 1 to 4 do
for j:= i+1 to 5 do
if mat[i] > mat[j] then
begin
{*** Troca Matricula ***}
aux_mat:=mat[i];
mat[i]:=mat[j];
mat[j]:=aux_mat;

{*** Trocar Notas ***}
for l:= 1 to 3 do
begin
aux_nota:= nota[i,l];
nota[i,l]:= nota[j,l];
nota[j,l]:= aux_nota;
end;

{*** Troca Media ***}
aux_nota:= media[i];
media[i]:= media[j];
media[j]:= aux_nota;

end;
end.

Exemplo 2 de 2:

program cad_alunos;
uses crt;

var
mat : array [1..5] of integer;
nome : array [1..5] of string [30];
nota : array [1..5,1..3] of real;
media : array [1..5] of real;
i,j,k,l : integer;
soma : real;
aux_mat : integer;
aux_nota : real;

begin
soma:=0;
clrscr;
writeln ('Cadastramento de Alunos');
writeln;
{*** Cadastramento de Alunos ***}
for i:= 1 to 5 do
begin
write ('Matricula: '); readln (mat[i]);
write ('Nome : '); readln (nome[i]);
for i:= 1 to 5 do
begin
writeln ('Notas do ',i,'o. trimestre: ');
for l:= 1 to 3 do
begin
write ('Informe a ',l,'a. nota: '); readln (nota[i,l]);
soma:= soma + nota[i,l];
end;
end;
media[i]:= soma / 3;
end;

{*** Ordenacao dos alunos Cadastrados ***}
for i:= 1 to 4 do
for j:= i+1 to 5 do
if mat[i] > mat[j] then
begin
{*** Troca Matricula ***}
aux_mat:=mat[i];
mat[i]:=mat[j];
mat[j]:=aux_mat;

{*** Trocar Notas ***}
for l:= 1 to 3 do
begin
aux_nota:= nota[i,l];
nota[i,l]:= nota[j,l];
nota[j,l]:= aux_nota;
end;

{*** Troca Media ***}
aux_nota:= media[i];
media[i]:= media[j];
media[j]:= aux_nota;
end;

{*** Relatorio dos Alunos Cadastrados ***}
for i:= 1 to 5 do
begin
write ('Matricula: ',mat[i]);
write ('Nome : ',nome[i]);
for i:= 1 to 5 do
begin
writeln ('Notas do ',i,'o. trimestre: ');
for l:= 1 to 3 do
writeln (l,'a. nota: ',nota[i,l]);
writeln ('Media : ',media[i]);
end;
end;
writeln;
writeln ('Tecle <ENTER> para sair ... '); readln;
end.

quarta-feira, 17 de outubro de 2012

Vetor - Listagem de Exercícios Resolvidos

Vetor - Listagem de Exercícios Resolvidos

{1. Cria um programa que registe 6 temperaturas ocorridas diariamente numa
localidade e que calcule a media dessas temperaturas. O programa tambem
deve indicar quais as temperaturas que tiveram valores acima da media.}

PROGRAM TEMP_MEDIA ;

uses crt;

VAR
   i,j         : integer;
   soma, media : real;
   temp        : array [1..6] of real;

BEGIN
   clrscr;
   gotoxy (10,02); write ('Controle de Temperaturas');
   gotoxy (10,03); write ('-----------------------------------------------');

   {*** Digitar as 6 temperaturas e armazenar em um vetor de 6 posicoes ***}

   gotoxy (10,05); write ('Introduza os valores das 6 temperaturas');
   j:= 10;
   FOR i := 1 TO 6 DO
     begin
        gotoxy (j,06); write(' ',i,'a.: '); readln (temp[i]);
        j:=j+10;
     end;

   {**** Calculo da media das temperaturas armazenadas no vetor ****}

   soma := 0;
   FOR i := 1 TO 6 DO
     begin
        soma := soma + temp[i];
        media := soma / 6;
     end;

   gotoxy (10,08); write ('Media das 6 temperaturas : ',media:3:1);

   {**** Listagem das temperaturas acima da media ****}

   j:=10;
   gotoxy (10,10); write ('Temperatura acima da media: ');
   FOR i := 1 TO 6 DO {Valores acima da media}
      BEGIN
         IF temp[i] > media THEN
           begin
            gotoxy (j,12); write (' ',temp[i]:3:1);
            j:=j+10;
           end;
      END;
   gotoxy (10,24); write ('Tecle [ENTER] para sair'); readln;
END.

{1.1. Cria um programa que registe 6 temperaturas ocorridas diariamente numa
localidade e que calcule a media dessas temperaturas. O programa tambem
deve indicar quais as temperaturas que tiveram valores acima da media.}

PROGRAM TEMP_MEDIA ;

uses crt;

VAR
   i,j         : integer;
   soma, media : real;
   temp        : array [1..6] of real;

BEGIN
   clrscr;
   gotoxy (10,02); write ('Controle de Temperaturas');
   gotoxy (10,03); write ('-------------------------------------------------');

   {*** Digitar as 6 temperaturas e armazenar em um vetor de 6 posicoes ***}

   gotoxy (10,05); write ('Introduza os valores das 6 temperaturas');
   j:= 10;
   soma := 0;
   FOR i := 1 TO 6 DO
     begin
        gotoxy (j,06); write(' ',i,'a.: '); readln (temp[i]);
        j:=j+10;
        soma := soma + temp[i];
     end;

   {**** Calculo da media das temperaturas armazenadas no vetor ****}
   media := soma / 6;
   gotoxy (10,08); write ('Media das 6 temperaturas : ',media:3:1);

   {**** Listagem das temperaturas acima da media ****}

   j:=10;
   gotoxy (10,10); write ('Temperatura acima da media: ');
   FOR i := 1 TO 6 DO {Valores acima da media}
      BEGIN
         IF temp[i] > media THEN
           begin
            gotoxy (j,12); write (' ',temp[i]:3:1);
            j:=j+10;
           end;
      END;
   gotoxy (10,24); write ('Tecle [ENTER] para sair'); readln;
END.

{1.2. Cria um programa que registe 6 temperaturas ocorridas diariamente numa
localidade, depois disso o programa devera:
1. Exibir uma listagem ordenada de forma crescente de todas as temperaturas
     armazenadas nov vetor
2. Calcular a media dessas temperaturas
3. Indicar quais as temperaturas que tiveram valores acima da media }

PROGRAM TEMP_MEDIA ;

uses crt;

VAR
   i,j,x            : integer;
   soma, media, aux : real;
   temp             : array [1..6] of real;

BEGIN
   clrscr;
   gotoxy (10,02); write ('Controle de Temperaturas');
   gotoxy (10,03); write ('-------------------------------------------------');

   {*** Digitar as 6 temperaturas e armazenar em um vetor de 6 posicoes ***}

   gotoxy (10,05); write ('Introduza os valores das 6 temperaturas');
   j:= 10;
   soma := 0;
   FOR i := 1 TO 6 DO
     begin
        gotoxy (j,06); write(' ',i,'a.: '); readln (temp[i]);
        j:=j+10;
        soma := soma + temp[i];
     end;

   {**** Calculo da media das temperaturas armazenadas no vetor ****}
   media := soma / 6;
   gotoxy (10,08); write ('Media das 6 temperaturas : ',media:3:1);

   {**** Ordenar as temperaturas em ordem crescente ****}

   FOR i:= 1 TO 5 DO
     FOR x:=i+1 TO 6 DO
       if (temp[i] > temp[x]) then
         begin
               aux:= temp[i];
           temp[i]:= temp[x];
           temp[x]:= aux;
         end;

   {**** Listagem das temperaturas acima da media ****}

   j:=10;
   gotoxy (10,10); write ('Temperatura acima da media: ');
   FOR i := 1 TO 6 DO {Valores acima da media}
      BEGIN
         IF temp[i] > media THEN
           begin
            gotoxy (j,12); write (' ',temp[i]:3:1);
            j:=j+10;
           end;
      END;

   {**** Listagem das temperaturas em ordem crescente ****}

   gotoxy (10,14); write ('Temperaturas listadas em ordem crescente:');
   j:= 10;
   FOR i := 1 TO 6 DO
     begin
        gotoxy (j,16); write(' ',i,'a.: ',temp[i]:3:1);
        j:=j+10;
     end;

   gotoxy (10,24); write ('Tecle [ENTER] para sair'); readln;
END.

{2. Criar um Programa que, utilizando vectores, solicite ao
utilizador as classificacoes de 10 alunos, calcule a sua media e a
escreva no ecran[tela] .}

PROGRAM EX_VECTORES;

uses crt;

CONST
   N_ALUNOS=10; {A constante NALUNOS e substituida pelo seu valor no programa antes da

compilação}

VAR
   NOTA      : ARRAY [1..N_ALUNOS] OF INTEGER;
   I, SOMA   : INTEGER;
   MEDIA     : REAL;

BEGIN
clrscr;

{**** Cadastramento ds 10 Notas ****}

FOR I:=1 TO N_ALUNOS DO
     BEGIN
        WRITE ('Introduza a Nota do Aluno ', I, ' : ');
        READLN (NOTA[I]);
     END;

{**** Calculo da Média das 10 notas armazenadas ****}

SOMA := 0;
FOR I:=1 TO N_ALUNOS DO
     SOMA := SOMA + NOTA[I];
MEDIA := SOMA / N_ALUNOS;

{**** Exibir o resultado ****}

WRITELN ('A Media e : ', MEDIA:4:1); {A MEDIA é apresentada com 1 casa decimal (4 digitos,

1 decimal)}

writeln ('Tecle [ENTER] para sair..'); READLN;

END.

{3. Programa que mostra o calculo do factorial com repeticoes}

PROGRAM FACTORIAL ;

uses crt;

VAR
Fac         : integer ;
i           : integer ;
N           : Integer;

Begin

   gotoxy (10,06); write ('Calculo do Fatorial:');

   {*** Entrada de dados *** }

   gotoxy (10,10); WRITE ('Informe o Valor de N: '); READLN (N);

   {*** Calculo do fatorial ***}

   Fac := 1;
   for i:= 1 to N do
      Begin
         Fac :=Fac * i;
      end;

   {*** Exibir o resultado ***}

   gotoxy (10,14); WRITE ('O Valor de ', N, ' Factorial e: ', fac);

   gotoxy (10,18); write ('Tecle [ENTER] para sair...'); readln;

End.

{4. Programa que demonstra a utilização de Arrays, Procedures e
Functions em PASCAL. Este programa em Pascal atraves de vectores, solicita
ao utilizador a classificacao de 15 alunos, atraves de um procedimento que as
armazena num array, e calcula a media das classificacoes, atraves de uma
funcao, fazendo o seu display no ucran;}

PROGRAM EXEMPLO_ARRAY;

uses crt;

CONST

NALUNOS=15; {A constante NALUNOS e substituida pelo seu valor no programa
                antes da compilacao}

VAR
   NOTA : ARRAY [1..NALUNOS] OF Real; {poderiamos alterar o array para
   valores reais , nesse caso a soma também terá de passar a ser real, no
   entanto o indice do array "I" tera de continuar inteiro}
   MEDIA : REAL; {Nao ha indices reais para arrays }
   i,j   : integer;

{*** Procedimento de cadastrameto das notas ***}

PROCEDURE PEDEDADOS;

BEGIN
   gotoxy (10,01); write ('Cadastramento das Notas dos 15 alunos: ');
   J:=2;
   FOR I:=1 TO NALUNOS DO
      BEGIN
         gotoxy (10,J+i); WRITE ('Nota do ',I,' aluno: ');
         READLN (NOTA[I]);
      END;
END;

{*** funcao para CALCULO DA MEDIA ***}

FUNCTION CALCULAMEDIA:REAL;

VAR
SOMA : Real ;

BEGIN
   SOMA := 0 ;
   FOR I:=1 TO NALUNOS DO
      SOMA := SOMA + NOTA[i];
   CALCULAMEDIA := SOMA / NALUNOS ;
END;

{*** Procedimento para ordenar de forma crescente as notas ***}

procedure ordenar_notas;

var
aux    : real;

begin
   for i:=1 to 14 do
     for j:=i+1 to 15 do
        if nota[i] > nota[j] then
          begin
            aux := nota[i];
            nota[i] := nota[j];
            nota[j] := aux;
          end;
end;

{*** Procedure de listagem de notas em ordem crescente ***}

procedure listagem_notas;

BEGIN
   gotoxy (10,16); write ('Notas dos 15 alunos em ordem crescente: ');
   J:=9;
   FOR I:=1 TO NALUNOS DO
      BEGIN
         gotoxy (J+i,18); WRITE ('Nota do ',I,' aluno: ',NOTA[I]);
      END;
END;

{*** PROGRAMA PRINCIPAL ***}

BEGIN
   clrscr;
   gotoxy (10,01); write ('Cadastramento dos dados de alunos: ');
   PEDEDADOS ; {executa o procedimento de cadastramento}
   MEDIA := CALCULAMEDIA ;

   {*** Escreve o Resultado ***}
   gotoxy (10,20); WRITE ('A Media da turma e: ', MEDIA:4:1); {A MEDIA e apresentada com 1

casa
                                       decimal (2 inteiros + "." + 1decimal)}

   gotoxy (10,24); write ('Tecle [ENTER] para sair....'); READLN;
END.

terça-feira, 2 de outubro de 2012

{ Funcao : Faca um programa que permita a usuario incluir, alterar, excluir, pesquisar e listar as informacoes num vetor de no maximo 200 clientes de uma agencia bancaria. Tendo as seguintes informacoes: numero da conta, nome, saldo e senha de 6 digitos.
Autor :
Data : 4/9/2012
Seção de Declarações }

Program Banco_Novo;

uses crt;

const
max = 200;

type
TContaCorrente = record
                      num: integer;
                      nome: string[40];
                      saldo: real;
                      senha: string[6];
                    end;

TContas = array[1.. max] of TContaCorrente;

var
contas                                : TContas;      { *** upos - ultima posicao *** }
p, i, op, upos, pesq, erro            : integer;
resp                                  : char;
teste_senha,nova_senha,vsenha,senha_digitada     : string[6];

{*** PROCEDURE MOSTRAR DADOS DA CONTA - UTILIZADO EM QUASE TODAS AS PARTES DESTE PROGRAMA ***}

procedure MostrarConta(conta: TContaCorrente);

begin
gotoxy (10,06); write ('        Cliente Cadastrado - Banco PASCAL:           ');
gotoxy (10,07); write ('-----------------------------------------------------');
gotoxy (10,08); write ('N£mero Nome                            Saldo');
gotoxy (10,09); write ('-------+-------------------------------+-------------');
writeln;
gotoxy (10,10); write (conta.num);
gotoxy (18,10); write (conta.nome);
gotoxy (53,10); write ('R$ ',conta.saldo:10:2);
end;

procedure criptografar_senha;
var
   s         : char;

begin
i:= 1;
while i <= 6 do
    begin
      s:=readkey;
      i:= i + 1;
      if (s <> ' ') then
        begin
          senha_digitada:= concat(senha_digitada+s);
          write ('*');
        end;
    end;
end;

function localizar: integer;

var
achou: boolean;

begin
p:= 1;
achou := false;
while (p <= upos) and (not achou) do {not achou = achou = false}
    if pesq = contas[p].num then
      achou := true
    else
      p := p + 1;
if achou then     {if achou then = if achou = true then}
    localizar := p
else
    localizar := -1; { numero negativo ira interrompoer as procedures: }
end;                 { alterar, excluir, pesquisar, listar             }

{*** CADASTRAMENTO DE CLIENTES - Incluir ***}

procedure incluir;

begin
clrscr;
gotoxy (10,01); write ('         Abertura de nova conta          ');
gotoxy (10,02); write ('---------------------------------------- ');

gotoxy (10,04); write ('Ate o momento o banco tem ',upos,' clientes cadastrados');
gotoxy (10,06); write ('Podendo chegar a numero ',max,' de clientes');

if upos < max then
    begin
      gotoxy (10,24); write ('Deseja realmente cadastrar uma nova conta [S/N] : ');
      readln (resp);
      if (resp = 's') or (resp = 'S') then
        begin
          gotoxy (10,24); write ('                                                   ');
          upos := upos + 1;                                                        {       upos - ultima posicao         }
          gotoxy (10,08); write ('N£mero: ');                readln (contas[upos].num);
          gotoxy (10,09); write ('Nome : ');               readln (contas[upos].nome);
          gotoxy (10,10); write ('Saldo Inicial: R$ ');   readln (contas[upos].saldo);
          gotoxy (10,12); write ('Digite a senha: ');
          criptografar_senha;
          contas[upos].senha:=senha_digitada;
          gotoxy (10,22); write ('Cadastramento de conta concluido com sucesso!!');
          delay (2500);
        end
     else
        begin
          gotoxy (10,22); write ('Nao foi registrado uma conta nova.');
        end;
      gotoxy (10,22); write ('Tecle [ENTER] para retornar oa menu principal');
    end
else
    begin
      gotoxy (10,17); write ('Nosso numero de clientes ja esta complento');
      gotoxy (10,18); write ('Foi atingido o numero maximo de clientes');
      gotoxy (10,19); write ('Um total de ',upos,' de ',max);
      gotoxy (10,20); write ('Tecle [ENTER] para continuar.');
      readkey;
    end;
end;

{**** Procedimento para efetuar alteracoes nos dados dos clientes ****}

procedure alterar;

var
opl: integer;
begin
clrscr;
gotoxy (10,01); write ('Alterarcao de dados no registro do cliente cadastrado: ');
gotoxy (10,02); write ('---------- -- ----- -- -------- -- ------- ----------- ');

gotoxy (10,04); write ('Digite o n£mero da conta a ser alterada: ');
readln(pesq);
p := localizar; {aciona a procedure localizar e recebe um informacao           }
if p > 0 then   {se encontrou ou nao o numero da conta no registro de clientes }
    begin
      MostrarConta(contas[p]);
      gotoxy (10,12); write ('Qual o campo que deseja alterar?');
      gotoxy (10,13); write ('1 - Nome');
      gotoxy (10,14); write ('2 - Saldo');
      gotoxy (10,15); write ('3 - Senha');
      gotoxy (10,16); write ('9 - Voltar ao menu principal');

      gotoxy (10,18); write ('Digite a Opcao: '); readln(opl);
      if opl = 1 then
        begin
          gotoxy (14,20); write ('Nome: ');
          readln(contas[p].nome);
        end
      else
        if opl = 2 then
          begin
            gotoxy (14,20); write ('Saldo: R$');
            readln(contas[p].saldo);
          end
        else
          if opl = 3 then
            begin
              gotoxy (14,20); write ('Digite a nova senha: ');
              criptografar_senha;
              contas[upos].senha:=senha_digitada;
            end
          else
            if opl = 9 then
              begin
                gotoxy (14,24); write ('Tecle [ENTER] para voltar ao MENU PRINCIPAL')
              end;
      gotoxy (10,22); write ('Alera‡Æo de conta concluido com sucesso!!');
      delay (2500);
    end
else
    begin
       gotoxy (14,24); write ('Conta nÆo localizada. Tecle [ENTER] para continuar.');
       readkey;
    end;
end;

{ *** PROCEDIMENTO PARA EXCLUIR CONTA DE CLIENTE *** }

procedure excluir;

begin
clrscr;
if upos > 0 then
    begin
       gotoxy (10,02); write ('Excluir Registro de Cliente Cadastrado: ');
       gotoxy (10,03); write ('------- -------- -- ------- ----------- ');

       gotoxy (10,05); write ('Digite o n£mero da conta a ser excluida: ');
       readln(pesq);
       p := localizar;
       if p > 0 then
         begin
           MostrarConta(contas[p]);
           gotoxy (10,24); write('Comfirma a exclusao <S/N>: ');
           readln(resp);
           resp := upcase(resp);
           if resp = 'S' then
            begin
              for i := p to upos - 1 do
                contas[i] := contas[i + 1];
              upos := upos - 1;
            end;
           gotoxy (10,24); write ('Conta excluida com sucesso!!');
           delay (2500);
         end
       else
         begin
           gotoxy (10,24);write('Conta nÆo localizada. Tecle [ENTER] para continuar.');
           readkey;
         end;
      end
else
     begin
       gotoxy (07,08); write ('Banco Pascal');
       gotoxy (07,24); write ('NÆo existe informa‡Æo a excluir. Tecle [ENTER] para continuar.');
       readkey;
     end;
end;

procedure pesquisar;

begin
clrscr;
gotoxy (10,02); write ('Excluir Registro de Cliente Cadastrado: ');
gotoxy (10,03); write ('------- -------- -- ------- ----------- ');

gotoxy (10,05); write('Didite o n£mero da conta a ser localizada: ');
readln(pesq);
p := localizar;
if p > 0 then
begin
    MostrarConta(contas[p]);
    gotoxy (10,24); write('Tecle [ENTER] para continuar.');
    readkey;
end
else
begin
    gotoxy (10,24); write('Conta nÆo localizada. Tecle [ENTER] para continuar.');
    readkey;
end;
end;

procedure listar;

var
l, x: integer;

begin
X:=7;
clrscr;
if upos > 0 then
    begin
      l := 2;
      gotoxy (10,02); write ('Listagem dos Cliente Cadastrados - Banco PASCAL: ');
      gotoxy (10,03); write ('-------- --- ------- -----------   ----- ------- ');
      gotoxy (10,05); write ('N£mero Nome                             Saldo');
      gotoxy (10,06); write ('-------+--------------------------------+-----------------');
      writeln;
      for i := 1 to upos do
        begin
          gotoxy (10,x); write (contas[i].num:7);
          gotoxy (18,x); write (contas[i].nome);
          gotoxy (53,x); write ('R$ ',contas[i].saldo:10:2);
          x:=x+1;
          if l < 22 then
            l := l + 1
          else
            begin
              gotoxy (10,24); write ('Tecle [ENTER] para continuar.');
              readkey;
              l := 1;
              clrscr;
              writeln('N£mero Nome Saldo : ');
            end
        end;
      gotoxy (10,24); write ('Tecle [ENTER] para continuar.');
      readkey;
    end
else
    begin
      gotoxy (10,24); write ('NÆo exitem contas cadastradas. Tecle [ENTER] para continuar.');
      readkey;
    end;
end;
{
procedure extrato_bancario;

Type
    extrato     = record
                   operacao : integer;

var }

{ *** Principal parte do programa *** }
begin
repeat
    clrscr;

{Comandos do programa}


    gotoxy (05,05); write ('        Banco Pascal');
    gotoxy (05,06); write ('----------------------------');
    gotoxy (05,10); write ('       MENU PRINCIPAL       ');
    gotoxy (05,12); write ('----------------------------');

    gotoxy (13,14); write ('1 - Incluir');
    gotoxy (13,15); write ('2 - Alterar');
    gotoxy (13,16); write ('3 - Excluir');
    gotoxy (13,17); write ('4 - Pesquisar');
    gotoxy (13,18); write ('5 - Listar');
    gotoxy (13,19); write ('6 - Extrato');
    gotoxy (13,20); write ('9 - Sair');
    gotoxy (10,22); write ('Digite a opcao: ');
    val(readkey,op,erro);
    clrscr;
    case op of
      1: incluir;
      2: alterar;
      3: excluir;
      4: pesquisar;
      5: listar;
      6: begin
            gotoxy (26,19); writeln ('EM CONSTRUCAO'); readkey;
         end;
    end;
until op = 9;
end.

terça-feira, 11 de setembro de 2012

Programas que utilizam procedures e functions - Pascal

{[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,01); write('Rotina de adição');
gotoxy(05,06); write('Entre um valor para A: '); readln(a);
gotoxy(05,07); write('Entre um valor para b: '); readln(b);
x:=a+b;
gotoxy(05,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,01); write('Rotina de adição');
gotoxy(05,06); write('Entre um valor para A: '); readln(a);
gotoxy(05,07); write('Entre um valor para b: '); readln(b);
x:=a-b;
gotoxy(05,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,01); write('Rotina de adição');
gotoxy(05,06); write('Entre um valor para A: '); readln(a);
gotoxy(05,07); write('Entre um valor para b: '); readln(b);
x:=a*b;
gotoxy(05,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,01); 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,01); write('Menu principal');
gotoxy(22,06); write('1 Soma');
gotoxy(22,08); 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>)

{[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.

{[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.