如何能将输入的数字变成大写金额,且符合票据的拼写规则呢?(50分)

  • 主题发起人 主题发起人 hengzhu
  • 开始时间 开始时间
H

hengzhu

Unregistered / Unconfirmed
GUEST, unregistred user!
我在设计一个票据打印程序,所以需要将数字变成大写金额
 
放在一个数组里面就可以了.
const
values: array [0..10] of string =
('零','壹','贰','叁','肆','伍','陆','柒','捌','玖','拾');
 
程序已发出,
请查收!
 
这好说,给你一段源程序,
这个函数,我们的软件中打印发票用的。

Function ChangeCase ( GetName , GetCount , SetName , SetName2 )
str =do
cument.GetCaseContent ( GetName , 0 )
Price = CDbl ( str )
str =do
cument.GetCaseContent ( GetCount , 0 )
Count = CLng ( str )
Total = Price * Count
str = CStr ( Total )
do
cument.SetCaseContent ( SetName , str , 0 )
if right ( str , 2 )<> "整" then
Dim money ( 12 )
money ( 1 )= "分"
money ( 2 )= "角"
money ( 3 )= "元"
money ( 4 )= "拾"
money ( 5 )= "百"
money ( 6 )= "千"
money ( 7 )= "万"
money ( 8 )= "拾"
money ( 9 )= "百"
money ( 10 )= "千"
money ( 11 )= "亿"
money ( 12 )= "拾"
max = len ( str )
if max = 4 or max = 3 then
ctemp = left ( str , 1 )
if ctemp = "0" then
ctemp = right ( str , 3 )
str = ctemp
max = max - 1
end if
end if
i = 0
test = clng ( str )
a1 = clng ( test / 1000000000 )
a2 = clng (( test - 1000000000 * a1 )/ 100000000 )
c1 = clng (( test - 1000000000 * a1 - 100000000 * a2 )/ 10000000 )
c2 = clng (( test - 1000000000 * a1 - 100000000 * a2 - 10000000 * c1 )/ 1000000 )
c3 = clng (( test - 1000000000 * a1 - 100000000 * a2 - 10000000 * c1 - 1000000 * c2 )/ 100000 )
c4 = clng (( test - 1000000000 * a1 - 100000000 * a2 - 10000000 * c1 - 1000000 * c2 - 100000 * c3 )/ 10000 )
do
tkey = 0
do
t = right ( str , 1 )
do
t = left (do
t , 1 )
ifdo
t = "." then
do
tkey = 1
end if
whiledo
t <> "." and i <= 3
i = i + 1
do
t = right ( str , i + 1 )
do
t = left (do
t , 1 )
ifdo
t = "." then
do
tkey = 1
end if
wend
if i > 2 then
declen = 0
else

declen = i
end if
newstr = ""
if declen = 0 then
curpos = max + 2 -do
tkey
else
curpos = max
end if
if declen = 2 then
curpos = max - 1
end if
i = 1
store = curpos
key = 1
while i <= max
a = left ( str , i )
a = right ( a , 1 )
select case a
case "1"
newstr = newstr + "壹"
key = 1
case "2"
newstr = newstr + "贰"
key = 1
case "3"
newstr = newstr + "叁"
key = 1
case "4"
newstr = newstr + "肆"
key = 1
case "5"
newstr = newstr + "伍"
key = 1
case "6"
newstr = newstr + "陆"
key = 1
case "7"
newstr = newstr + "柒"
key = 1
case "8"
newstr = newstr + "捌"
key = 1
case "9"
newstr = newstr + "玖"
key = 1
case "0"
a = left ( str , i - 1 )
a = right ( a , 1 )
if a = "0" then
key = 0
end if
if curpos = 7 or curpos = 3 or curpos = 11 then
key = 0
end if
a = left ( str , i + 1 )
a = right ( a , 1 )
if curpos = 8 and a = "0" then
key = 0
end if
m = 1
j = curpos
while j > 2
temp = left ( str , store - j + 1 )
temp = right ( temp , 1 )
if temp = "0" then
m = m + 1
end if
j = j - 1
wend
if m = curpos - j + 1 then

key = 0
end if
if key = 1 then
newstr = newstr + "零"
key = 0
end if
if declen > 0 then

if i = max - declen - 1 then

newstr = newstr + "元"
end if
else
if i = max then
newstr = newstr + "元"
end if
end if
case "."
curpos = curpos + 1
a = left ( str , i + 1 )
a = right ( a , 1 )
b = left ( str , i + 2 )
b = right ( b , 1 )
if a = "0" and b <> "0" then

