Вещественные числа. Посчитать порядок числа (Pascal)

[Черепаwка]

Суть программы перевод числа из 10 СС --> 8 СС. И представить число в виде 0,мантисса*на порядок.
Программа работает, высчитывает. Но порядок высчитывает не правильно.
Например число(берем всегда вещественное число): 78,45 переводим в 8 СС =116,34. Число представляем как 0,11634*10^6.
Ошибка в том что порядок должен быть 10^-3. Не знаю как исправить это, кто сможет помогите пожалуйста

Uses
 CRT;
const
 a: string[36] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; 
var
chisloL, g,h: integer;
chislo, otvet, perem:string;
  r,rez, s, s2, ss2, s3, ss3: string;
  i, d, t, cc, ind, cc2, k: integer;
  b:real;
  j:byte;
  m,l:boolean;

procedure Del(var ss: string);
var
  i: integer;
begin
  ind := 0;
  s2 := '';
  for i := 1 to length(ss) do  
    if ss[i] in [',', '.'] then 
    begin
      ind := i; 
      break
    end
    else
      s2 := s2 + ss[i]; 
  s3 := '';  
  if ind <> 0 then 
  begin
    delete(s, 1, ind); 
        s3 := ss; 
  end;
end;


function ToDec(var ss: string; cc: byte): string;
var
  i, n, sum: longint;
  s:string;
begin
  sum := 0;  
  n := length(ss); 
  for i := 1 to n do 
  begin
    dec(n); 
    sum := sum + round((pos(ss[i], a) - 1) * exp(ln(cc) * n)); 
  end;
  str(sum,s); 
  ToDec := s;
end;

function Cel(d: string; c: integer): string;
var
  s: string;
  k: integer;
  n2:real;
begin
  val(d,n2,k); 
  s := '';   
  repeat
    s := ((a[round(n2) mod c + 1]) + s); 
    n2 := round(n2) div c;
  until (n2 = 0);
  Cel := s;
end;

function Drob(d: string; t, c: integer): string;
var
  s, l: string;
  l2, m: real;
  i, k: integer;
begin
if pos('E',d)=0 then 
 val(('0.'+d),m,k)
else
val(d,m,k); 
  s := ''; 
  i := 0;
  if t <> 0 then  
  begin
    repeat
      l2 := m * c;
      m := frac(l2); 
      s := s + a[round(int(l2)) + 1]; 
      inc(i); 
    until i = t;
  end
  else
   s := '0';
  Drob := s;
end;


function prov(c:integer;s:string):boolean;
var
 i,kol,j:integer;
begin
kol:=0; 
for i:=1 to c do 
begin
 for j:=1 to length(s) do 
 if s[j]=a[i] then 
  inc(kol); 
end;
if kol=length(s) then 
 prov:=true 
else
 prov:=false;
end;

function drob2(ss: string; c: integer): string;
var
  i: integer;
  sum: real;
  s:string;
begin
  for i := 1 to length(ss) do 
    sum := sum + (pos(ss[i], a) - 1) * exp(ln(c) * -i); 
  str(sum,s); 
  drob2 := s;
end;

begin
  ClrScr;
  repeat
    write('iz kakoi budem perevodit SS: ');
    readln(cc2);
    write('vvedite SS v kotoryu xotite perevesti: ');
    readln(cc);
until (cc2 in [2..36]) and (cc in [2..36]); 
  repeat
   write('vvod 4isla v ', cc2, '-i SS: ');
   readln(s);
   Del(s); 
   if not prov(cc2,s2) and not prov(cc2,s3)  then
    write('nekorektnoe 4islo. Povtorite ')
  until prov(cc2,s2) and prov(cc2,s3);
  if cc2 = 10 then 
  begin
    write('Vvedite to4nost : ');
    readln(t);
    if (s3='') then 
      rez := Cel(s2, cc)
    else     
      rez := Cel(s2, cc) + ',' + Drob(s3, t, cc);
  end
  else 
  begin
    if ind = 0 then
      rez := Cel(ToDec(s2, cc2), cc) 
    else
      rez := Cel(ToDec(s2, cc2), cc) + ',' + drob(drob2(s3, cc2), length(s3), cc); 
  end;
  writeln('4islo ',s,'_',cc2,' v ',cc,'-i sisteme s4isleniya:=',rez);

begin
  h:=length(rez);
  chislo:=rez;
  otvet:='0,';
  chisloL:=length(chislo);
  g:=3;
    for i:=1 to chisloL do
begin
  perem:=copy(chislo,i,1);
    if perem<>',' then
begin
  insert(perem, otvet, g);
  g:=g+1;
  end;
end;
  writeln(otvet,'*10^',h);
   readkey
   end;
end.