捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  沪ICP备05001939号 DELPHI盒子 | 盒子论坛 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 论坛检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
 
广告
评论:一款人民币金额大小写转换的演示程序
jh_swl 8139 2004/8/31 17:04:12
function NumToChar(const n: Real): string; //可以到万亿,并且可以随便扩大范围
const cNum: WideString=’零壹贰叁肆伍陆柒捌玖--万仟佰拾亿仟佰拾万仟佰拾元角分’;
      cCha:array[0..1, 0..15]of string =
      (('零元’,’零拾’,’零佰’,’零仟’,’零万’,’零亿’,’亿万’,’零零零’,
        '零零’,’零万’,’零亿’,’亿万’,’零元’,’零角’,’零分’,’零整’),
       ('元’,’零’,’零’,’零’,’万’,’亿’,’亿’,’零’,
        '零’,’万’,’亿’,’亿’,’元’,’零’,’整’,’整’));
  var i : Integer;
      sNum,sTemp : WideString;
begin
  result :='’;
  sNum := format(’%15d’,[round(n * 100)]);
  for i := 0 to 14 do
  begin
    stemp := copy(snum,i+1,1);
    if stemp=’' then continue
      else result := result + cNum[strtoint(stemp)+1] + cNum[i+13];
  end;
  for i:= 0 to 15 do //去掉多余的零
    Result := StringReplace(Result, cCha[0,i], cCha[1,i], [rfReplaceAll]);
end;
coolboyhd 2650 2004/2/29 0:58:24
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
function SmallToBig(Small:Real):string;
Var Str:String;
  DotPos:Integer;
  i:Integer;
  bStart:Boolean;
  sResult:WideString;
  SmallDit:Double;
begin
  Result:='零圆整';
  SmallDit:=Round((Small-INT(Small))*100)/100;
  Small:=INT(Small)+SmallDit;
  if SmallDit<0.01 then
    Exit;
  Str:=FormatFloat('#.##',Small);
  DotPos:=Pos('.',Str);
  if DotPos=0 then
    DotPos:=length(Str)+1;
  bStart:=False;
  For i:=DotPos-1 downto 1 do
  begin
    if (Str[i]<>'0') and (not bStart) then
      bStart:=True;
    if ABS(i-DotPos) MOD 4=1 then
    begin
      if (Str[i]='0') and (DotPos-i<>1) then
        sResult:='零'+sResult;
      Case DotPos-i of
        1:sResult:='圆'+sResult;
        5:sResult:='万'+sResult;
        9:sResult:='亿'+sResult;
        13:sResult:='兆'+sResult;
      end;
      bStart:=False;
    end;
    if (Str[i]<>'0') then
    begin
      Case ABS(i-DotPos) MOD 4 of
        0:sResult:='仟'+sResult;
        2:sResult:='拾'+sResult;
        3:sResult:='佰'+sResult;
      end;
    end;
    if i=3 then
      Application.ProcessMessages;
    Case Str[i] of
      '0':if bStart and (sResult[1]<>'零') then
          begin
            sResult:='零'+sResult;
            bStart:=False;
          end;
      '1':sResult:='壹'+sResult;
      '2':sResult:='贰'+sResult;
      '3':sResult:='叁'+sResult;
      '4':sResult:='肆'+sResult;
      '5':sResult:='伍'+sResult;
      '6':sResult:='陆'+sResult;
      '7':sResult:='柒'+sResult;
      '8':sResult:='捌'+sResult;
      '9':sResult:='玖'+sResult;
    end;
    if Str[i]<>'0' then
      bStart:=True;
  end;
  Delete(Str,1,DotPos);
  if Length(Str)>0 then
  begin
    Case Str[1] of
      '0':if sResult<>' then
            sResult:=sResult+'零';
      '1':sResult:=sResult+'壹';
      '2':sResult:=sResult+'贰';
      '3':sResult:=sResult+'叁';
      '4':sResult:=sResult+'肆';
      '5':sResult:=sResult+'伍';
      '6':sResult:=sResult+'陆';
      '7':sResult:=sResult+'柒';
      '8':sResult:=sResult+'捌';
      '9':sResult:=sResult+'玖';
    end;
    if Str[1]<>'0' then
      sResult:=sResult+'角';
    if Length(Str)>1 then
    begin
      Case Str[2] of
        '1':sResult:=sResult+'壹';
        '2':sResult:=sResult+'贰';
        '3':sResult:=sResult+'叁';
        '4':sResult:=sResult+'肆';
        '5':sResult:=sResult+'伍';
        '6':sResult:=sResult+'陆';
        '7':sResult:=sResult+'柒';
        '8':sResult:=sResult+'捌';
        '9':sResult:=sResult+'玖';
      end;
      if Str[2]<>'0' then
        sResult:=sResult+'分';
    end else
      sResult:=sResult+'整';
  end else
    sResult:=sResult+'整';
  Result:=sResult;
end;

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

procedure TForm1.Button2Click(Sender: TObject);
begin
  Close;
end;

end.
第一页 上一页 下一页 最后页 有 2 条纪录 共1页 1 - 2
 用户名:
 密 码:
自动登陆(30天有效)
 
  DELPHI盒子版权所有 1999-2012 V3.01 沪ICP备05001939号 更新RSS列表