把上写金额转换为大写金额(200分)

  • 主题发起人 主题发起人 QQL
  • 开始时间 开始时间
Q

QQL

Unregistered / Unconfirmed
GUEST, unregistred user!
有没有现成的把小写金额转换为大写金额的程序。
如(123313323.45转为壹亿贰仟参佰参拾壹万参仟参佰贰拾参圆肆角伍分整)。
 
讨论过很多次了,检索一下以前的问题
 
I have a Exg:

CREATE PROCEDURE dbo.submoney (
@amt numeric(10, 2),
@L1 char(1) output,
@L2 char(1) output,
@L3 char(1) output,
@L4 char(1) output,
@L5 char(1) output,
@L6 char(1) output,
@L7 char(1) output,
@L8 char(1) output,
@L9 char(1) output,
@L10 char(1) output,
@amtC char(64) output) AS
declare @s char(11)
declare @i integer
declare @C char(1)
declare @f integer
declare @C1 char(2)
select @f=0
select @s=convert(char(11),@amt)
select @i=charindex('.',@s)
select @s=stuff('000000000',10-@i,@i-1,@s)
/*----------------L1--------------*/
select @C=substring(@s,1,1)
if @C<>'0'
begin
select @f=1
select @L1=@C
end
else
select @L1=' '
/*----------------L2--------------*/
select @C=substring(@s,2,1)
if @f=1
select @L2=@C
else
begin
if @C<>'0'
begin
select @f=1
select @L2=@C
end
else
select @L2=' '
end
/*----------------L3--------------*/
select @C=substring(@s,3,1)
if @f=1
select @L3=@C
else
begin
if @C<>'0'
begin
select @f=1
select @L3=@C
end
else
select @L3=' '
end
/*----------------L4--------------*/
select @C=substring(@s,4,1)
if @f=1
select @L4=@C
else
begin
if @C<>'0'
begin
select @f=1
select @L4=@C
end
else select @L4=' '
end
/*----------------L5--------------*/
select @C=substring(@s,5,1)
if @f=1
select @L5=@C
else
begin
if @C<>'0'
begin
select @f=1
select @L5=@C
end
else select @L5=' '
end
/*----------------L6--------------*/
select @C=substring(@s,6,1)
if @f=1
select @L6=@C
else
begin
if @C<>'0'
begin
select @f=1
select @L6=@C
end
else select @L6=' '
end
/*----------------L7--------------*/
select @C=substring(@s,7,1)
if @f=1
select @L7=@C
else
begin
if @C<>'0'
begin
select @f=1
select @L7=@C
end
else select @L7=' '
end
/*----------------L8--------------*/
select @C=substring(@s,8,1)
if @f=1
select @L8=@C
else
begin
if @C<>'0'
begin
select @f=1
select @L8=@C
end
else select @L8=' '
end
/*----------------L9--------------*/
select @C=substring(@s,10,1)
if @f=1
select @L9=@C
else
begin
if @C<>'0'
begin
select @f=1
select @L9=@C
end
else
select @L9=' '
end
/*----------------L10--------------*/
select @C=substring(@s,11,1)
if @f=1
select @L10=@C
else
begin
if @C<>'0'
begin
select @f=1
select @L10=@C
end
else
select @L10=' '
end
/*======================================*/
/*L1*/
select @C1=
Case @L1
when '1' then '壹'
when '2' then '贰'
when '3' then '叁'
when '4' then '肆'
when '5' then '伍'
when '6' then '陆'
when '7' then '柒'
when '8' then '捌'
when '9' then '玖'
else '零'
end
select @amtC=@C1+'千'
/*L2*/
select @C1=
Case @L2
when '1' then '壹'
when '2' then '贰'
when '3' then '叁'
when '4' then '肆'
when '5' then '伍'
when '6' then '陆'
when '7' then '柒'
when '8' then '捌'
when '9' then '玖'
else '零'
end
select @amtC=@amtC+@C1+'百'
/*L3*/
select @C1=
Case @L3
when '1' then '壹'
when '2' then '贰'
when '3'then '叁'
when '4' then '肆'
when '5' then '伍'
when '6' then '陆'
when '7' then '柒'
when '8' then '捌'
when '9' then '玖'
else '零'
end
select @amtC=@amtC+@C1+'拾'
/*L4*/
select @C1=
Case @L4
when '1' then '壹'
when '2' then '贰'
when '3' then '叁'
when '4' then '肆'
when '5' then '伍'
when '6' then '陆'
when '7' then '柒'
when '8' then '捌'
when '9' then '玖'
else '零'
end
select @amtC=@amtC+@C1+'万'
/*L5*/
select @C1=
Case @L5
when '1' then '壹'
when '2' then '贰'
when '3' then '叁'
when '4' then '肆'
when '5' then '伍'
when '6' then '陆'
when '7' then '柒'
when '8' then '捌'
when '9'then'玖'
else'零'
end
select @amtC=@amtC+@C1+'千'
/*L6*/
select @C1=
Case @L6
when '1' then '壹'
when '2' then '贰'
when '3' then '叁'
when '4' then '肆'
when '5' then '伍'
when '6' then '陆'
when '7' then '柒'
when '8' then '捌'
when '9'then '玖'
else '零'
end
select @amtC=@amtC+@C1+'百'
/*L7*/
select @C1=
Case @L7
when '1' then '壹'
when '2' then '贰'
when '3' then '叁'
when '4' then '肆'
when '5' then '伍'
when '6' then '陆'
when '7' then '柒'
when '8' then '捌'
when '9'then '玖'
else '零'
end
select @amtC=@amtC+@C1+'拾'
/*L8*/
select @C1=
Case @L8
when '1' then '壹'
when '2' then '贰'
when '3' then '叁'
when '4' then '肆'
when '5' then '伍'
when '6' then '陆'
when '7' then '柒'
when '8' then '捌'
when '9' then '玖'
else '零'
end
select @amtC=@amtC+@C1+'元'
/*L9*/
select @C1=
Case @L9
when '1' then '壹'
when '2' then '贰'
when '3' then '叁'
when '4' then '肆'
when '5' then '伍'
when '6' then '陆'
when'7' then '柒'
when '8' then '捌'
when '9' then '玖'
else '零'
end
select @amtC=@amtC+@C1+'角'
/*L10*/
select @C1=
Case @L10
when '1' then '壹'
when '2' then '贰'
when '3' then '叁'
when '4' then '肆'
when '5' then '伍'
when'6' then '陆'
when '7' then '柒'
when '8' then '捌'
when '9' then '玖'
else '零'
end
select @amtC=@amtC+@C1+'分 '

