Ir para conteúdo
Fórum Script Brasil
  • 0

Pascal ZIM problema na impressão

Marcelo Pena

Perguntado por Marcelo Pena,

 Share

Pergunta

Marcelo Pena

Marcelo Pena

Postado
Postado
Program Pzim;
Uses crt;
const tam=30;
type cad = record
nome: string;
mat: integer;
n1,n2,media: real;
end;
var
aluno: array [1..tam] of cad;
i,X:integer;
op: real;
procedure Enter;
begin
writeln; writeln;
write('Pressione [ENTER] Para Voltar Pro Menu.');
readln;
end;
procedure cadastro;
var i: integer;
begin
i:=0;
op:=1;
while (i <= tam) and (op=1) do
begin
i:= i + 1;
write('Nome: ');
readln(aluno.nome);
write('Matricula: ');
readln(aluno.mat);
write('Nota 1: ');
readln(aluno.n1);
write('Nota 2: ');
readln(aluno.n2);
aluno.media:= (aluno.n1 + aluno.n2)/2;
write('Deseja cadastrar outro aluno? Aperte 1 para sim');
readln(op);
end;
Enter;
end;
procedure troca(p1,p2:integer);
var aux:cad;
begin
aux := aluno[p1];
aluno[p1] := aluno[p2];
aluno[p2] := aux;
end;
procedure ordenar;
var i, j: integer; aux: real;
begin
for i:= 1 to tam-1 do
for j:= 1 to tam-i do
if ( aluno[j].mat > aluno[j+1].mat ) then
troca(j,j+1);
end;
procedure ObtemX;
begin
clrscr;
writeln('Informe o numero a ser pesquisado.');
write('X : ');
readln(X);
end;
procedure sequencial;
var encontrou:boolean;
begin
ObtemX;
encontrou:= false;
i:=1;
while (i<=tam) and (not(encontrou)) do
begin
if (aluno.mat = X) then
begin
encontrou:= true;
end
else
i:= i+1;
end;
if (encontrou = true) then
begin
writeln('O elemento ',X,'foi encontrado na posição',i);
end
else
writeln('O elemento ',X,'não foi encontrado na lista.');
Enter;
end;
procedure binaria;
var Meio, Inicio, Fim: integer;
Achou: boolean;
begin
ordenar;
ObtemX;
Achou := false; Inicio := 1; Fim := tam;
while (Inicio <= Fim) and (not(Achou)) do
begin
Meio := (Inicio + Fim) div 2;
if aluno[Meio].mat = X then
Achou := true
else
if aluno[Meio].mat > X then
Fim := Meio - 1
else
Inicio := Meio + 1;
end;
writeln;
if Achou then
writeln('Este elemento existe no conjunto na posicao ', Meio)
else
writeln('Este elemento não existe no conjunto !');
Enter;
end;
procedure busca;
var op2:integer;
begin
clrscr;
writeln('1. Busca Binária');
writeln('2. Busca Sequencial');
write('Selecione uma opção: ');
readln(op2);
case op2 of
1: binaria;
2: sequencial;
else
writeln('outro');
readkey;
end;
end;
procedure imprimir;
begin
for i := 1 to tam do
begin
writeln('====================');
writeln('Nome: ',aluno.nome);
writeln('Matrícula: ', aluno.mat);
writeln('Nota 1: ', aluno.n1);
writeln('Nota 2: ', aluno.n2);
writeln('Média: ', aluno.media);
end;
Enter;
end;
procedure menu_principal;
var op1:integer;
begin
repeat
clrscr;
writeln('1. Cadastrar alunos');
writeln('2. Ordenar dados dos alunos');
writeln('3. Buscar alunos');
writeln('4. Imprimir dados de todos os alunos');
writeln('5. Sair');
write('Selecione uma opção: ');
readln(op1);
case op1 of
1: cadastro;
2:ordenar;
3:busca;
4:imprimir;
end;
until op1=5;
writeln('FIM DO PROGRAMA');
for i := 1 to tam do
begin
writeln('====================');
writeln('Nome: ',aluno.nome);
writeln('Matrícula: ', aluno.mat);
writeln('Nota 1: ', aluno.n1);
writeln('Nota 2: ', aluno.n2);
writeln('Média: ', aluno.media);
end;
Enter;
end;
Begin
menu_principal;
End.
não imprimiu certo o que eu escrevi, alguém pode me ajudar... sou iniciante... muito obrigado...
Link para o comentário
Compartilhar em outros sites

1 resposta a esta questão

Posts Recomendados

  • 0
Jhonas

Jhonas

Postado
Postado

veja se isso resolve o seu problema ... deixei como comentario algumas linhas, mas faça o teste ai

Program Pzim;



     Uses crt;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const tam=30;

type cad = record
nome: string;
mat: integer;
n1,n2,media: real;
end;
 
var
aluno: array [1..tam] of cad;
i,X:integer;
op: real;
n : Real ;
s : String ;

