求“阿拉伯数字转成人民币大写”函数

Question

在下用炎鼎公司的“数巨报表”设计报表，现遇到一个问题，需要将阿拉伯数字转成人民币大写。“数巨报表”内嵌pascal脚本解释器，不过它把pascal语言简化了，有如下要求：　　变量都是全局的； 
　　没有类、记录、枚举等数据类型； 
　　没有循环的中断操作符（break，continue）； 
　　只能定义一维数组。 在下对pascal一窍不通，求诸位高手根据以上要求写一个函数，能将阿拉伯数字转成人民币大写，先谢谢各位了。

Answer 1

//大小写金额转换
function TAccessOthers.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;
         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;
   SmallTOBig := BigMonth;
end;

Answer 2

小写金额转化为大写
Function MaxtoMin(minje:string):string;
var
  dx,dy,nn,cccc,dd,c,cc,lc:string;
  n,iii:integer;
begin
  dx:='壹贰叁肆伍陆柒捌玖';
  dy:='分角圆拾佰仟万拾佰仟亿拾佰';
  nn:=trim(floattostr(strtofloat(minje)*100));
  n:=length(nn);
  cccc:='整';
  for iii:=1 to n do
  begin
    dd:=copy(dy,iii*2-1,2);
    c:=copy(nn,n-iii+1,1);
    if c<>'0' then
    begin
      cc:=copy(dx,(strtoint(c)*2 - 1),2);
      cccc:=trim(cc)+trim(dd)+trim(cccc);
    end
    else
    begin
      lc:=copy(trim(cccc),1,2);
      if ((iii=3) or (iii=7) or (iii=11)) then
      begin
        cccc:=trim(dd) + trim(cccc);
        continue;
      end;
      if ((lc<>'零') and (LC<>'整') and (LC<>'亿') and (LC<>'万') and (LC<>'圆')) then
        cccc:='零'+cccc;
    end;
  end;
  cccc:='合计:'+cccc;
  Result:=cccc;end;
//调用:
showmessage(MaxtoMin(trim('100')));

Answer 3

function momeytostr(const hjnum:real):string ;
var Vstr,zzz,cc,cc1,Presult:string;
xxbb:array[1..12]of string;
uppna:array[0..9] of string;
iCount,iZero,vPoint,vdtlno:integer;
begin
//*设置大写中文数字和相应单位数组*//
xxbb[1]:='亿';
xxbb[2]:='仟';
xxbb[3]:='佰';
xxbb[4]:='拾';
xxbb[5]:='万';
xxbb[6]:='仟';
xxbb[7]:='佰';
xxbb[8]:='拾';
xxbb[9]:='元';
xxbb[10]:='.';
xxbb[11]:='角';
xxbb[12]:='分';
uppna[0]:='零';
uppna[1]:='壹';
uppna[2]:='贰';
uppna[3]:='叁';
uppna[4]:='肆';
uppna[5]:='伍';
uppna[6]:='陆';
uppna[7]:='柒';
uppna[8]:='捌';
uppna[9]:='玖';
Str(hjnum:12:2,Vstr);
cc:='';
cc1:='';
zzz:='';
result:='';
presult:='';
iZero:=0;
vPoint:=0;
for iCount:=1 to 10 do
begin
cc:=Vstr[iCount];
if cc<>' ' then
begin
zzz:=xxbb[iCount];
if cc='0' then
begin
if iZero<1 then //*对“零”进行判断*//
cc:='零'
else
cc:='';
if iCount=5 then //*对万位“零”的处理*//
if copy(result,length(result)-1,2)='零' then
result:=copy(result,1,length(result)-2)+xxbb[iCount]
+'零'
else
result:=result+xxbb[iCount];
cc1:=cc;
zzz:='';
iZero:=iZero+1;
end
else
begin
if cc='.' then
begin
cc:='';
if (cc1='') or (cc1='零') then
begin
Presult:=copy(result,1,Length(result)-2);
result:=Presult;
iZero:=15;
end;
if iZero>=1 then
zzz:=xxbb[9]
else
zzz:='';
vPoint:=1;
end
else
begin
iZero:=0;
cc:=uppna[StrToInt(cc)];
end
end;
result:=result+(cc+zzz)
end;
end;
If Vstr[11]='0' then //*对小数点后两位进行处理*//
begin
if Vstr[12]<>'0' then
begin
cc:='零';
result:=result+cc;
cc:=uppna[StrToInt(Vstr[12])];
result:=result+(uppna[0]+cc+xxbb[12]);
end
end
else
begin
if iZero=15 then
begin
cc:='零';
result:=result+cc;
end;
cc:=uppna[StrToInt(Vstr[11])];
result:=result+(cc+xxbb[11]);
if Vstr[12]<>'0' then
begin
cc:=uppna[StrToInt(Vstr[12])];
result:=result+(cc+xxbb[12]);
end;
end;
result:=result+'正';
end;

Answer 4

