金额小写转换为大写得程序 ( 积分: 100 )

小弟最近需要写个金额小写转换为大写得程序,请高手们贴出代码.谢谢.

小弟最近需要写个金额小写转换为大写得程序,请高手们贴出代码.谢谢.

你可以用查表的方法实现：
NumTable=壹贰叁肆伍陆柒捌玖

然用数值查表
1:NumTable[1]
2:NumTable[2]
...

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);
BigMonth :=wei1+qianwei1+BigMonth;{组合成大写金额}
end;
end;
SmallTOBig:=BigMonth;
end;

到盒子上去找，好多的。

自己以前写的，如果要写好的程序可以加我QQ：38223756
调用如下
Edit2.text := chn_money(strtofloat(trim(Edit1.text)));

代码：在下面
unit Unit2;
//*************************************************//
// 单元作用:定义函数chn_money将数字转为金额大写 //
// 敬告: 整数部分不能超过10位 //
//*************************************************//
interface

uses SysUtils, Dialogs, StrUtils;

//***********************************************//
// 作用:将数字转为金额大写 //
// 函数名: chn_money //
// 输入参数：一个数字（double) //
// 返回值： 数字的金额大写(String) //
// 备注：返回值精度到分,4舍5入 //
// 敬告: 整数部分不能超过10位 //
// 参考：字符串转换strtofloat //
//***********************************************//
function chn_money(money: double): string;

implementation

var
chn_sectionunit: array[0..2] of string;
chn_number: array[0..9] of string;
gw: integer
// 个位

//******************************************//
// chn_intvalue：将整数转为大写 //
// 输入参数：整数(int) 正负均可 //
// 返回值： 整数的大写(String) //
//******************************************//

function chn_intvalue(ivalue: integer): string;
var
intstr, signstr, tstr, ls_gw: 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
begin
signstr := '';
end;
intstr := IntToStr(ivalue)
//整数转字符型
len := Length(intstr)
//len 整数的位数
ls_gw := Copy(intstr, len, 1);
gw := StrToInt(ls_gw);
sectionlevel := -1
//以4位数字为一节: eg. &quot;万&quot;节
&quot;亿&quot;节;
zeroresulthead := false;
{跨节用途.(指明上一循环后产生的中间结果(低位&quot;节&quot是否为&quot;零&quot;开头)}
while (len > 0) do
begin
inc(sectionlevel);
//取得本节各位的数值, 并更新数据源intstr.
g_digit := Copy(intstr, len, 1)
// 节内&quot;个&quot;位.
if (len > 1) then
s_digit := Copy(intstr, len - 1, 1)
else
s_digit := ''
// 节内&quot;十&quot;位.
if (len > 2) then
b_digit := Copy(intstr, len - 2, 1)
else
b_digit := ''
// 节内&quot;百&quot;位.
if (len > 3) then
q_digit := Copy(intstr, len - 3, 1)
else
q_digit := ''
// 节内&quot;千&quot;位.
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 := ''
//完成&quot;个&quot;位中文翻译.
if (s_digit = '0') then
s_digit := ''
//完成&quot;拾&quot;位中文翻译.
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 := ''
//完成&quot;佰&quot;位中文翻译.
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 := ''
//完成&quot;千&quot;位中文翻译.
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)
// 除首&quot;零&quot;
result := signstr + result;
if RightStr(result, 1) = '零' then
result := Copy(result, 1, Length(result) - 2);
end;

//********************************************************//
// 金额转换 //
//********************************************************//