newstr = newstr + "零"
end if
if declen = 0 then
newstr = newstr + "元"
end if
end select
a = left ( str , i )
a = right ( a , 1 )
if ( a <> "0" and a <> "." ) or ( curpos = 7 and ( c1 <> 0 or c2 <> 0 or c3 <> 0 or c4 <> 0 )) or curpos = 11 then
newstr = newstr + money ( curpos )
if a = "0"and ( curpos = 7 or curpos = 11 ) then
m = 1
j = curpos
while j > 2
temp = left ( str , store - j + 1 )
temp = right ( temp , 1 )
if temp = "0" then
m = m + 1
end if
j = j - 1
wend
if m <> curpos - j + 1 then

newstr = newstr + "零"
key = 0
end if
end if
end if
i = i + 1
curpos = curpos - 1
wend
newstr = newstr + "整"
do
cument.SetCaseContent ( SetName2 , newstr , 0 )
end if
End Function
 
来晚了!
这类问题通常用数组、Case 语句就行!(如果有需要 if 语句判断一下)
 
用用以下代码,我用的没问题:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Button1: TButton;
function SmallToBig(Small:real):string;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
{ TForm1 }
function TForm1.SmallToBig(Small: real): string;
var
SmallMonth,BigMonth: string;
weil,qianweil:string[2];
qianwei,dianweizhi,qian:integer;
begin
//修改参数令值更精确
qianwei := -2;//小数点后的位置,需要的话也可以改动-2值
Smallmonth := formatfloat('0.00',small);//转换成货币形式,需要的话小数点后多加几个零
dianweizhi := pos('.',Smallmonth);//小数点的位置
for qian := length(smallmonth)do
wnto 1do
begin
if qian<>dianweizhi then
//如果读到的不是小数点就继续
begin
case StrToInt(Copy(Smallmonth,qian,1)) of
1: weil := '壹';
2: weil := '贰';
3: weil := '叁';
4: weil := '肆';
5: weil := '伍';
6: weil := '陆';
7: weil := '柒';
8: weil := '捌';
9: weil := '玖';
0: weil := '零';
end;
Case qianwei of//判断大写位置,可以继续增大到real类型的最大值
-3: qianweil := '厘';
-2: qianweil := '分';
-1: qianweil := '角';
0: qianweil := '元';
1: qianweil := '拾';
2: qianweil := '佰';
3: qianweil := '仟';
4: qianweil := '万';
5: qianweil := '拾';
6: qianweil := '佰';
7: qianweil := '仟';
8: qianweil := '亿';
9: qianweil := '十';
10: qianweil := '佰';
11: qianweil := '仟';
end;
inc(qianwei);
BigMonth := weil+qianweil+BigMonth;//组合成大写金额
end;
end;
SmallToBig := BigMonth;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Money:do
uble;
begin
try
Money := StrToFloat(Edit1.Text);
except
MessageDlg('请检查',mtinformation,[mbOK],0);
Exit;
end;
Label1.Caption := SmallToBig(Money);
end;

end.
 
(1).TIANREI:你的程序我没收到,不知道为什么?
(2).程云的程序我试过了,编译时有点问题,我还没有明白为什么.
(3).XLF的程序所得到的结果不符和票据的大写拼写习惯,可惜...
(4).谢谢各位啦!有没有又短又好用的程式呢>?
 
我有一个处理人民币的单元,不短(500多行),好用
用法: s:=rmbFormat(<数>,<格式串>)
要不要?
 
龙丹:可否发给我你的程序,发至delphiuser@citiz.net,谢啦!
 
‘程序员大本营’中有个控件,是黄凯作的,自己去拉回来吧。
 
hwk2000:你所说的那个地方的网址是什么?你可否把这个控件发给我?
 
有必要吗?自己写就行了,又不复杂
 
