【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中調試通過。