急..关于人民币大小写转换问题!(50分)

Y

yjtajun

Unregistered / Unconfirmed
GUEST, unregistred user!
//原代码:
function TForm1.xTOd(i:Real):string;

const
d='零壹贰叁肆伍陆柒捌玖分角元拾佰仟万拾佰仟亿';

var
m,k:string;

j:integer;

begin

k:='';

m:=floattostr(int(i*100));

for j:=length(m) do
wnto 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;

//调用:
procedure TForm1.Button1Click(Sender: TObject);

var
Sum:real;

begin

sum:=12.30;

showmessage('人民币大写:'+xTOd(Sum));

end;

//本段程序运行结果为:壹拾贰元叁角零分
欲求结果为:"零万零仟零佰壹拾贰元叁角零分"代码?
请各位大侠帮忙!!!!
 
把分给我吧:
procedure TForm1.Button1Click(Sender: TObject);
var
Sum:real;
s,s_b:string;
begin
s_b:='零万零仟零佰零拾零元零角零分';
sum:=12.30;
s:= xTOd(Sum);
showmessage('人民币大写:'+copy(s_b,1,length(s_b)-length(s))+s);
end;
 
哈哈. 晕. 楼上的. 又手接.LZ就给你了.
 
可以把'零万零仟零佰零拾零元零角零分'定义个全局的,用着不爽一点啊.呵呵.
 
unit ucTPrice;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs;
type
RPriceUpper = record
bai: string;
baiwan: string;
fen: string;
jiao: string;
qian: string;
qianwan: string;
shi: string;
shiwan: string;
wan: string;
yuan: string;
end;

RPriceNum = record
bai: string;
baiwan: string;
fen: string;
jiao: string;
qian: string;
qianwan: string;
shi: string;
shiwan: string;
wan: string;
yuan: string;
end;

//////////////////////////////////////////////////////////////////
//TPrice
//货币有关操作类
//功能:存储货币数值,并转换成大写。可以定制两种大写格式,自然读法和机械读法
//作者:糖醋鼻子(anyway)
//日期:2006-05-10
//////////////////////////////////////////////////////////////////
TPrice = class(TObject)
private
FBlankStr: string;
FPrice: Real;
FPriceNum: RPriceNum;
FPriceUpper: RPriceUpper;
function GetPriceString: string;
function GetPriceUpperString: string;
protected
procedure decodeNum;
procedure decodeNumUpper;
function toUpper(inchar: string): string;
function formatPrice(pr: real): string;
public
constructor Create(Price: real);
property BlankStr: string read FBlankStr write FBlankStr;
property Price: Real read FPrice;
property PriceNum: RPriceNum read FPriceNum;
property PriceString: string read GetPriceString;
property PriceUpper: RPriceUpper read FPriceUpper;
property PriceUpperString: string read GetPriceUpperString;
end;

implementation
{
************************************ TPrice ************************************
}
constructor TPrice.Create(Price: real);
begin
FPrice := Price;
FBlankStr := '○';
decodeNum;
decodeNumUpper;

end;

Function XxToDx(const hjnum:real):String;
var Vstr,zzz,cc,cc1,Presult:string;
xxbb:array[1..12]of string;
uppna:array[0..9] of string;
iCount,iZero:integer;
begin
//*设置大写中文数字和相应单位数组*//
xxbb[1]:='亿';
xxbb[2]:='仟';
xxbb[3]:='佰';
xxbb[4]:='拾';
xxbb[5]:='万';
xxbb[6]:='仟';
xxbb[7]:='佰';
xxbb[8]:='拾';
xxbb[9]:='元';
xxbb[10]:='.';
xxbb[11]:='角';
xxbb[12]:='分';
uppna[0]:='零';
uppna[1]:='壹';
uppna[2]:='贰';
uppna[3]:='叁';
uppna[4]:='肆';
uppna[5]:='伍';
uppna[6]:='陆';
uppna[7]:='柒';
uppna[8]:='捌';
uppna[9]:='玖';
Str(hjnum:12:2,Vstr);
cc:='';
cc1:='';
zzz:='';
result:='';
presult:='';
iZero:=0;
//vPoint:=0;
for iCount:=1 to 10do
begin
cc:=Vstr[iCount];
if cc<>' ' then
begin
zzz:=xxbb[iCount];
if cc='0' then
begin
if iZero<1 then
//*对“零”进行判断*//
cc:='零'
else
cc:='';
if iCount=5 then
//*对万位“零”的处理*//
if copy(result,length(result)-1,2)='零' then
result:=copy(result,1,length(result)-2)+xxbb[iCount]+'零'
else
result:=result+xxbb[iCount];
cc1:=cc;
zzz:='';
iZero:=iZero+1;
end
else
begin
if cc='.' then
begin
cc:='';
if (cc1='') or (cc1='零') then
begin
Presult:=copy(result,1,Length(result)-2);
result:=Presult;
iZero:=15;
end;
if iZero>=1 then
zzz:=xxbb[9]
else
zzz:='';
// vPoint:=1;
end
else
begin
iZero:=0;
cc:=uppna[StrToInt(cc)];
end
end;
result:=result+(cc+zzz)
end;
end;
If Vstr[11]='0' then
//*对小数点后两位进行处理*//
begin
if Vstr[12]<>'0' then
begin
cc:='';
result:=result+cc;
cc:=uppna[StrToInt(Vstr[12])];
result:=result+(uppna[0]+cc+xxbb[12]);
end;
end
else
begin
if iZero=15 then
begin
cc:='';
result:=result+cc;
end;
cc:=uppna[StrToInt(Vstr[11])];
result:=result+(cc+xxbb[11]);
if Vstr[12]<>'0' then
begin
cc:=uppna[StrToInt(Vstr[12])];
result:=result+(cc+xxbb[12]);
end;
end;
end;

