function Tprintform.Currency(rmb: Double): string;
var s1,s2,s3,s4,dxs:string;
l,l1,l2,l3:integer;
begin
s1:='分角元拾佰仟万拾佰仟亿拾佰仟万拾佰仟万';
s2:='零壹贰叁肆伍陆柒捌玖';
l:=length(floattostr(rmb));
if copy(floattostr(rmb),l-2,1)='.' then
begin
dxs:=floattostr(abs(rmb));
end
else
begin
if copy(floattostr(rmb),l-1,1)='.' then
dxs:=floattostr(abs(rmb)) '0'
else
dxs:=floattostr(abs(rmb)) '.00'
end;
l1:=length(dxs);
dxs:=copy(dxs,1,l1-3) copy(dxs,l1-1,2);
s3:='';
l2:=length(dxs);
l3:=0;
while l2>0 do
begin
s3:=copy(s1,l3*2 1,2) s3;
s3:=copy(s2,strtoint(copy(dxs,l2,1))*2 1,2) s3;
l2:=l2-1;
l3:=l3 1;
end;
s4:='';
l2:=1;
while l2 begin
if copy(s3,l2,2)='零' then
begin
if copy(s3,l2 2,2)='万' then
begin
if copy(s4,length(s4)-1,2)='零' then
s4:=copy(s4,1,length(s4)-2) '万'
else
s4:=s4 '万';
end;
if copy(s3,l2 2,2)='元' then
begin
if copy(s4,length(s4)-1,2)='零' then
s4:=copy(s4,1,length(s4)-2) '元'
else
s4:=s4 '元';
end;
if copy(s3,l2 2,2)='亿' then
begin
if copy(s4,length(s4)-1,2)='零' then
s4:=copy(s4,1,length(s4)-2) '亿'
else
s4:=s4 '亿';
end;
if copy(s4,length(s4)-1,2)<>'零' then
s4:=s4 '零';
end
else
s4:=s4 copy(s3,l2,4);
l2:=l2 4;
end;
if copy(s4,length(s4)-3,4)='元零' then
begin
s4:=copy(s4,1,length(s4)-2) '整';
end;
if copy(s4,length(s4)-3,4)='角零' then
begin
s4:=copy(s4,1,length(s4)-2) '整';
end;
if copy(s4,length(s4)-1,2)='零' then
begin
s4:=copy(s4,1,length(s4)-2) '元整';
end;
Currency:=s4;
end;
以上这段代码一直用得很好,但今天发现个问题,，就是元为零时比如0.90元，就会显示为 "元零玖角"，前面的元是多出来的。其它任何时候好象都对的，不知道代码哪一段出了错

------
我的编程起步于ktop，我将永远支持ktop

試試！

function Num2BCNum(dblArabic: double): string;
const
_ChineseNumeric = '零壹貳參肆伍陸柒捌玖';
var
sArabic: string;
sIntArabic: string;
iPosOfDecimalPoint: integer;
i: integer;
iDigit: integer;
iSection: integer;
sSectionArabic: string;
sSection: string;
bInZero: boolean;
bMinus: boolean;

begin
Result := '';
bInZero := True;
sArabic := FloatToStr(dblArabic); (* 將數字轉成阿拉伯數字字串 *)
if sArabic[1] = '-' then
begin
bMinus := True;
sArabic := Copy(sArabic, 2, 254);
end
else
bMinus := False;
iPosOfDecimalPoint := Pos('.', sArabic); (* 取得小數點的位置 *)

(* 先處理整數的部分 *)
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;
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;

(* 其他例外狀況的處理 *)
if Length(Result) = 0 then Result := '零';
if Copy(Result, 1, 2) = '點' then Result := '零' Result;

(* 是否為負數 *)
if bMinus then Result := '負' Result;
end;

------
「人們所以覺得寂寞，是因為他們會築牆，卻不會搭橋。」
程式寫的越久，卻發現自己越來越不會寫程式！

試試！

function Num2BCNum(dblArabic: double): string;
const
_ChineseNumeric = '零壹貳參肆伍陸柒捌玖';
var
sArabic: string;
sIntArabic: string;
iPosOfDecimalPoint: integer;
i: integer;
iDigit: integer;
iSection: integer;
sSectionArabic: string;
sSection: string;
bInZero: boolean;
bMinus: boolean;

begin
Result := '';
bInZero := True;
sArabic := FloatToStr(dblArabic); (* 將數字轉成阿拉伯數字字串 *)
if sArabic[1] = '-' then
begin
bMinus := True;
sArabic := Copy(sArabic, 2, 254);
end
else
bMinus := False;
iPosOfDecimalPoint := Pos('.', sArabic); (* 取得小數點的位置 *)

(* 先處理整數的部分 *)
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;
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;

(* 其他例外狀況的處理 *)
if Length(Result) = 0 then Result := '零';
if Copy(Result, 1, 2) = '點' then Result := '零' Result;

(* 是否為負數 *)
if bMinus then Result := '負' Result;
end;

------
「人們所以覺得寂寞，是因為他們會築牆，卻不會搭橋。」
程式寫的越久，卻發現自己越來越不會寫程式！