1) Перевод чисел из десятичной системы исчисления в заданную;
2) Перевод чисел из системы с заданным основанием в десятичную;
Program Perevod;
Const {Описание констант}
mas: array [0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
var {Описание переменных}
str: string;
m: real;
n: byte;
{Описание Процедур и функций}
function alert(n: byte): boolean; {Функция проверки основания системы}
begin
if (n<2) or (n>16) then
result:=true;
{Вывод сообщения}
end;
function trans(c: char): byte; {Функция перевода символа в число}
begin
{Перевод символа в верхний регистр}
Case c of
{Перевод соответствующего символа в число}
end;
end;
function AnyToInt(s: string; n: byte): longint; {Функция перевода E->10 цел}
begin
for i:=1 to length(s) do
begin
{Перевод символа в число}
{Перевод в 10 систему}
end;
end;
function AnyToFrac(s: string; n: byte): real; {Функция перевода E->10 дроб}
begin
if s='' then exit; {Выход при отсутствии дробной части}
for i:=length(s) downto 1 do
begin
{Перевод символа в число}
{Перевод в 10 систему}
end;
end;
function IntToAny(m: longint; n: byte): string; {Функция перевода 10->E цел}
begin
res:='';
while m>0 do
begin
{определение остатка}
{конкотенация с предыдущим результатом}
{определение целой части от деления}
end;
end;
function FracToAny(r: real; n: byte): string; {Функция перевода 10->E дроб}
begin
i:=1;
st:='';
while r<>0 do
begin
{умножение дробной части на основание системы}
{конкотенация с целой частью предыдущего выражения}
{выделение дробной части}
if i>15 then break; {выход из цикла если дробь периодическая}
end;
end;
procedure AnyToDec(s: string; n: byte); {Процедура перевода E->10}
var
str1, str2: string;
i,j: shortint;
flag: boolean;
begin
if alert(n) then exit; {Выход из процедуры при неправильном основании}
for i:=1 to length(s) do {Проверка допустимых символов}
begin
if s[i]='.' then continue;
if (s[i] in ['g'..'z','G'..'Z']) or (trans(s[i])>=n) then
{вывод уведомления и выход}
end;
flag:=false;
for i:=1 to length(s) do
{вычисление позиции точки}
{копирование первой подстроки}
if flag then {копирование второй подстроки}
{вызов функций перевода}
end;
procedure DecToAny(m: real; n: byte); {Процедура перевода 10->E}
var
l: longint;
r: real;
begin
if alert(n) then exit;
l:=trunc(m);
r:=frac(m);
{вызов функций перевода}
end;
begin
repeat
{Вывод описания доступных операция}
Readln(n);
Case n of
1: begin
{запрос числа}
Readln(m);
{запрос нового основания для перевода}
Readln(n);
DecToAny(m,n);
end;
2: begin
{запрос числа}
Readln(str);
{запрос основания числа}
Readln(n);
AnyToDec(str,n);
end;
3: exit;
end;
until false;
end.
Проверим оба направления перевода. Для начала выберем перевод (10 => 2), и введём число 8.25, в ответ программа выдаёт результат 1000.01, что соответствует действительности.
Далее выберем направление (16 => 10), и введём число FF, в ответ программа выдаёт 255, что соответствует действительности.
Рисунок 1 – Результат работы программы
Program Perevod;
const
mas: array [0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
var
str: string;
m: real;
n: byte;
function alert(n: byte): boolean;
begin
result:=false;
if (n<2) or (n>16) then
begin
writeln('Вы ввели неправильную систему счисления, попробуйте снова.');
result:=true;
end;
{end if}
end;
function trans(c: char): byte;
var
tmp: byte;
begin
c:=UpCase(c);
Case c of
'A': tmp:=10;
'B': tmp:=11;
'C': tmp:=12;
'D': tmp:=13;
'E': tmp:=14;
'F': tmp:=15
else tmp:=StrToInt(c);
end;
result:=tmp;
end;
function AnyToInt(s: string; n: byte): longint;
var
res: longint;
i, tmp: byte;
begin
res:=0;
for i:=1 to length(s) do
begin
tmp:=trans(s[i]);
res:=res*n+tmp;
end;
{end for}
result:=res;
end;
function AnyToFrac(s: string; n: byte): real;
var
res: real;
i, tmp: byte;
begin
if s='' then exit;
res:=0;
for i:=length(s) downto 1 do
begin
tmp:=trans(s[i]);
res:=(res+tmp)/n;
end;
{end for}
result:=res;
end;
function IntToAny(m: longint; n: byte): string;
var
tmp, res: string;
begin
res:='';
while m>0 do
begin
tmp:=mas[m mod n];
res:=tmp+res;
m:=m div n;
end;
{end while}
result:=res;
end;
function FracToAny(r: real; n: byte): string;
var
i: byte;
st: string;
d: integer;
begin
i:=1;
st:='';
while r<>0 do
begin
r:=r*n;
st:=st+mas[trunc(r)];
r:=frac(r);
inc(i);
if i>15 then break;
end;
{end while}
result:=st;
end;
procedure AnyToDec(s: string; n: byte);
var
str1, str2: string;
i,j: shortint;
flag: boolean;
begin
if alert(n) then exit;
for i:=1 to length(s) do
begin
if s[i]='.' then continue;
if (s[i] in ['g'..'z','G'..'Z']) or (trans(s[i])>=n) then
begin
Writeln('Вы ввели неправильное число для заданной системы счисления!');
exit;
end;
{end if}
end;
{end for}
flag:=false;
for i:=1 to length(s) do
if s[i]='.' then
begin
flag:=true;
j:=i-1;
break;
end
else
j:=i;
{end if}
{end for}
str1:=copy(s,1,j);
if flag then
str2:=copy(s,i+1,length(s)-i)
else
str2:='';
{end if}
if str2='' then
Writeln(s,'(',n,') = ',AnyToInt(str1,n),'(10)')
else
Writeln(s,'(',n,') = ',AnyToInt(str1,n)+AnyToFrac(str2,n),'(10)');
{end if}
end;
procedure DecToAny(m: real; n: byte);
var
l: longint;
r: real;
begin
if alert(n) then exit;
l:=trunc(m);
r:=frac(m);
if r=0 then
Writeln(m,'(10) = ',IntToAny(l,n),'(',n,')')
else
Writeln(m,'(10) = ',IntToAny(l,n)+'.'+FracToAny(r,n),'(',n,')');
{end if}
end;
begin
repeat
Writeln('- Перевести десятичное число в заданную систему(1)');
Writeln('- Перевести число из заданной системы в десятичную(2)');
Writeln('- Выход(3)');
Write('Ваш выбор[1-3]: ');
Readln(n);
Writeln;
Case n of
1: begin
Write('Введите число: ');
Readln(m);
Write('Введите основание системы счисления для перевода[2-16]: ');
Readln(n);
DecToAny(m,n);
Readln;
end;
2: begin
Write('Введите число: ');
Readln(str);
Write('Введите основание системы счисления[2-16]: ');
Readln(n);
AnyToDec(str,n);
Readln;
end;
3: exit;
end;
until false;
end.
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.
