无限位数乘法

// 无限位数乘法//技术论坛要有技术文章//加一段，免得被放到非技术区 :)
uses StrUtils, Math;
function formatnum(mNumber: string):string;
var
m:integer;
TemStr:string;
begin
 Result:='';
 for m:=1 to Length(mNumber) do
 begin
   if mNumber[m]='.' then
     Result:=Result+'.'
   else
     Result:=Result+IntToStr(StrToIntDef(mNumber[m], 0));
 end;
 while Pos('0', Result) = 1 do Delete(Result, 1, 1); //排除整数前无效的0
 if Pos('.', Result )<= 0 then Result := Result + '.'; //没有有小数点补小数点
 TemStr:=StrRight(Result,'.');
 while Copy(TemStr, Length(TemStr), 1) = '0' do Delete(TemStr, Length(TemStr), 1); //排除小数后无效的0
 Result:=StrLeft(Result,'.')+'.'+TemStr;
 if Copy(Result, Length(Result), 1) = '.' then Delete(Result, Length(Result), 1); //排除无效小数点
 if Result[1]='.' then Result:='0'+Result;
 if (Result = '') then Result := '0';
end;

function StrLeft(const mStr: string; mDelimiter: string): string;
begin
 Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1);
end; { StrLeft }

function StrRight(const mStr: string; mDelimiter: string): string;
begin
 if Pos(mDelimiter, mStr) <= 0 then
   Result := ''
 else Result := Copy(mStr, Pos(mDelimiter, mStr) + Length(mDelimiter), MaxInt);
end; { StrRight }

function InfiniteAdd(mNumberA, mNumberB: string): string; { 无限位数加法 }
var
 I: Integer;
 T: Integer;
begin
 Result := '';
 if Pos('.', mNumberA) <= 0 then mNumberA := mNumberA + '.'; //没有有小数点补小数点
 if Pos('.', mNumberB) <= 0 then mNumberB := mNumberB + '.'; //没有有小数点补小数点
 I := Max(Length(StrLeft(mNumberA, '.')), Length(StrLeft(mNumberB, '.'))); //整数部分最大长度
 mNumberA := DupeString('0', I - Length(StrLeft(mNumberA, '.'))) + mNumberA; //整数前补0
 mNumberB := DupeString('0', I - Length(StrLeft(mNumberB, '.'))) + mNumberB; //整数前补0
 T := Max(Length(StrRight(mNumberA, '.')), Length(StrRight(mNumberB, '.'))); //小数部分最大长度
 mNumberA := mNumberA + DupeString('0', T - Length(StrRight(mNumberA, '.'))); //小数后补0
 mNumberB := mNumberB + DupeString('0', T - Length(StrRight(mNumberB, '.'))); //小数后补0
 I := I + T + 1; //计算总长度//小数长度和整数长度加上小数点长度
 T := 0; //进位数初始化
 for I := I downto 1 do //从后向前扫描
   if [mNumberA[I], mNumberB[I]] <> ['.'] then begin //不是小数点时
     T := StrToIntDef(mNumberA[I], 0) + T; //累加当前数位
     T := StrToIntDef(mNumberB[I], 0) + T; //累加当前数位
     Result := IntToStr(T mod 10) + Result; //计算当前数位上的数字
     T := T div 10; //计算进位数
   end else Result := '.' + Result; //加上小数点
 if T <> 0 then Result := IntToStr(T mod 10) + Result; //处理进位数
 while Pos('0', Result) = 1 do Delete(Result, 1, 1); //排除整数前无效的0
 while Copy(Result, Length(Result), 1) = '0' do
   Delete(Result, Length(Result), 1); //排除小数后无效的0
 if Copy(Result, Length(Result), 1) = '.' then
   Delete(Result, Length(Result), 1); //排除无效小数点
 if Copy(Result, 1, 1) = '.' then Result := '0' + Result; //处理无0小数情况
 if (Result = '') then Result := '0'; //处理空字符情况
end; { InfiniteAdd }

function InfiniteMult(mNumberA, mNumberB: string): string; { 无限位数乘法 }
 function fMult(mNumber: string; mByte: Byte): string; { 无限位数乘法子函数 }
 var
   I: Integer;
   T: Integer;
 begin
   Result := '';
   T := 0;
   for I := Length(mNumber) downto 1 do begin //从后向前扫描
     T := StrToIntDef(mNumber[I], 0) * mByte + T; //累加当前数位
     Result := IntToStr(T mod 10) + Result; //计算当前数位上的数字
     T := T div 10; //计算进位数
   end;
   if T <> 0 then Result := IntToStr(T mod 10) + Result; //处理进位数
 end; { fMult }

var
 I: Integer;
 vDecimal: Integer; //小数位数
 T: string;
begin
 Result := '';
 ///////Begin 处理小数
 if Pos('.', mNumberA) <= 0 then mNumberA := mNumberA + '.'; //没有有小数点补小数点
 if Pos('.', mNumberB) <= 0 then mNumberB := mNumberB + '.'; //没有有小数点补小数点
 vDecimal := Length(StrRight(mNumberA, '.')) + Length(StrRight(mNumberB, '.')); //计算小数位数
 mNumberA := StrLeft(mNumberA, '.') + StrRight(mNumberA, '.'); //删除小数点
 mNumberB := StrLeft(mNumberB, '.') + StrRight(mNumberB, '.'); //删除小数点
 ///////End 处理小数
 T := '';
 for I := Length(mNumberB) downto 1 do begin
   Result := InfiniteAdd(Result, fMult(mNumberA, StrToIntDef(mNumberB[I], 0)) + T);
   T := T + '0';
 end;
 Insert('.', Result, Length(Result) - vDecimal + 1);
 while Pos('0', Result) = 1 do Delete(Result, 1, 1); //排除整数前无效的0
 while Copy(Result, Length(Result), 1) = '0' do
   Delete(Result, Length(Result), 1); //排除小数后无效的0
 if Copy(Result, Length(Result), 1) = '.' then
   Delete(Result, Length(Result), 1); //排除无效小数点
 if Copy(Result, 1, 1) = '.' then Result := '0' + Result; //处理无0小数情况
 if (Result = '') then Result := '0'; //处理空字符情况
end; { InfiniteMult }

procedure TForm1.Button1Click(Sender: TObject);
begin
 Edit3.Text := InfiniteMult(Edit1.Text, Edit2.Text);
end;