Ir ao conteúdo
  • Cadastre-se

Como criar esse programa no Pascal ???


pvfinger

Posts recomendados

  • Membro VIP
(O código do EstilingueAtomico está melhor)

Você está de brincadeira né??? :lol:

1) Comando não reconhecidos em alguns compiladores

Tem compiladores que NÃO aceitam o comando "+=", se for o caso basta alterá os trechos..

ANTES

  Repeat
{Ler voto}
Voto := LerVoto(ContVotos.Dilma+ContVotos.Serra+ContVotos.Marina+1);
With ContVotos Do
Case Voto Of
[COLOR="Red"] 1: Serra +=1 ;
2: Dilma +=1;
3: Marina +=1;[/COLOR]
End;
{Ler opinião}
If Voto <> 0 Then
Begin
Voto := LerOpiniao(ContVotos.Dilma+ContVotos.Serra+ContVotos.Marina);
[COLOR="Red"] ContOpinioes[Voto] +=1;[/COLOR]
End;
Until Voto = 0;

Depois

  Repeat
{Ler voto}
Voto := LerVoto(ContVotos.Dilma+ContVotos.Serra+ContVotos.Marina+1);
With ContVotos Do
Case Voto Of
[COLOR="Blue"] 1: Serra:=Serra+1 ;
2: Dilma:=Dilma+1;
3: Marina:=Marina+1;[/COLOR]
End;
{Ler opinião}
If Voto <> 0 Then
Begin
Voto := LerOpiniao(ContVotos.Dilma+ContVotos.Serra+ContVotos.Marina);
[COLOR="Blue"]ContOpinioes[Voto]:=ContOpinioes[Voto]+1;[/COLOR]
End;
Until Voto = 0;

Ficou massa esse código...

Já que fez um código mais robusto, só vou dar uns pitacos...

1) Function LerVoto()

  Repeat
ClrScr;
ReadLn(Receb);
Val(Receb, Saida, Erro);
Until (Erro = 0) And (Saida In [0..[COLOR="Red"]4[/COLOR]]);

Não seria 3 no lugar do 4 não?

2) Sair sem votar em ninguém

Se apertar "0" direto o programa trava... erro de divisão por "0". No caso não precisa nem fazer a conta...

Aqui algumas dicas

3) Para aceitar ENTER do teclado numérico

  Repeat
Tecla:=ReadKey;
Until Ord(tecla) in [13,0];
if Ord(tecla)=0 then {se ENTER numérico}
ReadKey; {Corrige bug ENTER numérico}

(vê se roda certo ai)

4) Demonstração de bordas

Só implementei uma borda verde no código, só para efeito de demonstração!!!



Uses
Crt, SysUtils;

Type
TVot = Record
Serra, Dilma, Marina: Byte;
End;
TOp = Array [1..5] Of Byte;

Var
ContVotos: TVot;
ContOpinioes: TOp;
Voto: Byte;
Tecla: Char;

