(*//

标题:无限进制处理

说明:使用于数学领域进制之间相互转换和计算

设计:Zswang

日期:2005-01-15

支持:wjhu111@21cn.com

//*)

uses Math;

const

 cScaleChar: array[0..35] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';

function StringToCharSet( //字符串集合

 mString: string //源字符串

): TSysCharSet; //返回字符串中包含的集合

var

 I: Integer;

begin

 Result := [];

 for I := 1 to Length(mString) do Include(Result, mString);

end; { StringToCharSet }

function StrLeft( //取左边的字符串

 mStr: string; //原字符串

 mDelimiter: string; //分隔符

 mIgnoreCase: Boolean = False //是否忽略大小写

): string; //返回第一个分隔符左边的字符串

begin

 if mIgnoreCase then

   Result := Copy(mStr, 1, Pos(UpperCase(mDelimiter), UpperCase(mStr)) - 1)

 else Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1);

end; { StrLeft }

function StrRight( //取右边的字符串

 mStr: string; //原字符串

 mDelimiter: string; //分隔符

 mIgnoreCase: Boolean = False //是否忽略大小写

): string; //返回第一个分隔符右边的字符串

begin

 if mIgnoreCase then

 begin

   if Pos(UpperCase(mDelimiter), UpperCase(mStr)) > 0 then

     Result := Copy(mStr, Pos(UpperCase(mDelimiter), UpperCase(mStr)) +

       Length(mDelimiter), MaxInt)

   else Result := '';

 end else

 begin

   if Pos(mDelimiter, mStr) > 0 then

     Result := Copy(mStr, Pos(mDelimiter, mStr) + Length(mDelimiter), MaxInt)

   else Result := '';

 end;

end; { StrRight }

function IntegerFullZero( //对齐前补0

 mInteger: string; //整数字符串

 mLength: Integer //总长度

): string; //返回补0后的整数字符串

begin

 Result := StringOfChar('0', mLength - Length(mInteger)) + mInteger;

end; { IntegerFullZero }

function IntegerCompare( //比较两个整数

 mIntegerA: string; //整数1

 mIntegerB: string //整数2

): Integer; //返回比较的值 +1、0、-1

var

 I: Integer;

begin

 I := Max(Length(mIntegerA), Length(mIntegerB)); //整数部分最大

 mIntegerA := IntegerFullZero(mIntegerA, I);

 mIntegerB := IntegerFullZero(mIntegerB, I);

 Result := CompareText(mIntegerA, mIntegerB);

end; { IntegerCompare }

function IntegerFormat( //清除无效的0

 mInteger: string //整数字符串

): string; //返回处理后的整数字符串

begin

 Result := UpperCase(mInteger);

 if Result = '' then Result := '0';

 while (Pos('0', Result) = 1) and (Result <> '0') do Delete(Result, 1, 1); //排除整数前无效的0

end; { IntegerFormat }

function IntegerAdd( //无限整数加法

 mIntegerA: string; //整数1

 mIntegerB: string; //整数2

 mScale: Byte = 10 //进制

): string; //返回两个整数的和

var

 I: Integer;

 T: Integer;

begin

 Result := '';

 if mScale < 2 then Exit;

 mIntegerA := IntegerFormat(mIntegerA);

 mIntegerB := IntegerFormat(mIntegerB);

 if StringToCharSet(mIntegerA + mIntegerB) -

   [cScaleChar[0]..cScaleChar[mScale - 1]] <> [] then Exit;

 I := Max(Length(mIntegerA), Length(mIntegerB)); //整数部分最大

 mIntegerA := IntegerFullZero(mIntegerA, I); //对齐前补0

 mIntegerB := IntegerFullZero(mIntegerB, I); //对齐前补0

 T := 0; //进位数初始

 for I := I downto 1 do //从后向前扫描

 begin

   T := (Pos(Copy(mIntegerA, I, 1), cScaleChar) - 1) + T; //累加当前数位

   T := (Pos(Copy(mIntegerB, I, 1), cScaleChar) - 1) + T; //累加当前数位

   Result := cScaleChar[T mod mScale] + Result; //计算当前数位上的数字

   T := T div mScale; //计算进位数

 end;

 if T <> 0 then Result := cScaleChar[T mod mScale] + Result; //处理进位数

 while (Pos('0', Result) = 1) and (Result <> '0') do Delete(Result, 1, 1); //排除整数前无效的0

end; { IntegerAdd }

function IntegerSub( //无限整数减法

 mIntegerA: string; //整数1

 mIntegerB: string; //整数2

 mScale: Byte = 10 //进制

): string; //返回两个整数的积