hope it can help!
 
procedure TForm1.SpeedButton2Click(Sender: TObject);
var ls_qian_1, ls_qian,ls_1,ls_w :string;
li_long,li_i :integer;
Begin
ls_qian:=123313323.45;
li_long:=length(ls_qian);
for li_i := 0 TO li_long-1 do
begin
ls_1 := copy(ls_qian,li_long-li_i,1);
if ls_1<>'.' THEN
begin
if ls_1 ='0' then ls_1:='零';
if ls_1 ='1' then ls_1:='壹';
if ls_1 ='2' then ls_1:='贰';
if ls_1 ='3' then ls_1:='叁';
if ls_1 ='4' then ls_1:='肆';
if ls_1 ='5' then ls_1:='伍';
if ls_1 ='6' then ls_1:='陆';
if ls_1 ='7' then ls_1:='柒';
if ls_1 ='8' then ls_1:='捌';
if ls_1 ='9' then ls_1:='玖';
case li_i of
0:ls_w := '分整';
1:ls_w := '角';
2:ls_w := '';
3:ls_w := '元';
4:ls_w := '拾';
5:ls_w := '佰';
6:ls_w := '仟';
7:ls_w := '万';
8:ls_w := '拾';
9:ls_w := '佰';
10:ls_w := '仟';
11:ls_w := '亿';
12:ls_w := '拾';
13:ls_w := '佰';
14:ls_w := '仟';
end;
end
else
begin
ls_1:='';
ls_w:='';
end;
ls_qian_1:=ls_1+ls_w+ls_qian_1;
end;
end;
原理由后向前依次取数,要求两位小数,可加转换。
 
