Системы счисления, Перевести из одной в другую! Опции

[_JC_]

Помогите решить задачу:
Информация: Натуральное число, записанное в шестнадцатиричной системе счисления в формате string.
Задание: Вывести значение этого числа в восьмиричной системе счисления.
Примечание: значение числа может не вмещаться в формат longint, но вмещается в string.

[volvo]

Когда-то делал вот такое. Посмотри, может тебе подойдет?

function HexToBin(s: string): string;
  function get_index(ch: char): byte;
  begin
    case upcase(ch) of
      '0'..'9': get_index := ord(ch) - ord('0');
      'A'..'F': get_index := $A + ord(upcase(ch)) - ord('A');
    end;
  end;

const
  h_b: array[0 .. $F] of string[4] =
    ('0000', '0001', '0010', '0011',
     '0100', '0101', '0110', '0111',
     '1000', '1001', '1010', '1011',
     '1100', '1101', '1110', '1111');
var
  i: integer;
  res: string;
begin
  res := '';
  for i := 1 to length(s) do
    res := res + h_b[ get_index(s[i]) ];
  HexToBin := res;
end;

function BinToOct(s: string): string;
  const
    b_oct: array[0 .. 7] of string[3] =
      ('000', '001', '010', '011',
       '100', '101', '110', '111');

  function get_index(st: string): byte;
  var i: integer;
  begin
    for i := 0 to 7 do
      if st = b_oct[i] then begin
        get_index := i; exit
      end;
  end;

var
  res, group: string;

begin
  while s[1] = '0' do
    delete(s, 1, 1);

  while (length(s) mod 3) <> 0 do
    s := '0' + s;

  while length(s) >= 3 do begin
    group := copy(s, length(s)-2, 3);
    delete(s, length(s)-2, 3);
    res := chr(ord('0')+get_index(group)) + res;
  end;
  BinToOct := res;
end;

Вызывать как-то вот так:

writeln( BinToOct(HexToBin('1234')) );

[_JC_]

Спасибо попробую, а можешь мне ещё одну помочь сделать. Вот такую:
Исходная информация: целое число А, записанное в системе счисления с основанием 4 в формате string.
Задание: вывести значение числа А в двоичной системе счисления.
Примечание: двоичное представление числа А может не вмещаться в формат string.

[volvo]

:no: Эта задача абсолютно аналогична предыдущей (за исключением того, что используется переход 4 -> 2, а не 16 -> 8), попробуй ее сделать сам.

То, что двоичное представление не помещается в строку - не страшно, просто нужно сразу распечатывать пары символов, а не сохранять их, как делал я в функции HexToBin ...

[_JC_]

Т.е. что бы сделать вторую задачу мне надо изменить
1)значение массивов(array 0..4)
2)case upcase(ch) of
'0'..'9': get_index := ord(ch) - ord('0');
'A'..'F': get_index := $A + ord(upcase(ch)) - ord('A');-что то изменить тут=)
3)везде где 0..7(0 to 7 do)ставить 0..4
4)напиши что ещё поменять а то я плохо знаю паскаль и что бы разобраться
в 1-ой задаче уйдёт не мало времени а что бы написать самому.......а время поджимает!

[_JC_]

Ну что же ты ответь пожалуйста volvo! Please!

[volvo]

Ну что же ты ответь пожалуйста volvo! Please!

Понимаешь, до тех пор, пока ты не будешь хотя бы пытаться сделать что-то САМ, толку не будет... От того, что кто-то решает ЗА ТЕБЯ, ты лучше разбираться не станешь.

Неужели это было ТАК сложно?

procedure QuarToBin(s: string);
  function get_index(ch: char): byte;
  begin
    get_index := ord(ch) - ord('0');
  end;

const
  q_b: array[0 .. 3] of string[2] =
    ('00', '01', '10', '11');
var
  i: integer;
begin
  while s[1] = '0' do
    delete(s, 1, 1);

  for i := 1 to length(s) do
    write( q_b[ get_index(s[i]) ] );
end;

[_JC_]

=)Ты знаешь я воспользовался твоими ссылками с функциями и применил тот способ и у меня всё получилось! Спасибо! Удаляй эту тему если она не кому больше не нужна! Спасибо ещё раз!

[NorthAngel]

Смотрела в faq - не нашла, если что - пост сразу удалю.
В общем, нужно мне в написать подпрограммку перевода из разлиынх систем счисления, но только чтобы переводились НЕ целые числа, а десятичные дроби.

Может, у кого-нибудь есть готовый код таких функций.. просто не охото "изобретать велосипед", хотя, в принципе, ничего сверхсложного там нет


Спасибо, volvo!

Сообщение отредактировано: NorthAngel - 16.12.2005 20:26

[volvo]

Когда-то нашел вот такую программку (переводит числа из 10 системы счисления в другую):

uses crt;

const
    value     = 0.1875; { число, которое будем переводить }
    base      = 2;         { в какую систему переводим }
    precision = 5;        { точность }

var
    ivalue, nbase, digit, k : integer;
    fvalue, eps             : real;
    sym                     : char;

begin
    ivalue := trunc(value);
    fvalue := value - ivalue;

    nbase := 1;
    while (ivalue >= nbase) do nbase := nbase * base;
    while (nbase > 1) do begin
        nbase := nbase div base;
        digit := ivalue div nbase;
        ivalue := ivalue - digit * nbase;
        if (digit < 10) then sym := chr(48+digit)
                        else sym := chr(55+digit);
        write(sym);
    end;

    write('.');
    eps := 1;
    for k := 1 to precision do eps := eps * base;

    for k := 1 to precision do begin
        digit := trunc(fvalue * base);
        fvalue := fvalue * base - digit;
        if (digit < 10) then sym := chr(48+digit)
                        else sym := chr(55+digit);
        write(sym);
        if (fvalue < 1/eps) then break;
    end;

    writeln;
    readkey;
end.