KLENINA_Transfer_to_another_number_system

program ss;

var
   q, w, e, r, t, i, p, h, z, mn1, mn4,mn5: integer;
   m1, m2, m3, m4, m7: array [1..100] of integer;
   aa: char;

procedure v10(q, p, h: integer);
var
   i, s, d, f: integer;
begin
   if mn1 > 1 then
   begin
      m1 := m4;
      p := mn4;
   end;
   for i := 1 to p do
   begin
      d := q;
      if i < p - 2 then
         for s := i to p - 2 do
            d := d * q
      else
      if i < p - 1 then
         d := d * q
      else
      if i = p then
         d := 1;
      d := d * m1[i];
      f := f + d;
      m2[h] := f;
   end;
   for i := 1 to p do
      write(m1[i]);
end;

procedure vdrugyu(q: integer);
var
   w1, e1, mn3, ll,iii: integer;
begin
   mn3 := mn3;
   w1 := m2[h];
   e1 := m2[h];
   while w1 > 1 do
   begin
      aa := 'A';
      mn3 := mn3 + 1;
      w1 := w1 div q;
      if e1 - w1 * q < 10 then
      begin
         m3[mn3] := e1 - w1 * q;
         e1 := w1;
      end;
      if w1 = 1 then
      begin
         mn3 := mn3 + 1;
         m3[mn3] := 1;
      end;
      if e1 - w1 * q > 9 then
      begin
         m7[mn3] := e1 - w1 * q;
         e1 := w1;
      end;
   end;
   writeln();
   writeln();
   write('Число ');
   for iii:=1 to p do
   write(m1[iii]);
   write(' в ',mn5,' с/c переводим в ', q, ' c/c - ');
   mn4 := mn3;
   i := 0;
   for mn3 := mn3 downto 1 do
   begin
      aa := 'A';
      inc(i);
      m4[i] := m3[mn3];
      if m7[mn3] <> 0 then
      begin
         for ll := 11 to m7[mn3] do
            inc(aa);
         write(aa);
         m7[mn3] := 0;
      end
      else
         write(m3[mn3]);
   end;
   writeln();
end;

begin
   aa := 'A';
   writeln('Программа перевод чисел из системы счисления N, в систему счисления N^q, каждый раз увеличиваю q на 1, пока N^q<37 (при первом переводе q=2)');
   writeln();
   while (q > 6) or (q < 2) do
   begin
      writeln('Введите основание системы счисления (не больше 6)');
      readln(q);
   end;
   mn5:=q;
   while p < 1 do
   begin
      writeln('Введите разрядность исходного числа');
      readln(p);
   end;
   writeln('Введите ',p,' цифр(ы), цифра должна быть не больше ',q-1);
   writeln('(Вводим цифру числа - нажимаем enter, затем повторяем это действие)');
   for i := 1 to p do
   begin
      readln(m1[i]);
      if m1[i] > q - 1 then
         while m1[i] > q - 1 do
         begin
            writeln('Введите заново цифру, она не должно быть больше', q-1);
            readln(m1[i]);
         end;
   end;
   if q * q < 37 then
   begin
      z := z + 1;
      w := q * q;
      if q * q * q < 37 then
      begin
         z := z + 1;
         e := q * q * q;
         if q * q * q * q < 37 then
         begin
            z := z + 1;
            r := q * q * q * q;
            if q * q * q * q * q < 37 then
            begin
               z := z + 1;
               t := q * q * q * q * q;
            end
            else
               z := z;
         end
         else
            z := z;
      end
      else
         z := z;
   end
   else
      z := 0;
   for mn1 := 1 to z do
   begin
      h := 1;
      if mn1 = 1 then
      begin
         v10(q, p, h);
         q := w
      end
      else
      if mn1 = 2 then
         q := e
      else
      if mn1 = 3 then
         q := r
      else
      if mn1 = 4 then
         q := t;
      vdrugyu(q);
      writeln();
   end;
end.