请问哪里有阿拉伯数字转换为大写中文数字的源码或好的思路

Question

请问哪里有阿拉伯数字转换为大写中文数字的源码或好的思路
做票据软件时，要用到

Answer 1

http://pdc.csmud.com/bbs/list.asp?boardid=51

Answer 2

function TffqkForm.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)) of1: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; 
SmallTOBig:=BigMonth; 
end;

Answer 3

来晚了一点:Function XiaoxieToDaxie(f : String) : String;
var
   Fs,dx,d2,zs,xs,h,jg:string;
   i,ws,{l,}w,j,lx:integer;
begin
  f := Trim(f);
  if copy(f,1,1)='-' then begin
    Delete(f,1,1);fs:='负';end
  else fs:='';
  dx:='零壹贰叁肆伍陆柒捌玖';
  d2:='拾佰仟万亿';
  i := AnsiPos('.',f);   //小数点位置
  if i = 0 Then
     zs := f     //整数
  else begin
     zs:=copy(f,1,i - 1);  //整数部分
     xs:=copy(f,i + 1,200);
  end;
  ws:= 0; //l := 0;
  for i := Length(zs) downto 1 do begin
    ws := ws + 1; h := '';
    w:=strtoint(copy(zs, i, 1));
    if (w=0) and (i=1) then jg:='零';
    If w > 0 Then
       Case ws of
         2..5:h:=copy(d2,(ws-1)*2-1,2);
         6..8:begin
           h:=copy(d2,(ws-5)*2-1,2);
           If AnsiPos('万',jg)=0 Then h:=h+'万';
           end;
         10..13:h := copy(d2,(ws-9)*2-1, 2);
       End;
    jg:=copy(dx,(w+1)*2-1,2) + h + jg;
    If ws=9 Then jg := copy(jg,1,2) + '亿' + copy(jg,3,200);
  end;
  j:=AnsiPos('零零',jg);
  While j > 0 do begin
    jg := copy(jg, 1, j - 1) + copy(jg, j + 2,200);
    j := AnsiPos('零零',jg);
  end;
  If (Length(jg) > 1) And (copy(jg,length(jg)-1,2)='零') Then jg :=copy(jg,1,Length(jg)-2);
  j := AnsiPos('零亿',jg);
  If j > 0 Then jg := copy(jg,1, j - 1) + copy(jg, j + 2,200);
  //转换小数部分
  lx := Length(xs);
  If lx > 0 Then begin
    jg := jg + '元';
    For i := 1 To lx do begin
      if i=1 then begin
        jg := jg + copy(dx, strtoint(copy(xs,i,1))*2 + 1, 2);
        jg := jg +'角';
      end;
      if i=2 then begin
        jg := jg + copy(dx, strtoint(copy(xs,i,1))*2 + 1, 2);
        jg := jg +'分';
      end;
    end;
    j :=AnsiPos('零角零分',jg);
    if j>0 then jg := copy(jg,1,j-1)+copy(jg,j+8,200)+'整';
    j := AnsiPos('零角',jg);
    if j>0 then jg := copy(jg,1,j-1)+copy(jg,j+4,200);
    j := AnsiPos('零分',jg);
    if j>0 then jg := copy(jg,1,j-1)+copy(jg,j+4,200);
  End
  else
    jg := jg + '元整';
  result := fs+jg;
end;

Answer 4

好像以前写过一个小函数，你试一下。
function ConvertStr(const sBeConvert: string): string;
    var
     x: integer;
    begin
      Result := '';
      for x := Length(sBeConvert) downto 1 do
      //AppendStr(Result, sBeConvert[x]);
    end;begin
      one[0]:='○';
      one[1]:='一';
      one[2]:='二';
      one[3]:='三';
      one[4]:='四';
      one[5]:='五';
      one[6]:='六';
      one[7]:='七';
      one[8]:='八';
      one[9]:='九';
      sarabic:=dblarabic;
      sintarabic:= convertstr(sarabic);
      for i:=1 to length(sintarabic) do
      begin
        strArabic:=midstr(sintarabic,i,1);
        for j:=0 to 9 do
        if j=strtoint(strarabic) then
        begin
        strarabic1:=one[j]+strarabic1;
        end;
         num:=strarabic1;
        if i=length(sintarabic) then
        exit;
      end;
