cndigits.pas

cnupper131货币及日期转换大写组件

unit CnDigits;
{--------------------------------------------------------------------
    货币数字转为为中文大写的组件 Version 1.31
                          by lichaohui 2003.4.13

简介:
    可以转化整数，浮点数，及时间日期型数据
    配合别名列表可以进行语音合成，主要用于
    东进中继卡中的PlayPrompt提示语音的合成
    用于电话系统中播放金额，日期及时间
    还有输入的数字序列，同时更多的应用于显示
    销售系统中的打印发票时的中文大写金额字段

email:
[e-mail]

来自：小猪, 时间：2003-4-14 13:44:00, ID：1767011
to：LiChaoHui

没有习惯，有规定。
给你看看人民银行的规定吧（说不定你还得改改^_^）。

正确填写票据和结算凭证的基本规定

    银行、单位和个人填写的各种票据和结算凭证是办理支付结算和现金收付
的重要依据，直接关系到支付结算的准确、及时和安全。票据和结算凭证是银
行、单位和个人凭以记载账务的会计凭证，是记载经济业务和明确经济责任的
一种书面证明。因此，填写票据和结算凭证，必须做到标准化、规范化，要要
素齐全、数字正确、字迹清晰、不错漏、不潦草，防止涂改。
    一、中文大写金额数字应用正楷或行书填写，如壹（壹）、贰（贰）、叁、
肆（肆）、伍（伍）、陆（陆）、柒、捌、玖、拾、佰、仟、万（万）、亿、
元、角、分、零、整（正）等字样。不得用一、二（两）、三、四、五、六、
七、八、九、十、念、毛、另（或0）填写，不得自造简化字。如果金额数字
书写中使用繁体字，如貳、陸、億、萬、圓的，也应受理。
    二、中文大写金额数字到“元”为止的，在“元”之后，应写“整”
（或“正”）字，在“角”之后可以不写“整”（或“正”）字。大写金额数
字有“分”的，“分”后面不写“整”（或“正”）字。
    三、中文大写金额数字前应标明“人民币”字样，大写金额数字应紧接
“人民币”字样填写，不得留有空白。大写金额数字前未印“人民币”字样的，
应加填“人民币”三字。在票据和结算凭证大写金额栏内不得预印固定的“仟、
佰、拾、万、仟、伯、拾、元、角、分”字样。
    四、阿拉伯小写金额数字中有“0”时，中文大写应按照汉语语言规律、
金额数字构成和防止涂改的要求进行书写。举例如下：
    （一）阿拉伯数字中间有“O”时，中文大写金额要写“零”字。如
          ￥1，409．50，应写成人民币壹仟肆佰零玖元伍角。
    （二）阿拉伯数字中间连续有几个“0”时，中文大写金额中间可以只写
          一个“零”字。如￥6，007．14，应写成人民币陆仟零柒元壹角肆分。
    （三）阿拉伯金额数字万位或元位是“0”，或者数字中间连续有几个“0”，
          万位、元位也是“0’，但千位、角位不是“0”时，中文大写金额中
          可以只写一个零字，也可以不写“零”字。如￥1，680．32，应写成
          人民币壹仟陆佰捌拾元零叁角贰分，或者写成人民币壹仟陆佰捌拾元
          叁角贰分；又如￥107，000．53，应写成人民币壹拾万柒仟元零伍角
          叁分，或者写成人民币壹拾万零柒仟元伍角叁分。
    （四）阿拉伯金额数字角位是“0”，而分位不是“0”时，中文大写金额
          “元”后面应写“零”字。如￥16，409.02，应写成人民币壹万陆
          仟肆佰零玖元零贰分；又如￥325．04，应写成人民币叁佰贰拾伍元
          零肆分。
    五、阿拉伯小写金额数字前面，均应填写入民币符号“￥”（或草写：）。
阿拉伯小写金额数字要认真填写，不得连写分辨不清。
    六、票据的出票日期必须使用中文大写。为防止变造票据的出禀日期，在
填写月、日时，月为壹、贰和壹拾的，日为壹至玖和壹拾、贰拾和叁抬的，应
在其前加“零”；日为抬壹至拾玖的，应在其前加“壹”。如1月15日，应写成
零壹月壹拾伍日。再如10月20日，应写成零壹拾月零贰拾日。
    七、票据出票日期使用小写填写的，银行不予受理。大写日期未按要求规范
填写的，银行可予受理，但由此造成损失的，由出票入自行承担。
--------------------------------------------------------------------}
{ $message 'NOTICE: uncomment following line to discard unused code !'}
{ $message '注意: 去掉下面这一行，可以抛弃收集的其它代码'}
// {$define discard_other_code}

interface

uses
  Windows, Messages, SysUtils, Classes, Math;