function chn_money(money: double): string;
var
intpart, chiao, cent: integer;
fracpart: double;
signstr, tstr: string;
begin
if money > 2147483647.994999 then
begin
result := '数据过大,无法显示!数据必须小于2147483647.994999！';
Exit;
end;
signstr := ''
// 符号
if (money < 0) then
begin
money := -money;
signstr := '负';
end;
money := money + 0.005
//准备四舍五入 1.996
intpart := Trunc(money)
//取得金额四舍五入后的整数部分 2
fracpart := money - intpart;
fracpart := fracpart * 10;
chiao := Trunc(fracpart)
//角
fracpart := fracpart - chiao;
fracpart := fracpart * 10;
cent := Trunc(fracpart)
//分
tstr := chn_intvalue(intpart)
//整数部分(不加元)的大写
if tstr = '金额过大无法显示!' then
begin
result := tstr;
Exit;
end;
//******************************************************//
{.00}
if (chiao = 0) and (cent = 0) then
result := tstr + '元整';
{.09}
if (chiao = 0) and (cent <> 0) then //0.7
result := tstr + '元零' + chn_number[cent] + '分';
{.90}
if (chiao <> 0) and (cent = 0) then
begin
if intpart = 0 then
result := '零元' + chn_number[chiao] + '角整'
else if gw = 0 then // 个位是0
result := tstr + '元零' + chn_number[chiao] + '角整'
else
result := tstr + '元' + chn_number[chiao] + '角整';
end;
{.99}
if (chiao <> 0) and (cent <> 0) then
begin
if intpart = 0 then
result := '零元' + chn_number[chiao] + '角' + chn_number[cent] + '分'
else if gw = 0 then // 个位是0
result := tstr + '元零' + chn_number[chiao] + '角' + chn_number[cent] + '分'
else
result := tstr + '元' + chn_number[chiao] + '角' + chn_number[cent] + '分';
end;
//******************************************************//
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 NumberCn(mNumber: Real): WideString;
const
cPointCn: WideString = '点十百千万十百千亿十百千';
cNumberCn: WideString = '零一二三四五六七八九';
var
I, L, P: Integer;
S: string;
begin
Result := '';
if mNumber = 0 then begin
Result := cNumberCn[1];
Exit;
end;
S := FloatToStr(mNumber);
if Pos('.', S) <= 0 then S := S + '.';
P := Pos('.', S);
L := Length(S);
for I := 1 to L do
if P > I then
Result := Result + cNumberCn[StrToInt(S) + 1] + cPointCn[P - I]
else if P = I then begin
Result := StringReplace(Result, '零十零', '零', [rfReplaceAll]);
Result := StringReplace(Result, '零百零', '零', [rfReplaceAll]);
Result := StringReplace(Result, '零千零', '零', [rfReplaceAll]);
Result := StringReplace(Result, '零十', '零', [rfReplaceAll]);
Result := StringReplace(Result, '零百', '零', [rfReplaceAll]);
Result := StringReplace(Result, '零千', '零', [rfReplaceAll]);
Result := StringReplace(Result, '零万', '万', [rfReplaceAll]);
Result := StringReplace(Result, '零亿', '亿', [rfReplaceAll]);
Result := StringReplace(Result, '亿万', '亿', [rfReplaceAll]);
Result := StringReplace(Result, '零点', '点', [rfReplaceAll]);
end else if P < I then
Result := Result + cNumberCn[StrToInt(S) + 1];
if Result[Length(Result)] = cPointCn[1] then
Result := Copy(Result, 1, Length(Result) - 1);
if Result[1] = cPointCn[1] then Result := cNumberCn[1] + Result;
if (Length(Result) > 1) and (Result[2] = cPointCn[2]) and
(Result[1] = cNumberCn[2]) then
Delete(Result, 1, 1);
end
{ NumberCn }

{把阿拉伯数字转换成人民币汉字}
function MoneyCn(mMoney: Real): WideString;
var
P: Integer;
begin
if mMoney = 0 then begin
Result := '无';
Exit;
end;
Result := NumberCn(Round(mMoney * 100) / 100);
Result := StringReplace(Result, '一', '壹', [rfReplaceAll]);
Result := StringReplace(Result, '二', '贰', [rfReplaceAll]);
Result := StringReplace(Result, '三', '叁', [rfReplaceAll]);
Result := StringReplace(Result, '四', '肆', [rfReplaceAll]);
Result := StringReplace(Result, '五', '伍', [rfReplaceAll]);
Result := StringReplace(Result, '六', '陆', [rfReplaceAll]);
Result := StringReplace(Result, '七', '柒', [rfReplaceAll]);
Result := StringReplace(Result, '八', '捌', [rfReplaceAll]);
Result := StringReplace(Result, '九', '玖', [rfReplaceAll]);
Result := StringReplace(Result, '九', '玖', [rfReplaceAll]);
Result := StringReplace(Result, '十', '拾', [rfReplaceAll]);
Result := StringReplace(Result, '百', '佰', [rfReplaceAll]);
Result := StringReplace(Result, '千', '仟', [rfReplaceAll]);
P := Pos('点', Result);
if P > 0 then begin
Insert('分', Result, P + 3);
Insert('角', Result, P + 2);
Result := StringReplace(Result, '点', '圆', [rfReplaceAll]);
Result := StringReplace(Result, '角分', '角', [rfReplaceAll]);
Result := StringReplace(Result, '零分', '', [rfReplaceAll]);
Result := StringReplace(Result, '零角', '', [rfReplaceAll]);
Result := StringReplace(Result, '分角', '', [rfReplaceAll]);
if Copy(Result, 1, 2) = '零圆' then
Result := StringReplace(Result, '零圆', '', [rfReplaceAll]);
end else Result := Result + '圆整';
Result := '人民币' + Result;
end
{ MoneyCn }
///////End Source