function show(v_1:integer):string;
begin
  case v_1 of
  1: result:='分';
  2: result:='角';
  3: result:='';
  4: result:='';
  5: result:='拾';
  6: result:='佰';
  7: result:='仟';
  8: result:='';
  9: result:='拾';
  10: result:='佰';
  11: result:='仟';
  12: result:='億';
  13: result:='拾';
  end;
end;function smalltobig1(v_no:integer):string;
begin
  case v_no of
  0: result:='零';
  1: result:='壹';
  2: result:='貳';
  3: result:='參';
  4: result:='肆';
  5: result:='伍';
  6: result:='陸';
  7: result:='柒';
  8: result:='捌';
  9: result:='玖';
  end;
end;function big(v_str:string):string;
var v_len,i,j,k,a:integer;
    v_str1,v_str2:string;
    v_flag,v_flag1:integer;
begin
  a:=1;
  v_flag:=0;  //元的標志
  v_flag1:=0; //萬的標志
  v_str2:='';
  v_len:=length(v_str);
  if v_len>13 then exit;
  v_str1:=copy(v_str,v_len-2,1);
  if v_str1<>'.' then
    begin
      v_str1:=copy(v_str,v_len-1,1);
      if v_str1<>'.' then
        v_str:=v_str+'.00'
      else
        v_str:=v_str+'0';
    end;
  v_len:=length(v_str);
  if v_len>13 then exit;
  k:=1;
  for i:=1 to v_len do
  begin
    v_str1:=copy(v_str,v_len-i+1,1);
    if v_str1<>'.' then
    begin
      j:=strtoint(v_str1);
      if (j<>0) and (k>=3) then v_flag:=v_flag+1;
      if (j<>0) and (k>=8) and (k<=11) then v_flag1:=v_flag1+1;
      if j<>0 then     //數字不為0
        v_str1:=smalltobig1(j)+show(k)
      else if (a<>0) and (i<>1) and (i<>4) then v_str1:=smalltobig1(j)  //上一位為0且不為分位且不為'.'
      else v_str1:='';
      if (a=0) and (i=13) and (j<>0) then  v_str1:=v_str1+'億'; //億位為0﹐但十億位不為0
      if (k>=8) and (k<=11) and (v_flag1=1) and (j<>0) then  v_str1:=v_str1+'萬'; //沒有萬則加上萬
      if (k>=3) and  (v_flag=1) and (j<>0) then  v_str1:=v_str1+'圓'; //沒有圓則加上圓
      v_str2:=v_str1+v_str2;
      a:=j;
    end;
    k:=k+1;
  end;
  result:=v_str2;
end;

Answer 5

Function MaxtoMin(minje:string):string;
var
  dx,dy,nn,cccc,dd,c,cc,lc:string;
  n,iii:integer;
begin
  dx:='壹贰叁肆伍陆柒捌玖';
  dy:='分角圆拾佰仟万拾佰仟亿拾佰';
  nn:=trim(floattostr(strtofloat(minje)*100));
  n:=length(nn);
  cccc:='整';
  for iii:=1 to n do
  begin
    dd:=copy(dy,iii*2-1,2);
    c:=copy(nn,n-iii+1,1);
    if c<>'0' then
    begin
      cc:=copy(dx,(strtoint(c)*2 - 1),2);
      cccc:=trim(cc)+trim(dd)+trim(cccc);
    end
    else
    begin
      lc:=copy(trim(cccc),1,2);
      if ((iii=3) or (iii=7) or (iii=11)) then
      begin
        cccc:=trim(dd) + trim(cccc);
        continue;
      end;
      if ((lc<>'零') and (LC<>'整') and (LC<>'亿') and (LC<>'万') and (LC<>'圆')) then
        cccc:='零'+cccc;
    end;
  end;
  cccc:='合计:'+cccc;
  Result:=cccc;end;

Answer 6

{下面这个很好用的}
function ChiFormatCurrency(sValue: string): string;
var
  HZ, NS, NW, NA, N1, N2: string;
  LA, X, Nk: integer;
  fValue: Double;
begin
  if Trim(sValue) = '' then
  begin
    Result := '';
    Exit;
  end;
  try
    fValue := StrToFloat(sValue);
  except
    Result := '';
    Exit;
  end;
  if fValue > 9999999999999.99 then
  begin
    HZ := '';
    Result := HZ;
    exit;
  end;
  if fValue < 0.001 then
  begin
    HZ := '零元整';
    Result := HZ;
    exit;
  end;
  if fValue = 0 then
  begin
    HZ := '零元整';
    result := HZ;
    exit;
  end;
  NS := '零壹贰叁肆伍陆柒捌玖';
  NW := '分角元拾佰仟万拾佰仟亿拾佰仟万';
  NA := FloatToStr(fValue * 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);
          N1 := '';
        end;
        N2 := '';
      end;
    HZ := HZ + N1 + N2;
    X := X + 1
  end;
    if pos('分', HZ) = 0 then
      HZ := HZ + '整';
  Result := HZ;
end;

Answer 7

weizi2000(秋风啊)写的那个好用，经得起测试

Answer 8

Mark
需說明一下,各位定義的變量名稱,唉........