function RealStr ( r : Real ; d : Integer) : String;
  Var
    i,j : Integer ;
    aux : String ;
    s   : String ;
  Begin
  // Parte Inteira
  i := trunc (r) ;
  str (i,s) ;
  r := r - i ; // Remove a parte inteira
  s := s + ' .' ; // Ponto da casa decimal
  // Casas Decimais
  j := 0 ;
  While r < 1 Do
  Begin
    r := r * 10 ;
    i := trunc (r) ;
    str (i,aux) ;
    s := s + aux ;
    r := r - i ;
    j := j + 1 ;
    if j = d Then break ; // Sai do Looping
  End ;   
  RealStr := s ;   
End ;

procedure Enter;
  begin
writeln; writeln;
write('Pressione [ENTER] Para Voltar Pro Menu.');
readln;
  end;
 
procedure cadastro;
var i: integer;
begin
i:=0;
op:=1;
while (i <= tam) and (op=1) do
begin

  i:= i + 1;
 
write('Nome: ');
readln(aluno[i].nome);
 
write('Matricula: ');
readln(aluno[i].mat);

write('Nota 1: ');
readln(aluno[i].n1);
 
write('Nota 2: ');
readln(aluno[i].n2);
 
aluno[i].media:= (aluno[i].n1 + aluno[i].n2)/2;
write('Deseja cadastrar outro aluno? Aperte 1 para sim');
 
readln(op);
 
  end;
  Enter;
  end;

  procedure troca(p1,p2:integer);
  var aux:cad;
begin
         aux := aluno[p1];
             aluno[p1] := aluno[p2];
                aluno[p2] := aux;
  end;
 
    procedure ordenar;
  var i, j: integer; aux: real;
  begin

   for i:= 1 to tam-1 do
      for j:= 1 to tam-i do
        if ( aluno[j].mat > aluno[j+1].mat ) then
    troca(j,j+1);
 
  end;
 
  procedure ObtemX;
  begin
    //clrscr;
      writeln('Informe o numero a ser pesquisado.');
      write('X : ');
      readln(X);
  end;
 
procedure sequencial;
var encontrou:boolean;
begin
 
   ObtemX;
   encontrou:= false;
   i:=1;
while (i<=tam) and (not(encontrou)) do
begin
  if (aluno[i].mat = X) then
  begin
  encontrou:= true;
  end
  else
  i:= i+1;
  end;
  if (encontrou = true) then
  begin
  writeln('O elemento ',X,'foi encontrado na posição',i);
  end
  else
    writeln('O elemento ',X,'não foi encontrado na lista.');
    Enter;
end;

procedure binaria;
var Meio, Inicio, Fim: integer;
    Achou: boolean;
begin
 ordenar;
 ObtemX;
 Achou := false; Inicio := 1; Fim := tam;
 while (Inicio <= Fim) and (not(Achou)) do
 begin
   Meio := (Inicio + Fim) div 2;
   if aluno[Meio].mat = X then
      Achou := true
   else
      if aluno[Meio].mat > X then
         Fim := Meio - 1
         else
            Inicio := Meio + 1;
 end;
 writeln;
 if Achou then
 writeln('Este elemento existe no conjunto na posicao ', Meio)
 else
 writeln('Este elemento não existe no conjunto !');
 Enter;
end;

procedure busca;
    var op2:integer;
    begin
    //clrscr;
    writeln('1.  Busca Binária');
    writeln('2. Busca Sequencial');
    write('Selecione uma opção: ');
    readln(op2);
    case op2 of
    1: binaria;
    2: sequencial;
    else
    writeln('outro');
    Readln;
    end;
    end;
 
     procedure imprimir;
     begin
 
        for i := 1 to tam do
        begin
                writeln('====================');
                writeln('Nome: ',aluno[i].nome);
                writeln('Matrícula: ', aluno[i].mat);

                n := aluno[i].n1;
                s := RealStr (n,5);
                writeln('Nota 1:', n:8:2);

                n := aluno[i].n2;
                s := RealStr (n,5);
                writeln('Nota 2:', n:8:2);

                n := aluno[i].media;
                s := RealStr (n,5);
                writeln('Media: ', n:8:2);

        end;
 
        Enter;
     end;
 
    procedure menu_principal;
    var op1:integer;
begin
 repeat
    //clrscr;
    writeln('1. Cadastrar alunos');
    writeln('2. Ordenar dados dos alunos');
    writeln('3. Buscar alunos');
    writeln('4. Imprimir dados de todos os alunos');
    writeln('5. Sair');
    write('Selecione uma opção: ');
 
    readln(op1);
      case op1 of
      1: cadastro;
      2:ordenar;
      3:busca;
      4:imprimir;
 
end;
       until op1=5;
       writeln('FIM DO PROGRAMA');
       for i := 1 to tam do
        begin
                writeln('====================');
                writeln('Nome: ',aluno[i].nome);
                writeln('Matrícula: ', aluno[i].mat);

                n := aluno[i].n1;
                s := RealStr (n,5);
                writeln('Nota 1:', n:8:2);

                n := aluno[i].n2;
                s := RealStr (n,5);
                writeln('Nota 2:', n:8:2);

                n := aluno[i].media;
                s := RealStr (n,5);
                writeln('Media: ', n:8:2);
        end;


        Enter;
end;
 Begin
  menu_principal;
 End.

abraço

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...