Две задачи на системы счисления Опции

[-Chester-]

Друг попросил помочь, а я, мягко говоря, в программировании не силен
Если не трудно, помогите пожалуйста... Не дайте, так сказать ударить в грязь лицом...

ЗАДАЧА 1: Перевести число, представленное в системе счисления с основанием S, в системы счисления с основаниями P, Q, R. Обеспечить корректность ввода числа в системе счисления с основанием S. Перевод чисел реализовать с применением функций. (Разработайте функцию для перевода числа из системы счисления с основанием S в систему счисления с основанием P, а затем, функции для перевода из P в Q и из P в R.) Не использовать стандартных возможностей по вводу/выводу чисел представленных в 2-ой, 8-ой, 16-ой системах счисления. Для представления цифр больших 9 использовать заглавные буквы латинского алфавита.
ЗАДАЧА 2: Вывести на экран в виде таблицы значения чисел из интервала от A до B с шагом C в системах счисления с основаниями S, P, Q, R. Числа A, B, C задаются в системе счисления с основанием S, A>=0, B>A. Обеспечить точность 5 знаков после запятой во всех системах счисления. Разработайте функцию для сложения двух чисел в системе счисления с основанием S.
S=7 P=10 Q=19 R=28

[volvo]

Да что ты говоришь? А РАЗОБРАТЬСЯ в работе этого пресловутого "универсального" переводчика - не судьба? Только один пример:

function simvol(n:byte):char;
begin
  if n in [10..15] then simvol:=chr(n+55)
  else simvol:=chr(n+48);
end;

Всё !!! Однозначный диагноз: правильно работает ТОЛЬКО для систем счисления с основанием <= 16... Я добавлю эту ремарку по ссылке...

Вот, кстати, моя программа, выполняющая нужные тебе действия. И результат проверен на бумаге:
666666 (7) = 117648 (10) = H2H0 (19) ...

const
  _symbols: string = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';

function FromDec(n, radix:longint):string;
var
  s: string;
begin
  s := '';
  repeat
    s := _symbols[(n mod radix)+1] + s;
    n := n div radix;
  until n = 0;
  FromDec := s;
end;

function ToDec(n:string; radix:longint):longint;
var
  m, i: longint;
begin
  m := 0;
  while n[1] = '0' do delete(n, 1, 1);
  for i := 1 to length(n) do
    m := m * radix + pos(n[i],_symbols) - 1;
  ToDec := m;
end;

function isCorrect(n: string; radix: longint): boolean;
var
  bad: boolean;
  i: integer;
begin
  bad := False;
  i := 0;
  repeat
    inc(i);
    bad := (pos(n[i], copy(_symbols, 1, radix)) = 0);
  until bad or (i = length(n));
  isCorrect := not bad;
end;


var
  s: string;

begin
  write('(7) : '); readln(s);
  if not isCorrect(s, 7) then writeln('error !!!')
  else begin
    writeln('(19): ', fromdec(todec(s, 7), 19) );
    writeln('(28): ', fromdec(todec(s, 7), 28) );
  end;
end.