///////Begin Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := MoneyCn(StrToFloatDef(Edit3.Text, 0));
Edit2.Text := NumberCn(StrToFloatDef(Edit3.Text, 0));
end;
///////End Demo

使用了很久的,代码不长输入实型直接返回大写字符串
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:='分角元拾佰仟万拾佰仟亿拾佰仟万';
NN:=StrToFloat(FormatFloat('0.00',NN));//这句是经过网友jycjd调试得出的结果
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 MoneyName(Value: Double): string;
const
SCnNumber = '零壹贰叁肆伍陆柒捌玖';
SCnPower = '拾佰仟';
var
V, V1: Double;
X: array[0..4] of Integer;
N, P, I, J: Integer;
S: array[0..4] of string;
B: array[0..4] of Boolean;
BK, BL: Boolean;
begin
V := Int(Value);
X[4] := Trunc((Value - V) * 100 + 0.5);
X[0] := 0;
X[1] := 0;
X[2] := 0;
X[3] := 0;
I := 3;
while (V > 0) and (I >= 0) do
begin
V1 := Int(V / 10000) * 10000;
X := Trunc(V - V1);
Dec(I);
V := V1 / 10000;
end;
BL := True;
for I := 0 to 4 do
if X <> 0 then
begin
BL := False;
Break;
end;
if BL then
Result := '零元整'
else
begin
for I := 0 to 3 do
begin
S := '';
if X > 0 then
begin
B := False;
P := 1000;
BK := False;
BL := False;
for J := 0 to 3 do
begin
N := X div P;
X := X - N * P;
P := P div 10;
if N = 0 then
begin
if J = 0 then
B := True
else
if BL then
BK := True;
end
else
begin
if BK then
S := S + '零';
BL := True;
S := S + Copy(SCnNumber, N * 2 + 1, 2);
if J < 3 then
S := S + Copy(SCnPower, (3 - J) * 2 - 1, 2);
BK := False;
end;
end;
end;
end;
BL := False;
if X[4] mod 10 > 0 then
S[4] := Copy(SCnNumber, (X[4] mod 10) * 2 + 1, 2) + '分'
else
begin
BL := True;
S[4] := '';
end;
X[4] := X[4] div 10;
if X[4] > 0 then
begin
S[4] := Copy(SCnNumber, (X[4] mod 10) * 2 + 1, 2) + '角' + S[4];
B[4] := False;
end
else
B[4] := not BL;
Result := '';
BL := False;
for I := 0 to 3 do
if Length(S) > 0 then
begin
if BL then
if B then
Result := Result + '零';
Result := Result + S;
case I of
0, 2: Result := Result + '万';
1: Result := Result + '亿';
3: Result := Result + '元';
end;
BL := True;
end
else
if BL then
case I of
1: Result := Result + '亿';
3: Result := Result + '元';
end;
if Length(S[4]) = 0 then
Result := Result + '整'
else
begin
if B[4] then
if BL then
Result := Result + '零';
Result := Result + S[4];
end;
end;
end;

//转。有史以来最简单的大小写金额转换程序(送Delphi代码共13行)
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
procedure Edit1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject
var Action: TCloseAction);
public
app ,sheet, book : olevariant;
function gf_MoneyConvert(str1:string):string;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses ComCtrls, Clipbrd, ComObj;

{$R *.DFM}

function TForm1.gf_MoneyConvert(str1:string):string;
begin
Sheet.Cells[1, 1] :=str1;
Sheet.Cells[1, 1].copy;
result := trim(Clipboard.AsText);
end;



procedure TForm1.Edit1Change(Sender: TObject);
begin
Sheet.Cells[1,1].select;
sheet.Cells[1,1].NumberFormatLocal := '[DBNum2][$-804]G/通用格式';
edit2.Text := gf_MoneyConvert(edit1.text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
app := CreateoleObject('excel.application');
book:= app.Workbooks.Add;
sheet := CreateoleObject('excel.sheet');
book.Worksheets.Select(2);
sheet := book.Sheets.Add;
end;

procedure TForm1.FormClose(Sender: TObject
var Action: TCloseAction);
begin
App.DisplayAlerts := False;
app.quit;
end;

end.

//接分~~ ^_^

ak-2005的代码好强呀!

帮顶

--------签名档---------------------------

惊爆开源站

http://www.source520.com

80G源码电子书免费免注册下载,大量精辟技术文档库随时更新