!!!Переход от одной системы счисления к другой!!! Опции

[Trofimov Artur]

Товарищи!!!
Помогите пожалуйста.
До сессии мне ныжно написать программу перевода числа из одной системы счисления в другую (bin, oct, dec, hex).
Сам почему-то не могу :о( Не получается.
Помогите пожалуйста.

Все должно выглядеть примерно так:
Сначала забается из какой сис-мы ныжно совершить перевод, а потом в какую. Далее выводится результат.
Или так:
Вводится число в определенной сис-ме счисления и выводется его значение в других сис-мах.

[GLuk]

Выложи то, что начал... поможем  ;)

[___ALex___]

прочитай сначала теорию по с/c
потом все вопросы сами собой отпадут

[Паук]

Код

uses CRT;

const
     h15 = '0123456789ABCDEF';

var
     hold_in, dec_str, hex_str: string;
     hex_digits: array [0..15] of Char;
     ch: Char;
     k: Integer;

procedure initialize;
var
     j: Word;
     temp: string [Length(h15)];
begin
     temp := h15;
     for j := 0 to 15 do hex_digits[j] := temp[j + 1];
end;

procedure get_decimal(var dec_str: string );
var
     k: Word;
begin
     repeat
           WriteLn('Введите строку десятичных цифр:');
           ReadLn(dec_str);
           if dec_str = '' then
                 Halt;
           {Удалить недесятичные символы}
           for k := Length(dec_str) downto 1 do
                 if not (dec_str[k] in ['0'..'9']) then
                       Delete(dec_str, k, 1);
           {Удалить нули в старших разрядах}
           while (Length(dec_str) > 1) and (dec_str[1] = '0') do
                 Delete(dec_str, 1, 1);
           if Length(dec_str) > 0 then
                 Exit;
           WriteLn('Ошибка при вводе, повторите');
           WriteLn;
     until false;
end;

procedure convert(var dec_str, hex_str: string );
var
     remainder: Integer;

procedure divide_by_16;
{Строка dec_str, состоящая из десятичных цифр, делится на 16.
Остаток далее будет преобразован в следующую шестнадцатеричную цифру.
Частное преобразуется в строку dec_str}
var
     j, k,
     dividend: Word;
     error: Integer;
begin
     remainder := 0; {0 <= remainder <= 15}
     for j := 1 to Length(dec_str) do
     begin
           if KeyPressed then
                 Halt;
           Val(dec_str[j], k, error);
           dividend:= 10*remainder + k;
           {0 <= dividend<= 159}
           remainder := dividend mod 16;
           {0 <= remainder <= 15}
           dec_str[j] := hex_digits[dividend div 16];
     end;
     Delete(dec_str, 1, 1);
end;{divide_by_16}

begin
     hex_str := '';
     while Length(dec_str) > 0 do
     begin
           if KeyPressed then Halt;
           divide_by_16;
           hex_str := hex_digits[remainder] + hex_str;
     end;
end;{convert}

begin
     initialize;
     repeat
           get_decimal(dec_str);
           hold_in := dec_str;
           convert(dec_str, hex_str);
           k := Length(hold_in) - 2;
           while k > 1 do
           begin
                 Insert(',', hold_in, k);
                 Dec(k, 3);
           end;
           Write(hold_in, ' = $');
           while Length(hex_str) mod 4 <> 0 do
           hex_str := '0' + hex_str;
           k := Length(hex_str) - 3;
           while k > 1 do
           begin
                 Insert(' ', hex_str, k);
                 Dec(k, 4);
           end;
           WriteLn(hex_str); WriteLn;
           WriteLn('Для продолжения работы нажмите <Enter>, а для окончания <Esc>');
           ch := ReadKey;
           if ch = #27 then Break;
           WriteLn;
     until false;
end.

Это перевод из 10-тичной в 16-ричную
Другие делаются аналогично.

[AlaRic]

Из 10 с/с в любую с/с:

Код

Var
 a,b,i,m,n,k : Integer;
 s,s1,s2: string;
Begin
 WriteLn('Введите 10-ное число: ');
 Readln(a);
 WriteLn('Введите основание системы счисления: ');
 Readln(b);
 s:='';s1:='';s2:='';
 i:=1;
 k:=a;
 While  a>0 do
   begin
     m:= a mod b;
     a:=a div b;
     if m>9 then
       case m of
         10: s2:='A';
         11: s2:='B';
         12: s2:='C';
         13: s2:='D';
         14: s2:='E';
         15: s2:='F';
       end
     else
       str(m,s2);
     s:=s+s2;
     i:=i+1;
   end;
 for i:=1 to Length(s) do
   s1:=s1+s[Length(s)-i+1];
 WriteLn('10-ное число ',k,' = ',b,'-ному ',s1);
 ReadLn;
end.

[mj]

Вот клёвенький пример