end;

Answer 5

重发一下，刚才有些问题：
function tfrmmain.num(dblarabic:string):string;
var one:array[0..9] of string;
    i:integer;
    j:integer;
    sarabic:string;
    sintarabic:string;
    strArabic:string;
    strArabic1:string;function ConvertStr(const sBeConvert: string): string;
    var
     x: integer;
    begin
      Result := '';
      for x := Length(sBeConvert) downto 1 do
      //AppendStr(Result, sBeConvert[x]);
    end;begin
      one[0]:='○';
      one[1]:='一';
      one[2]:='二';
      one[3]:='三';
      one[4]:='四';
      one[5]:='五';
      one[6]:='六';
      one[7]:='七';
      one[8]:='八';
      one[9]:='九';
      sarabic:=dblarabic;
      sintarabic:= convertstr(sarabic);
      for i:=1 to length(sintarabic) do
      begin
        strArabic:=midstr(sintarabic,i,1);
        for j:=0 to 9 do
        if j=strtoint(strarabic) then
        begin
        strarabic1:=one[j]+strarabic1;
        end;
         num:=strarabic1;
        if i=length(sintarabic) then
        exit;
      end;
end;

Answer 6

procedure TForm1.Button1Click(Sender: TObject);
const
  Digits: array[0..9] of String = (
      '零', '壹', '贰', '叁', '肆',
      '伍', '陆', '柒', '捌', '玖');
var
  i : Integer;
begin
  for i := 0 to 9 do
  begin
    showmessage(Digits[i]);
  end;end;

Answer 7

补充：把刚才的代码中有一行注释，把注释符号去掉，另外midstr函数在StrUtils单元中定义

Answer 8

函数功能：
输入：double的数字串（数字小写）
处理：DoubleToChinese(Value:string):Widestring;
输出：对应的中文大写
-----------------------------------
程序所用到的数据
单位：
十 'd'(ecade)
百 'h'(undred)
千 't'(housand)
万 'w'
亿 'y'
-------
数字：
零：'0'
壹：'1'
贰：'2'
叁：'3'
肆：'4'
伍：'5'
陆：'6'
柒：'7'
捌：'8'
玖：'9'
-------
点:'.' 
-----------------------------------------------------------
具体实现：  声明：
      常量：（Const）内部函数（private）
1.取小数点位置函数：GetDotPosition(Value:string):integer;
2.去左边‘0’的函数：TrimZeroLeft(Value:string):string;
3.去右边‘0’的函数：TrimZeroRight(Value:string):string;
4.取整数部分：GetInteger(Value:string):string;
5.取小数部分：GetDecimal(Value:string):string;
6.加‘0’的函数：AddZeroLeft(Value:string):string;
7.对整数开始进行过渡转换：TransitionStart(Value:string):string;//有些混乱
8.对整数完成进行过渡转换：TransitionEnd(Value:string):string;//有些混乱
9.转换整数部分：IntegerToChinese(Value:string):widestring;
10.转换小数部分：DecimalToChinese(Value:string):widestring;   外部函数
11.合并整数和小数的结果：DoubleToChinese(Value:string):string;
    定义：
内部函数（private）
1.取小数点位置函数:GetDotPosition(Value:string):integer;
  输入：需要进行转换的原始字符串Originality
  输出：
如果Value 为空，则返回
如果没有小数点，返回 0；
     有小数点，返回 小数点在 Value 中的索引值
2.去左边‘0’的函数：TrimZeroLeft(Value:string):string;
  输入：需要进行转换的原始字符串Originality
  输出：
如果Value为空，则返回 空；
去掉Value左边的‘0’，直到Value左边不为‘0’，返回去‘0’后的Value
3.去右边‘0’的函数：TrimZeroRight(Value:string):string;
  输入：需要进行转换的原始字符串Originality
  输出：