古老的问题!
之是来自xwolf的答案:
unit Chnum;
interface
uses SysUtils, Dialogs;
var
chn_number: array [0..9] of string;
function chn_intvalue(ivalue: integer): string;
function chn_money(money:do
uble): string;
implementation
var
chn_sectionunit: array [0..2] of string;
//=================================================================
function chn_intvalue(ivalue: integer): string;
var
intstr, signstr, tstr: string;
q_digit, b_digit, s_digit, g_digit: string;
len, sectionlevel: integer;
zeroresulthead, zerohead: boolean;
begin
if (ivalue=0) then
begin
result:='零';
exit;
end
else
if (ivalue<0) then
begin
signstr:='负';
ivalue:=-ivalue;
end
else
signstr:='';
intstr:=inttostr(ivalue);
len:=Length(intstr);
sectionlevel:=-1;
//以4位数字为一节: eg. "万"节;
"亿"节;
zeroresulthead:=false;
//跨节用途.(指明上一循环后产生的中间结果(低位"节")是否为"零"开头)
while (len>0)do
begin
inc(sectionlevel);
if (sectionlevel>=3) then
// 限定 1 兆以内.
begin
showmessage('chn_intvalue error: value('+intstr
+') result in overflow.');
abort;
end;
//取得本节各位的数值, 并更新数据源intstr.
g_digit:=Copy(intstr, len, 1);
// 节内"个"位.
if (len>1) then
s_digit:=Copy(intstr, len-1, 1)
else
s_digit:='';
// 节内"十"位.
if (len>2) then
b_digit:=Copy(intstr, len-2, 1)
else
b_digit:='';
// 节内"百"位.
if (len>3) then
q_digit:=Copy(intstr, len-3, 1)
else
q_digit:='';
// 节内"千"位.
if (len>4) then
Delete(intstr, len-3, 4)
else
intstr:='';
len:=Length(intstr);
//对本节进行中文翻译.
zerohead:=false;
if (g_digit<>'0') then
tstr:=chn_number[strtoint(g_digit)]
else
tstr:='';
//完成"个"位中文翻译.
if (s_digit='0') then
s_digit:='';
//完成"拾"位中文翻译.
if (s_digit<>'') then
begin
tstr:=chn_number[strtoint(s_digit)]+'拾'+tstr;
zerohead:=false;
end
else
if (tstr<>'') then
begin
tstr:='零'+tstr;
zerohead:=true;
end;
if (b_digit='0') then
b_digit:='';
//完成"佰"位中文翻译.
if (b_digit<>'') then
begin
tstr:=chn_number[strtoint(b_digit)]+'佰'+tstr;
zerohead:=false;
end
else
if (tstr<>'') and not(zerohead) then
begin
tstr:='零'+tstr;
zerohead:=true;
end;
if (q_digit='0') then
q_digit:='';
//完成"千"位中文翻译.
if (q_digit<>'') then
begin
tstr:=chn_number[strtoint(q_digit)]+'仟'+tstr;
zerohead:=false;
end
else
if (tstr<>'') and not(zerohead) then
begin
tstr:='零'+tstr;
zerohead:=true;
end;
if (tstr<>'') then
begin
result:=tstr+chn_sectionunit[sectionlevel]+result;
zeroresulthead:=zerohead;
end
else
if not(zeroresulthead) then
begin
result:='零'+result;
zeroresulthead:=true;
end;
end;
// of while
if (zeroresulthead) then
Delete(result, 1, 2);
// 除首"零"
result:=signstr+result;
end;
//-----------------------------------------------------------------
function chn_money(money:do
uble): string;
var
intpart, chiao, cent: integer;
fracpart:do
uble;
signstr, tstr: string;
begin
signstr:='';
if (money<0) then
begin
money:=-money;
signstr:='负';
end;
money:=money+0.005;
//包含四舍五入
intpart:=Trunc(money);
//Trunc truncates a real number to an integer.
fracpart:=money-intpart;
fracpart:=fracpart*10;
chiao:=Trunc(fracpart);
fracpart:=fracpart-chiao;
fracpart:=fracpart*10;
cent:=Trunc(fracpart);
tstr:=chn_intvalue(intpart);
if (chiao=0) and (cent=0) then
result:=tstr+'元整';
if (chiao <> 0) and (cent = 0) then
result:=tstr+'元'+chn_number[chiao]+'角整';
if (chiao=0) and (cent <> 0) then
result:=tstr+'元'+'零'+chn_number[cent]+'分';
if (chiao <> 0) and (cent <> 0) then
result:=tstr+'元'+chn_number[chiao]+'角'+chn_number[cent]+'分';
result:=signstr+result;
end;
//=================================================================
initialization
chn_number[0]:='零';
chn_number[1]:='壹';
chn_number[2]:='贰';
chn_number[3]:='叁';
chn_number[4]:='肆';
chn_number[5]:='伍';
chn_number[6]:='陆';
chn_number[7]:='柒';
chn_number[8]:='捌';
chn_number[9]:='玖';
chn_sectionunit[0]:='';
chn_sectionunit[1]:='万';
chn_sectionunit[2]:='亿';
end.
 
首先,谢谢各位啦,给了我那么多的答案,不过似乎又短又好的的还是没有,
程序是要越写越精致才对是么?好像,短小而且解决问题的答案,现在还没有,
再次谢谢各位!这个问题可以结束了
 
接受答案了.
 
后退
顶部