Desenho de objectos em consola

[Carlos Correia]

Boa noite.

É a 1ª vez que posto aqui não sei muito bem como funciona, mas aqui vai.

Tenho um problema exactamente igual ao postado aqui, é também a primeira vez que tenho programação e não estou nada familiarizado com esta linguagem. Consegui por as ditas bolas a a cair em animação mas penso não estar muito bem. Não sei como desenhar os recipientes onde caem as bolas, as bolas ao caírem fica sempre a posição anterior marcada, a árvore não está centrada e não sei como por a contagem das bolas por baixo de cada recipiente.

Ite é o procedimento que desenvolvi até agora:

Procedure Arvore(Var Nrecip,NBolas,Serie,Mseg:integer);

Var x,y,Cor,c,IniX,IniY,TNBolas,Sinal,EsqDir,Lpregos:integer;


BEGIN
   clrscr;
   n:=NRecip;
   TNBolas:=0;
   x:=1;
   y:=40;
   textcolor(Red);
   GOTOXY(x+1,y-1);
   TextColor(Green);
   For i:=1 to NRecip do recip[i]:=0;
   For i:=1 to NRecip do WRITE(#178,' ');
   WRITELN;

   FOR i:=1 TO Nrecip DO WRITE(i MOD 10,' ');
   WRITELN;
   TextColor(yellow);
   WRITELN('Serie=',Serie+1,'/',Nsim);
   n:=nrecip-1;
   Lpregos:=n;
   REPEAT
      GOTOXY(x,y);
      x:=x+1;
       y:=y-1;
       For i:=1 TO N do WRITE(#193,' ');
       Lpregos:=Lpregos-1;
       n:=Lpregos;
       delay(Mseg);
   UNTIL n=0;
//*******************calcular posicao da bolas**************
   iniX:=x-1;
   IniY:=y+1;
   x:=IniX;
   y:=IniY;

   REPEAT
    Repeat Cor:=random(15) Until cor<>0;
       GOTOXY(x,y);
     textcolor(Cor);
       WRITE('o');
       Sinal:=random(10)+1;
       IF Sinal>5 THEN EsqDir:=0 ELSE EsqDir:=1;
     IF EsqDir=0 THEN
       BEGIN
     y:=y+1;
       x:=x-1;
            END
  ELSE
        BEGIN
      y:=y+1;
     x:=x+1;
  END;
       Delay(Mseg);
       IF y=40 THEN
       BEGIN
     c:=trunc((x+1)/2);
     GOTOXY(x,y);WRITE(#178);
     Recip[c]:=Recip[c]+1;
     x:=IniX;
     y:=IniY;
               TNBolas:=TNBolas+1;
     GOTOXY(70,30);WRITE(TnBolas,'/',NBolas);
           END;
   UNTIL TnBolas=NBolas;
   Delay(50);
END;

Se alguém me puder ajudar agradeço imenso.

Cumprimentos

Edited December 15, 2012 at 11:22 PM by thoga31
GeSHi

[thoga31]

Boa noite, @Carlos Correia.

Antes de mais, bem-vindo ao P@P 😉

Visto que a tua dúvida não se enquadrava com o outro tópico, a tua questão deveria estar num tópico novo - assim o fiz.

De seguida, o código deverá ser colocado com as tags CODE, além de se dever utilizar o GeSHi para colorir o código. Para pascal, é [ code=pascal ]código...[ /code ], mas sem os espaços entre as tags.

Por último, explica um pouco melhor qual é o objectivo deste programa para nos podermos enquadrar melhor com aquilo que já tens feito e aquilo que pretendes que o programa faça.

Cumprimentos.

[Carlos Correia]

Antes de mais obrigado pela rápida resposta.

Quanto ao código que postei assim farei na próxima vez e peço desculpa por qualquer transtorno.

O objectivo do programa será simular de 1 a 10 séries, com um máximo de 21 recipientes, a queda de 10 a 1000 bolas por série(apenas estes 3 dados serão introduzidos pelo utilizador) sobre várias fiadas de pregos(a primeira fiada de pregos acima dos recipientes terá o nº de recipientes -1 e as consecutivas retirar-se-a 1 prego a cada uma acabando por formar uma espécie de pirâmide com um prego apenas no topo) de modo a ficarem distribuídas nos vários recipientes. As bolas serão lançadas uma a uma do topo da pirâmide de pregos. Do resultado das bolas em cada recipiente terei que calcular a média e o desvio padrão. Por fim esta distribuição terá que ser comparada em modo gráfico com a distribuição normal de Gauss teórica. Foi-nos fornecido um ficheiro com imensos valores que penso serem valores teóricos para utilização na unidade gráfica e assim comparar com os valores acumulados da(s) amostra(s) simulada(s).

Obrigado desde já por qualquer ajuda que puderem disponibilizar.

Qualquer informação necessária estarei aqui para a dar...

Cumprimentos.

Edited December 16, 2012 at 04:23 AM by Carlos Correia

[thoga31]

Isto é suposto ser um exercício para uma cadeira de Programação ou para uma cadeira de Matemática ou para uma cadeira de... humm... "Artes"? Estás em que curso?

Ora bem, só ao tentar compilar esse procedimento deparei-me com um par de más práticas de programação. Vejamos:

1) Tens uma série de variáveis globais que eu não sei como são declaradas (i, n, etc). Dentro de um procedimento e de uma função devem-se utilizar somente variáveis locais, incluindo contadores e tudo para evitar efeitos secundários indesejados no resto do programa.

2) Por que alma caridosa tens os parâmetros do procedimento declarados com "var"? É suposto as variáveis que são passadas por referência no bloco principal sofrerem alterações com este procedimento?

3) A indentação não está boa, e ainda não entendi qual é o teu padrão para escolher se escreves tudo com maiúsculas num determinado ponto ou não, e isto não contribui para a legibilidade do código - não há um padrão.

