Delphi版金额大写(人民币大写读数)代码

1.  uses
2.         math;
4. const  mnUnit:WideString ='分角元';
5. const  OtherWords:WideString='整负';
6. const  hzUnit:WideString = '拾佰仟万拾佰仟亿';
7. const  hzNum:WideString='零壹贰叁肆伍陆柒捌玖';
9. function Money2ChineseCapital2(const Num:double ): WideString;
10. var
11.    szNum:PWideChar;
12.    i,iLen,iLen2, iNum, iAddZero,ResultCount:Integer;
13.    buff:AnsiString;
14.    buf:PAnsiChar;
16.    dblNum: Double;
17. begin
18.    SetLength(Result,33*2 + 1);
19.    iAddZero := 0;
20.    if Num < 0.0 then
21.     dblNum := Num * 100.0 + 0.5
22.   else
23.     dblNum := Num * 100.0 - 0.5;
25.    buff := format('%0.0f',[dblNum]);
26.    if Pos(buff,'e')>0 then begin
27.     SetLength(Result,0);
28.     Raise Exception.Create('数值过大!');
29.     Exit;
30.    end;
31.    iLen := Length(buff);
32.    szNum := PWideChar(Result);
33.    buf := PAnsiChar(buff);
34.    if(Num<0.0) then
35.    begin
36.       szNum^:=OtherWords[2];
37.       Inc(szNum);
38.       Inc(buf);
39.       Dec(iLen);
40.    end;
42.    for i:=1 to iLen do
43.    begin
44.       iNum :=Ord(buf^)-48;
45.       Inc(buf);
46.       iLen2 := iLen-i;
47.       if(iNum=0) then
48.       begin
49.          if(((iLen2-2) mod 4)=0) and ((iLen2-3)>0) and (((iLen2>=8) or (iAddZero<3))) then
50.          begin
51.             szNum^ := hzUnit[(iLen2-3) mod 8 + 1];
52.             Inc(szNum);
53.          end;
54.          Inc(iAddZero);
55.          if(iLen>1) and (iLen2=1) and (buff[iLen] <> '0') then
56.          begin
57.             szNum^:=hzNum[1];
58.             Inc(szNum);
59.          end;
60.       end
61.       else
62.       begin
63.          if(((iAddZero>0) and (iLen2>=2)) and (((iLen2-1) mod 4)<>0) or ((iAddZero>=4) and ((iLen2-1)>0))) then
64.          begin
65.             szNum^:=hzNum[1];
66.             Inc(szNum);
67.          end;
68.          szNum^:=hzNum[iNum+1];
69.          Inc(szNum);
70.          iAddZero:=0;
71.       end;
72.       if (iAddZero<1) or (iLen2=2) then
73.       begin
74.          if(iLen-i>=3) then
75.          begin
76.             szNum^:=hzUnit[(iLen2-3) mod 8 + 1];
77.             Inc(szNum);
78.          end
79.          else
80.          begin
81.             szNum^:=mnUnit[(iLen2) mod 3 +1 ];
82.             Inc(szNum);
83.          end;
84.       end;
85.    end;
86.    ResultCount := szNum-PWideChar(Result);
87.    if((Num < 0.0) and (ResultCount - 1 = 0)) or ((Num>=0.0) and (ResultCount=0)) then
88.    begin
89.       szNum^:=hzNum[1];
90.       Inc(szNum);
91.       szNum^:=mnUnit[3];
92.       Inc(szNum);
93.       szNum^:=OtherWords[1];
94.       Inc(szNum);
95.       Inc(ResultCount,3);
96.    end
97.    else
98.    if((Num<0.0) and (buff[iLen+1] ='0')) or ((Num>=0.0) and (buff[iLen] ='0')) then
99.    begin
100.       szNum^:=OtherWords[1];
101.       Inc(ResultCount);
102.    end;
104.    SetLength(Result, ResultCount);
105. end;

 Function   CovMoney(money   :   Double)   :   String;   //小写金额转换成大写金额  
  Var  
      sStr,   buf,   sPower,   buf1   :   String;  
      i,   j,   iPosition,   lenth,   iTmp   :   Integer;  
      flag0   :   boolean;  
   
        Function   Sjoin(Var   buff   :   String;   sString   :   String;   digit   :   String;   nextdig   :   String;   iPos   :   Integer)   :   Integer;  
        Var  
            dig   :   String;   //   *   1  
            flag0   :   Boolean;  
        Begin  
            flag0   :=   True;  
   
            If   digit   =   '0'   Then  
                If   nextdig   <>   '0'   Then  
                    dig   :=   '零'  
                Else  
                    flag0   :=   False;  
            If   digit   =   '1'   Then  
                dig   :=   '壹';  
            If   digit   =   '2'   Then  
                dig   :=   '贰';  
            If   digit   =   '3'   Then  
                dig   :=   '叁';  
            If   digit   =   '4'   Then  
                dig   :=   '肆';  
            If   digit   =   '5'   Then  
                dig   :=   '伍';  
            If   digit   =   '6'   Then  
                dig   :=   '陆';  
            If   digit   =   '7'   Then  
                dig   :=   '柒';  
            If   digit   =   '8'   Then  
                dig   :=   '捌';  
            If   digit   =   '9'   Then  
                  dig   :=   '玖';  
   
            If   digit   =   '0'   Then  
                If   (flag0   =   True)   And   (iPos   <>   0)   Then  
                Begin  
                    buff   :=   buff   +   dig;  
                    Result   :=   2;  
                End  
                Else  
                    Result   :=   0  
            Else  
            Begin  
                buff   :=   buff   +   dig;  
                buff   :=   buff   +   sString;  
                Result   :=   4;  
            End;  
        End;  
  Begin  
      If   money   =   0   Then  
      Begin  
          Result   :=   '零元整';  
          exit;  
      End;  
      iPosition   :=   0;  
      buf1   :=   trim(Format('%12.2f',   [money]));  
   
      lenth   :=   Length(buf1);  
      buf   :=   '                                 ';   //     16   bit   space;  
      j   :=   1;  
      For   i   :=   16   -   lenth   To   15   Do  
      Begin  
          buf[i]   :=   buf1[j];  
          j   :=   j   +   1;  
      End;  
   
      For   i   :=   1   To   15   Do  
      Begin  
          iTmp   :=   ord(buf[i]);  
          If   ((iTmp   >=   49)   And   (iTmp   <=   58))   Or   (chr(iTmp)   =   ',')   Then  
              break;  
      End;  
      While   i   <=   15   Do  
      Begin  
          flag0   :=   True;  
          iTmp   :=   0;  
          Case   i   -   1   Of  
              0,   4,   8   :   sPower   :=   '仟';  
              1,   5,   9   :   sPower   :=   '佰';  
              2,   6,   10   :   sPower   :=   '拾';  
              3   :  
                  Begin  
                      sPower   :=   '亿';  
                      If   copy(buf,   i,   1)   =   '0'   Then  
                      Begin  
                          sStr   :=   sStr   +   sPower+'零';  
                          iPosition   :=   iPosition   +   2;  
                          iTmp   :=   1;  
                      End;  
                  End;  
              7   :  
                  Begin  
                      sPower   :=   '万';  
                      If   copy(buf,   i,   1)   =   '0'   Then  
                      Begin  
                          sStr   :=   sStr   +   sPower+'零';  
                          iPosition   :=   iPosition   +   2;  
                          iTmp   :=   1;  
                      End;  
                  End;  
              11   :  
                  Begin  
                      sPower   :=   '元';  
                      If   (copy(buf,   i,   1)   =   '0')   And   (iPosition   <>   0)   Then  
                      Begin  
                          sStr   :=   sStr   +   sPower;  
                          iPosition   :=   iPosition   +   2;  
                          iTmp   :=   1;  
                      End;  
                  End;  
              12   :  
                  Begin  
                      flag0   :=   False;  
                      If   (copy(buf,   i   +   1,   1)   =   '0')   And   (copy(buf,   i   +   2,   1)   =   '0')   Then  
                      Begin  
                          sPower   :=   '整';  
                          sStr   :=   sStr   +   sPower;  
                          iPosition   :=   iPosition   +   2;  
                          iTmp   :=   2;  
                      End;  
                  End;  
              13   :   sPower   :=   '角';  
              14   :  
                  Begin  
                      If   copy(buf,   i,   1)   =   '0'   Then   iTmp   :=   2;  
                      sPower   :=   '分';  
                  End;  
          End;  
          If   (flag0   =   True)   And   (iTmp   =   0)   Then  
              Begin  
                  If   i   >   0   Then  
                      iPosition   :=   iPosition   +   Sjoin(sStr,   sPower,   copy(buf,   i,   1),   copy(buf,   i   +   1,   1),   iPosition)  
                  Else  
                      iPosition   :=   iPosition   +   Sjoin(sStr,   sPower,   copy(buf,   i,   1),   copy(buf,   i,   1),   iPosition);  
              End;  
          If   iTmp   =   2   Then  
              break  
          Else  
              i   :=   i   +   1;  
      End;  
  //     If   (ilength   <>   0)   Then   ilength   :=   iPosition;  
      If   pos('整',   sStr)   <   1   then  
      begin  
        if   (pos('角',   sStr)   <   1)   and   (pos('分',   sStr)   <   1)   Then  
            sStr   :=   sStr   +   '整';  
      end;  
          sStr   :=stringreplace(sStr,'零零','零',[rfReplaceAll]);  
          sStr   :=stringreplace(sStr,'零元','元',[rfReplaceAll]);  
          Result   :=   Trim(sStr);  
  End;