type
  //类型定义
  TDate = TDateTime;
  TTime = TDateTime;

  { 中文数字大写组件 by lichaohui }

  TCnDigits = class(TComponent)
  private
    Fda: Boolean;
    procedure SetDA(const Value: Boolean);
    procedure SetCnUP(const Value: String);
  protected
    FCurrVa: Currency;
    FCnUpDigits: String;
    FAlias: TStrings;
    procedure SetCurrVa(const Value: Currency);
    procedure SetAlias(const Value: TStrings);
  public
    {$ifndef discard_other_code}
    //下面是肖杨的商场管理源码中的代码
    //返加人民币的中文数值
    class function other_RMB(NN:real):string;
    //其它的两个方法
    class function other_SmallTOBig(small: real): string;
    class function other_XD(xx: currency): string;
    {$endif}
    //下面是lichaohui的工具函数
    class function LzhFmtInt(IntValue: Int64;
      IsYear: Boolean = False; SoftTone: Boolean = False): String;
    class function LzhFmtDigits(Digits: String): String;
    class function LzhFmtFloat(FloatValue: Extended;
      RoundPos: Integer = 8): String;
    class function LzhFmtCurrency(AValue: Currency): String; overload;
    class function LzhFmtCurrency(AValue: Int64): String; overload;
    class function LzhFmtDate(AValue: TDate;
      DigitsYear: Boolean = False): String;
    class function StdFmtDate(AValue: TDate;
      DigitsYear: Boolean = False): String;
    class function LzhFmtTime(AValue: TTime;
      HasSecond: Boolean = False): String;
    class function LzhFmtDateTime(AValue: TDateTime;
      DigitsYear: Boolean = False): String;
    class function StdFmtDateTime(AValue: TDateTime;
      DigitsYear: Boolean = False): String;
    //常用方法调用接口
    function ChineseUpper(Curr: Currency): String;
    function ChineseDate(ADate: TDate;
      DigitsYear: Boolean = False): String;
    function ChineseTime(ATime: TTime;
      HasSecond: Boolean = False): String;
    //等价别名转化
    function StrToAlias(S: String): String;
    function StrToAlias2(S: String): String;
    //构造和析构函数
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property CurrencyValue: Currency read FCurrVa write SetCurrVa;
    property CnUpperDigits: String read FCnUpDigits write SetCnUP stored False;
    property Alias: TStrings read FAlias write SetAlias;
    property DefaultAlias: Boolean read Fda write SetDA;
  end;

const
  DP: WideString = '零壹贰叁肆伍陆柒捌玖两负';
  DN: WideString = '点拾佰仟万拾佰仟亿拾佰仟万拾佰仟兆拾佰仟';
  CrNa: WideString = '元角分整';
  DtNa: WideString = '年月日时分秒';

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('System', [TCnDigits]);
end;

{ TCnDigits }

{$ifndef discard_other_code}
class function TCnDigits.other_RMB(NN: real): string;
var
  HZ, NS, NW, NA, N1, N2:string;
  LA, X, Nk:integer;
begin
  //此行代码是为了修正小数位多于两位时生成的结果的错误
  NN := Int(NN * 100) / 100;
  //下面的代码被lichaohui格式化整理
  if NN > 9999999999999.99 then
  begin
    //MessageDlg('金额溢出。',mtError,[mbOk], 0);
    HZ := '';
    Result := HZ;
    exit;
  end;
  if NN = 0 then
  begin
    HZ := '零元';
    result := HZ;
    exit;
  end;
  NS := '零壹贰叁肆伍陆柒捌玖';
  NW := '分角元拾佰仟万拾佰仟亿拾佰仟万';
  NA := FloatToStr(NN * 100);
  LA := length(NA);
  X := 1;
  HZ := '';
  while X<=LA do
  begin
    NK := Ord(NA[x]) - Ord('0');
    N1 := Copy(NS, NK * 2 + 1, 2);
    N2 := Copy(NW, LA * 2 + 1 - X * 2, 2);
    if (NK = 0) AND ((N2 = '亿') OR( N2 = '万') OR( N2 = '元'))then
    begin
      if copy(HZ,Length(HZ)-1,2) = '零' then
        HZ := copy(HZ, 1, length(HZ) - 2);
      if copy(HZ, Length(HZ) - 1, 2) = '亿' then
        if N2 = '元' then
        begin
          N1 := N2;
          N2 := '零';
        end
        else
          N2 := ''
      else
      begin
        N1 := N2;
        N2 := '零';
      end
    end
    else if NK=0 then
    begin
      if copy(HZ, length(HZ) - 1, 2)='零' then
        N1 := '';
      if N2='分' then
      begin
        if copy(HZ, length(HZ) - 1, 2)='零' then
          HZ := copy(HZ, 1, length(HZ) - 2) + '整'
        else
          HZ := HZ + '整';
         N1 := '';
      end;
      N2 := '';
    end;
    HZ := HZ + N1 + N2;
    X := X + 1
  end; {end of while statement}
  Result := HZ;
end;

