(* 将字串反向, 例如: 传入 '1234', 传回 '4321' *)
function ConvertStr(const sBeConvert: string): string;
var
x: integer;
begin
Result := '';
for x := Length(sBeConvert) downto 1 do
AppendStr(Result, sBeConvert[x]);
end; { of ConvertStr }
begin
Result := '';
bInZero := True;
sArabic := FloatToStr(dblArabic); (* 将数字转成阿拉伯数字字串 *)
{$ifdef __Debug}
ShowMessage('FloatToStr(dblArabic): ' + sArabic);
{$endif}
if sArabic[1] = '-' then
begin
bMinus := True;
sArabic := Copy(sArabic, 2, 254);
end
else
bMinus := False;
iPosOfDecimalPoint := Pos('.', sArabic); (* 取得小数点的位置 *)
{$ifdef __Debug}
ShowMessage('Pos(''.'', sArabic) ' + IntToStr(iPosOfDecimalPoint));
{$endif}
(* 先处理整数的部分 *)
if iPosOfDecimalPoint = 0 then
sIntArabic := ConvertStr(sArabic)
else
sIntArabic := ConvertStr(Copy(sArabic, 1, iPosOfDecimalPoint - 1));
(* 从个位数起以每四位数为一小节 *)
for iSection := 0 to ((Length(sIntArabic) - 1) div 4) do
begin
sSectionArabic := Copy(sIntArabic, iSection * 4 + 1, 4);
sSection := '';
(* 以下的 i 控制: 个十百千位四个位数 *)
for i := 1 to Length(sSectionArabic) do
begin
iDigit := Ord(sSectionArabic[i]) - 48;
if iDigit = 0 then
begin
(* 1. 避免 '零' 的重覆出现 *)
(* 2. 个位数的 0 不必转成 '零' *)
if (not bInZero) and (i <> 1) then sSection := '零' + sSection;
bInZero := True;
end
else
begin
case i of
2: sSection := '十' + sSection;
3: sSection := '百' + sSection;
4: sSection := '千' + sSection;
end;
sSection := Copy(_ChineseNumeric, 2 * iDigit + 1, 2) +
sSection;
bInZero := False;
end;
end;
(* 加上该小节的位数 *)
if Length(sSection) = 0 then
begin
if (Length(Result) > 0) and (Copy(Result, 1, 2) <> '零') then
Result := '零' + Result;
end
else
begin
case iSection of
0: Result := sSection;
1: Result := sSection + '万' + Result;
2: Result := sSection + '亿' + Result;
3: Result := sSection + '兆' + Result;
end;
end;
{$ifdef __Debug}
ShowMessage('sSection: ' + sSection);
ShowMessage('Result: ' + Result);
{$endif}
end;
(* 处理小数点右边的部分 *)
if iPosOfDecimalPoint > 0 then
begin
AppendStr(Result, '点');
for i := iPosOfDecimalPoint + 1 to Length(sArabic) do
begin
iDigit := Ord(sArabic[i]) - 48;
AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
end;
end;
{$ifdef __Debug}
ShowMessage('Result before 其他例外处理: ' + Result);
{$endif}
(* 其他例外状况的处理 *)
if Length(Result) = 0 then Result := '零';
if Copy(Result, 1, 4) = '一十' then Result := Copy(Result, 3, 254);
if Copy(Result, 1, 2) = '点' then Result := '零' + Result;
(* 是否为负数 *)
if bMinus then Result := '负' + Result;
{$ifdef __Debug}
ShowMessage('Result before Exit: ' + Result);
{$endif}
end;
(* 简单的十次方函数, 取 10^n, where n: byte and n >= 0 *)
function EasyPower10(iPower: byte): double;
var
i: integer;
begin
Result := 1;
try
for i := 1 to iPower do Result := Result * 10;
except
Result := 0;
end;
end;
begin
Result := False;
dblArabic := 0;
dblBuffer := 0;
iDigit := -1;
iRightOfDecimal := -1;
if Copy(sChineseNum, 1, 2) = '负' then
begin
sChineseNum := Copy(sChineseNum, 3, 254);
bMinus := True;
end
else
bMinus := False;
i := 1;
while i < Length(sChineseNum) do
begin
(* 如果不是中文字 ==> Fail *)
if sChineseNum[i] < #127 then Exit;
sMultiChar := Copy(sChineseNum, i, 2);
iPos := Pos(sMultiChar, _ChineseNumeric);
if iPos = 0 then Exit;
if (iDigit = -1) and (iPos > 13) then
iDigit := (iPos - 15) div 2;
case iPos of
1, 3, 5:
begin
(* 十百千 *)
if iDigit = -1 then iDigit := 1;
dblBuffer := dblBuffer + iDigit * EasyPower10((iPos + 1) div 2);
iDigit := -1;
end;
7, 9, 11:
begin
(* 万亿兆 *)
if (iDigit > 0) and (iDigit < 10) then
dblBuffer := dblBuffer + iDigit;
dblArabic := dblArabic + dblBuffer * EasyPower10((iPos-5) div 2 * 4);
iDigit := -1;
dblBuffer := 0;
end;
13:
begin
(* 小数点 *)
if (iDigit > 0) and (iDigit < 10) then
dblBuffer := dblBuffer + iDigit;
dblArabic := dblArabic + dblBuffer;
dblBuffer := 0;
iDigit := -1;
iRightOfDecimal := 0;
end;
15: (* 零 *)
begin
if iRightOfDecimal > -1 then Inc(iRightOfDecimal);
iDigit := -1;
end;
else
begin
if iRightOfDecimal > -1 then
begin
(* 小数点右边的部分 *)
Inc(iRightOfDecimal);
try
dblArabic := dblArabic + iDigit / EasyPower10(iRightOfDecimal);
except
Exit;
end;
iDigit := -1;
end;
end;
end;