Localize file www.TrSek.com/zadania/sustava.pas
{ SUSTAVA.PAS                                                       }
{ Program na prevod cisel z dvojkovej do desiatkovej sustavy        }
{ alebo na prevod z desiatkovej do dvojkovej sustavy.               }
{                                                                   }
{ Author: Juraj Pupak                                               }
{ Date  : 27.10.2006                           http://www.trsek.com }

program Sustava;
uses crt;

Function VypocetMocniny(str_number : string) : integer;
var
  i : integer;
  modulo : integer;
  vysledok : longint;
  numeral_count : integer;
begin
  modulo:=1;
  numeral_count := length(str_number);

  For i:=numeral_count downto 1 Do
    begin
      if str_number[i] = '1' then
        begin
          vysledok:=vysledok+modulo;
        end;

      modulo:=modulo*2;
    end;

  VypocetMocniny := vysledok;
end;

Function IsBinary(number : string) : Boolean;
var
  IsTrue  : Boolean;
  a,dlzka : integer;
begin
  dlzka:=length(number);
  IsTrue := True;

  For a:=1 to dlzka do
    begin
      IF (number[a]<>'0') and (number[a]<>'1') then
         IsTrue := False;
    end;

  IsBinary := IsTrue;
end;

var
  number,zvysok : longint;
  number1 : string;
  temp2 : integer;
  zapis : string;
  Cstr : string;
  Cstr1 : string;
  menu : integer;

begin
  clrscr;
  writeln('Vyber aky prevod chces spravit');
  writeln('1. Z dvojkovej sustavy do desiatkovej');
  writeln('2. Z desiatkovej susatvy do dvojkovej');
  writeln('3. Koniec');
  readln(menu);

  IF menu = 1 THEN
    begin

      Repeat
        clrscr;
        writeln('Zadaj cislo');
        readln(number1);
      Until IsBinary(number1);

      temp2 := VypocetMocniny(number1);
      writeln(temp2);
      readln;
    end;

 IF menu = 2 THEN
  begin
    writeln('Zadaj cislo');
    readln(number);

    Repeat
      zvysok := number mod 2;
      number := number div 2;
      Str(zvysok,zapis);
      Cstr := zapis;
      Cstr1 := Cstr + Cstr1;
    Until number = 0;

    writeln(Cstr1);
    readln;
  end;
end.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com