# 大悟还俗

::  ::  ::
(*//

//*)

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[I]);
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 }

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

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
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, mScale);
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
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; //来源进制
mScaleTo: Byte //目标进制
): string; //返回处理后的整数字符串
function fIntegerDigit( //进制间的转换
mIntegerFrom: Char //来源整数
): string; //返回处理后的整数字符串
var
T: string;
begin
Result := '0';
T := '0';
while IntegerCompare(T, mIntegerFrom) < 0 do
begin
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
end;
L := Length(mIntegerFrom);
for I := 1 to L do
begin
Result,
IntegerMult(
fIntegerDigit(
mIntegerFrom[L - I + 1]
),
IntegerPower(
vBase,
I - 1,
mScaleTo
),
mScaleTo)
mScaleTo
);
end;
end; { IntegerDigit }

function Numberexpression_r(mNumber: string): string;
var
vExponent: Integer;
vBase: string;
L: Integer;
begin
Result := '';
vBase := StrLeft(mNumber, 'e', True);
vExponent := StrToIntDef(StrRight(mNumber, 'e', True), 0);
L := Length(StrRight(vBase, '.'));
vBase := StringReplace(vBase, '.', '', [rfReplaceAll]);
Result := vBase + StringOfChar('0', vExponent - L);
end; { NumberExpression }

//Example
procedure TForm1.Edit1Change(Sender: TObject);
var
vDiv, vMod: string;
begin
Edit4.Text := IntegerMult(Edit1.Text, Edit2.Text, 10);
Edit5.Text := IntegerSub(Edit1.Text, Edit2.Text, 10);
IntegerDivMod(Edit1.Text, Edit2.Text, vDiv, vMod, 10);
Edit6.Text := vDiv;
Edit7.Text := vMod;
Edit8.Text := IntegerDigit(Edit1.Text, 36, 23);
Edit9.Text := IntegerDigit(Edit8.Text, 23, 36);
CheckBox1.Checked :=
IntegerCompare(IntegerAdd(IntegerMult(vDiv, Edit2.Text), vMod), Edit1.Text) = 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Text := IntegerFactorial(1000, 20); // 计算1000的阶乘用20进制表示
end;
View Code