基本信息

---

下载

   友情提示：（无需注册或充值，赞助后即可获取资源下载链接）

---

     嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：813200300

本次赞助数额为： 2 元　

支付宝支付

微信支付

   源码介绍

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    Function ConvertMoney(Num: Real): String;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
   uses math;
{$R *.dfm}

{ TForm1 }

function TForm1.ConvertMoney(Num: Real): String;
var
  intstr,decstr,s: String;
  intlen,declen,i: word;
begin
  Intstr:= intToStr(Trunc(Num));
  decstr := FloatToStr(RoundTo(Frac(num),-2));//对小数进行四舍五入
  decstr := copy(decstr,3,Length(decstr)-1);
  declen := Length(decstr);
  intlen := Length(Intstr);
  For i :=  1 to Intlen do
  begin
    Case StrToInt(Intstr[i]) of
      0: begin
           if (copy(s,Length(s)-1,2)<>'零')  then
             s := s '零';
         end;
      1: s := s '壹';
      2: s := s '贰';
      3: s := s '叁';
      4: s := s '肆';
      5: s := s '伍';
      6: s := s '陆';
      7: s := s '柒';
      8: s := s '捌';
      9: s := s '玖';
    end;
     case intlen-i 1 of
       13: begin
             if (StrToInt(Intstr[i])<>0)then
               s := s '万';
           end;
       12: begin
             if (StrToInt(Intstr[i])<>0) then
               s := s '千';
           end;
       11: begin
             if (StrToInt(Intstr[i])<>0) then
               s := s '佰';
           end;
       10: begin
             if (StrToInt(Intstr[i])<>0) then
             begin
               //if (copy(s,Length(s)-1,2) ='壹')then
                // s := copy(s,0,Length(s)-2);
               s := s '十';
             end;
           end;
       9: begin
              if (StrToInt(Intstr[i])<>0) then
                s := s '亿'
              else
              begin
                if (copy(s,Length(s)-1,2) ='零')then
                  s := copy(s,0,Length(s)-2);
                  s := s '亿';
              end;
           end;
       8: begin
             if (StrToInt(Intstr[i])<>0) then
               s := s '千';
           end;
       7: begin
             if (StrToInt(Intstr[i])<>0)then
               s := s '佰';
           end;
       6: begin
             if (StrToInt(Intstr[i])<>0) then
             begin
               if (copy(s,Length(s)-1,2) ='壹')then
                 s := copy(s,0,Length(s)-2);
               s := s '十';
             end;
           end;
       5: begin
             if (StrToInt(Intstr[i])<>0) then
              s := s '万'
              else
              begin
                  s := copy(s,0,Length(s)-2);
                if (copy(s,Length(s)-1,2) <>'亿')then
                  s := s '万'
                else
                  s := s '零';
              end;
           end;
       4: begin
             if (StrToInt(Intstr[i])<>0) then
               s := s '千';
           end;
       3: begin
             if (StrToInt(Intstr[i])<>0) then
               s := s '佰';
           end;
       2: begin
             if (StrToInt(Intstr[i])<>0) then
               s := s '十';
           end;
       1: begin
             if (copy(s,Length(s)-1,2) ='零')then
               s := copy(s,0,Length(s)-2);
               s := s '元';
           end;
     end;
  end;
  For i := 1 to declen do
  begin
    Case StrToInt(decstr[i]) of
      0: begin
           if (copy(s,Length(s)-1,2)<>'零')  then
             s := s '零';
         end;
      1: s := s '壹';
      2: s := s '贰';
      3: s := s '叁';
      4: s := s '肆';
      5: s := s '伍';
      6: s := s '陆';
      7: s := s '柒';
      8: s := s '捌';
      9: s := s '玖';
    end;
    case i of
      1: begin
            if (StrToInt(decstr[i])<>0)then
              s := s '角';
          end;
      2: begin
            if (StrToInt(decstr[i])<>0) then
              s := s '分';
          end;
    end;
  end;
  Result := s;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit2.Text:= Convertmoney(StrToFloat(Edit1.Text));
end;

end.