(*//

标题:无限位数加法

说明:支持小数情况;不支持负数

设计:Zswang

日期:2002-01-26

支持:wjhu111@21cn.com

//*)

///////Begin Source

uses

 Math, StrUtils;

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 }

///////End Source

///////Begin Demo

procedure TForm1.Button1Click(Sender: TObject);

begin

 Edit1.Text := InfiniteAdd(Edit2.Text, Edit3.Text);

end;

///////End Demo