Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- { Autor : Tiago Portela
- Email : sapitando@gmail.com
- Sobre o programa : Ele ordena os numeros buscando o ultimo menor e colocando ele em primeiro,
- e deslocando todos a frente e pulando ele mesmo depois. O limite de 38 é
- por causa da interface, mas ele ordenaria indefinidamente.
- Compatível com Turbo Pascal e FreePascal.
- Lazarus não aceitou minha manipulação de string "NroStr[0]".
- Obs : Apenas tentando aprender algoritimos, sozinho, por hobby. }
- {$G+}
- {$N+}
- program ordenador_de_numeros;
- uses crt;
- const MaxSizeList = 38;
- var Nro : array [1..MaxSizeList] of extended;
- NroAux1, NroAux2 : extended;
- PosArray, PosLastSmaller, CounterPos, TotalPos, LastPos, FirstPos : word;
- NroStr : string;
- Code : integer;
- begin
- clrscr;
- textcolor(white);
- write(' Programa '); textcolor(red); write('ORDENADOR DE NUMEROS');
- textcolor(white); write('. Voce pode digitar ate ');
- textcolor(yellow); write(MaxSizeList) ; textcolor(white); writeln(' numeros.');
- writeln;
- textcolor(white);
- writeln(' Digite o numero : ');
- gotoxy(1,25); write(' Digite '); textcolor(yellow); write('Esc'); textcolor(white); write(' para sair.');
- write(' Digite '); textcolor(yellow); write('Espaco'); textcolor(white); write(' para ordenar.');
- gotoxy(21,3);
- TotalPos := 0;
- CounterPos := 1;
- repeat
- NroStr[CounterPos] := readkey;
- case NroStr[CounterPos] of
- #0 : readkey;
- #8 : if CounterPos > 1
- then begin
- write(#8#32#8);
- dec(CounterPos);
- dec(NroStr[0]);
- end;
- #13 : if (CounterPos > 1) and (TotalPos < MaxSizeList) and
- (not ((pos(#46,NroStr) = 1) and (CounterPos = 2)))
- then begin
- inc(TotalPos);
- val(NroStr,Nro[TotalPos],Code);
- window(2,5,39,23);
- if TotalPos > 19
- then gotoxy(18, TotalPos - 19)
- else gotoxy(1, TotalPos);
- write(Nro[TotalPos] : 15 : 2);
- window(1,1,80,25);
- gotoxy(21,3);
- clreol;
- CounterPos := 1;
- NroStr := '';
- end;
- #32 : if TotalPos > 1
- then begin
- FirstPos := 1;
- LastPos := TotalPos;
- for PosArray := FirstPos to (LastPos - 1) do
- begin
- NroAux1 := Nro[PosArray];
- PosLastSmaller := PosArray;
- for CounterPos := (PosArray + 1) to LastPos do
- if NroAux1 >= Nro[CounterPos]
- then begin;
- PosLastSmaller := CounterPos;
- NroAux1 := Nro[PosLastSmaller];
- end;
- if PosLastSmaller > PosArray
- then for CounterPos := PosArray to LastPos do
- begin
- if (CounterPos >= PosLastSmaller) and (CounterPos < LastPos)
- then NroAux2 := Nro[CounterPos + 1]
- else NroAux2 := Nro[CounterPos];
- Nro[CounterPos] := NroAux1;
- NroAux1 := NroAux2;
- end;
- end;
- window(42,5,79,23);
- textcolor(magenta);
- for CounterPos := 1 to TotalPos do
- begin
- if CounterPos > 19
- then gotoxy(18, CounterPos - 19)
- else gotoxy(1, CounterPos);
- write(Nro[CounterPos] : 15 : 2);
- end;
- window(1,1,80,25);
- textcolor(white);
- gotoxy(52,25);
- write('Digite '); textcolor(red); write('Enter');
- textcolor(white); write(' para zerar.');
- gotoxy(21,3);
- clreol;
- repeat
- NroStr[1] := readkey;
- until NroStr[1] in [#13, #27];
- gotoxy(52,25);
- clreol;
- window(1,5,80,23);
- clrscr;
- window(1,1,80,25);
- gotoxy(21,3);
- TotalPos := 0;
- CounterPos := 1;
- NroStr := '';
- end;
- #46, #44 : if (CounterPos <= 13) and (pos(#46,NroStr) = 0) and (TotalPos < MaxSizeList)
- then begin
- NroStr[CounterPos] := #46;
- write(NroStr[CounterPos]);
- inc(CounterPos);
- inc(NroStr[0]);
- end;
- #48..#57 : if ((CounterPos <= 12) and (TotalPos < MaxSizeList)
- and ((CounterPos < pos(#46,NroStr) + 3) or (pos(#46,NroStr) = 0)))
- or (((pos(#46,NroStr) = 13) or (pos(#46,NroStr) = 12)
- or (pos(#46,NroStr) = 11)) and (CounterPos < pos(#46,NroStr) + 3))
- then begin
- write(NroStr[CounterPos]);
- inc(CounterPos);
- inc(NroStr[0]);
- end;
- end;
- until NroStr[CounterPos] in [#27];
- textcolor(lightgray);
- clrscr;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement