задача:перевод чисел, прошу помощи в доработке Опции

[Kubus]

в общем есть у меня курсавая. Задача написать программку перевода чисел из разных систем счисления в другие(с основаниями от 2 до 16) с дробной частью. Задача не новая да и не особо сложноя. Сделал я ее и понес к преподу. Там-то и выяснилось, что сделана она через одно местно, так как программка переводит отдельно дробную, отдельно целую часть, а это неправильно. Так вот может кто-нибудь возьмется помочь и отредактирует так, как надо? или мож у кого готовая есть? а то мне сдавать в понедельник, а у самого завал с мейплом, не успеваю. Буду очень, очень благодарен.

вот исходный текст:

 Program Radix1;
uses crt;
var
      ch : char;
      continue : boolean;
      radix,i : integer;
      number : real;
      int,decimal : integer;
function enter_radix : integer;
begin
      repeat
             clrscr;
             writeln('Input radix  ');
             readln(radix);
      until (radix>=2) and (radix<=16);
enter_radix:= radix;
end;

function get_val(c:char) : integer;
begin
      if (c>='0') and (c<='9')
      then get_val := ord© - ord('0')
      else if (c>='a') and (c<='f')
      then get_val:= ord©-ord('a')+10
      else if(c>='A') and (c<='F')
      then get_val:= ord©-ord('A')+10
      else
      get_val:= - 10000;
end;

function in_radix(radix: integer; c: char): boolean;
Var
      x : integer;
Begin
      x:= get_val©;
      if(radix<=abs(x)) then in_radix:= false
      else in_radix:= true;
end;

function get_char(x : integer) : char;
begin
      if(x<10)then get_char:= chr(x+ord('0'))
      else get_char:= chr(x-10+ord('A'));
end;

function enter_digit(radix : integer; Var int, decimal : integer) : boolean;
Var   str : string[21];
      z : char;
      i,l : integer;
      dot_flag : boolean;
begin
dot_flag:= false;
int:= 0;
decimal:= 0;
writeln('Input number with radix = ',radix);
readln(str);
l:=length(str);
writeln(int);
      for i:= 1 to l do
             begin
                    if(str[i]='.' ) then
                           begin
                                  if dot_flag then
                                         begin
                                         enter_digit:=false;
                                         exit;
                                         end
                                  else
                           dot_flag:= true;
                           end
                    else if in_radix (radix, str[i]) then
                    begin
                           if dot_flag then
                                  begin
                                  decimal:= decimal*radix+get_val(str[i]);
                                  end
                           else
                           begin
                           int:= int*radix+get_val(str[i]);
                           end;
                    end
                    else
                    begin
                    enter_digit:= false;
                    exit;
                    end;
               end;
               enter_digit:= true;
end;

procedure print_number(radix : integer; num : integer);
Var   c : char;
      i,j : integer;
      out : string[20];
      q,r : integer;
begin
      for i:=1 to 20 do out[i]:=' ';
             repeat
             q:=num div radix;
             r:=num mod radix;
             c:= get_char®;
             out[i]:= c;
             i:= i-1;
             num:= q;
             until num = 0;
      i:= 1;
      while(out[i]=' ') do i:=i+1;
             for j:= i to 20 do write  (out[j]);
end;

procedure startup_init;
Var
      i,j : integer;
      c : char;
begin
textmode (co80);
clrscr;
textcolor(0);
textbackground(10);
clrscr;
gotoxy (11,19);
      for i:=11 to 70 do write (#219);
             for i:=7 to 19 do
                    begin
                    gotoxy(71,i);
                    writeln(#219);
                    END;
             window (10,6,70,17);
             textbackground(blue);
             textcolor(0);
             clrscr;
             window(10,6,70,21);
             write(#218);
                    for i:=11 to 69 do write (#196);
                    write(#191);
                           for i:=2 to 12 do
                                  begin
                                  gotoxy(1,i);
                                  write(#179);
                                  gotoxy (61,i);
                                  write(#179);
                                  end;
                           write(#192);
                           gotoxy(2,13);
                                  for i:=11 to 69 do write (#196);
                                  write(#217);
                                  window(12,7,68,12);
                                  textcolor(lightgreen);
end;

begin
startup_init;
ch:='r';
while ch='r' do
      begin
      radix:=enter_radix;
             repeat
             clrscr;
             continue:=enter_digit(radix,int,decimal);

             until continue;
      radix:=enter_radix;
      clrscr;
      writeln('Nuber in radix = ',radix);
      print_number(radix,int);
             if(decimal<>0) then
                    begin
                    write('.');
                    print_number(radix,decimal);
                    end;
             gotoxy(1,4);

             writeln('Press r to repeat');
             writeln('and other kay to exit');
             ch:=readkey;
      end;
end.

Сообщение отредактировано: Kubus - 24.12.2005 23:08

[Kubus]

подскажите, пожалуйста, что нужно изменить, чтоб этот кусочек счетал не из десятичной в двоичную, а из любой в любую?

[Гость]

подскажите, пожалуйста, что нужно изменить, чтоб этот кусочек счетал не из десятичной в двоичную, а из любой в любую?

Код

(*
Function Dec2Hex (num: Word): String;  { перевод из 10-ичной в 16-ичную }
Function Dec2Bin (num: word): String;  { перевод из 10-ичной в 2-ичную }
Function Hex2Dec (hs:string): longint; { перевод из 16-ичной в 10-ичную }
Function Bin2Dec (S: String): longint; { перевод из 2-ичной в 10-ичную }
*)

Function Dec2Hex (num: Word): String;
var result: string;
    remainder: word;
    c: char;
begin
     result := '';
     while num <> 0 do
     begin
          remainder := num mod 16;
          num := num div 16; { или  num := num shr 4 }
          if remainder < 10 then
             c := chr (remainder + ord ('0'))
          else
             c := chr (remainder + ord ('A') - 10);
          result := c + result;
     end;
     Dec2Hex := '$' + result
end;

Function Dec2Bin (num: word): String;
var result: string;
    remainder: word;
    c: char;
begin
     result := '';
     while num <> 0 do
     begin
          remainder := num mod 2;
          num := num div 2; { или num := num shr 1 }
          c := chr (remainder + ord ('0'));
          result := c + result;
     end;
     Dec2Bin := result
end;

Function Hex2Dec (hs:string): longint;
var
  res,k: longint;
  r,i: word;
  c: char;
begin
       res := 0;
       k := 1;
       for i := length (hs) downto 1 do
       begin
            c := UpCase (hs[i]);
            case c of
            'A'..'F': r := ord(c) - (ord('A') - 10);    { ord (c) - 55 }
            '0'..'9': r := ord(c) - ord('0');           { ord (c) - 48 }
            else break
            end;
            inc (res, r * k); { res := res + r * k}
            k := k * 16; { или k := k shl 4 }
       end;
       Hex2Dec := res;
end;

Function Bin2Dec (S: String): longint;
var
  i, bit: word;
  p, result: longint;
Begin
       result := 0;
       p := 1;
       for i := length (S) downto 1 do
       begin
            bit := ord (S[i]) - ord ('0');
            inc (result, bit * p);
            p := p * 2;                    { или   p := p shl 1 }
       end;
       Bin2dec:=result;
End;

begin
     writeln (dec2bin (2004));
     writeln (dec2hex (2004));
     writeln (hex2dec ('fff0'));
     writeln (bin2dec ('11111010100'))
end.

Может это приблизит тебя к истине !