unit1.~pas

Delphi函数参考大全的CD

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

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.