Program na prevod čísel z dvojkovej do desiatkovej sústavy alebo naopak

{ 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);
  vysledok := 0;
 
  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.