function CurrToChinese(C: Currency; Bits: Integer=-1): string;
var S, Space: string; I,L,J: Integer;
begin
S:=format('%12.2f',[C]);
S:=TrimStrNum(S); //调用另外一个过程,用于去掉非数字字符;可以用Trim代替
L:=Length(S);
if Bits>-1
then if Bits>L
then begin
Space:='0';
for I:=2 to Bits-L do Space:=Space+'0';
S:=Space+S;
L:=Bits;
end;
Result:='¥';
for I:=L-1 downto 0
do begin
J:=ord(S[L-I]);
case J of
48: Result:=Result+'零';
49: Result:=Result+'壹';
50: Result:=Result+'贰';
51: Result:=Result+'叁';
52: Result:=Result+'肆';
53: Result:=Result+'伍';
54: Result:=Result+'陆';
55: Result:=Result+'柒';
56: Result:=Result+'捌';
57: Result:=Result+'玖';
end;
case I of
0: Result:=Result+'分';
1: Result:=Result+'角';
2: Result:=Result+'元';
3: Result:=Result+'拾';
4: Result:=Result+'佰';
5: Result:=Result+'仟';
6: Result:=Result+'万';
7: Result:=Result+'拾';
8: Result:=Result+'佰';
9: Result:=Result+'仟';
10: Result:=Result+'亿';
11: Result:=Result+'拾';
12: Result:=Result+'佰';
end;
end;
end;
 
function Tform1.SmallTOBig(small:real):string;
var SmallMonth,BigMonth:string;
wei1,qianwei1:string[2];
wei,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;
调用如下“edit1.text:=SmallTOBig(1234567890.1234);”他自动默认小数点后两位
 
我发一个给你!
 
能考滤多一点吗?如20053040.05,要写成二仟零伍万参仟零肆拾圆伍分。不能直接就
转换的。
 
这是从DFW们的答案中改写的,保证满足要求
//小写转换大写
function CurrToChnNum(Currnum:currency):string;
var s:string;
begin
s:=format('%11.2f',[Currnum]);
Result := StringToChnNum(Trim(s));
end; //'10001008001.12'

function StringToChnNum(str:string):string;
const ChnNum1='圆万亿兆';
var i,Len,Len1,Level,Start:integer;
s1,s:string;
Pre: Boolean;
begin
Result := '';
Len := Pos('.',str)-1;
Level := (Len + 3) div 4 ;
Len1 := Len mod 4 ;
if Len1=0 then Len1 := 4;
Start := 1;
for i := 1 to Level
do begin
Pre := False;
s := Copy(str,Start,Len1);
s1 := FourNumToChnNum(s,' 拾佰仟',Pre); // 注意有两个空格
if s1<>'' then
Result := Result + s1 + Copy(ChnNum1,(Level-i)*2+1,2);;
Start := Start + Len1;
Len1 := 4;
end;
Pre := False;
s1 := FourNumToChnNum(Copy(str,Len+2,2),'分角',Pre);
if s1 = '' then
s1 := '整';
Result := Result + s1 ;
end;

function FourNumToChnNum(Str:string;ChnNum:string;var Pre:boolean):string;
const digits: array [0..9] of string = ('零','壹','贰','叁','肆',
'伍','陆','柒','捌','玖');
var i,j,Len:integer;
begin
Result := '';
Len := Length(str) ;
for i:=1 to Len
do begin
j := Ord(str)-48;
if j=0 then
Pre := True
else begin
if Pre then
Result := Result + '零';
Result := Result + digits[j] + Trim(Copy(ChnNum,(Len - i) * 2+1,2));
Pre := False;
end;
end;
end;
 
对来信的回答已经Email给你。
 

例子发出,请查收。
 
感谢各位大侠!特别是Tianrei,他给了我一个很好的例子,稍微改一下就很完美。
再一次感谢各位。
 
后退
顶部