高分求函数，小弟搞不定啊

Question

那位算法高手给我编一个数字转化为大写的函数吧。
比如
18009.98
转化为壹万捌仟零玖圆玖角玖分，多谢了。

Answer 1

function TDianFrm.xTOd(i:Real):string;
const
d='零壹贰叁肆伍陆柒捌玖分角元拾佰仟万拾佰仟亿';
var
m,k:string;
j:integer;
begin
k:='';
m:=floattostr(int(i*100));
for j:=length(m) downto 1 do
k:=k+d[(strtoint(m[Length(m)-j+1])+1)*2-1]+
d[(strtoint(m[Length(m)-j+1])+1)*2]+d[(10+j)*2-1]+d[(10+j)*2];
xTOd:=k;
end;
调用:
Edit26.text:=xTOd(123123);

Answer 2

http://aiirii.mblogger.cn/posts/4690.aspx

Answer 3

function Tform1.SmallTOBig(small:real):string;
var
   SmallMonth,BigMonth: string;
   wei1,qianwei1: string[2];
   qianwei,dianweizhi,qian: integer;
begin
      { 修改参数令值更精确 }
   qianwei:=-2; //小数点后的位置，需要的话也可以改动-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 //判断大写位置，可以继续增大到real类型的最大值
            -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 4

{返回中文大写数字}
function GetChinaNum(Num:TNumChar;ChinaNumFormat:TChinaNumFormat=cnfBig):string;
begin
  case ChinaNumFormat of
    cnfArab:begin
      case Num of
        '0':Result:='0';
        '1':Result:='1';
        '2':Result:='2';
        '3':Result:='3';
        '4':Result:='4';
        '5':Result:='5';
        '6':Result:='6';
        '7':Result:='7';
        '8':Result:='8';
        '9':Result:='9';
      end;
    end;
    cnfBig:begin
      case Num of
        '0':Result:='零';
        '1':Result:='壹';
        '2':Result:='贰';
        '3':Result:='叁';
        '4':Result:='肆';
        '5':Result:='伍';
        '6':Result:='陆';
        '7':Result:='柒';
        '8':Result:='捌';
        '9':Result:='玖';
      end;
    end;
    cnfSmall:begin
      case Num of
        '0':Result:='零';
        '1':Result:='一';
        '2':Result:='二';
        '3':Result:='三';
        '4':Result:='四';
        '5':Result:='五';
        '6':Result:='六';
        '7':Result:='七';
        '8':Result:='八';
        '9':Result:='九';
      end;
    end;
  end;
end;{将数字变成中文大写}
function FloatToChinaBig(Num:Double;ChinaBigFormat:TChinaBigFormat=cbfFull;Blanks:Byte=0):string;
var
  Str:string;
  AgainstStr:string;
  NumStr:string;
  i,j:Integer;
  AllNumLength:Integer;
  TempStr:string;
begin
  if Blanks>15 then Blanks:=17;
  NumStr:=CurrToStrF(Num,ffFixed,2);
  Delete(NumStr,Pos('.',NumStr),1);
  AllNumLength:=Length(NumStr);
  if Blanks<=AllNumLength then Blanks:=AllNumLength
  else begin
    TempStr:='';
    for i:=1 to Blanks-AllNumLength do
    begin
      TempStr:=TempStr+'0';
    end;
    NumStr:=TempStr+NumStr;
  end;
  NumStr:=ReverseStr(NumStr);
  Str:=FormatFloat('0佰0拾0万0仟0佰0拾0亿0仟0佰0拾0万0仟0佰0拾0圆.0角0分',Num);
  Delete(Str,Pos('.',Str),1);
  AgainstStr:=ReverseStr(Str);
  AgainstStr:=Copy(AgainstStr,1,3*Blanks);
  if ChinaBigFormat=cbfBlank then
  begin
    AgainstStr:='';
    for i:=1 to Blanks do
      AgainstStr:=AgainstStr+'  '+NumStr[i];
  end;
  j:=0;
  for i:=1 to Blanks do
  begin
    Insert(ReverseStr(GetChinaNum(AgainstStr[3*i+2*j])),AgainstStr,3*i+2*j);
    Inc(j);
  end;
  j:=0;
  for i:=1 to Blanks do
  begin
    Delete(AgainstStr,5*i-j,1);
    Inc(j);
  end;
  Result:=ReverseStr(AgainstStr);
end;function FloatToChnStr(Value: Real; ClearZero: Boolean; full:Boolean=False): String;
const
  ChnUnit: array[0..13] of string = ('分', '角', '元', '拾', '佰', '仟', '万', '拾', '佰', '仟', '亿', '拾', '佰', '仟');
  ChnNum : array[0..9]  of string = ('零', '壹','贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖');
var
  I: Integer;
  StrValue, StrNum: String;
  ValueLen: Integer;