class function TCnDigits.other_SmallTOBig(small: real): string;
var
  SmallMonth,BigMonth:string;
  wei1,qianwei1:string[2];
  qianwei,dianweizhi,qian:integer;
begin
  {------- 修改参数令值更精确 -------}
  {小数点后的位数，需要的话也可以改动该值}
  qianwei:=-2;

  {转换成货币形式，需要的话小数点后加多几个零}
  Smallmonth:=formatfloat('0.00',small);
  {---------------------------------}

  dianweizhi :=pos('.',Smallmonth);{小数点的位置}

  {循环小写货币的每一位，从小写的右边位置到左边}
  for qian:=length(Smallmonth) downto 1 do
    begin
      {如果读到的不是小数点就继续}
      if qian<>dianweizhi then
        begin
          {位置上的数转换成大写}
          case strtoint(copy(Smallmonth,qian,1)) of
            1:wei1:='壹'; 2:wei1:='贰';
            3:wei1:='叁'; 4:wei1:='肆';
            5:wei1:='伍'; 6:wei1:='陆';
            7:wei1:='柒'; 8:wei1:='捌';
            9:wei1:='玖'; 0:wei1:='零';
          end;
          {判断大写位置，可以继续增大到real类型的最大值，可是谁有那么多钱}
          case qianwei of
            -3:qianwei1:='厘';
            -2:qianwei1:='分';
            -1:qianwei1:='角';
            0 :qianwei1:='元';
            1 :qianwei1:='拾';
            2 :qianwei1:='佰';
            3 :qianwei1:='千';
            4 :qianwei1:='万';
            5 :qianwei1:='拾';
            6 :qianwei1:='佰';
            7 :qianwei1:='千';
            8 :qianwei1:='亿';
            9 :qianwei1:='拾';
            10:qianwei1:='佰';
            11:qianwei1:='千';
          end;
      inc(qianwei);
      BigMonth :=wei1+qianwei1+BigMonth;{组合成大写金额}
    end;
  end;
  Result := BigMonth;
end;

class function TCnDigits.other_XD(xx: currency): string;
var
  dx,ws:string;
  i,cd:integer;
  int:currency;
begin
  int:=trunc(abs(xx)+0.005*100);
  cd:=length(currtostr(int));
  dx:='零壹贰叁肆伍陆柒捌玖';
  ws:='分角元拾佰仟万拾佰仟亿拾佰仟';
  result:='';
  i:=1;
  while i <= cd do
  begin
    result := result + copy(dx,strtoint(copy(currtostr(int),i,1))*2+1,2);
    result := result + copy(ws,(cd-i)*2+1,2);
    i:=i+1;
  end;
end;
{$endif}

class function TCnDigits.LzhFmtCurrency(AValue: Currency): String;
var
  IntPart: Int64;
  FracPart: Integer;
  Jiao, Fen: Integer;
  rs: WideString;
  ts: String;
  dts: Integer;
begin
  //获得整数部分
  IntPart := Trunc(Abs(AValue));
  //获得两位小数部分
  //此处出现舍入异常，即舍入的结果无法预料，多谢
  //DFW上的sichuan发现此错误，在此进行修正
  //FracPart := Round(Frac(Abs(AValue)) * 100);
  //修正后的语句
  //FracPart := Trunc(Abs(AValue) * 100 + 1e-5) mod 100;
  //格式化整数部分
  ts := FormatFloat('0.00', AValue);
  dts := Pos('.', ts);
  rs := LzhFmtInt(IntPart) + CrNa[1];
  //Jiao := FracPart div 10 mod 10;
  Jiao := Ord(ts[dts + 1]) - Ord('0');
  //Fen := FracPart mod 10;
  Fen := Ord(ts[dts + 2]) - Ord('0');
  FracPart := Jiao * 10 + Fen;
  //如果个位为零且大于零，则补零
  if (IntPart mod 10 = 0) and (IntPart > 0) and (FracPart >= 10) then
    rs := rs + DP[1];
  if (IntPart = 0) and (FracPart <> 0)  then rs := '';
  if FracPart >= 10 then
  begin
    if FracPart mod 10 = 0 then
      rs := rs + DP[Jiao + 1] + CrNa[2] + CrNa[4]
    else
      rs := rs + DP[Jiao + 1] + CrNa[2] + DP[Fen + 1] + CrNa[3];
  end
  else if FracPart > 0 then
  begin
    if IntPart = 0 then
      rs := rs + DP[Fen + 1] + CrNa[3]
    else
      rs := rs + DP[1] + DP[Fen + 1] + CrNa[3];
  end
  else
  begin
    rs := rs + CrNa[4];
  end;
  if AValue < 0 then rs := DP[12] + rs;
  Result := rs;
end;

class function TCnDigits.LzhFmtCurrency(AValue: Int64): String;
var
  IntPart: Int64;
  FracPart: Integer;
  Jiao, Fen: Integer;
  rs: WideString;