Program Perevod;
 Uses Crt;
 Const P1='Перевод из ';                                            { константы для начального меню }
       s:array [1..7] of string[50]=(p1+'десятеричного кода в двоичный.',
                                     p1+'двоичного кода в десятеричный.',
                                     p1+'десятеричного кода в шестнадцатиричный.',
                                     p1+'шестнадцатиричного кода в десятеричный.',
                                     p1+'двоичного кода в шестнадцатиричный.',
                                     p1+'шестнадцатиричного кода в двоичный.',
                                     '            ESC - ВЫХОД В DOS');
 Var Promeg,Chast:Longint;
     Znach,j:Integer;
     Klav:Char;
     i,Stroka,Isx,Kon,y,Kol,Help:Byte;
     Keys: Set of '0'..'F';
     a: Array [1..255] of Char;
     Otv,Pom: string;
 Procedure Zast;                                                    { процедура вывода меню }
   begin
     Window(1,1,80,24);                                             { выделить окно 80х24 }
     ClrScr;                                                        { очистить окно }
     TextColor(15);                                                 { установить цвет - белый }
     FOR I:=1 TO 7 do begin                                         { цикл по строкам }
       GoToXY (15,I*2); Write (s[i]);                               { формирование меню }
     end;
   end { zast };                                                    { конец процедуры меню }
 Function Stepen (Chis,St: Byte): Longint;                          { функция возведения в степень }
   var c: Byte;
       Res: longint;
   begin
     Res:=1;
     For c:=1 to st do Res:=Res*chis;
     Stepen:=Res;                                                   { присвоение функции значения }
   End { Stepen };                                                  { конец функции возведения в сепень }

 Begin                                                              { НАЧАЛО ОСНОВНОЙ ПРОГРАММЫ }
 y:=1;                                                              { y - текущая строка в меню }
 Zast;                                                              { вывести меню }
 Repeat                                                             { цикл для перемещения в меню }
   TextColor(13);
   GoToXY (13,y*2); Write(Chr(16));                                 { вывести метку текущей строки меню }
   klav:=ReadKey;                                                   { считывание клавиши в klav }
   GoToXY (13,y*2); Write(' ');                                     { стирание старой метки текущей строки }
   if Ord(Klav)=72 then if y > 1 then y:=y-1 else y:= 7;            { если клавиша ВВЕРХ }
   if Ord(Klav)=80 then if y < 7 then y:=y+1 else y:= 1;            { если клавиша ВНИЗ }
   if Ord(Klav)=27 then begin y:=7; klav:=Chr(13) end;              { если клавиша ESC }
   if (Ord(Klav)=13) and (y<7) then begin                           { если клавиша ВВОД не на выходе }
     ClrScr;                                                        { очистить экран }
     TextCOLOR (13); GoToXY (20, 1); Write (s[y]);                  { вывести название перевода }
     TextCOLOR (10); GoToXY (31,24); Write ('ESC - ВЫХОД В МЕНЮ');  { вывести клавишу для выхода }
     TextColor(15);                                                 { поменять цвет - белый }
     Window(1,2,80,23);                                             { установить окно со 2 по 23 строки }
     Stroka:=2;                                                     { текущая строка }

[mj]

     Case y of                                                      { определение клавиш которые можно будет нажимать }
       1,3 : begin                                                  { если перевод из десятиричного кода }
               Isx:=10;
               Keys:=['0'..'9'];                                    { возможные клавиши }
               If y=1 Then Kon:=2 else Kon:=16;                     { присвоение системы исчисления результата }
             end;
       2,5 : begin
               Isx:= 2;
               Keys:=['0','1'];                                     { определение клавиш которые можно будет нажимать }
               If y=2 Then Kon:=10 else Kon:=16;                    { присвоение системы исчисления результата }
             end;
       4,6 : begin
               isx:=16;
               keys:=['0'..'9','A'..'F'];                           { определение клавиш которые можно будет нажимать }
               if y=4 then kon:=10 else kon:=2;                     { присвоение системы исчисления результата }
             end;
     end;
     Repeat                                                         { основной цикл для перевода }
       Write('? '); Promeg:=0; Kol:=0; Otv:='';                     { подготовительные действия }
       Repeat                                                       { цикл для ввода числа }
         klav:=ReadKey;                                             { чтение клавиши }
         if UpCase(Klav) in Keys then begin                         { если клавиша допустимая }
           kol:=kol+1;                                              { количество символов в исходном числе }
           a[kol]:=UpCase(Klav);                                    { запоминание введенного символа }
           Write (a[kol]);                                          { вывод нажатого символа }
         end;
         if (Ord(Klav)=8) and (Kol>0) then begin                    { если клавиша ЗАБОЙ }
           kol:=kol-1;
           GoToXY(WhereX-1,WhereY);
           ClrEol;
         end;
       Until (Ord(klav)=13) or (Ord(klav)=27);                      { пока не нажата ВВОД или ESC }
       if Ord(klav)=13 then begin                                   { если клавиша ВВОД - начало обработки результата }
         for i:=1 to kol do begin                                   { перевода введенного числа в десятеричную систему}
           if a[i]<'A' then Znach:=Ord(a[i])-48
           else Znach:=Ord(a[i])-55;
           promeg:=promeg+Znach*Stepen(isx,kol-i);
         end;
         i:=0;
         Repeat                                                     { определение максимального порядка результата }
           i:=i+1;
           Chast:=Trunc(Promeg/Stepen(Kon,i));
         Until Chast<Kon;
         For j:=i downto 0 do begin                                 { перевод в нужную систему исчисления }
           Help:=Trunc(Promeg/Stepen(Kon,j));
           If Help>9 Then Pom:=Chr(55+Help)
           Else Str(Help,Pom);
           Otv:=Otv+Pom;
           Promeg:=Promeg-Help*Stepen(Kon,j);
         end;
         WriteLn(' = ',Otv);                                        { вывод результата }
       end;                                                         { конец обработки результата }
     Until Ord(Klav)=27;                                            { если нажата ESC то выход в основное меню }
     Zast;                                                          { вывод заставки }
   end;
 Until (Ord(Klav)=13) and (y=7);                                    { если в меню нажали ESC или ВВОД на выходе }
 ClrScr                                                             { очистить экран }
 end.