4) Dependendo da resposta que me deres à minha pergunta inicial (que não foi retórica) poderei comentar mais.

Entre algumas tentativas de descobrir qual seria a declaração das variáveis em falta, e depois de eliminar aquele "var", lá consegui compilar e obtive este género de output:

Não consigo entender onde é que isto está a desenhar bolas como tu referes no tópico inicial...

[Carlos Correia]

Isto é um exercício para uma cadeira de programação do curso de engenharia civil que frequento.

Em relação ao dito var...foi um lapso, não há qualquer alteração dessas variáveis nesse procedimento.

Entretanto com a ajuda da Internet e com algumas sugestões dos docentes já consegui desenvolver mais o código mas a parte da queda das bolas continua na mesma...

Deixo o código inteiro:

Program Gauss;

USES CRT;
Const
   MinBolas=10;   MaxBolas=1000;
   MinRecip=5;    MaxRecip=21;
   MinSimul=1;    MaxSimul=10;
   MAXGauss=790;
Type
   Tabela=Array [1..MaxRecip] of Integer;
   Tabela1=Array [1..MaxRecip] of Real;
   TabTRecip=Array [1..MaxRecip,1..MaxSimul] of Integer;
   TABGauss= Array[1..MAXGAUSS,1..2] of real;
Var
   I,N,j,Serie,NSim,NBolas,NRecip,Mseg,Coluna,Media_T: integer;
   Z,Percentot,DesvioPad_T,DesvioPad_A,SomaDesv2_T,SomaDesv2_A,Media_A:Real;
   TabAccGauss:TabGauss;
   Opcao: Char;
   Recip, Bolas:Tabela;
   Perc, PercT:Tabela1;
   TSerieRecip:TabTRecip;
   Ficheiro: Text;
//******************Moldura***************************
Procedure Moldura;
Var I ,k:integer;

