Помогите решить задачу:
Информация: Натуральное число, записанное в шестнадцатиричной системе счисления в формате string.
Задание: Вывести значение этого числа в восьмиричной системе счисления.
Примечание: значение числа может не вмещаться в формат longint, но вмещается в string.
Когда-то делал вот такое. Посмотри, может тебе подойдет?
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')) );
Спасибо попробую, а можешь мне ещё одну помочь сделать. Вот такую:
Исходная информация: целое число А, записанное в системе счисления с основанием 4 в формате string.
Задание: вывести значение числа А в двоичной системе счисления.
Примечание: двоичное представление числа А может не вмещаться в формат string.
:no: Эта задача абсолютно аналогична предыдущей (за исключением того, что используется переход 4 -> 2, а не 16 -> 8), попробуй ее сделать сам.
То, что двоичное представление не помещается в строку - не страшно, просто нужно сразу распечатывать пары символов, а не сохранять их, как делал я в функции HexToBin ...
Т.е. что бы сделать вторую задачу мне надо изменить
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-ой задаче уйдёт не мало времени а что бы написать самому.......а время поджимает!
Ну что же ты ответь пожалуйста 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;
=)Ты знаешь я воспользовался твоими ссылками с функциями и применил тот способ и у меня всё получилось! Спасибо! Удаляй эту тему если она не кому больше не нужна! Спасибо ещё раз!
Смотрела в faq - не нашла, если что - пост сразу удалю.
В общем, нужно мне в написать подпрограммку перевода из разлиынх систем счисления, но только чтобы переводились НЕ целые числа, а десятичные дроби.
Может, у кого-нибудь есть готовый код таких функций.. просто не охото "изобретать велосипед", хотя, в принципе, ничего сверхсложного там нет
Спасибо, 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.