Advertisement
sapitando

Ordenador de números em Pascal(Array).

Jul 29th, 2016
275
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 5.66 KB | None | 0 0
  1. { Autor : Tiago Portela
  2.   Email : sapitando@gmail.com
  3.   Sobre o programa : Ele ordena os numeros buscando o ultimo menor e colocando ele em primeiro,
  4.                      e deslocando todos a frente e pulando ele mesmo depois. O limite de 38 é
  5.                      por causa da interface, mas ele ordenaria indefinidamente.
  6.                      Compatível com Turbo Pascal e FreePascal.
  7.                      Lazarus não aceitou minha manipulação de string "NroStr[0]".
  8.   Obs : Apenas tentando aprender algoritimos, sozinho, por hobby. }
  9. {$G+}
  10. {$N+}
  11. program ordenador_de_numeros;
  12. uses crt;
  13.  
  14. const MaxSizeList = 38;
  15.  
  16.  
  17. var Nro : array [1..MaxSizeList] of extended;
  18.     NroAux1, NroAux2 : extended;
  19.     PosArray, PosLastSmaller, CounterPos, TotalPos, LastPos, FirstPos : word;
  20.     NroStr : string;
  21.     Code : integer;
  22.  
  23.  
  24.  
  25. begin
  26.  clrscr;
  27.  textcolor(white);
  28.  write('     Programa '); textcolor(red); write('ORDENADOR DE NUMEROS');
  29.  textcolor(white); write('. Voce pode digitar ate ');
  30.  textcolor(yellow); write(MaxSizeList) ; textcolor(white); writeln(' numeros.');
  31.  writeln;
  32.  textcolor(white);
  33.  writeln(' Digite o numero : ');
  34.  gotoxy(1,25); write(' Digite '); textcolor(yellow); write('Esc'); textcolor(white); write(' para sair.');
  35.  write(' Digite '); textcolor(yellow); write('Espaco'); textcolor(white); write(' para ordenar.');
  36.  gotoxy(21,3);
  37.  TotalPos := 0;
  38.  CounterPos := 1;
  39.  repeat
  40.   NroStr[CounterPos] := readkey;
  41.   case NroStr[CounterPos] of
  42.  
  43.    #0       : readkey;
  44.  
  45.    #8       : if CounterPos > 1
  46.               then begin
  47.                     write(#8#32#8);
  48.                     dec(CounterPos);
  49.                     dec(NroStr[0]);
  50.                    end;
  51.  
  52.    #13      : if (CounterPos > 1) and (TotalPos < MaxSizeList) and
  53.               (not ((pos(#46,NroStr) = 1) and (CounterPos = 2)))
  54.               then begin
  55.                     inc(TotalPos);
  56.                     val(NroStr,Nro[TotalPos],Code);
  57.                     window(2,5,39,23);
  58.                     if TotalPos > 19
  59.                     then gotoxy(18, TotalPos - 19)
  60.                     else gotoxy(1, TotalPos);
  61.                     write(Nro[TotalPos] : 15 : 2);
  62.                     window(1,1,80,25);
  63.                     gotoxy(21,3);
  64.                     clreol;
  65.                     CounterPos := 1;
  66.                     NroStr := '';
  67.                    end;
  68.  
  69.    #32      : if TotalPos > 1
  70.                  then begin
  71.                        FirstPos := 1;
  72.                        LastPos := TotalPos;
  73.                        for PosArray := FirstPos to (LastPos - 1) do
  74.                         begin
  75.                          NroAux1 := Nro[PosArray];
  76.                          PosLastSmaller := PosArray;
  77.                          for CounterPos := (PosArray + 1) to LastPos do
  78.                           if NroAux1 >= Nro[CounterPos]
  79.                           then begin;
  80.                                 PosLastSmaller := CounterPos;
  81.                                 NroAux1 := Nro[PosLastSmaller];
  82.                                end;
  83.                          if PosLastSmaller > PosArray
  84.                          then for CounterPos := PosArray to LastPos do
  85.                                begin
  86.                                 if (CounterPos >= PosLastSmaller) and (CounterPos < LastPos)
  87.                                 then NroAux2 := Nro[CounterPos + 1]
  88.                                 else NroAux2 := Nro[CounterPos];
  89.                                 Nro[CounterPos] := NroAux1;
  90.                                 NroAux1 := NroAux2;
  91.                                end;
  92.                         end;
  93.                        window(42,5,79,23);
  94.                        textcolor(magenta);
  95.                        for CounterPos := 1 to TotalPos do
  96.                         begin
  97.                          if CounterPos > 19
  98.                          then gotoxy(18, CounterPos - 19)
  99.                          else gotoxy(1, CounterPos);
  100.                          write(Nro[CounterPos] : 15 : 2);
  101.                         end;
  102.                        window(1,1,80,25);
  103.                        textcolor(white);
  104.                        gotoxy(52,25);
  105.                        write('Digite '); textcolor(red); write('Enter');
  106.                        textcolor(white); write(' para zerar.');
  107.                        gotoxy(21,3);
  108.                        clreol;
  109.                        repeat
  110.                         NroStr[1] := readkey;
  111.                        until NroStr[1] in [#13, #27];
  112.                        gotoxy(52,25);
  113.                        clreol;
  114.                        window(1,5,80,23);
  115.                        clrscr;
  116.                        window(1,1,80,25);
  117.                        gotoxy(21,3);
  118.                        TotalPos := 0;
  119.                        CounterPos := 1;
  120.                        NroStr := '';
  121.                       end;
  122.  
  123.    #46, #44 : if (CounterPos <= 13) and (pos(#46,NroStr) = 0) and (TotalPos < MaxSizeList)
  124.               then begin
  125.                     NroStr[CounterPos] := #46;
  126.                     write(NroStr[CounterPos]);
  127.                     inc(CounterPos);
  128.                     inc(NroStr[0]);
  129.                    end;
  130.  
  131.    #48..#57 : if ((CounterPos <= 12) and (TotalPos < MaxSizeList)
  132.               and ((CounterPos < pos(#46,NroStr) + 3) or (pos(#46,NroStr) = 0)))
  133.               or (((pos(#46,NroStr) = 13) or (pos(#46,NroStr) = 12)
  134.               or (pos(#46,NroStr) = 11)) and (CounterPos < pos(#46,NroStr) + 3))
  135.               then begin
  136.                     write(NroStr[CounterPos]);
  137.                     inc(CounterPos);
  138.                     inc(NroStr[0]);
  139.                    end;
  140.  
  141.   end;
  142.  until NroStr[CounterPos] in [#27];
  143.  textcolor(lightgray);
  144.  clrscr;
  145. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement