IPB
ЛогинПароль:

> Правила раздела!

1. Заголовок или название темы должно быть информативным !
2. Все тексты фрагментов программ должны помещаться в теги [code] ... [/code] или [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ" и используйте ПОИСК !
4. НЕ используйте форум для личного общения!
5. Самое главное - это раздел теоретический, т.е. никаких задач и программ (за исключением небольших фрагментов) - для этого есть отдельный раздел!

> !!!Переход от одной системы счисления к другой!!!
Trofimov Artur
сообщение 10.05.2003 14:27
Сообщение #1


Гость






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

Все должно выглядеть примерно так:
Сначала забается из какой сис-мы ныжно совершить перевод, а потом в какую. Далее выводится результат.
Или так:
Вводится число в определенной сис-ме счисления и выводется его значение в других сис-мах.
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Паук
сообщение 11.05.2003 6:05
Сообщение #2


Гость






Код
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-ричную
Другие делаются аналогично.
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 26.07.2025 8:02
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"