var

 I: Integer;

 T: Integer;

begin

 Result := '';

 if mScale < 2 then Exit;

 mIntegerA := IntegerFormat(mIntegerA);

 mIntegerB := IntegerFormat(mIntegerB);

 if StringToCharSet(mIntegerA + mIntegerB) -

   [cScaleChar[0]..cScaleChar[mScale - 1]] <> [] then Exit;

 I := Max(Length(mIntegerA), Length(mIntegerB)); //整数部分最大

 mIntegerA := IntegerFullZero(mIntegerA, I); //对齐前补0

 mIntegerB := IntegerFullZero(mIntegerB, I); //对齐前补0

 if mIntegerA < mIntegerB then Exit;

 T := 0; //进位数初始

 for I := I downto 1 do //从后向前扫描

 begin

   T := (Pos(Copy(mIntegerA, I, 1), cScaleChar) - 1) - T; //累加当前数位

   T := T - (Pos(Copy(mIntegerB, I, 1), cScaleChar) - 1); //累加当前数位

   Result := cScaleChar[(T + mScale) mod mScale] + Result; //计算当前数位上的数字

   if T >= 0 then T := 0 else T := 1;

 end;

 while (Pos('0', Result) = 1) and (Result <> '0') do Delete(Result, 1, 1); //排除整数前无效的0

end; { IntegerSub }

function IntegerMult( //无限整数乘法

 mIntegerA: string; //整数1

 mIntegerB: string; //整数2

 mScale: Byte = 10 //进制

): string; //返回两个整数的积

 function fMult( //无限位数乘法子函数

   mInteger: string; //整数

   mByte: Byte //位数

 ): string; //返回位数和整数的积

 var

   I: Integer;

   T: Integer;

 begin

   Result := '';

   T := 0;

   for I := Length(mInteger) downto 1 do //从后向前扫描

   begin

     T := (Pos(Copy(mInteger, I, 1), cScaleChar) - 1) * mByte + T; //累加当前数位

     Result := cScaleChar[T mod mScale] + Result; //计算当前数位上的数字

     T := T div mScale; //计算进位数

   end;

   if T <> 0 then Result := cScaleChar[T mod mScale] + Result; //处理进位数

 end; { fMult }

var

 I: Integer;

 T: string;

begin

 Result := '';

 if mScale < 2 then Exit;

 mIntegerA := IntegerFormat(mIntegerA);

 mIntegerB := IntegerFormat(mIntegerB);

 if StringToCharSet(mIntegerA + mIntegerB) -

   [cScaleChar[0]..cScaleChar[mScale - 1]] <> [] then Exit;

 T := '';

 for I := Length(mIntegerB) downto 1 do

 begin

   Result := IntegerAdd(Result,

     fMult(mIntegerA, (Pos(Copy(mIntegerB, I, 1), cScaleChar) - 1)) + T, mScale);

   T := T + '0';

 end;

 Result := IntegerFormat(Result);

end; { InfiniteMult }

function IntegerDivMod( //无限整数除法

 mIntegerA: string; //整数1

 mIntegerB: string; //整数2

 var nDiv: string; //返回除数

 var nMod: string; //返回余数

 mScale: Byte = 10 //进制

): Boolean; //返回两个整数的积

var

 T: string;

 K: string;

begin

 Result := False;

 if mScale < 2 then Exit;

 mIntegerA := IntegerFormat(mIntegerA);

 mIntegerB := IntegerFormat(mIntegerB);

 if StringToCharSet(mIntegerA + mIntegerB) -

   [cScaleChar[0]..cScaleChar[mScale - 1]] <> [] then Exit;

 if mIntegerB = '0' then Exit;

 Result := True;

 nDiv := '0';

 while IntegerCompare(mIntegerA, mIntegerB) >= 0 do

 begin

   T := mIntegerB;

   K := '1';

   while IntegerCompare(mIntegerA, T + '0') >= 0 do

   begin

     T := T + '0';

     K := K + '0';

   end;

   mIntegerA := IntegerSub(mIntegerA, T);

   nDiv := IntegerAdd(nDiv, K);

 end;

 nMod := mIntegerA;

end; { IntegerDivMod }

function IntegerFactorial( //无限整数的阶乘

 mInteger: Integer; //整数

 mScale: Byte = 10 //进制

): string; //返回整数的阶乘

var

 I: Integer;

 T: string;

begin

 Result := '';

 if mScale < 2 then Exit;

 Result := '1';

 T := '0';

 for I := 1 to mInteger do

 begin

   T := IntegerAdd(T, '1', mScale);

   Result := IntegerMult(Result, T, mScale);

 end;

