Здравствуйте, Квашнин Олег Петрович!

Конечно больше ... ;).
Данная задача решается с использованием массива, в котором число хранится поразрядно - в каждой ячейке один разряд числа. Сам алгоритм возведения в степень очень похож на умножение в столбик, только с соответствующими коррективами.

Вот решение:
<code><b>const</b> n=3; power=512;
<b>var</b> a:<b>array</b> [<font color=purple>1</font>..<font color=purple>500</font>] <b>of</b> integer;
    i,j,x,mem:integer;
    s:<b>string</b>;
<b>begin</b>
  a[<font color=purple>500</font>]:=n; mem:=0; <font color=green>{число храним в массиве, в первый разряд заносим само число}</font>
  <b>for</b> i:=2 <b>to</b> power <b>do</b> <font color=green>{повторяем цикл столько раз в зависимости от степени}</font>
     <b>for</b> j:=500 downto <font color=purple>1</font> <b>do</b>  <font color=green>{заполняем число поразрядно}</font>
     <b>begin</b> x:=a[j]*n; <font color=green>{умножаем текущий разряд на 3}</font>
        a[j]:=(x+mem) <b>mod</b> <font color=purple>10</font>; <font color=green>{записываем в ячейку только одну цифру - текущий разряд}</font>
        mem:=(x+mem) <b>div</b> <font color=purple>10</font>; <font color=green>{старшие разряды запоминаем}</font>
     <b>end</b>;
  j:=1; <b>while</b> a[j]=0 <b>do</b> inc(j); <font color=green>{поскольку массив мы заполняли справа налево, то необходимо найти позицию первой цифры числа в массиве}</font>
  writeln(a[j+125-<font color=purple>1</font>]); <font color=green>{выводим на экран 125-ю цифру слева}</font>
  <b>write</b>(<font color=blue>‘(‘</font>,n,<font color=blue>‘^‘</font>,power,<font color=blue>‘)=‘</font>); <b>for</b> i:=j <b>to</b> <font color=purple>500</font> <b>do</b> <b>write</b>(a[i]); <font color=green>{для полноты выведем все число целиком}</font>
  readln;
<b>end</b>.</code>

А вот результат:
<code>3
(3^512)=193233498322889151054540687220195810554014657616033285501845376289024667
46415537000017939429786029354390082329294586119505153509101332940884098040478728
63954256055013372739948277806232240737233812104339966824227659179150465898588299
5272436541441</code>

Good Luck!

<i>Здравствуйте, <b>Квашнин Олег Петрович</b>!</i>

Пример находится в приложении. Функции для работы с длинными числами взяты отсюда: <a target=_blank href=http://cit.vvsu.ru/MIRROR/Science/DL-AR/da.html><u>Длинная арифметика</u></a>.
Алгоритм вычисления степени взят там же.
Перемножение двух длинных чисел реализовано самостоятельно.

PS
У меня 125-я цифра слева получилась равная трем.

<em>Удачи!</em>