begin
  if Value <= 0 then
  begin
    Result := '输入参数应大于零。';
    Exit;
  end;
  value:=RoundTo(Value,-2);
  StrValue := IntToStr(Round(Value * 100));
  ValueLen := Length(StrValue);
  Result := '';
  for I := 1 to ValueLen do
  begin
    StrNum := StrValue[I];
    Result := Result + ChnNum[StrToInt(StrNum)] + ChnUnit[ValueLen - I];
  end;
  if ClearZero then
  begin
    Result := StringReplace(Result, '零分', '',   [rfReplaceAll]);
    if Frac(Value)>0.009999 then
      Result := StringReplace(Result, '零角', '零',   [rfReplaceAll])
    else
      Result := StringReplace(Result, '零角', '',   [rfReplaceAll]);
    Result := StringReplace(Result, '零元', '元', [rfReplaceAll]);
    Result := StringReplace(Result, '零拾', '零',   [rfReplaceAll]);
    Result := StringReplace(Result, '零佰', '零',   [rfReplaceAll]);
    Result := StringReplace(Result, '零仟', '零',   [rfReplaceAll]);
    Result := StringReplace(Result, '零万', '万', [rfReplaceAll]);
    Result := StringReplace(Result, '零零', '零',   [rfReplaceAll]);
    Result := StringReplace(Result, '零零', '零',   [rfReplaceAll]);
  end;
  if full then
  begin
    if Frac(Value)<0.009999 then
      Result:=Result+'整';
  end;
end;

Answer 5

//朋友，这点你也写不出来，就别编程了吧，
=======================================
有这么多高手在，我就偷个懒了。//他们跟你一样懒，也是COPY的

Answer 6

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 7

这东西漫天飞
function CurrencyToChinese(ACurrency: Currency): String;  { 返回指定字符串的右边 N 个字符 }
  function _RightStr(S: String; N: Integer): String;
  var
    Start: Integer;
  begin
    Start := Length(S) - N + 1 ;
    if Start <= Length(S) then
      Result := Copy(S, Start, N)
    else Result := '';
  end;var
  LowStr                 : String;    // 小写金额字符串
  CurrentChar            : Char;      // 当前数值的ASCII码 
  CurrentNum             : Integer;   // 当前数值
  UpperStr, UnitageChar  : String[4]; // 大写金额字符串和金额单位字符串  CurrentPos, UnitagePos : Integer;   // 索引 
const
  UNITAGE_STR : String = '仟佰拾亿仟佰拾万仟佰拾元角分'; // 单位大写中文字符串
  UPPER_STR   : String = '零壹贰叁肆伍陆柒捌玖';         // 数值大写中文字符串
begin   { 让俺先看看金额是不是为零，如果是就省事啦 } 
  if ACurrency=0 then
  begin
    Result := ''; // 这里您要是想返回'零'、或者一个圈或者一个减号都可以     Exit;
  end;  { 不是零，要费点事儿啦 }
  Result := '';
  FmtStr(LowStr, '%15.2f', [ACurrency]); // 将数值转换成字符串 
  LowStr := Trim(LowStr);                // 去掉空格符  { 如果是负值，先把字符串里的那个负号去掉 } 
  if ACurrency<0 then LowStr := Copy(LowStr, 2, Length(LowStr)-1);   CurrentPos := 1;
  UnitagePos := 15 - Length(LowStr); 
  while UnitagePos<14 do
  begin
    CurrentChar := LowStr[CurrentPos];   // 取当前位数字 
    if (CurrentChar>'9') or (CurrentChar<'0') then
    begin
      { 取到的字符可能不是数字（比如说是小数点） } 
      Inc(CurrentPos); 
      Continue; 
    end;
    CurrentNum := Ord(CurrentChar) - Ord('0');                 // 取当前数字的值
    UpperStr := Copy(UPPER_STR, (CurrentNum shl 1)+1, 2);      // 取相应的大写中文
    UnitageChar := Copy(UNITAGE_STR, (UnitagePos shl 1)+1, 2); // 相应的单位    { 如果取得的数字不是零，很简单，在字符串后面添加上数值和单位就行了
 } 
    if (CurrentNum<>0) then 
    begin 
      Result := Result + UpperStr + UnitageChar; 
      Inc(UnitagePos);
      Inc(CurrentPos); 
      Continue;
    end;     { 是零就麻烦了，先看看是不是重复零，不是就先加一个'零'再说 }
    if _RightStr(Result, 2) <> '零' then Result := Result + '零';    { 如果是零且又正好在'亿'、'万'、'元'这三个位置上，就…… 
      大家都清楚，没有'参拾零元'或'贰拾零万玖仟'这种说法，只有 
      '参拾元'和'贰拾万玖仟'，因此要删去上面那句代码所加的'零'字符
    } 
    if (UnitageChar='亿') or (UnitageChar='万') or (UnitageChar='元')  
then
    begin 
      Delete(Result, Length(Result)-1, 2);
      { 还要看看前一位是不是'亿'位，是就不加单位了 } 
      if _RightStr(Result, 2)<>'亿' then 
        Result := Result + UnitageChar; 
      Result := Result + '零'; 
    end;
    Inc(UnitagePos); 
    Inc(CurrentPos); 
  end;   { 呀，终于转换完了，别忙，如果结果的末尾是'零'还要删去它 }
  if _RightStr(Result, 2)='零' then
    Result := Copy(Result, 1, Length(Result)-2);   { 如果结果的开始就是零，也要删除它 }
  if Copy(Result, 1, 2)='零' then
    Result := Copy(Result, 3, Length(Result)-2);   if _RightStr(Result, 2)='角' then
    { 如果结果正好是'XXXX角'，按习惯应该加上一个'XXXX角正' } 
    Result := Result + '正'
  else if _RightStr(Result, 2)<>'分' then 
    { 如果结果不是'XXXX分，就要加上一个'整'字} 
    Result := Result + '整';  if Copy(Result, 1, 2)='元' then
    { 还有一个小问题，就是…… }
    Result := _RightStr(Result, Length(Result)-4);  { 最后，如果是负值还要加上一个'负' }
  if ACurrency<0 then
    Result := '负' + Result;
end;