紧急求助:在一个收费系统中打印收据时要打印人民币大写,如何做?(50分)

  • 主题发起人 主题发起人 tomtomtom
  • 开始时间 开始时间
T

tomtomtom

Unregistered / Unconfirmed
GUEST, unregistred user!
在收费系统中要求打印人民币大写:如何将123类的数字转换成“壹贰叁”类
型的字符?
 
OFFICE中很容易。
 
能不能说详细一点?
 
你可以试试自己用代码来检查字符串呀,写个子程序并不难的。
 
老兄(姐)呀,看样子你们不知道我是菜鸟是不是?写不来那个子程序呀!
 
查找一下吧,应该有的,如果没有可以寄一个给你
 
wgzhang:老兄,麻烦你寄一个源程序给我看一下,谢了.
 
32Bit深度历险恰好就有这个程序,建议你去看看。
http://vcl.vclxx.com
 
刚好我们也有这个需求, 下面是我们所用的.
使用时uses Chnum;
chn_money(123)返回人民币大写


unit Chnum;

interface

uses SysUtils, Dialogs;

var
chn_number: array [0..9] of string;

function chn_intvalue(ivalue: integer): string;
function chn_money(money: double): 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: double): string;
var
intpart, chiao, cent: integer;
fracpart: double;
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.
 
Function CMoneyFormat(iMoney: Integer ;sLen :Word):String;
//数值转金额大写
//iMoney:金额数值
//sLen:字距
const Moneys:Array[0..12] of String =('元整','拾','佰','仟','万','拾','佰','仟','亿','拾','佰','仟','兆');
const MValue:Array[0..9] of String =('零','壹','贰','参','肆','伍','陆','柒','捌','玖');
var i:Word;s,sm,str:String;
begin
sm := '';
s:= IntToStr(iMoney);
if Length(s)>13 then Exit;
for i:=1 to Length(s) do
if Pos(Copy(s,i,1),'0123456789')=0 then Exit;
if Pos(IntToStr(sLen),'0123456789')=0 then Exit;
str:=AddEmptyChar(' ',sLen,' ');
for i:=0 to Length(s)-1 do
sm:=MValue[StrToInt(Copy(s,Length(s)-i,1))]+str+Moneys+str+sm; Result := Trim(sm); //DEMO: CMoneyFormat('2130',2):='贰 仟 壹 佰 参 拾 零 元整';end; //Result
 
function SmallTOBig(small:real):string;
var
SmallMonth,BigMonth:string;
wei1,qianwei1:string[2];
wei,qianwei,dianweizhi,qian:integer;
begin
{------- 修改参数令值更精确 -------}
{小数点后的位置,需要的话也可以改动-2值}
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;
{判断大写位置,可以继续增大到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;
 
贴在这里算了,首先声明,这一段不全部由本人完成,是从大富翁上检索后作修改的.
保证可以准确把货币转成中文大写,我们已经用了一年多了.
//小写转换大写
function CurrToChnNum(Currnum:currency):string;
var s:string;
begin
Currnum:=Currnum;
s:=format('%11.2f',[Currnum]);
Result := StringToChnNum(Trim(s));
end;

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;
 
function RMB(NN:real):string;
var
HZ,NS,NW,NA,N1,N2:string;
LA,X,Nk:integer;
begin
if NN>9999999999999.99 then
begin
MessageDlg('金额溢出.',mtError,[mbOk], 0);
HZ:='';
Result:=HZ;
exit;
end;
if NN=0 then
begin
HZ:='零元';
result:=HZ;
exit;
end;
NS:='零壹贰叁肆伍陆柒捌玖';
NW:='分角元拾佰仟万拾佰仟亿拾佰仟万';
NA:=FloatToStr(NN*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)+'整'
else
HZ:=HZ+'整';
N1:='';
end;
N2:='';
end;
HZ:=HZ+N1+N2;
X:=X+1
end;
Result:=HZ;
end;
 
Function CurrToCharNum(Number:Real):String;
var I,J,m,leng,leng1:Integer;
Str,Strs,s1,s2,s3:String;
const China:Array[1..10,1..2] of String=
(('0','零'),('1','壹'),('2','贰'),('3','叁'),('4','肆'),
('5','伍'),('6','陆'),('7','柒'),('8','捌'),('9','玖'));
Asi:Array[1..12] of String=('拾','亿','仟','佰','拾','万','仟','佰','拾','元','角','分');
Begin
if Number>=2147483646.999 then
Begin
ShowWarning('最大数只可支持到2147483646.99元');
Abort;
End;
m:=0;
Result :='';
Str:=IntToStr(Trunc(Number));
S1:=IntToStr(Round(100*(Number-int(Number))));
if length(s1)=1 then S1:='0'+S1;
if length(s1)=0 then S1:='00';
Str:=Str+S1;
leng:=length(Str);
for I :=leng downto 1 do
Begin
Strs:=copy(Str,I,1);
for J :=1 to 10 do if Strs=China[J,1] then Strs :=China[J,2];
Result :=Strs+Asi[12-m] + Result;
m:=m+1;
End;
leng1:=length(Result);
s2:=copy(Result,leng1-7,8);
s3:=copy(Result,1,leng1-8);
if s2='零角零分' then Result :=s3+'整';
End;
 
和和,好古老的问题,结束了吧
 
接受答案了.
 
后退
顶部