Begin
   Textcolor(random(17));
   Gotoxy(2,24);
   Write(#200);
   Gotoxy(2,2);
   Write(#201);
   Gotoxy(79,24);
   Write(#188);
   Gotoxy(79,2);
   Write(#187);
   For I:=3 to 78 do
       Begin
           Gotoxy(I,2);
           Write(#205);
       End;
   For I:=3 to 23 do
       Begin
           Gotoxy(79,I);
           Write(#186);
       End;
   For I:=3 to 23 do
       Begin
           Gotoxy(2,I);
           Write(#186);
       End;
   For I:=3 to 78 do
       Begin
           Gotoxy(I,24);
           Write(#205);
       End;
End;

//******************ISEL***************************
Procedure ISEL;
Var
   aux:integer;
Begin
   if aux= 1 Then
   Textcolor(10)
   else
   Textcolor(lightgreen);
   gotoxy(29,4);
   writeln('XXXXX XXXXX XXXXX X');
   delay(400);
   gotoxy(29,5);
   writeln('  X   X     X     X');
   delay(400);
   gotoxy(29,6);
   writeln('  X   XXXXX XXXX  X');
   delay(400);
   gotoxy(29,7);
   writeln('  X       X X     X');
   delay(400);
   gotoxy(29,8);
   writeln('XXXXX XXXXX XXXXX XXXXX');
   delay(400);
   gotoxy(28,11);
   Write('Informatica e Programacao'); delay(400);
   gotoxy (36,12);
   Write ('Turma: 11');delay(400);
   gotoxy(36,14);
   Write ('Autores:');delay(400);
   gotoxy(30,15);Write ('Carlos Correia      37091');delay(400);
   gotoxy(30,16);Write ('Maria Antoci        39293');delay(400);
   gotoxy(30,17);Write ('Guilherme Pereira   37143');delay(400);

end;


//******************Bloquer o Programa em Caso de Erro na Password************
Procedure Bloquear;
Var
   col,lin,ql,cont,aux:integer;
   letra:char;
Begin
   Clrscr;
   Repeat
       col:=1+Random(79);
       lin:=1+Random(23);
       ql:= Random(10);
       for cont:= lin to lin+ql do
           Begin
               if cont<24 then
               Begin
                   letra:= chr(Random(255));
                   for aux:=1 to 2 do
                   Begin
                       if aux= 1 Then
                       Textcolor(10)
                       else
                       Textcolor(2);
                       gotoxy(col,cont);
                       write(letra);
                       delay(50);
                   end;
               end;
           end;
   until col=81;
end;

//******************Registar a Tecla escolhida e Escrever um "*"  ************
Procedure Tecla(VAR C:Char);
 Begin
      TextColor(Black);
      C:=Readkey;
      C:=UpCase(C);
      TextColor(Yellow); Write('*')
 End;

//******************Validar Password (maximo 3 tentativas)********************
Procedure Password;
 Var Chave,Pass:String[5];
     C1,C2,C3,C4,C5:Char;
     Conta:Integer;
 Begin
    Chave:='GAUSS';
    Conta:=1;
    TextBackground(Black);
    Repeat
      TextColor(9);
      Gotoxy(10,20); Write(' ':40);
      Gotoxy(10,20); Write('Tentativa -',Conta,'- Password ---> ');

      Tecla(C1);
      Tecla(C2);
      Tecla(C3);
      Tecla(C4);
      Tecla(C5);

      Pass:=C1+C2+C3+C4+C5;
      Conta:=Conta+1
    Until (Chave=Pass) or (Conta=4);

    IF Chave<>Pass Then Bloquear

 End;

//*********************Distribuição de Gauss**********************
Procedure Titulo;
Begin

   Clrscr;
   Textcolor(lightgreen);
   writeln('          XXXX             X           X                     XX         ');
   writeln('          X   XX X  XXX  XXXXX X X  X  X           X                XX  ');
   writeln('          X    X   X       X   XX      XXX   X  X     XXXX   XXX   X  X ');
   writeln('          X    X X  XX     X   X    X  X  X  X  X  X X     X   X  X    X');
   writeln('          X   XX X    X    X   X    X  X  X  X  X  X X     X  XX   X  X ');
   writeln('          XXXX   X XXX     X   X    X  XXX    XX   X  XXXX  XX  X   XX  ');
   writeln('                                                       /                ');Delay(500);
   writeln('                                         X      ');
   writeln('                                         X      ');
   writeln('                                      XXXX  XXX ');
   writeln('                                     X   X X    ');
   writeln('                                     X   X X XXX');
   writeln('                                      XXXX  XXX ');
   writeln('                                                ');Delay(500);
   writeln('                             XXXX                       ');
   writeln('                            X    X        X  X  XXX  XXX');
   writeln('                            X       XXX   X  X X    X   ');
   writeln('                            X  XXX X  X   X  X  XX   XX ');
   writeln('                            X    X X  XX  X  X    X    X');
     write('                             XXXX   XX  X  XX  XXX  XXX ');
  Repeat Until Keypressed;

End;
//*********************PedirDados**********************
Procedure PedirDados(var NSim,NBolas,NRecip: integer);
Begin
   Clrscr;
   Gotoxy(5,8);Write('Indique o número de simulações pretendidas(de 1 a 10):');
   Repeat
       Gotoxy(61,8);Write(' ':10);gotoxy(61,8);readln(NSim);
   Until NSim in [1..10];
   Gotoxy(5,12);Write('Indique o número de recipientes pretendidos(de 5 a 21 e ímpar):');
   Repeat
       Gotoxy(71,12);Write(' ':10);gotoxy(71,12);readln(NRecip);
   Until NRecip in [5,7,9,11,13,15,17,19,21];
   Gotoxy(5,16);Write('Indique o número de bolas a serem lançadas(entre 10 e 1000):');
   Repeat
       Gotoxy(67,16);Write(' ':10);gotoxy(67,16);readln(NBolas);
   Until (NBolas>=5) and (NBolas<=1000)
End;
//*********************Resultados**********************
//*******************************************************Arvore Gauss************************************
Procedure Arvore(Nrecip,NBolas,Serie,Mseg:integer);

Var x,y,Cor,c,IniX,IniY,TNBolas,Sinal,EsqDir,Lpregos:integer;


BEGIN
   clrscr;
   n:=NRecip;
   TNBolas:=0;
   x:=1;
   y:=40;
   textcolor(Red);
   GOTOXY(x+1,y-1);
   TextColor(Green);
   For i:=1 to NRecip do recip[i]:=0;
   For i:=1 to NRecip do WRITE(#178,' ');
   WRITELN;

   FOR i:=1 TO Nrecip DO WRITE(i MOD 10,' ');
   WRITELN;
   TextColor(yellow);
   WRITELN('Serie=',Serie+1,'/',Nsim);
   n:=nrecip-1;
   Lpregos:=n;
   REPEAT
      GOTOXY(x,y);
      x:=x+1;
       y:=y-1;
       For i:=1 TO N do WRITE(#193,' ');
       Lpregos:=Lpregos-1;
       n:=Lpregos;
       delay(Mseg);
   UNTIL n=0;
//*******************calcular posicao da bolas**************
   iniX:=x-1;
   IniY:=y+1;
   x:=IniX;
   y:=IniY;

   REPEAT
    Repeat Cor:=random(15) Until cor<>0;
       GOTOXY(x,y);
     textcolor(Cor);
       WRITE('o');
       Sinal:=random(10)+1;
       IF Sinal>5 THEN EsqDir:=0 ELSE EsqDir:=1;
     IF EsqDir=0 THEN
       BEGIN
     y:=y+1;
       x:=x-1;
            END
  ELSE
        BEGIN
      y:=y+1;
     x:=x+1;
  END;
       Delay(Mseg);
       IF y=40 THEN
       BEGIN
     c:=trunc((x+1)/2);
     GOTOXY(x,y);WRITE(#178);
     Recip[c]:=Recip[c]+1;
     x:=IniX;
     y:=IniY;
               TNBolas:=TNBolas+1;
     GOTOXY(70,30);WRITE(TnBolas,'/',NBolas);
           END;
   UNTIL TnBolas=NBolas;
   Delay(50);
END;
//******************************************************Calcular Maximo de bolas por recipiente*****
Procedure CalcularMaximo(NRecip:integer;recip:tabela;var MaxBolasRecip:integer);
Var i,n:integer;
BEGIN
    FOR i:=1 TO NRecip DO
       BEGIN
           IF MaxBolasRecip<recip[i] THEN MaxBolasRecip:=recip[i];
       END;

END;
//********************************************************DESENHAR O HISTOGRAMA EM MODO TEXTO**********************
PROCEDURE Histograma(var NBolas,NRecip,Media_T:Integer; var Media_A:Real; Recip:Tabela);
Const AlturaHist=20;
Var MaxBolasRecip:Integer;
   i,k:Integer;
   FEscala,Somat:Real;
   BolasHist,Maior:Integer;

BEGIN
   Clrscr;
   MaxBolasRecip:=0;
   i:=1;

   CalcularMaximo(NRecip,Recip,MaxBolasRecip);

   FEscala:=AlturaHist/MaxBolasRecip;

   TextColor(LightGreen);
   GOTOXY(1,23);
   WRITE('RECIP.');
   FOR i:=1 TO NRecip DO BEGIN
                            GOTOXY(7+3*i,23);
                            IF i<10 THEN WRITE('0',i:1)
                                    ELSE WRITE(i:1);
                         END;

   GOTOXY(1,24);
   WRITE('BOLAS');
   FOR i:=1 TO NRecip DO
       BEGIN
           IF odd(i) THEN BEGIN
                            TextColor(yellow);
                            GOTOXY(5+3*i,24);
                          END
                     ELSE BEGIN
                            TextColor(Yellow);
                            GOTOXY(5+3*i,25)
                          END;
           WRITE(Recip[i]:4);
       END;
   Media_T:=NRecip div 2+1;
   For i:=1 to NRecip do
       Media_A:=Media_A+(Recip[i]*i);
   Media_A:=Media_A/NBolas;
   TextColor(1);
   Gotoxy(5,26); Write('Recipiente Médio da Amostra: ');Textcolor(Yellow);Write(Media_A:2:2);Textcolor(1);
   Gotoxy(5,27); Write('Recipiente Médio Teórico: ');Textcolor(Yellow);Write(Media_T:2);
   TextColor(Cyan);
   GOTOXY(7+3*(NRecip+1),24);
   WRITE('TOT=',NBolas:3);
   TextColor(LightRed);
   FOR i:=1 TO NRecip DO
     BEGIN
         BolasHist:=Trunc(Recip[i]*FEscala);
         FOR K:=1 TO BolasHist
            DO BEGIN
                 GOTOXY(7+3*i,23-k);
                 WRITE(#178,#178);
               END;
     END;
repeat until keypressed;
END;
//*************************************************************Quadro Percentagens Por cada Serie**********************************
Procedure QuadroPerc(Nrecip,NBolas,Serie,Media_T:Integer; Media_A:Real; var SomaDesv2_T,DesvioPad_T,DesvioPad_A,SomaDesv2_A:Real; Recip:Tabela; Var Perc: Tabela1);
Var i,j:integer;
   Somatorio_A,Somatorio_T:Real;
BEGIN
   Clrscr;
   GOTOXY(15,1);Textcolor(Red);WRITELN('Quadro Resumo dos Lancamentos da ',Serie+1,'ª Série');
   Textcolor(Blue);
   WRITE('Recipiente',' ':2,'Percentagem',' ':2,'Nº Bolas');
   Textcolor(Yellow);
   For i:=1 to Nrecip do
           Perc[i]:=(Recip[i]/NBolas)*100;
   For i:=1 to NRecip do
       Begin
       Somatorio_T:=SQR(i-Media_T);
       Somatorio_A:=SQR(i-Media_A);
       End;
   DesvioPad_T:=SQRT(Somatorio_T/(NBolas-1));
   DesvioPad_A:=SQRT(Somatorio_A/(NBolas-1));
   SomaDesv2_T:=SQR(DesvioPad_T);
   SomaDesv2_A:=SQR(DesvioPad_A);
   For i:=1 to Nrecip do
       Begin
               GOTOXY(2,2+i);
               WRITE(i:2,Perc[i]:16:2,'%',Recip[i]:10);
       END;
   Textcolor(1);
   Gotoxy(36,6);Write('Devio Padrão Teòrico=');Textcolor(Yellow);Write(DesvioPad_T:10:8);Textcolor(1);
   Gotoxy(36,8);Write('Devio Padrão Amostra=');Textcolor(Yellow);Write(DesvioPad_A:10:8);Textcolor(1);
   Gotoxy(36,10);Write('Variância Teòrica=');Textcolor(Yellow);Write(SomaDesv2_T:10:8);Textcolor(1);
   Gotoxy(36,12);Write('Variância Amostra=');Textcolor(Yellow);Write(SomaDesv2_A:10:8);
END;
//*************************************************************Quadro Percentagens das series**********************************
Procedure QuadroPercSeries(Nrecip,NSim:integer; Perc:Tabela1; var Bolas:Tabela; var PercT:Tabela1);
Var i,j,TRecip:integer;

BEGIn
   Clrscr;
   Trecip:=0;
   GOTOXY(2,1);Textcolor(Yellow);WRITELN('Quadro de Percentagens e Resultados Totais');
   WRITE('Recipiente',' ':2,'Percentagem',' ':2,'Nº de Bolas Total');
   {For i:=1 to Nrecip do}
    {for j:=1 to 10 do} Trecip:=NBolas*Nsim;
    For j:=1 to NSim do
               for i:=1 to NRecip do
                   Bolas[i]:=Bolas[i]+TSerieRecip[i,j];
           For i:=1 to NRecip do
               PercT[i]:=PercT[i]+Perc[i];
           PercT[i]:=PercT[i]/NRecip;
   For i:=1 to Nrecip do
       Begin
               GOTOXY(2,2+i);
               WRITE(i:2,PercT[i]:16:2,'%',Bolas[i]:10);
       END;

       END;


//***************************** Valores teóricos da probabilidade em cada recipiente******************
Procedure LerTABGauss(var TabAccGauss:TABGauss);
Var i:integer;
   Lixo:String;
Begin
      Assign( Ficheiro, 'TabelaG.txt' );
      Reset(Ficheiro);
      Readln(Ficheiro,Lixo);
      i:=1;
      While not(eof(ficheiro)) do Begin
           Readln(Ficheiro,TabAccGauss[i,1],TabAccGauss[i,2]);
           i:=i+1
           End;
      Close(Ficheiro);
End;


Procedure Ztabela(Z:real;TabAccGauss:TabGauss;var Percentot:real);
Var J:integer;
   ZtabInf,ZtabSup:real;
Begin
   J:=1;
   Ztabinf:=0;ZTabSup:=0;
   If (Z<-3.9) then Percentot:=0 Else
       If (z>3.9) then Percentot:=1.000 else
           While not((z>=Ztabinf) and (z<Ztabsup)) do Begin
               ZtabInf:=TabAccGauss[j,1];
               ZtabSup:=TabAccGauss[j+1,1];
               if (z>=Ztabinf) and (z<Ztabsup) and (TabAccGauss[j,2]-TabAccGauss[j+1,2]>0.000001)then
                   Percentot:=TabAccGauss[j,2] - (TabAccGauss[j,1]-z)*(TabAccGauss[j,2]-TabAccGauss[j+1,2])
                   /(TabAccGauss[j,1]-TabAccGauss[j+1,1])else percentot:=TabAccGauss[j,2];
               J:=j+1;
               End;
End;
//*************************Ler os dados de Ficheiro******************************
Procedure LerDados(var Ficheiro:Text; Var NSim,NRecip,NBolas:Integer);
Var Lixo:String;
Begin

      Assign( Ficheiro, 'Dados.txt' );
      Reset(Ficheiro);
      Readln(Ficheiro,Lixo);
      While not(eof(ficheiro)) do
           Begin
           Readln(Ficheiro,NSim,NRecip,NBolas);


           End;
      Close(Ficheiro);

End;
//*************************Gravar dados num Ficheiro************************
Procedure GravarDados(Var Ficheiro:Text; Bolas:Tabela; PercT:Tabela1);
Begin
   Assign(Ficheiro,'Resultados.txt');
   Rewrite(Ficheiro);
   Writeln(Ficheiro,'Recipiente',' ':2,'Percentagem',' ':2,'Nº de Bolas Total');
   For i:=1 to NRecip do
       Writeln(Ficheiro,i:2,PercT[i]:16:2,'%',Bolas[i]:10);
   Writeln(Ficheiro);
   Close(Ficheiro);
   Clrscr;
   Gotoxy(1,4);Write('Resultados Gravados em ficheiro de texto com o nome "Resultados.txt"...');
   Readkey;
End;
//*********************TraçarGrafico**********************
Procedure TracarGraf;
Begin
Repeat until Keypressed;
end;
//============================Bloco Principal=========================
Begin
   Moldura;
   ISEL;
   Password;
   Titulo;
   repeat
       repeat
           Textbackground(cyan);
           clrscr;
           Textcolor(14);
           Writeln;
           Writeln('Distribuição de Gauss':50);
           Textcolor(14);Gotoxy(24,7);write('[1]');Textcolor(15);Write(' Pedir dados');
           Textcolor(14);Gotoxy(26,9);write('[2]');Textcolor(15);Write(' Ler dados de Ficheiro "Dados.txt"');
           Textcolor(14);Gotoxy(28,11);write('[3]');Textcolor(15);Write(' Histograma e Quadro de Percentagens por Série');
           Textcolor(14);Gotoxy(30,13);write('[4]');Textcolor(15);Write(' Histograma e Quadro de Percentagens Totais');
           Textcolor(14);Gotoxy(32,15);Write('[5]');Textcolor(15);Write(' Traçar Gráfico');
           Textcolor(14);Gotoxy(34,17);Write('[6]');Textcolor(15);Write(' Guardar dados em ficheiro');
           Textcolor(14);Gotoxy(36,19);write('[7]');Textcolor(15);Writeln(' Sair');
           Textcolor(15);
           Gotoxy(4,14);Writeln('=====================');
           Gotoxy(4,15);Writeln('=Escolha a sua Opção=');
           Gotoxy(4,16);Writeln('=====================');
           opcao := readkey;
       Until opcao in ['1'..'7'];
       Case opcao of
           '1':
               begin
                   PedirDados(NSim,NBolas,NRecip);
               end;
           '2':
               Begin
                   LerDados(Ficheiro,NSim,NRecip,NBolas);
               End;
           '3':
               Begin
               Serie:=0;
                While Serie<NSim do
                       BEGIN
                           Random(100);
                           arvore(Nrecip,NBolas,Serie,Mseg);
                           Readkey;
                           Histograma(NBolas,NRecip,Media_T,Media_A,Recip);
                           Readkey;
                QuadroPerc(Nrecip,NBolas,Serie,Media_T,Media_A,SomaDesv2_T,DesvioPad_T,DesvioPad_A,SomaDesv2_A,Recip,Perc);
                           Writeln;
                           For i:=1 to NRecip do TSerieRecip[i,Serie+1]:=Recip[i];
                           writeln;writeln;
                           Readkey;
                           Serie:=Serie+1;
                      END;
               end;
           '4' :
               Begin
                   Clrscr;
                   Histograma(NBolas,NRecip,Media_T,Media_A,Recip);
                   Readkey;
                   QuadroPercSeries(Nrecip,NSim,Perc,Bolas,PercT);
                   Readkey;
               end;
           '6':
               Begin
                   GravarDados(Ficheiro,Bolas,PercT)
               end;
           end;
   Until (opcao = '7');
End.

 

A password é 'gauss', a opção da duvida referida é a 3 depois de introduzir dados.

Agradeço qualquer sugestão ou alteração que sugira em relação a todo o código.

Quando copio para aqui o código sofre algumas alterações... talvez pelos limites laterais da janela de texto.

Cumprimentos.

[passarito]

Olá,

Ainda não tive tempo para analisar o código como deve de ser, mas assim de repente, na opção 3 tens um random(100). Antes do random deves ter um randomize, e o random é uma função, logo tens de igualá-lo a uma variável real.

[thoga31]

OMG, o ensino da programação está cada vez mais decadente, não haja dúvida...

Bom, adiante, neste momento não tenho tempo para analisar o código, peço desculpa. Sou sincero ao dizer que só na quinta-feira a partir das 21h é que terei um tempinho para ver isto com atenção.

Espero que os meus colegas pascalianos te possam ajudar já que eu não posso neste momento.

Deixo, por último, a referência para este programa que eu fiz para comemorar o Carnaval de 2012. Nele podes ver como fiz a criação de confettis de fundo ao mesmo tempo que foguetes eram lançados, "rebentados" e "eliminados". Espero que te possa ajudar no teu exercício.

Boa sorte. 😉

[passarito]

@Carlos Correia

bem, o teu código está uma confusão... deu-me um nó cego nos neurónios...

Para já, esquece os procedimentos: Moldura; ISEL; Password; Titulo; Isto é no final, quando o programa já estiver a funcionar como deve de ser.

para não estar sempre a inserir os dados sempre que re-executo o programa, coloquei no inicio do programas seguintes atribuições:

nsim:=1;

nrecip:=5;

nbolas:=10;

E´daqui que estou a partir para tentar dissecar o teu código.

Na opção 3, que é onde estás com dificuldades, o teu primeiro procedimento é Arvore. Não entendi nada daquilo!

Parece-me que que estás a fazer confusão com o gotoxy.

- O X é a posição na horizontal e vai de 1 a 40;

- O Y é a posição na vertical e vai de 1 a 25 (ou 50) conforme a configuração do teu output;

Só por este motivo nada irá aparecer como desejas!

Arranja uma folha quadriculada e desenha à mão o que queres que apareça no ecrã. Acredita que isso resulta!

Se o teu programa vai usar muito a "fórmula" gotoxy - write então usa este procedimento

procedure escrevexy (xx,yy:byte, s:string);
begin
 goto(xx,yy);
 write(s);
end;

Isto é um bónus!

O teu código vai ficar mais limpinho!

Re-arranjei qualquer coisa, experimenta lá este procedimento e depois diz qualquer coisa e tenta por isso a funcionar como queres!

BEGIN
   clrscr;
   n:=NRecip;
   TNBolas:=0;
   x:=1;
{    y:=40;  Linha alterada}
   y:=20;

   textcolor(Red);		  
   y:=y-1						 {Linha adicionada}
   GOTOXY(x+1,y);	    {Linha Alterada}
   TextColor(Green);
{No bloco acima mudas o texto para vermelho e depois para verde para quê?}


{    For i:=1 to NRecip do recip[i]:=0;
   For i:=1 to NRecip do WRITE(#178,' ');   Isto è igual à linha de código abaixo!}
   For i:=1 to NRecip do begin
  recip[i]:=0;
  WRITE(#178,' ');
   end;

  { WRITELN;  com gotoxy não sei para que são os writeln ?!?}

   y:=y+1			                     	    {Linha adicionada}
   GOTOXY(x+1,y); 					    {Linha adicionada}

   FOR i:=1 TO Nrecip DO WRITE(i MOD 10,' ');
   WRITELN;
   TextColor(yellow);
   WRITELN('Serie=',Serie+1,'/',Nsim);
   n:=nrecip-1;
   Lpregos:=n;
   REPEAT
   GOTOXY(x,y);
   x:=x+1;
    y:=y-1;
    For i:=1 TO N do WRITE(#193,' ');
    Lpregos:=Lpregos-1;
    n:=Lpregos;
    delay(Mseg);
   UNTIL n=0;
//*******************calcular posicao da bolas**************
   iniX:=x-1;
   IniY:=y+1;
   x:=IniX;
   y:=IniY;

   REPEAT
 Repeat Cor:=random(15) Until cor<>0;
    GOTOXY(x,y);
  textcolor(Cor);
    WRITE('o');
    Sinal:=random(10)+1;
    IF Sinal>5 THEN EsqDir:=0 ELSE EsqDir:=1;
  IF EsqDir=0 THEN
    BEGIN
  y:=y+1;
    x:=x-1;
		 END
  ELSE
	 BEGIN
   y:=y+1;
  x:=x+1;
  END;
    Delay(Mseg);
    IF y=40 THEN
    BEGIN
  c:=trunc((x+1)/2);
  GOTOXY(x,y);WRITE(#178);
  Recip[c]:=Recip[c]+1;
  x:=IniX;
  y:=IniY;
		    TNBolas:=TNBolas+1;
  GOTOXY(70,30);WRITE(TnBolas,'/',NBolas);
	    END;
   UNTIL TnBolas=NBolas;
   Delay(50);
END;

Apenas vi o inicio do procedimento, agora que tens o empurrãozinho avança com isso

[thoga31]

Se o teu programa vai usar muito a "fórmula" gotoxy - write então usa este procedimento

procedure escrevexy (xx,yy:byte, s:string);
begin
 goto(xx,yy);
 write(s);
end;

Enganaste-te... é gotoxy(xx, yy); 🙂

Edited December 19, 2012 at 12:17 AM by thoga31

[passarito]

Sempre atento.... ok, obrigado 👍

[Carlos Correia]

Muito obrigado pela ajuda, foi óptima.

Vou só deixar o natal passar e volto a pegar no código e a dar feed back.

Bom natal.

Cumprimentos