捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  沪ICP备05001939号 DELPHI盒子 | 盒子论坛 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 论坛检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
盒子资源分类
全部展开 - 全部合拢
一款人民币金额大小写转换的演示程序
关键字:人民币 金额 大小写 转换 RMB 财务
来 自:原创
平 台:Win9x,Win2k/NT,WinXP 下载所需:0 火柴
深浅度:中级 完成时间:2003/10/5
发布者:inrm 发布时间:2003/10/9
编辑器:DELPHI7 语  种:简体中文
分 类:不常用 下载浏览:1158/13730
加入到我的收藏
下载错误报错
登陆以后才能下载
 用户名:
 密 码:
自动登陆(30天有效)
图片如果打不开,说明流量不够了,请稍候下载……
    本函数由本人十多年前用DBaseIII编写,现用Pascal改编。如发现有错请告诉我,如发现有更为短小精简(当然必须符合财务规定)的,也请告诉我。
    人民币金额大小写转换的函数,从国人使用数据库以来就被无数人用无数种算法写过,应该是一个典型的算法问题,但未见有比较权威的、业界公认比较优秀的算法。

//以下函数能将小于十万亿元的小写金额转换为大写
//作者 方小庆(inrm@263.net)
Function NtoC(n0 :real) :String;
  Function IIF(b :boolean; s1,s2:string):string;
    begin //本函数在VFP和VB中均为系统内部函数
      if b then IIF:=s1 else IIF:=s2;
    end;
  Const c = '零壹贰叁肆伍陆柒捌玖◇分角圆拾佰仟万拾佰仟亿拾佰仟万';
  var L,i,n, code :integer;
      Z :boolean;
      s, st,st1 :string;
begin
  s :=FormatFloat( '0.00', n0);
  L :=Length(s);
  Z :=n0<1;
  For i:= 1 To L-3 do
    begin
      Val(Copy(s, L-i-2, 1), n, code);
      st:=IIf((n=0)And(Z Or (i=9)Or(i=5)Or(i=1)), ', Copy(c, n*2+1, 2)) 
        + IIf((n=0)And((i<>9)And(i<>5)And(i<>1)Or Z And(i=1)),',Copy(c,(i+13)*2-1,2))
        + st;
      Z := (n=0);
    end;
  Z := False;
  For i:= 1 To 2 do
    begin
      Val(Copy(s, L-i+1, 1), n, code);
      st1:= IIf((n=0)And((i=1)Or(i=2)And(Z Or (n0<1))), ', Copy(c, n*2+1, 2))
         + IIf((n>0), Copy(c,(i+11)*2-1, 2), IIf((i=2) Or Z, ', '整'))
         + st1;
      Z := (n=0);
    end;
  For i := 1 To Length(st) do If Copy(st, i, 4) = '亿万' Then Delete(st,i+2,2);
  NtoC := IIf( n0=0, '零', st + st1);
End;
Google
 
本站原创作品,未经作者许可,严禁任何方式转载;转载作品,如果侵犯了您的权益,请联系我们
龙脉加密锁 15元起 Grid++Report 报表 申请支付@网
 相关文章
FastReport 创建“人民币大小写转换”自定义…
yangzh 2006/8/11 下+0/浏+18641 评+7
大写金额转为英文的算法 修改版 By Logitec…
logitech1229 2006/7/14 下+612/浏+9896 评+1
又一款人民币金额大小写转换的演示程序
zlb_nj 2004/2/8 下+1082/浏+11374 评+1
一款人民币金额大小写转换的演示程序
inrm 2003/10/9 下+1158/浏+13731 评+2
人民币小写转换为大写的演示程序
mantousoft 2003/9/11 下+740/浏+11714 评+5
相关评论
共有评论2条 当前显示最后2条评论
coolboyhd 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.
jh_swl 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;
我要发表评论 查看全部评论
 
  DELPHI盒子版权所有 1999-2012 V3.01 沪ICP备05001939号 更新RSS列表