【pascal】人民币大写转换

我们在编程的过程中，特别是开发和财务相关的应用程序的时候，几乎都会遇到要将阿拉伯数字(一般是货币金额)转换为中文大写的要求。也有一些转换程序，但大都不符合财务实际要求，比如最简单的：
function xd(xx:currency):string;
var dx,ws:string;
 　i,cd:integer;
　int:currency;
begin
　int:=trunc((abs(xx)+0.005)*100);
　{在“厘”上4舍5入后去掉小数点}
　cd:=length(currtostr(int));
　{取得数字的长度，跟据此长度即可判断位数}
　dx:='零壹贰叁肆伍陆柒捌玖';
　ws:='分角元拾佰仟万拾佰仟亿拾佰仟';
　{位数}
　Result:= ' ';
　i:=1;
　while i<=cd do
　begin
  　Result:=Result+copy(dx,strtoint(copy(currtostr(int),i,1))*2+1,2);
　{取数字的大写}
 　Result:=Result+copy(ws,(cd-i)*2+1,2);
　{加上数字的位数}
 　i:=i+1;
　end
end

在这里输入xd(1234567.89)，返回“壹佰贰拾叁万肆仟伍佰陆拾柒元捌角玖分”，但它并不完美，例如xd(100)，返回的却是：壹佰零拾零元零角零分（应是壹佰元整），显然这不符合财务工作的实际要求。

中文大写的特殊性关键在对“0”的处理上，我们编程的思路也是如此，程序中遇到0的时候并不能简单地用大写“零”来代替，要进行如下判断：是否是第一个零（即它的左边是否不为零）？如是第一个零，还要判断，它的后面是否全为零（这要分段判断：亿以上，万以上亿以下，元以上万以下，分以上元以下）？如不是，才能以大写零来代替；如果是就直接写上位数如万（例如：100000，就应是壹拾万，而不是壹拾零万）。另一方面如果它的后面不全为零，却有连续的零，也要注意（例如：1001，就应是壹仟零壹元，而不是壹仟零零壹元）。

　以下就是根据这一思路给出的程序（此程序最大可转换至千亿位，在实际工作中也应该足够了）：

……

　while i<=cd do
　begin
　　if copy(currtostr(int),i,1)<> '0' then
　　begin
  　　Result:=Result+copy(dx,strtoint(copy(currtostr(int),i,1))*2+1,2);
  　　Result:=Result+copy(ws,(cd-i)*2+1,2);
  　　ling:=false;
  　　i:=i+1;
 　end
　else if ling=false and (copy(currtostr(int),i,1)= '0' ) then
　{遇到第一个0}
　begin
　　if cd-i+1>10 then
　　{判断是否是亿以上}
　　 begin
  　　 w:=0;
  　　 for q:=11 to cd-i+1 do
  　　 begin
    　　 w:=w+strtoint(copy(currtostr(int),cd-q+1,1));
  　　 end ;
　　if w=0 then
　　{整亿，即亿位有0或连续的0}
　　 begin
　　 Result:=Result+'亿';
　　 i:=cd-9;
　　 end
　　else
　　{非整亿，即亿位无0}
　　 begin
　　 Result:=Result+'零';
　　 i:=i+1;
　　 ling:=true;
　　 end;
　　 end
　　else if cd-i+1>6 then
　　{判断是否是万以上}
　　……
　　{判断是否是元以上}
　　 ……
　　{判断是否是分以上}
　　 begin
　　 w:=0;
　　 for q:=1 to cd-i+1 do
　　 begin
　　 w:=w+strtoint(copy(currtostr(int),cd-q+1,1));
　　 end ;
　　 if w=0 then
　　 begin
　　 Result:=Result+'整';
　　 i:=cd+1 ;
　　 end
　　 else
　　 begin
　　 Result:=Result+'零';
　　 i:=i+1;
　　 ling:=true;
　　 end;
　　 end;
　　end
　　else if (copy(currtostr(int),i,1)= '0') and (ling=true) then
　　{遇到一个连续的0,跳过}
　　begin
　　i:=i+1;
　　end;
　　end;
　　if xx<0 then Result:= '负'+Result;
　　{判断是否为负数}
　　end;
　　以上程序在Windows 2000(Windows 98)+Delphi 6中调试通过。