Приложение:
program Q136673; const {Основание} OSN = 10000; {Максимальное количество элементов в массиве} {3^512 = 1.93e+244, значит нужно приблизительно 244/4=61 элемента} {берем с небольшим запасом} MAX_DIGIT = 100; type TLong = array[0..MAX_DIGIT] of LongInt; PLong = ^TLong; {Вывод длинного числа на экран} procedure writeLong(const A: PLong); var s, ls: String; i: Integer; begin str(OSN div 10, ls); write(A^[A^[0]]); for i:= Pred(A^[0]) downto 1 do begin str(A^[i], s); while (Length(s) < Length(ls)) do s:= ‘0‘ + s; write(s); end; writeln; end; {Перемножение длинного числа на недлинное} procedure mulLong(const A: TLong; const K: Integer; var C: TLong); var i: Integer; t: LongInt; begin fillChar(C, sizeof(C), #0); if (K = 0) then inc(C[0]) else begin for i:= 1 to A[0] do begin t:= A[i] * K + C[i]; C[Succ(i)]:= t div OSN; C[i]:= t mod OSN; end; if (C[Succ(A[0])] > 0) then C[0]:= Succ(A[0]) else C[0]:= A[0]; end; end; {Сумма двух длинных чисел} procedure sumLong2(const A, B: TLong; var C: TLong); var i, k: Integer; t: LongInt; begin fillChar(C, sizeof(C), #0); if (A[0] > B[0]) then k:= A[0] else k:= B[0]; for i:= 1 to k do begin t:= A[i] + B[i] + C[i]; C[Succ(i)]:= t div OSN; C[i]:= t mod OSN; end; if (C[Succ(k)] = 0) then C[0]:= k else C[0]:= Succ(k); end; {Копирование одного длинного числа в другое} procedure copyLong(const A: TLong; var C: TLong); begin move(A, C, sizeof(A)); end; {Умножение длинного числа на OSN} procedure shlLong1(var A: TLong); var i: Integer; begin Inc(A[0]); for i:= A[0] downto 1 do A[i]:= A[Pred(i)]; A[1]:= 0; end; {Перемножение двух длинных чисел} procedure mulLong2(const A, B: PLong; var C: TLong); var t1, t2, ts2, ts3, tt: PLong; s1, s2: TLong; i: Integer; begin {Определяем какое число длиннее} if (A^[0] > B^[0]) then begin t1:= A; t2:= B; end else begin t1:= B; t2:= A; end; {s2:= 0;} fillChar(s2, sizeof(s2), #0); s2[0]:= 1; ts2:= @s2; ts3:= @C; for i:= t2^[0] downto 2 do begin {Умножаем} mulLong(t1^, t2^[i],s1); {Добавляем} sumLong2(s1, ts2^, ts3^); {Умножаем на OSN} shlLong1(ts3^); {Меняем местами} tt:= ts3; ts3:= ts2; ts2:= tt; end; {Последний раз умножаем} mulLong(t1^, t2^[1], s1); {Убеждаемся, что в s2 находится то, что нужно} if (ts2 <> @s2) then copyLong(ts2^, s2); {Прибавляем} sumLong2(s1, s2, C); end; {Получаем N-ю цифру числа A} function getDigit(const A: TLong; const N: Integer): Byte; var s, ls: String; Result: Byte; i, len: Integer; begin str(OSN div 10, ls); str(A[A[0]], s); {Количество цифр у числа A} len:= Length(s) + Length(ls)*(A[0] - 1); if ((len < N) or (N <= 0)) then Result:= 0 else begin i:= 1 + (len - N) div Length(ls); str(A[i], s); i:= Length(ls) - (len - N) mod Length(ls); while (Length(s) < Length(ls)) do s:= ‘0‘ + s; Result:= Ord(s[i]) - Ord(‘0‘); end; getDigit:= Result; end; var pw, k: Integer; t1, t2, t3, tt: PLong; begin pw:= 512; {Первое число - a} getMem(Pointer(t1), sizeof(TLong)); t1^[0]:= 1; t1^[1]:= 3; {Второе число - b} getMem(Pointer(t2), sizeof(TLong)); t2^[0]:= 1; t2^[1]:= 1; {Третье число - c} getMem(Pointer(t3), sizeof(TLong)); k:= pw; {* ** Алгоритм вычисления степени длинных чисел взят здесь: ** http://cit.vvsu.ru/MIRROR/Science/DL-AR/stepen.html *} while (k <> 0) do begin {Если к четное} if ((k and 1) = 0) then begin {Делим на 2} k:= k shr 1; { c:= c*c; } mulLong2(t1, t1, t3^); tt:= t3; t3:= t1; t1:= tt; end else begin { k:= k - 1; } Dec(k); {b:= b*c; } mulLong2(t1, t2, t3^); tt:= t3; t3:= t2; t2:= tt; end; end; {Выводим b} {writeLong(t2);} {Выводим 125-ю цифру полученного числа} writeln(getDigit(t2^, 125)); {Освобождаем память} freeMem(Pointer(t1), sizeof(TLong)); freeMem(Pointer(t2), sizeof(TLong)); freeMem(Pointer(t3), sizeof(TLong)); WriteLn(‘Press any key...‘); Readln; end.