money.txt

货币转换工具

procedure Tfrm_ch_invoice.DBSumLowerChange(Sender: TObject);
VAR
  total_money:real;
  currency_chi:string;
begin
  try
    if (t_ch_invoice.state=dsinsert) or (t_ch_invoice.state=dsedit) then
    begin
      if frm_data_share.t_code_currency.Locate('币别',wwDBLookupCombo6.text,[])then
        currency_chi:=frm_data_share.t_code_currency.fieldbyname('中文名').asstring;
      total_money:=strtofloat(DBSumLower.text);
      if total_money<0 then
        begin
          total_money:=Abs(total_money);
          t_ch_invoice['金额大写']:=invoice_max(total_money,currency_chi+'(付)');
        end
      else
        t_ch_invoice['金额大写']:=invoice_max(total_money,currency_chi);
    end;
  except
    ;
  end;
end;


function invoice_max(num:real;str:string):widestring;
begin
  if strtobool(get_parameters_value(6,'false'))then
  begin
    result:=str+ max_num(num);
  end
  else
  begin
    result:=str+ntoc(num,false);
  end;
end;

function ntoc(s:real;bool:boolean):string;
begin
  if (s=0) and (bool=true) then 
  begin
    result:='ZERO';
    exit;
  end;
  if (s=0) and (bool=false) then
  begin
    result:='零元整';
    exit;
  end;
  result:=trim(uppercase(change(s,bool)))+' ';
end;

Function change( data:extended; mode: Boolean): String;
const cunit:Array[0..12] of string=('万', '仟', '佰', '拾', '亿', '仟', '佰', '拾', '万', '仟', '佰', '拾', '圆');
      Eunit:array[0..3] of string=(' billion ', ' million ', ' thousand ','');
var
  Sint,sdec,txtdec,txtint,s,intpart,decpart:String;
  i,jj,lentxt:Integer;
  tt:Boolean;
  Sth:array[1..5] of string;
begin
  if data>999999999999.99 then exit;
  If mode = false then    //选中中文模式
  begin
    txtint:=inttostr(trunc(data));
    txtdec:=formatfloat('00',frac(data)*100);
    lentxt := Length(txtint);
    for i := 1 to lentxt  do
      s:= txtint[i] + s;
    txtint := s;
    tt := False ;
    jj := 0;
    //处理整数部分
    if txtint <> '0' then
      for i := lentxt downto 1  do
        if txtint[i] = '0' Then
          if i = 1 then
            Sint := Sint + cunit[12]
          else if i = 9 then
            Sint := Sint + cunit[4]
          else if (i = 5) and (jj < 3) Then
            Sint := Sint + cunit[8]
          else if tt = False then
          begin
            tt := True;
            jj := 1;
          end
          else
            jj := jj + 1
    else
      if tt = True Then
      begin
        Sint := Sint + '零' + numtoc(txtint[i]) + cunit[13 - i];
        tt := False;
      end
      else
        Sint := Sint + numtoc(txtint[i]) + cunit[13 - i];


    //处理小数部分并输出
    if txtdec[2] = '0' Then
      if txtdec[1] = '0' Then
        if Sint = '0' Then
          result := '零圆整'
        else
          result := Sint + '整'
      else
      begin
        sdec := numtoc(txtdec[1]) + '角整';
        result := Sint + sdec;
      end
    else If txtdec[1] = '0' Then
      If Sint[2]= '0' Then
      begin
        sdec := numtoc(txtdec[2]) + '分';
        result:= sdec;
      end
      else
      begin
        sdec := '零' + numtoc(txtdec[2]) + '分';
        result := Sint + sdec;
      end
    else
    begin
      sdec := numtoc(txtdec[1]) + '角' + numtoc(txtdec[2]) + '分';
      result := Sint + sdec;
    end
  end
  // 英文模式
  else If mode = True Then
  begin
    //处理整数
    txtint:=formatfloat('000000000000.00',data);
    tt:=true;
    for i:=1 to 4 do
    begin
      Sth[i]:=txtint[3*i-2]+txtint[3*i-1]+txtint[3*i];
      if Sth[i]<>'000' then
      begin
        intpart:=intpart+spart(Sth[i],i,tt)+eunit[i-1];
        tt:=false
      end
    end;
    if intpart='' then
      intpart:='zero';
    //处理小数
    txtint[13]:='0';
    sdec:=txtint[13]+txtint[14]+txtint[15];
    decpart:=spart(sdec,1,true);
    if decpart='' then
      result:=intpart
    else
      result:=trim(intpart+' point '+decpart)
  end
end;

function numtoc(c:char):string;
var s: string;
begin
  case c of
    '0' : s:= '零';
    '1' : s:= '壹';
    '2' : s:= '贰' ;
    '3' : s:= '叁' ;
    '4' : s:= '肆' ;
    '5' : s:= '伍' ;
    '6' : s:= '陆' ;
    '7' : s:= '柒' ;
    '8' : s:= '捌' ;
    '9' : s:= '玖' ;
  end ;
  numtoc:=s;
end;
function numtoen(c:char):String;
var s:String;
begin
  case c of
    '0' : s:= '' ;
    '1' : s:= 'one';
    '2' : s:= 'two';
    '3' : s:= 'three';
    '4' : s:= 'four';
    '5' : s:= 'five';
    '6' : s:= 'six';
    '7' : s:= 'seven';
    '8' : s:= 'eight';
    '9' : s:= 'nine' ;
  end ;
  result:=s;
end;

function spart(s:String;k:integer;Isnil:boolean):String ;
var i:Integer;
begin
  if s[2] <> '0' Then
    if s[2] = '1' Then
    begin
      i:=strtoint(s[2]+s[3]);
      case i of
        10 :spart := 'ten';
        11 :spart := 'eleven';
        12 :spart := 'twelve';
        13 :spart := 'thirteen';
        14 :spart := 'fourteen';
        15 :spart := 'fifteen';
        16 :spart := 'sixteen';
        17 :spart := 'seventeen';
        18 :spart := 'eighteen';
        19 :spart := 'nineteen'
      end
    end
    else
    begin
      case s[2] of
        '2':spart := 'twenty';
        '3':spart := 'thirty';
        '4':spart := 'forty';
        '5':spart := 'fifty';
        '6':spart := 'sixty' ;
        '7':spart := 'seventy';
        '8':spart := 'eighty';
        '9':spart := 'ninety'
      end ;
      if s[3] <> '0' Then
        if k=4 then
          result:= result + '-' + numtoen(s[3])
        else
          result:= result+ ' ' + numtoen(s[3])
    end
  else
    result := numtoen(s[3]);
    
    
  if result <> '' Then
  begin
    if s[1]<>'0' then
      result := numtoen(s[1]) + ' hundred and ' + result
    else
      if Isnil=false then
        result:=' and '+result
  end
  else
    if s[1]<>'0' then
      result := numtoen(s[1])+ ' hundred '
end;