Function LerVoto(QtdEleitores: Byte) :Byte;
Var
Receb: String;
Erro, Saida: Integer;
Begin
TextColor(Yellow);
WriteLn(QtdEleitores:0,#167,' eleitor :');
WriteLn('Qual ser',#160,' seu voto para Presidente da Rep',#163,'blica nas Elei',#135,#229,'es 2010?');
TextColor(LightRed);
WriteLn('.........................................');
WriteLn('1. Jos',#130,' Serra');
WriteLn('2. Dilma Rousseff');
WriteLn('3. Marina Silva');
WriteLn(' ou 0 para terminar');
WriteLn('.........................................');
TextColor(LightCyan);
Window(3, WhereY+1, 78, 24);
Repeat
ClrScr;
ReadLn(Receb);
Val(Receb, Saida, Erro);
Until (Erro = 0) And (Saida In [0..3]);
LerVoto := Saida;
TextColor(Yellow);
Window(3, 2, 78, 24);
ClrScr;
End;

Function LerOpiniao(QtdEleitores: Byte) :Byte;
Var
Receb: String;
Erro, Saida: Integer;
Begin
TextColor(Yellow);
WriteLn(QtdEleitores:0,#167,' eleitor :');
WriteLn('Qual a sua opini',#198,'o sobre os oito anos de governo do Presidente Lula?');
TextColor(LightRed);
WriteLn('.........................................');
WriteLn('1. P',#130,'ssimo'); // coloquei péssimo primeiro
WriteLn('2. Ruim'); // para ficar parecido
WriteLn('3. Regular'); // com uma nota de 0 a 5
WriteLn('4. Bom');
WriteLn('5. ',#224,'timo');
WriteLn('.........................................');
TextColor(LightCyan);
Window(3, WhereY+2, 78, 24);
Repeat
ClrScr;
ReadLn(Receb);
Val(Receb, Saida, Erro);
Until (Erro = 0) And (Saida In [1..5]);
LerOpiniao := Saida;
TextColor(Yellow);
Window(3, 2, 78, 24);
End;

Procedure Apuracao (InCVot: TVot; InCOP: TOp);
Var
Eleitores, Max: Byte;
(* Begin - "Procedure"s *)
Procedure EscreveSerra;
Begin
{Serra}
TextColor(Yellow);
Write('Serra ');
TextColor(LightGreen);
Write(InCVot.Serra:Max);
TextColor(Yellow);
Write(' voto');
If InCVot.Serra>1 Then
Write('s ')
Else
Write(' ');
TextColor(LightGreen);
WriteLn((100*InCVot.Serra/Eleitores):6:2,'%');
TextColor(Yellow);
End;
Procedure EscreveDilma;
Begin
{Dilma}
TextColor(Yellow);
Write('Dilma ');
TextColor(LightGreen);
Write(InCVot.Dilma:Max);
TextColor(Yellow);
Write(' voto');
If InCVot.Dilma>1 Then
Write('s ')
Else
Write(' ');
TextColor(LightGreen);
WriteLn((100*InCVot.Dilma/Eleitores):6:2,'%');
TextColor(Yellow);
End;
Procedure EscreveMarina;
Begin
{Marina}
TextColor(Yellow);
Write('Marina ');
TextColor(LightGreen);
Write(InCVot.Marina:Max);
TextColor(Yellow);
Write(' voto');
If InCVot.Marina>1 Then
Write('s ')
Else
Write(' ');
TextColor(LightGreen);
WriteLn((100*InCVot.Marina/Eleitores):6:2,'%');
TextColor(Yellow);
End;
(* End - "Procedure"s *)
Begin
Eleitores := InCVot.Serra + InCVot.Dilma + InCVot.Marina;
Max := Length(IntToStr(Eleitores));
{Voto para Presidente}
WriteLn('.........................................');
WriteLn('Voto para Presidente:');
WriteLn('.........................................');
If (InCVot.Serra > InCVot.Dilma) And (InCVot.Serra > InCVot.Marina) Then {1º = Serra}
Begin
Write('1',#167,' ');
EscreveSerra;
If InCVot.Dilma > InCVot.Marina Then {2º = Dilma, 3º = Marina}
Begin
Write('2',#167,' ');
EscreveDilma;
Write('3',#167,' ');
EscreveMarina;
End
Else
If InCVot.Marina > InCVot.Dilma Then {2º = Marina, 3º = Dilma}
Begin
Write('2',#167,' ');
EscreveMarina;
Write('3',#167,' ');
EscreveDilma;
End
Else {2º = Marina = Dilma}
Begin
Write('2',#167,' ');
EscreveMarina;
Write('2',#167,' ');
EscreveDilma;
End;
End
Else
If (InCVot.Dilma > InCVot.Marina) And (InCVot.Dilma > InCVot.Serra) Then {1º = Dilma}
Begin
Write('1',#167,' ');
EscreveDilma;
If InCVot.Serra > InCVot.Marina Then {2º = Serra, 3º = Marina}
Begin
Write('2',#167,' ');
EscreveSerra;
Write('3',#167,' ');
EscreveMarina;
End
Else
If InCVot.Marina > InCVot.Serra Then {2º = Marina, 3º = Serra}
Begin
Write('2',#167,' ');
EscreveMarina;
Write('3',#167,' ');
EscreveSerra;
End
Else {2º = Marina = Serra}
Begin
Write('2',#167,' ');
EscreveSerra;
Write('2',#167,' ');
EscreveMarina;
End;
End
Else
If (InCVot.Marina > InCVot.Serra) And (InCVot.Marina > InCVot.Dilma) Then {1º = Marina}
Begin
Write('1',#167,' ');
EscreveMarina;
If InCVot.Serra > InCVot.Dilma Then {2º = Serra, 3º = Dilma}
Begin
Write('2',#167,' ');
EscreveSerra;
Write('3',#167,' ');
EscreveDilma;
End
Else
If InCVot.Dilma > InCVot.Serra Then {2º = Dilma, 3º = Serra}
Begin
Write('2',#167,' ');
EscreveDilma;
Write('3',#167,' ');
EscreveSerra;
End
Else {2º = Dilma = Serra}
Begin
Write('2',#167,' ');
EscreveSerra;
Write('2',#167,' ');
EscreveDilma;
End;
End
Else {Empates para 1º lugar}
If (InCVot.Serra = InCVot.Dilma) And (InCVot.Marina < InCVot.Dilma) Then {1º = Serra = Dilma, 2º = Marina}
Begin
Write('1',#167,' ');
EscreveSerra;
Write('1',#167,' ');
EscreveDilma;
Write('2',#167,' ');
EscreveMarina;
End
Else
If (InCVot.Serra = InCVot.Marina) And (InCVot.Dilma < InCVot.Serra) Then {1º = Serra = Marina, 2º = Dilma}
Begin
Write('1',#167,' ');
EscreveSerra;
Write('1',#167,' ');
EscreveMarina;
Write('2',#167,' ');
EscreveDilma;
End
Else
If (InCVot.Dilma = InCVot.Marina) And (InCVot.Serra < InCVot.Dilma) Then {1º = Dilma = Marina, 2º = Serra}
Begin
Write('1',#167,' ');
EscreveDilma;
Write('1',#167,' ');
EscreveMarina;
Write('2',#167,' ');
EscreveSerra;
End
Else {Empate total}
Begin
Write('1',#167,' ');
EscreveSerra;
Write('1',#167,' ');
EscreveDilma;
Write('1',#167,' ');
EscreveMarina;
End;
{Aprovação do Lula}
TextColor(Yellow);
WriteLn('.........................................');
WriteLn('Aprova',#135,#198,'o do governo Lula:');
WriteLn('.........................................');
{Ruim ou Péssimo}
Write('Ruim ou p',#130,'ssimo: ');
TextColor(LightGreen);
Write((100*(InCOp[1]+InCOp[2])/Eleitores):6:2,'% ');
Write((InCOp[1]+InCOp[2]):Max);
TextColor(Yellow);
Write(' eleitor');
If InCop[1]+InCop[2] > 1 Then
Write('es');
WriteLn;
TextColor(Yellow);
{Regular}
Write('Regular : ');
TextColor(LightGreen);
Write((100*InCOp[3]/Eleitores):6:2,'% ');
Write(InCOp[3]:Max);
TextColor(Yellow);
Write(' eleitor');
If InCop[3] > 1 Then
Write('es');
WriteLn;
TextColor(Yellow);
{Bom ou Ótimo}
Write('Bom ou ',#224,'timo : ');
TextColor(LightGreen);
Write((100*(InCop[4]+InCop[5])/Eleitores):6:2,'% ');
Write((InCOp[4]+InCOp[5]):Max);
TextColor(Yellow);
Write(' eleitor');
If InCop[4]+InCop[5] > 1 Then
Write('es');
WriteLn;
TextColor(Yellow);
WriteLn('.........................................');
End;

Begin
{BORDAS VERDE}
Window(1, 1, 80, 25);
TextBackGround(10);
ClrScr;
Window(3, 2, 78, 24);
TextBackGround(0);
ClrScr;

ContVotos.Dilma := 0;
ContVotos.Serra := 0;
ContVotos.Marina := 0;
TextColor(Yellow);
WriteLn('Seja bem vindo(a) ',#133,' nossa pesquisa.');
WriteLn('Pressione ENTER para iniciar...');
Repeat
Tecla:=ReadKey;
Until Ord(tecla) in [13,0];
if Ord(tecla)=0 then {se ENTER numérico}
ReadKey; {Corrige bug ENTER numérico}
ClrScr;
Repeat
{Ler voto}
Voto := LerVoto(ContVotos.Dilma+ContVotos.Serra+ContVotos.Marina+1);
With ContVotos Do
Case Voto Of
1: Serra:=Serra+1 ;
2: Dilma:=Dilma+1;
3: Marina:=Marina+1;
End;
{Ler opinião}
If Voto <> 0 Then
Begin
Voto := LerOpiniao(ContVotos.Dilma+ContVotos.Serra+ContVotos.Marina);
ContOpinioes[Voto]:=ContOpinioes[Voto]+1;
End;
Until Voto = 0;
Apuracao(ContVotos,ContOpinioes);
ReadKey;
End.
Program EX01;

A borda está logo no BEGIN principal, e como você usa Window em outros trechos, ele também tiveram de ser ajustados.

**

É isso ai...

PS: Qual é o compilador mesmo viniciusbmatos??

Abraços

Link para o comentário
Compartilhar em outros sites

Você está de brincadeira né??? :lol:

Olá, EstilingueAtomico.

Em comparação com o de pvfinger o seu está muito melhor sim! E no meu apenas acrescentei algumas coisas (na verdade, fiz tudo de um arquivo em branco:D, veja que o meu tem apenas 4 variáveis no programa principal, enquanto o seu tem 15).

1) Comando não reconhecidos em alguns compiladores

Tem compiladores que NÃO aceitam o comando "+=", se for o caso basta alterá os trechos..

É isso ai...

PS: Qual é o compilador mesmo viniciusbmatos??

Abraços

Estou utilizendo o Dev-Pascal, mas pelo que entendi ele usa o FPC.

O site do programa não existe mais (inclusive seu instalador), mas esta página mostra como era o site (e também disponibiliza o arquivo). Também hospedei aqui para download posterior. Uso-o porque não gosto de janelas com o estilo do DOS.

Ele tem a opção de aceitar esses comandos, acho que deixam o código mais "limpo":

magicalsnap201007281609.png

Ficou massa esse código...

Obrigado! Mas já perguntei algumas coisas "bobas", como esta e esta.

1) Function LerVoto()

  Repeat
ClrScr;
ReadLn(Receb);
Val(Receb, Saida, Erro);
Until (Erro = 0) And (Saida In [0..[COLOR="Red"]4[/COLOR]]);

Não seria 3 no lugar do 4 não?

Sim! Eu iria colocar o 4 para cancelar, então era [1..4], mas mudei para 0 e esqueci-me de corrigir! :(

2) Sair sem votar em ninguém

Se apertar "0" direto o programa trava... erro de divisão por "0". No caso não precisa nem fazer a conta...

Acho que está certo, pois o programa imprime "ou 0 para cancelar". Se o usuário apertou 0 no primeiro, não há apuração a ser feita, então acho que está certo fechar (embora não tivesse pensado nisso antes). Talvez o melhor seja finalizar o programa com um comando, não com um erro. Vou corrigir.

Aqui algumas dicas

3) Para aceitar ENTER do teclado numérico

  Repeat
Tecla:=ReadKey;
Until Ord(tecla) in [13,0];
if Ord(tecla)=0 then {se ENTER numérico}
ReadKey; {Corrige bug ENTER numérico}

(vê se roda certo ai)

Aqui, ambos os códigos funcionam tanto com o Enter do centro quanto com o da direita. Não entendi o que faz esta parte:

if Ord(tecla)=0 then {se ENTER numérico}
ReadKey;

4) Demonstração de bordas

Só implementei uma borda verde no código, só para efeito de demonstração!!!

(código)

A borda está logo no BEGIN principal, e como você usa Window em outros trechos, ele também tiveram de ser ajustados.

Ficou muito bom!

Só está faltando a pesquisa para o segundo turno...:lol:

Link para o comentário
Compartilhar em outros sites

  • Membro VIP

Olá,

viniciusbmatos

1) Compilador Dev-Pascal

Estou utilizendo o Dev-Pascal, mas pelo que entendi ele usa o FPC.

O site do programa não existe mais (inclusive seu instalador), mas esta página mostra como era o site (e também disponibiliza o arquivo). Também hospedei aqui para download posterior. Uso-o porque não gosto de janelas com o estilo do DOS.

Ele tem a opção de aceitar esses comandos, acho que deixam o código mais "limpo":

Eu também acho esse comando bem mais elegante. Mas de qualquer forma fica a dica para quem não consegui compilar, já que não é comum a todos os compiladores.

Outra forma também seria usar o comando Inc(X) (incrementa em 1) ou Inc(X,N) (incrementa em "N").

Ex:

Inc(Marina);  {ou Inc(Marina,1)}

...eu já tinha também uma versão guardada aqui do Dev-Pascal 1.9.2. Gostei dele. É bem semelhante ao que eu uso, mas não lembro porque deixei de usá-lo. Vou testá-lo melhor!

Tenho outros compiladores disponíveis também aqui.

2) Diferenças entre os ENTER

Realmente, no Dev-Pascal os ENTER funcionam normalmente, mas no meu compilador não (uso uma mistureba de NotePad++ 5.5.6 com compilador do Free Pascal Compiler 2.4.4).

Testei aqui no Turbo Pascal, funcionou também... ou seja, deve ser algum bug do meu NotePad++ mesmo (no caso do compilador FPC, já que o NotePad++ é somente um editor).

***

:)

No mais um abraços

Link para o comentário
Compartilhar em outros sites

Sobre o Dev-Pascal: uma desvantagem dele (não sei se os outros também são assim) é que a função "Compile and Run" não funciona caso a pasta do .pas contenha espaços ou caracteres especiais.

FIz uma nova versão do programa para ler as intenções de voto:

  • Mantive as bordas do EstilingueAtomico;
  • Adicionei a pesquisa para o segundo turno! Parece funcionar corretamente;
  • Utilizei Inc(x) em vez de x+=1;
  • Corrigi a função LerVoto para [0..3];
  • Coloquei os comandos para aceitar o Enter do teclado numérico em qualquer complador;
  • Adicionei exit; para sair sem votar (em vez de fechar por erro /0);
  • Agora o programa volta ao início do 1º turno caso haja empate total ou empate entre 2º e 3º e volta ao início do 2º turno caso haja empate 50%-50% (é claro, sem usar label e goto);

O código:

São 610 linhas, quer ver mesmo?

Tem certeza?

Aí está:


Program PesquisaDeOpiniao;

Uses
Crt, SysUtils;

Type
TVot = Record
Serra, Dilma, Marina: LongInt;
End;
TOp = Array [1..5] Of LongInt;
TVot2 = Array [1..2] Of LongInt;

Var
ContVotos: TVot;
ContOpinioes: TOp;
Voto: Byte;
Eleitores: LongInt;
Tecla, Vencedor: Char;
Voltar, Voltou, Haver2oT: Boolean;
Resultado, Resultado2: String;
Cand2oT: Array [1..2] Of String;
ContVotosSeg: TVot2;

Function LerVoto(QtdEleitores: LongInt) :Byte;
Var
Receb: String;
Erro, Saida: Integer;
Begin
TextColor(Yellow);
WriteLn(QtdEleitores:0,#167,' eleitor :');
WriteLn('Qual ser',#160,' seu voto para Presidente da Rep',#163,'blica nas Elei',#135,#229,'es 2010?');
TextColor(LightRed);
WriteLn('.........................................');
WriteLn('1. Jos',#130,' Serra');
WriteLn('2. Dilma Rousseff');
WriteLn('3. Marina Silva');
WriteLn(' ou 0 para terminar');
WriteLn('.........................................');
TextColor(LightCyan);
Window(3, WhereY+1, 78, 24);
Repeat
ClrScr;
ReadLn(Receb);
Val(Receb, Saida, Erro);
Until (Erro = 0) And (Saida In [0..3]);
LerVoto := Saida;
TextColor(Yellow);
Window(3, 2, 78, 24);
ClrScr;
End;

Function LerOpiniao(QtdEleitores: LongInt) :Byte;
Var
Receb: String;
Erro, Saida: Integer;
Begin
TextColor(Yellow);
WriteLn(QtdEleitores:0,#167,' eleitor :');
WriteLn('Qual a sua opini',#198,'o sobre os oito anos de governo do Presidente Lula?');
TextColor(LightRed);
WriteLn('.........................................');
WriteLn('1. P',#130,'ssimo'); // coloquei péssimo primeiro
WriteLn('2. Ruim'); // para ficar parecido
WriteLn('3. Regular'); // com uma nota de 0 a 5
WriteLn('4. Bom');
WriteLn('5. ',#224,'timo');
WriteLn('.........................................');
TextColor(LightCyan);
Window(3, WhereY+2, 78, 24);
Repeat
ClrScr;
ReadLn(Receb);
Val(Receb, Saida, Erro);
Until (Erro = 0) And (Saida In [1..5]);
LerOpiniao := Saida;
TextColor(Yellow);
Window(3, 2, 78, 24);
End;

Function Apuracao (InCVot: TVot; InCOP: TOp; InclOpiniao: Boolean):String;
Var
Eleitores, Max: Byte;
(* Begin - "Procedure"s *)
Procedure EscreveSerra;
Begin
{Serra}
TextColor(Yellow);
Write('Serra ');
TextColor(LightGreen);
Write(InCVot.Serra:Max);
TextColor(Yellow);
Write(' voto');
If InCVot.Serra>1 Then
Write('s ')
Else
Write(' ');
TextColor(LightGreen);
WriteLn((100*InCVot.Serra/Eleitores):6:2,'%');
TextColor(Yellow);
End;
Procedure EscreveDilma;
Begin
{Dilma}
TextColor(Yellow);
Write('Dilma ');
TextColor(LightGreen);
Write(InCVot.Dilma:Max);
TextColor(Yellow);
Write(' voto');
If InCVot.Dilma>1 Then
Write('s ')
Else
Write(' ');
TextColor(LightGreen);
WriteLn((100*InCVot.Dilma/Eleitores):6:2,'%');
TextColor(Yellow);
End;
Procedure EscreveMarina;
Begin
{Marina}
TextColor(Yellow);
Write('Marina ');
TextColor(LightGreen);
Write(InCVot.Marina:Max);
TextColor(Yellow);
Write(' voto');
If InCVot.Marina>1 Then
Write('s ')
Else
Write(' ');
TextColor(LightGreen);
WriteLn((100*InCVot.Marina/Eleitores):6:2,'%');
TextColor(Yellow);
End;
(* End - "Procedure"s *)
Begin
Eleitores := InCVot.Serra + InCVot.Dilma + InCVot.Marina;
Max := Length(IntToStr(Eleitores));
{Voto para Presidente}
WriteLn('*** PRIMEIRO TURNO ***');
WriteLn('.........................................');
WriteLn('Votos para Presidente:');
WriteLn('.........................................');
If (InCVot.Serra > InCVot.Dilma) And (InCVot.Serra > InCVot.Marina) Then {1º = Serra}
Begin
Write('1',#167,' ');
EscreveSerra;
If InCVot.Dilma > InCVot.Marina Then {2º = Dilma, 3º = Marina}
Begin
Apuracao := 'S.D.M';
Write('2',#167,' ');
EscreveDilma;
Write('3',#167,' ');
EscreveMarina;
End
Else
If InCVot.Marina > InCVot.Dilma Then {2º = Marina, 3º = Dilma}
Begin
Apuracao := 'S.M.D';
Write('2',#167,' ');
EscreveMarina;
Write('3',#167,' ');
EscreveDilma;
End
Else {2º = Marina = Dilma}
Begin
Apuracao := 'S.MD';
Write('2',#167,' ');
EscreveMarina;
Write('2',#167,' ');
EscreveDilma;
End;
End
Else
If (InCVot.Dilma > InCVot.Marina) And (InCVot.Dilma > InCVot.Serra) Then {1º = Dilma}
Begin
Write('1',#167,' ');
EscreveDilma;
If InCVot.Serra > InCVot.Marina Then {2º = Serra, 3º = Marina}
Begin
Apuracao := 'D.S.M';
Write('2',#167,' ');
EscreveSerra;
Write('3',#167,' ');
EscreveMarina;
End
Else
If InCVot.Marina > InCVot.Serra Then {2º = Marina, 3º = Serra}
Begin
Apuracao := 'D.M.S';
Write('2',#167,' ');
EscreveMarina;
Write('3',#167,' ');
EscreveSerra;
End
Else {2º = Marina = Serra}
Begin
Apuracao := 'D.SM';
Write('2',#167,' ');
EscreveSerra;
Write('2',#167,' ');
EscreveMarina;
End;
End
Else
If (InCVot.Marina > InCVot.Serra) And (InCVot.Marina > InCVot.Dilma) Then {1º = Marina}
Begin
Write('1',#167,' ');
EscreveMarina;
If InCVot.Serra > InCVot.Dilma Then {2º = Serra, 3º = Dilma}
Begin
Apuracao := 'M.S.D';
Write('2',#167,' ');
EscreveSerra;
Write('3',#167,' ');
EscreveDilma;
End
Else
If InCVot.Dilma > InCVot.Serra Then {2º = Dilma, 3º = Serra}
Begin
Apuracao := 'M.D.S';
Write('2',#167,' ');
EscreveDilma;
Write('3',#167,' ');
EscreveSerra;
End
Else {2º = Dilma = Serra}
Begin
Apuracao := 'M.DS';
Write('2',#167,' ');
EscreveSerra;
Write('2',#167,' ');
EscreveDilma;
End;
End
Else {Empates para 1º lugar}
If (InCVot.Serra = InCVot.Dilma) And (InCVot.Marina < InCVot.Dilma) Then {1º = Serra = Dilma, 2º = Marina}
Begin
Apuracao := 'SD.M';
Write('1',#167,' ');
EscreveSerra;
Write('1',#167,' ');
EscreveDilma;
Write('2',#167,' ');
EscreveMarina;
End
Else
If (InCVot.Serra = InCVot.Marina) And (InCVot.Dilma < InCVot.Serra) Then {1º = Serra = Marina, 2º = Dilma}
Begin
Apuracao := 'SM.D';
Write('1',#167,' ');
EscreveSerra;
Write('1',#167,' ');
EscreveMarina;
Write('2',#167,' ');
EscreveDilma;
End
Else
If (InCVot.Dilma = InCVot.Marina) And (InCVot.Serra < InCVot.Dilma) Then {1º = Dilma = Marina, 2º = Serra}
Begin
Apuracao := 'DM.S';
Write('1',#167,' ');
EscreveDilma;
Write('1',#167,' ');
EscreveMarina;
Write('2',#167,' ');
EscreveSerra;
End
Else {Empate total}
Begin
Apuracao := 'SDM';
Write('1',#167,' ');
EscreveSerra;
Write('1',#167,' ');
EscreveDilma;
Write('1',#167,' ');
EscreveMarina;
End;
{Aprovação do Lula}
If InclOpiniao Then
Begin
TextColor(Yellow);
WriteLn('.........................................');
WriteLn('Aprova',#135,#198,'o do governo Lula:');
WriteLn('.........................................');
{Ruim ou Péssimo}
Write('Ruim ou p',#130,'ssimo: ');
TextColor(LightGreen);
Write((100*(InCOp[1]+InCOp[2])/Eleitores):6:2,'% ');
Write((InCOp[1]+InCOp[2]):Max);
TextColor(Yellow);
Write(' eleitor');
If InCop[1]+InCop[2] > 1 Then
Write('es');
WriteLn;
TextColor(Yellow);
{Regular}
Write('Regular : ');
TextColor(LightGreen);
Write((100*InCOp[3]/Eleitores):6:2,'% ');
Write(InCOp[3]:Max);
TextColor(Yellow);
Write(' eleitor');
If InCop[3] > 1 Then
Write('es');
WriteLn;
TextColor(Yellow);
{Bom ou Ótimo}
Write('Bom ou ',#224,'timo : ');
TextColor(LightGreen);
Write((100*(InCop[4]+InCop[5])/Eleitores):6:2,'% ');
Write((InCOp[4]+InCOp[5]):Max);
TextColor(Yellow);
Write(' eleitor');
If InCop[4]+InCop[5] > 1 Then
Write('es');
WriteLn;
TextColor(Yellow);
WriteLn('.........................................');
End;
End;


Function LerVoto2 (QtdEleitores : LongInt; Nome1,Nome2:String):Byte;
Var
Receb: String;
Erro, Saida: Integer;
Begin
TextColor(Yellow);
WriteLn('*** SEGUNDO TURNO ***');
WriteLn(QtdEleitores:0,#167,' eleitor :');
WriteLn('Qual ser',#160,' seu voto para Presidente da Rep',#163,'blica nas Elei',#135,#229,'es 2010?');
TextColor(LightRed);
WriteLn('.........................................');
WriteLn('1. '+Nome1);
WriteLn('2. '+Nome2);
WriteLn(' ou 0 para terminar');
WriteLn('.........................................');
TextColor(LightCyan);
Window(3, WhereY+1, 78, 24);
Repeat
ClrScr;
ReadLn(Receb);
Val(Receb, Saida, Erro);
Until (Erro = 0) And (Saida In [0..2]);
LerVoto2 := Saida;
TextColor(Yellow);
Window(3, 2, 78, 24);
ClrScr;
End;

Function Apuracao2 (InCVot: TVot2; Nome1, Nome2: String):Boolean;
Var
Max, Venc: Byte;
QtdEleitores: LongInt;
(* Begin - Procedures *)
Procedure Escreve1;
Begin
TextColor(Yellow);
Write(Nome1);
TextColor(LightGreen);
Write(InCVot[1]:Max);
TextColor(Yellow);
Write(' voto');
If InCVot[1] > 1 Then
Write('s ')
Else
Write(' ');
TextColor(LightGreen);
WriteLn((100*InCVot[1]/QtdEleitores):6:2,'%');
TextColor(Yellow);
End;
Procedure Escreve2;
Begin
TextColor(Yellow);
Write(Nome2);
TextColor(LightGreen);
Write(InCVot[2]:Max);
TextColor(Yellow);
Write(' voto');
If InCVot[2] > 1 Then
Write('s ')
Else
Write(' ');
TextColor(LightGreen);
WriteLn((100*InCVot[2]/QtdEleitores):6:2,'%');
TextColor(Yellow);
End;
(* End - Procedures *)
Begin
WriteLn('*** SEGUNDO TURNO ***');
WriteLn('.........................................');
WriteLn('Votos para Presidente:');
WriteLn('.........................................');
Apuracao2 := False;
QtdEleitores := InCVot[1]+InCVot[2];
Max := Length(IntToStr(QtdEleitores));
If InCVot[2] > InCVot[1] Then
Venc := 2
Else
If InCVot[2] < InCVot[1] Then
Venc := 1
Else
Begin
Venc := 0;
Apuracao2 := True;
End;
If Venc = 2 Then
Begin
TextColor(Yellow);
Write('1',#167,' ');
Escreve2;
Write('2',#167,' ');
Escreve1;
End
Else
If Venc = 1 Then
Begin
TextColor(Yellow);
Write('1',#167,' ');
Escreve1;
Write('2',#167,' ');
Escreve2;
End
Else {empate}
Begin
TextColor(Yellow);
Write('1',#167,' ');
Escreve1;
Write('1',#167,' ');
Escreve2;
End;
WriteLn('.........................................');
End;


Begin {Programa principal}
Voltou := False;
Voltar := True;
{BORDAS VERDES}
Window(1, 1, 80, 25);
TextBackGround(10);
ClrScr;
Window(3, 2, 78, 24);
TextBackGround(0);
ClrScr;
TextColor(Yellow);
WriteLn('Seja bem vindo(a) ',#133,' nossa pesquisa.');
WriteLn('Pressione ENTER para iniciar...');
Repeat
Tecla:=ReadKey;
Until Ord(tecla) in [13,0];
If Ord(tecla)=0 then {se ENTER numérico}
ReadKey; {Corrige bug ENTER numérico}
While Voltar do
Begin
ContVotos.Dilma := 0;
ContVotos.Serra := 0;
ContVotos.Marina := 0;
ClrScr;
Repeat
{Ler voto}
Voto := LerVoto(ContVotos.Dilma+ContVotos.Serra+ContVotos.Marina+1);
With ContVotos Do
Case Voto Of
1: Inc(Serra) ;
2: Inc(Dilma);
3: Inc(Marina);
End;
{Ler opinião}
If (Voto <> 0) And Not Voltou Then
Begin
Voto := LerOpiniao(ContVotos.Dilma+ContVotos.Serra+ContVotos.Marina);
ContOpinioes[Voto]:=ContOpinioes[Voto]+1;
End;
Until Voto = 0;
Eleitores := ContVotos.Serra + ContVotos.Dilma + ContVotos.Marina;
If Eleitores <> 0 Then
Resultado := Apuracao(ContVotos, ContOpinioes, Not Voltou)
Else
Exit;
{Descobrir se haverá segundo turno}
Haver2oT := False;
If not (Pos('.',Resultado) in [0,2]) Then {se há empate total ou há empate entre 2º e 3º}
If (((Resultado[1] = 'S') And (ContVotos.Serra/Eleitores <= 0.5))
Or ((Resultado[1] = 'D') And (ContVotos.Dilma/Eleitores <= 0.5))
Or ((Resultado[1] = 'M') And (ContVotos.Marina/Eleitores<= 0.5)))
Then
Begin
Haver2oT := True;
Voltar := False;
Cand2oT[1] := Resultado[1];
Cand2oT[2] := Resultado[2];
End;
{Se venceu no primeiro turno}
If ( (ContVotos.Serra/Eleitores > 0.5)
Or (ContVotos.Dilma/Eleitores > 0.5)
Or (ContVotos.Marina/Eleitores> 0.5)
)
Then
Voltar := False;
{Caso precise voltar}
If Voltar Then
Begin
TextColor(LightRed);
WriteLn('***************************************************************');
TextBackGround(Blue);
WriteLn('Houve um empate, a pesquisa para o primeiro turno ser',#160,' refeita.');
WriteLn('Pressione ENTER para iniciar...');
TextBackGround(Black);
Repeat
Tecla:=ReadKey;
Until Ord(tecla) In [13,0];
If Ord(tecla)=0 Then {se ENTER numérico}
ReadKey; {Corrige bug ENTER numérico}
Voltou := True;
End;
{Caso haja segundo turno}
If Haver2oT Then
Begin
TextColor(LightRed);
WriteLn('***************************************************************');
TextBackGround(Blue);
WriteLn('Pressione ENTER para iniciar a pesquisa para o segundo turno...');
TextBackGround(Black);
Repeat
Tecla:=ReadKey;
Until Ord(tecla) In [13,0];
If Ord(tecla)=0 Then {se ENTER numérico}
ReadKey; {Corrige bug ENTER numérico}
End;
End;
{Segundo Turno}
Voltar := True;
While Voltar And Haver2oT Do {Segundo turno}
Begin
ClrScr;
ContVotosSeg[1] := 0;
ContVotosSeg[2] := 0;
Repeat
{Ler voto}
If Cand2oT[1] = 'S' Then
If Cand2oT[2] = 'M' Then
Voto := LerVoto2 (ContVotosSeg[1]+ContVotosSeg[2]+1, 'Jos'+#130+' Serra', 'Marina Silva')
Else {Cand2oT[2] = 'D'}
Voto := LerVoto2 (ContVotosSeg[1]+ContVotosSeg[2]+1, 'Jos'+#130+' Serra', 'Dilma Rousseff')
Else
If Cand2oT[1] = 'D' Then
If Cand2oT[2] = 'S' Then
Voto := LerVoto2 (ContVotosSeg[1]+ContVotosSeg[2]+1, 'Dilma Rousseff', 'Jos'+#130+' Serra')
Else {Cand2oT[2] = 'M'}
Voto := LerVoto2 (ContVotosSeg[1]+ContVotosSeg[2]+1, 'Dilma Rousseff', 'Marina Silva')
Else {Cand2oT[1] = 'M'}
If Cand2oT[2] = 'S' Then
Voto := LerVoto2 (ContVotosSeg[1]+ContVotosSeg[2]+1, 'Marina Silva ', 'Jos'+#130+' Serra')
Else {Cand2oT[2] = 'D'}
Voto := LerVoto2 (ContVotosSeg[1]+ContVotosSeg[2]+1, 'Marina Silva ', 'Dilma Rousseff');
If Voto <> 0 Then
Inc(ContVotosSeg[Voto]);
Until Voto = 0;
Eleitores := ContVotosSeg[1] + ContVotosSeg[2];
{Apuração}
If Eleitores <> 0 Then
Begin
If Cand2oT[1] = 'S' Then
If Cand2oT[2] = 'M' Then
Voltar := Apuracao2 (ContVotosSeg, 'Serra ', 'Marina ')
Else {Cand2oT[2] = 'D'}
Voltar := Apuracao2 (ContVotosSeg, 'Serra ', 'Dilma ')
Else
If Cand2oT[1] = 'D' Then
If Cand2oT[2] = 'S' Then
Voltar := Apuracao2 (ContVotosSeg, 'Dilma ', 'Serra ')
Else {Cand2oT[2] = 'M'}
Voltar := Apuracao2 (ContVotosSeg, 'Dilma ', 'Marina ')
Else {Cand2oT[1] = 'M'}
If Cand2oT[2] = 'S' Then
Voltar := Apuracao2 (ContVotosSeg, 'Marina ', 'Serra ')
Else {Cand2oT[2] = 'D'}
Voltar := Apuracao2 (ContVotosSeg, 'Marina ', 'Dilma ');
End
Else
Exit;
If Voltar Then
Begin
TextColor(LightRed);
WriteLn('***************************************************************');
TextBackGround(Blue);
WriteLn('Houve um empate, a pesquisa para o segundo turno ser',#160,' refeita.');
WriteLn('Pressione ENTER para continuar...');
TextBackGround(Black);
Repeat
Tecla:=ReadKey;
Until Ord(tecla) In [13,0];
If Ord(tecla)=0 Then {se ENTER numérico}
ReadKey; {Corrige bug ENTER numérico}
End;
End;
TextColor(LightRed);
WriteLn('***************************************************************');
TextBackGround(Blue);
WriteLn('Pesquisas conclu',#161,'das........');
WriteLn('Pressione ENTER para sair...');
TextBackGround(Black);
Repeat
Tecla:=ReadKey;
Until Ord(tecla) In [13,0];
If Ord(tecla)=0 Then {se ENTER numérico}
ReadKey; {Corrige bug ENTER numérico}
End.

Link para o comentário
Compartilhar em outros sites

  • Membro VIP
repeat
readln(voto);
until voto in [0..3];

repeat
readln(opiniao);
until opiniao in [1..5];

daria pra trocar esses dois comandos usando o While ??? como ficaria ???velho na boa .. espero um dia fazer isso igual a você's.. hsuahshuasua

Olá,

pvfinger, dá!!! E digo mais:

Todo e qualquer tipo de laço de repetição pode ser substituído por outro, ou seja, o que um faz, qualquer outro pode fazer

O que muda é que cada uma tem suas características, sobretudo na forma de implementação. (uns são mais práticos que outros para cada caso).

Veja as 3 principais formas

While: "Verifica antes de iniciar" (só começa se a condição já for favorável)

Repeat: "executa e depois verifica se quer repetir" (usado quando se sabe que sempre será executado pelo menos uma vez, logo não sendo necessário verificar antes)

For: "Executa determinada quantidade de vezes, baseada num contador e que este pode ser usado durante os loops." (usado quando se quer executar uma quantidade pre-fixada de loops e/ou se necessita de uma variável numérica se que "auto-incrementa", ou decrementa, de 1 em 1)

***

Quer ver?

Com Repeat

repeat
readln(voto);
until voto in [0..3];

Com While

voto:=-1; {um valor que faça a condição ser verdadeira para poder entrar}
while not (voto in [0..3]) do
readln(voto);

Com For

for i:=1 to 1 do
begin
readln(voto);
if not (voto in [0..3]) then
i:=0; {no final de cada loop, o "i" é incrementado em 1, logo passará a ser "1" novamente e assim repetindo o loop}
end;

Veja que uma forma é mais prática que outra, daí qual escolher?

Isso vai da prática e dos critério da lógica de programação.

Veja que num contexto geral, nesse caso, o repeat é mais adequado, pois se sabe que sempre vai ter que ler o voto pelo menos uma vez. Mas veja que o While também poderia ser usado, pois ela dá uma ideia de proteção, ou seja, só vai "ser executado porque eu quero", e por último o for, que neste caso dá pra vê que foi feito um armengue total... uma adaptação para se comportar como esperado. Veja que neste caso, o for perdeu toda a sua característica, que sereia ter uma quantidade de loops pré-definidos e/ou a questão de poder aproveitar a variável numérica dentro dele.

Como disse, cada tipo de laço vai ser mais prático do que o outro para determinada situação. Tudo depende da prática.

***

Não tem mistério.

Como sugestão tente ai converter para Repeat e para While esse código abaixo.

{imprime os 10 primeiros números pares}
for i:=1 to 10 do
writeln(i*2);

Abraços

for

Abraços

Link para o comentário
Compartilhar em outros sites

Olá,

***

Não tem mistério.

Como sugestão tente ai converter para Repeat e para While esse código abaixo.

{imprime os 10 primeiros números pares}
for i:=1 to 10 do
writeln(i*2);

Abraços

Já que o pvfinger não colocou aqui, vou pôr para o caso de alguém ler o tópico posteriormente:


i := 0;
repeat
inc(i);
writeln(i*2);
until i = 10;


i := 0;
while i < 10 do
begin
inc(i);
writeln(i*2);
end;


for i := 1 to 20 do
if i mod 2 = 0 then
writeln(i);

Link para o comentário
Compartilhar em outros sites

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

 

GRÁTIS: ebook Redes Wi-Fi – 2ª Edição

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!