Перевод целых 10-ых чисел в 16 с.с->2с.с->8c.c

[Anna17_04]

Помогите пожалуйста!
У меня задача, перевод целых 10-ых чисел в 16 с.с->2с.с->8c.c
Я сделала отдельные процедуры по переводу из 10 в 16-ю и из 2-ой в 8-ую, а из 16-ой в 2-ую не могу ссобразить как мне нужно описать процедуру.
Задача по практике, очень нужна ваша помощь. Заранее спасибо

From Stilet: Не надо лезть в чужую тему. Посты перенес.

[newerow1989]

function s16to2(s:string):string;
var i:integer;
begin
   Result:='';
   For i:=1 to Length(s) do
      Case s[i] of
      '0': Result:=Result+'0000';
      '1': Result:=Result+'0001';
      '2': Result:=Result+'0010';
      '3': Result:=Result+'0011';
      '4': Result:=Result+'0100';
      '5': Result:=Result+'0101';
      '6': Result:=Result+'0110';
      '7': Result:=Result+'0111';
      '8': Result:=Result+'1000';
      '9': Result:=Result+'1001';
      'A','a': Result:=Result+'1010';
      'B','b': Result:=Result+'1011';
      'C','c': Result:=Result+'1100';
      'D','d': Result:=Result+'1101';
      'E','e': Result:=Result+'1110';
      'F','f': Result:=Result+'1111';
      end;
end;

begin
   Writeln(s16to2('Ac1870'));
   Readln;
end.

Сойдет?

[Anna17_04]

Она не работает((

[newerow1989]

Как это не работает? Покажи ошибку!

В следующий раз меня не пугай!!! См. рис.

[Anna17_04]

Так у меня число вводиться с клавиатуры и мне нужно переводить его в разные системы счисления по цепочке

[newerow1989]

Так у меня число вводиться с клавиатуры

Изменить

begin
   Writeln(s16to2('Ac1870'));

на

var s:string;
begin
   Readln(s);
   Writeln(s16to2(s));

Я сделала отдельные процедуры по переводу из 10 в 16-ю и из 2-ой в 8-ую

Выкладывай сюда - я склею их! Все 3 перевода!

[Anna17_04]

{Перевод целых 10-ых чисел в 16-ю с.с->2c.c->8c.c}

program perevod;
const trd:array[0..7] of string[3]=('000','001','010','011','100','101','110','111');
Var s2, s8:string;
    i: byte;

Procedure perev10_16;
const znach: array [0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
var a: longint; res : string; d:0..15;
begin

writeln('введите число в десятеричной системе счисления-');
readln (a);
res := ' '; {инициализируем строку, в которой затем будем накапливать шестнадцатиричное представление.}
while (a<>0) do
begin
d := a mod 16;
a := a div 16;
res := znach[d]+res; {накапливаем строку из шестнадцатиричных цифр}
end;
writeln ('Число в 16 с.с-',res);
Writeln('__________________________');
end;

procedure perev2_8;
var i, k: byte;
a:string;
Begin

k:=0;
i:=1;
while (i<=length(a))and(k=0) do
if not(a[i] in ['0','1']) then k:=1
else i:=i+1;
//перевод в СС 8
while length(a) mod 3 <> 0 do a:='0'+a;
//дополняем строку влево до длины, крастной 3
s8:='';
while a<>'' do
  begin
  for i:=1 to 7 do
  if copy(a,1,3)=trd[i] then s8:=s8+chr(i+48);
  //сравниваем с массивом значений для перевода и записываем найденное значение в строку s8
  delete(a,1,3); //удаляем триаду
  end;
Write('Число в 8СС: ');
Writeln(s8);
end;

Begin
perev10_16;
perev2_8;
end.

Если не сложно, я буду очень признательна


Anna17_04, следующий раз свою тему создавайте, а не в чужой свои вопросы решайте
Модератор

[Anna17_04]

Извините, я не знала. Буду иметь в виду

[newerow1989]

procedure s16to2(var s:string);
var i:integer;
    Result:string;
begin
   Result:='';
   For i:=1 to Length(s) do
      Case s[i] of
      '0': Result:=Result+'0000';
      '1': Result:=Result+'0001';
      '2': Result:=Result+'0010';
      '3': Result:=Result+'0011';
      '4': Result:=Result+'0100';
      '5': Result:=Result+'0101';
      '6': Result:=Result+'0110';
      '7': Result:=Result+'0111';
      '8': Result:=Result+'1000';
      '9': Result:=Result+'1001';
      'A','a': Result:=Result+'1010';
      'B','b': Result:=Result+'1011';
      'C','c': Result:=Result+'1100';
      'D','d': Result:=Result+'1101';
      'E','e': Result:=Result+'1110';
      'F','f': Result:=Result+'1111';
      end;
   Writeln('Число в 16 с.с - ',Result);
   Writeln('__________________________ ');
   s:=Result;
end;

Procedure perev10_16(var res:string);
const znach: array [0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
var a: longint; d:0..15;
begin
  writeln('введите число в десятеричной системе счисления - ');
  readln (a);
  res := ''; {инициализируем строку, в которой затем будем накапливать шестнадцатиричное представление.}
  while (a<>0) do
  begin
    d := a mod 16;
    a := a div 16;
    res := znach[d]+res; {накапливаем строку из шестнадцатиричных цифр}
  end;
  writeln ('Число в 16 с.с - ',res);
  Writeln('__________________________ ');
end;

procedure perev2_8(a:string);
const trd:array[0..7] of string[3]=('000','001','010','011','100','101','110','111');
var i, k: byte;
    s8:string;
Begin
  k:=0;
  i:=1;
  while (i<=length(a))and(k=0) do
    if not(a[i] in ['0','1']) then k:=1
    else i:=i+1;
  //перевод в СС 8
  while length(a) mod 3 <> 0 do a:='0'+a;
  //дополняем строку влево до длины, крастной 3
  while a<>'' do
  begin
    for i:=0 to 7 do//с нуля надо начинать!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       if copy(a,1,3)=trd[i] then s8:=s8+chr(i+48);
       //сравниваем с массивом значений для перевода и записываем найденное значение в строку s8
    delete(a,1,3); //удаляем триаду
  end;
  Write('Число в 8СС: ');     
  Writeln(s8);
end;

var s:string;
Begin
  perev10_16(s);
  s16to2(s);
  perev2_8(s);
  Readln;
end.

Переделал. Там в процедуре perev2_8 исправил ошибку!

[Anna17_04]

Огромное спасибо! Все отлично работает))
А что была за ошибка?