如果Value为空，则返回 空；
去掉Value右边的‘0’，直到Value右边不为‘0’，返回去‘0’后的Value
4.取整数部分：GetInteger(Value:string):string;
  输入：TrimZeroLeft(Value:string):string; 函数的结果
  输出：
如果没有整数部分，则返回 ''(空字符串）
      有，返回 整数 字符串
5.取小数部分：GetDecimal(Value:string):string;
  输入：TrimZeroRight(Value:string):string;
  输出：
如果没有小数部分，则返回 ''(空字符串）
     有，返回 小数 字符串
6.加‘0’的函数：AddZeroLeft(Value:string):string;
  输入：GetInteger(Value:string):string;函数的结果
  输出：
如果输入为空，则输出为空
     不为空
如果Value的长度为四的倍数，则直接返回Value;
不是四的倍数，则在Value前面添加‘0’，直到其是四的倍数，返回添加‘0’后的Value
7.对整数开始进行过渡转换：TransitionStart(Value:string):string;
  输入：AddZeroLeft(Value:string):string;函数的结果
  输出：
如果输入为空，则返回为空
     不为空
由于AddZeroLeft的作用，使得Value的长度正好是四的倍数，假设分N组,一定有N>=1;
将Value分成N组，每组对应Value中的连续的四个字符；
在Value中，越是后面的的字符，其组号越小；
对每一组，依次判断每一位是否不为‘0’，不是，就在这位后面加一个单位'd'(拾)、'h'（百）、't'（千）或不加其中的一个
是，不加；
然后再将刚才的组内部的四次判断结果，结合新组；
对每一组，判断其组号码，如果是1，则此组不加；
如果大于1，则判断组号取2模，结果为0，此组后加'w'(万)
结果为1，此组后加'y'（亿）
将各组的结果组合在一起，作为返回值；
8.对整数完成进行过渡转换：TransitionEnd(Value:string):string;
  输入：TransitionStart(Value:string):string;函数的结果
  输出：
如果输入为空，则输出为空
     不为空
去掉Value中，前面不是数字的字符，直到Value的第一个字符是数字:
去掉Value中直接跟在'y'（亿）后面的'w'(万)
此时返回Value
9.转换整数部分：IntegerToChinese(Value:string):widestring;
  输入：TransitionEnd(Value:string):string;函数的结果
  输出：
如果输入为空，则输出为空
不为空，按照顺序将Value中的每个字符转换成其中文大写形式，并按照原顺序组合成中文字符串
10.转换小数部分：DecimalToChinese(Value:string):widestring;
  输入：
  输出：
如果输入为空，则输出为空
不为空，按照顺序将Value中的每个字符转换成其中文大写形式，并按照原顺序组合成中文字符串 外部函数（public）
11.合并整数和小数的结果：DoubleToChinese(Value:string):string;
  输入：需要进行转换的原始字符串Originality
  输出：
如果输入为空，则输出为空
     不为空
IntegerToChinese(Value:string):widestring;函数的结果，以ITC表示
DecimalToChinese(Value:string):widestring;函数的结果，以DTC表示
依照以下规定
如果ITC与DTC都为空，返回：‘零’
如果ITC与DTC都不为空，返回：ITC+'点'+DTC
如果ITC为空，DTC都不为空，返回：‘零’+DTC
如果ITC不为空，DTC都为空，返回：ITC
-----------------
存在未能解决的问题，大部分数据（具有代表性）测试能通过，只对极特殊的有些问题，发现是在定义处理组合并的情况下产生，即第7和第8的后面还应该有一个过度函数。
--------
评论：不知道是我自己想的太复杂，还是问题本身就很复杂；
此问题关键在于对'0'的处理，有相当多的情况
我认为150行以内pascal代码是无法完成转换的
我有一个根据以上思想写好的程序，有需要的给我短信

Answer 9

谢谢 pdcdiy163(代码写的好、要饭要到老) 提供地址
刚才看由 pdcdiy163(代码写的好、要饭要到老) ( ) 提供的地址中的转换方法
不好意思，本人对SQL脚本不熟悉，所以不清楚是否真正有效
不过，其中的思路的可以借鉴，即：将'0'的情况作成字典，可有效的减少代码长度