如何将数字转换成大写金额(100分)

  • 主题发起人 主题发起人 jony1
  • 开始时间 开始时间
J

jony1

Unregistered / Unconfirmed
GUEST, unregistred user!
打印发票,需要将数字金额转换成大写金额,因为是外贸系统用的,金额的大写要用英文
的,例如102转换成 ‘ONE HUNDRED AND TWO,要求准确到千万位,小数点后要2位
不知那位大虾写过,请指教一下
JONY1
 
www.Delphi3000.com

{**************************************************}
{ }
{ Number to letters unit version 1.1 }
{ }
{ copyright (C) Dylan Thomas 2000 }
{ }
{ License: No significant restrictions. }
{ }
{ Language: US. English }
{ }
{**************************************************}

unit NumberToLetters;

interface

{var

Calls: Integer;} //Use to count number of recursive calls

(* This function returns the written equivalent of a number. *)
function NumToLetters(Number: Real): string;

implementation
uses SysUtils;

type

TNumberStr = string[13];

const
Numbers: array[1..19] of TNumberStr = ('one', 'two', 'three', 'four',
'five', 'six', 'seven', 'eight', 'nine', 'ten', 'eleven', 'twelve',
'thirteen', 'fourteen', 'fifteen', 'sixteen', 'seventeen', 'eighteen',
'nineteen');

Tenths: array[1..9] of TNumberStr = ('ten', 'twenty', 'thirty', 'forty',
'fifty', 'sixty', 'seventy', 'eighty', 'ninety');

ErrorString = 'not in valid range';

Min = 1.00;
Max = 4294967295.99;

function NumToLetters(Number: Real): string;

function RecurseNumber(N: LongWord): string;
begin
{Inc(Calls);} //Use to count the number of recursive calls
case N of
1..19:
Result := Numbers[N];
20..99:
Result := Tenths[N div 10] + ' ' + RecurseNumber(N mod 10);
100..999:
Result := Numbers[N div 100] + ' hundred ' + RecurseNumber(N mod 100);
1000..999999:
Result := RecurseNumber(N div 1000) + ' thousand ' +
RecurseNumber(N mod 1000);
1000000..999999999: Result := RecurseNumber(N div 1000000) + ' million '
+ RecurseNumber(N mod 1000000);
1000000000..4294967295: Result := RecurseNumber(N div 1000000000) +
' billion ' + RecurseNumber(N mod 1000000000);
end; {Case N of}
end; {RecurseNumber}

begin
{Calls := 0;} //Use to count the number of recursive calls
if (Number >= Min) and (Number <= Max) then
begin
Result := RecurseNumber(Round(Int(Number)));
{Added for cents in a currency value}
if not(Frac(Number) = 0.00) then
Result := Result + ' and ' + IntToStr(Round(Frac(Number) * 100)) +
'/100';
end
else
raise ERangeError.CreateFmt('%g ' + ErrorString + ' %g..%g',
[Number, Min, Max]);
end;{NumToLetters}

end.
 
只要关注每个三位就变换的规律,这和转换成“大写壹,贰,,,万 亿等”差不多

算法可要好好考虑,最好用函数调用
 