procedure TPrice.decodeNum;
var
s: string;
slen: Integer;
i: Integer;
begin
//do
NE -cMM: TPrice.decodeNum default body inserted
s := formatfloat('0.00',FPrice);
slen := Length(s);
if slen <=10 then
begin
for i := 0 to 9 -slendo
begin
s := ' '+s;
end;
end;
FPriceNum.fen := s[10];
FPriceNum.jiao := s[9];
FPriceNum.yuan := s[7];
FPriceNum.shi := s[6];
FPriceNum.bai := s[5];
FPriceNum.qian := s[4];
FPriceNum.wan := s[3];
FPriceNum.shiwan := s[2];
FPriceNum.baiwan := s[1];


end;

procedure TPrice.decodeNumUpper;
begin
//do
NE -cMM: TPrice.decodeNumUpper default body inserted
FPriceUpper.fen := toUpper(FPriceNum.fen);
FPriceUpper.jiao := toUpper(FPriceNum.jiao);
FPriceUpper.yuan := toUpper(FPriceNum.yuan);
FPriceUpper.shi := toUpper(FPriceNum.shi);
FPriceUpper.bai := toUpper(FPriceNum.bai);
FPriceUpper.qian := toUpper(FPriceNum.qian);
FPriceUpper.wan := toUpper(FPriceNum.wan);
FPriceUpper.shiwan := toUpper(FPriceNum.shiwan);
FPriceUpper.baiwan := toUpper(FPriceNum.baiwan);
end;

function TPrice.formatPrice(pr: real): string;
begin
// TODO -cMM: TPrice.formatPrice default body inserted
Result := FormatFloat('###,###.00',pr);
end;

function TPrice.GetPriceString: string;
begin
// TODO -cMM: TPrice.GetPriceString default body inserted
Result := formatPrice(FPrice);
end;

function TPrice.GetPriceUpperString: string;
var Vstr,zzz,cc,cc1,Presult:string;
xxbb:array[1..12]of string;
uppna:array[0..9] of string;
iCount,iZero:integer;
hjnum: Real;
begin
hjnum := FPrice;
//*设置大写中文数字和相应单位数组*//
xxbb[1]:='亿';
xxbb[2]:='仟';
xxbb[3]:='佰';
xxbb[4]:='拾';
xxbb[5]:='万';
xxbb[6]:='仟';
xxbb[7]:='佰';
xxbb[8]:='拾';
xxbb[9]:='元';
xxbb[10]:='.';
xxbb[11]:='角';
xxbb[12]:='分';
uppna[0]:='零';
uppna[1]:='壹';
uppna[2]:='贰';
uppna[3]:='叁';
uppna[4]:='肆';
uppna[5]:='伍';
uppna[6]:='陆';
uppna[7]:='柒';
uppna[8]:='捌';
uppna[9]:='玖';
Str(hjnum:12:2,Vstr);
cc:='';
cc1:='';
zzz:='';
result:='';
presult:='';
iZero:=0;
//vPoint:=0;
for iCount:=1 to 10do
begin
cc:=Vstr[iCount];
if cc<>' ' then
begin
zzz:=xxbb[iCount];
if cc='0' then
begin
if iZero<1 then
//*对“零”进行判断*//
cc:='零'
else
cc:='';
if iCount=5 then
//*对万位“零”的处理*//
if copy(result,length(result)-1,2)='零' then
result:=copy(result,1,length(result)-2)+xxbb[iCount]+'零'
else
result:=result+xxbb[iCount];
cc1:=cc;
zzz:='';
iZero:=iZero+1;
end
else
begin
if cc='.' then
begin
cc:='';
if (cc1='') or (cc1='零') then
begin
Presult:=copy(result,1,Length(result)-2);
result:=Presult;
iZero:=15;
end;
if iZero>=1 then
zzz:=xxbb[9]
else
zzz:='';
// vPoint:=1;
end
else
begin
iZero:=0;
cc:=uppna[StrToInt(cc)];
end
end;
result:=result+(cc+zzz)
end;
end;

if (Vstr[11]='0')and(Vstr[12]='0') then
begin
Result := Result +'整';
end;

If Vstr[11]='0' then
//*对小数点后两位进行处理*//
begin
if Vstr[12]<>'0' then
begin
cc:='';
result:=result+cc;
cc:=uppna[StrToInt(Vstr[12])];
result:=result+(uppna[0]+cc+xxbb[12]);
end;
end
else
begin
if iZero=15 then
begin
cc:='';
result:=result+cc;
end;
cc:=uppna[StrToInt(Vstr[11])];
result:=result+(cc+xxbb[11]);
if Vstr[12]<>'0' then
begin
cc:=uppna[StrToInt(Vstr[12])];
result:=result+(cc+xxbb[12]);
end;
end;
end;

function TPrice.toUpper(inchar: string): string;
var
num: Integer;
begin
//do
NE -cMM: TPrice.toUpper default body inserted
if Trim(inchar) = '' then
begin
num := -1;
end
else
begin
num := StrToInt(inchar);
end;

case num of
-1: Result := FBlankStr;
0: Result := '零';
1: Result := '壹';
2: Result := '贰';
3: Result := '叁';
4: Result := '肆';
5: Result := '伍';
6: Result := '陆';
7: Result := '柒';
8: Result := '捌';
9: Result := '玖';
end;
end;

end.
 

Similar threads

I
回复
0
查看
634
import
I
I
回复
0
查看
813
import
I
I
回复
0
查看
608
import
I
回复
0
查看
592
柳枫
顶部