end; { InfiniteFactorial }

function IntegerPower( //无限整数的次方

 mBase: string; //指数

 mExponent: Integer; //幂数

 mScale: Byte = 10 //进制

): string; //返回Base的Exponent次方

var

 I: Integer;

begin

 Result := '';

 if mScale < 2 then Exit;

 mBase := IntegerFormat(mBase);

 if StringToCharSet(mBase) -

   [cScaleChar[0]..cScaleChar[mScale - 1]] <> [] then Exit;

 Result := '1';

 for I := 1 to mExponent do

   Result := IntegerMult(Result, mBase, mScale);

end; { IntegerPower }

function IntegerDigit( //进制间的转换

 mIntegerFrom: string; //来源整数

 mScaleFrom: Byte; //来源进制

 mScaleT Byte //目标进制

): string; //返回处理后的整数字符串

 function fIntegerDigit( //进制间的转换

   mIntegerFrom: Char //来源整数

 ): string; //返回处理后的整数字符串

 var

   T: string;

 begin

   Result := '0';

   T := '0';

   while IntegerCompare(T, mIntegerFrom) < 0 do

   begin

     Result := IntegerAdd(Result, '1', mScaleTo);

     T := IntegerAdd(T, '1', mScaleFrom);

   end;

 end;

var

 I, L: Integer;

 vBase: string;

 T: string;

begin

 Result := '';

 if (mScaleFrom < 2) or (mScaleTo < 2) then Exit;

 mIntegerFrom := IntegerFormat(mIntegerFrom);

 if StringToCharSet(mIntegerFrom) -

   [cScaleChar[0]..cScaleChar[mScaleFrom - 1]] <> [] then Exit;

 if mScaleFrom = mScaleTo then

 begin

   Result := mIntegerFrom;

   Exit;

 end;

 Result := '0';

 if mIntegerFrom = '0' then Exit;

 vBase := '1';

 T := '1';

 while IntegerCompare(T, cScaleChar[mScaleFrom - 1]) <= 0 do

 begin

   vBase := IntegerAdd(vBase, '1', mScaleTo);

   T := IntegerAdd(T, '1', mScaleFrom);

 end;

 L := Length(mIntegerFrom);

 for I := 1 to L do

 begin

   Result := IntegerAdd(

     Result,

     IntegerMult(

       fIntegerDigit(

         mIntegerFrom[L - I + 1]

       ),

       IntegerPower(

         vBase,

         I - 1,

         mScaleTo

       ),

       mScaleTo)

     mScaleTo

   );

 end;

end; { IntegerDigit }

[/pas]

1000!=402387260077093773543702433923003985719374864210714632543799910429938512398629020592044208486969404800479988610197196058631666872994808558901323829669944590997424504087073759918823627727188732519779505950995276120874975462497043601418278094646496291056393887437886487337119181045825783647849977012476632889835955735432513185323958463075557409114262417474349347553428646576611667797396668820291207379143853719588249808126867838374559731746136085379534524221586593201928090878297308431392844403281231558611036976801357304216168747609675871348312025478589320767169132448426236131412508780208000261683151027341827977704784635868170164365024153691398281264810213092761244896359928705114964975419909342221566832572080821333186116811553615836546984046708975602900950537616475847728421889679646244945160765353408198901385442487984959953319101723355556602139450399736280750137837615307127761926849034352625200015888535147331611702103968175921510907788019393178114194545257223865541461062892187960223838971476088506276862967146674697562911234082439208160153780889893964518263243671616762179168909779911903754031274622289988005195444414282012187361745992642956581746628302955570299024324153181617210465832036786906117260158783520751516284225540265170483304226143974286933061690897968482590125458327168226458066526769958652682272807075781391858178889652208164348344825993266043367660176999612831860788386150279465955131156552036093988180612138558600301435694527224206344631797460594682573103790084024432438465657245014402821885252470935190620929023136493273497565513958720559654228749774011413346962715422845862377387538230483865688976461927383814900140767310446640259899490222221765904339901886018566526485061799702356193897017860040811889729918311021171229845901641921068884387121855646124960798722908519296819372388642614839657382291123125024186649353143970137428531926649875337218940694281434118520158014123344828015051399694290153483077644569099073152433278288269864602789864321139083506217095002597389863554277196742822248757586765752344220207573630569498825087968928162753848863396909959826280956121450994871701244516461260379029309120889086942028510640182154399457156805941872748998094254742173582401063677404595741785160829230135358081840096996372524230560855903700624271243416909004153690105933983835777939410970027753472000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000