呵呵,刚刚好我才写过类似的东西,我写的是集装箱有几个和你的差不多,参数就是输入的
数值,例如:123
function Tform1.English(lcnum:string):string;
type
arr=array[1..9,1..3] of string;
var
num:arr;
lclast,temp:string;
i,code,len,lntimes,lnhundred,lnten,lnone,lntempnum:integer;
begin
lntimes:=0;
lclast:='';
num[1,1]:='ONE';
num[1,2]:='ELEVEN';
num[1,3]:='TEN';
num[2,1]:='TWO';
num[2,2]:='TWELVE';
num[2,3]:='TWENTY';
num[3,1]:='THREE';
num[3,2]:='THIRTEEN';
num[3,3]:='THIRTY';
num[4,1]:='FOUR';
num[4,2]:='FOURTEEN';
num[4,3]:='FORTY';
num[5,1]:='FIVE';
num[5,2]:='FIFTEEN';
num[5,3]:='FIFTY';
num[6,1]:='SIX';
num[6,2]:='SIXTEEN';
num[6,3]:='SIXTY';
num[7,1]:='SEVEN';
num[7,2]:='SEVENTEEN';
num[7,3]:='SEVENTY';
num[8,1]:='EIGHT';
num[8,2]:='EIGHTEEN';
num[8,3]:='EIGHTY';
num[9,1]:='NINE';
num[9,2]:='NINETEEN';
num[9,3]:='NINETY';
len:=length(lcnum);
for i:=1 to 12-len do
lcnum:=concat('0',lcnum);
for i:=0 to 3 do
begin
temp:=copy(lcnum,1+3*i,3);
val(temp,lntempnum,code);
lntimes:=lntimes+1;
if lntempnum=0 then
continue;
lnhundred:=lntempnum div 100;
lnten:=(lntempnum div 10) mod 10;
lnone:=lntempnum mod 10;
if lnhundred<>0 then
lclast:=concat(lclast,' ',num[lnhundred,1],' HUNDRED');
if (length(trim(lclast))<>0) and (lnhundred<>0) then
lclast:=concat(lclast,' AND');
if (lntimes=4) and (lnhundred=0) and (length(trim(lclast))<>0) then
lclast:=concat(lclast,' AND');
case lnten of
0:
begin
if lnone<>0 then
lclast:=concat(lclast,' ',num[lnone,1])
else
begin
temp:=copy(lclast,length(lclast)-2,3);
if temp='AND' then
lclast:=copy(lclast,1,length(lclast)-3);
end;//case 0 else
end;//case 0
1:
begin
if lnone<>0 then
lclast:=concat(lclast,' ',num[lnone,2])
else
lclast:=concat(lclast,' ',num[1,3]);
end;//case 1
else
if lnone<>0 then
lclast:=concat(lclast,' ',num[lnten,3],'-',num[lnone,1])
else
lclast:=concat(lclast,' ',num[lnten,3]);
end;//case1
case lntimes of
1:lclast:=concat(lclast,' BILLION');
2:lclast:=concat(lclast,' MILLION');
3:lclast:=concat(lclast,' THOUSAND');
end;//case2
end;//for
result:=lclast;
end;
 
http://202.96.70.228/cakk/delphi/delphi.htm上有一个控件sncCurrency。
我以前拿人家写的再改的,不过代码太丑了,全部贴出来,你自己慢慢看吧


function 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);
if wei1<>'零' then
BigMonth :=wei1+qianwei1+BigMonth {组合成大写金额}
else if qianwei1 = '万' then
BigMonth := qianwei1+BigMonth {组合成大写金额}
else if qianwei1 = '元' then
BigMonth := qianwei1+BigMonth {组合成大写金额}
else
BigMonth := wei1+BigMonth; {组合成大写金额}
end;
end;
SmallTOBig:=BigMonth;
end;

procedure GetEveryBit(small:real);
var
SmallMonth,BigMonth:string;
wei1,qianwei1:string[4];
wei,qianwei,dianweizhi,qian, nCurrentBit:integer;
strResult : string;
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
nCurrentBit := strtoint(copy(Smallmonth,qian,1));
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;
strMoneyBitName[qianwei] := qianwei1;
nMoneyBit[qianwei] := nCurrentBit;
strResult := IntToStr(nCurrentBit)+ qianwei1 + strResult;
inc(qianwei);
end;
end;
// showmessage(strResult)
end;

//一个替换指定串的函数,从一个字符串中找出指定子串,并替换为另一子串。
function replacing(S , source,target:string):string;
var
site,StrLen:integer;
begin
{source在S中出现的位置}
site:= pos(source,s);
{source的长度}
StrLen:=length(source);
{删除source字符串}
delete(s,site,StrLen);
{插入target字符串到S中}
if Site <> 0 then insert(target,s,site);
{返回新串}
replacing:=s;
end;


//*******此过程是小写转大写smallTobig函数的调用方法***************************//
procedure TfrmIntoLib.Edit3Change(Sender: TObject);
var
strTemp : string;
begin
if Trim(Edit3.text) = '' then
exit;
strTemp := smallTobig(StrTofloat(Edit3.text));
StrTemp := replacing(strTemp, '元零零','元正');
StrTemp := replacing(strTemp, '角零','角');
StrTemp := replacing(strTemp, '零零零','零');
StrTemp := replacing(strTemp, '零零','零');
StrTemp := replacing(strTemp, '零零','零');
StrTemp := replacing(strTemp, '零万','万');
StrTemp := replacing(strTemp, '零元','元');

Edit2.Text := strTemp;
// Edit2.Text :=replacing(smallTobig(StrTofloat(Edit3.text)), '零元', '元'));
end;
 
我要求的是转成英文的,不是中文的,所以只有creation_zy和terry_lzs答对,不过也谢谢
各位回答的朋友。
jony1
 
我刚开始写,谢谢各位。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
572
import
I
I
回复
0
查看
955
import
I
后退
顶部