小写金额转换(50分)

给一数字，转换为大写

www.playicq.com上找找

copy一个给你，DFW以前的

function FourNumToChnNum(Str:string;ChnNum:string;var Pre:boolean):string

const
ChnNum2='零壹贰叁肆伍陆柒捌玖'

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 + Copy(ChnNum2,j*2+1,2) + Trim(Copy(ChnNum,(Len - i) * 2+1,2))

Pre := False

end

end

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

Pre := False

for i := 1 to Level do begin
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

s1 := FourNumToChnNum(Copy(str,Len+2,2),'分角',Pre)

if s1 = '' then
s1 := '整'

Result := Result + s1

end


function RealToChnNum(realnum:real;Width:integer):string

var
s:string

begin
Str(realnum:Width:2,s)

Result := StringToChnNum(Trim(s))

end;

呵呵， 我做过， 不过哪年的事情啦， 早压箱底了。

我记得HubDog的《葵花宝典》上有一个现成的函数， 你先看一下。
要是不行我给你找。

这是我的函数库中的，全部给你了：
function RMB(vNum:Real):String
//转为汉字人民币
var num1,num2:Real;
num_str,v_str1,v_str2,v_str3,s_1:String;
l_str1,i,v_1,num3:integer;
begin

num_str:='零壹贰叁肆伍陆柒捌玖';
num1:=abs(vNum);
num3:=round(num1);
num2:=num1-num3;
Str(num1:12:2,v_str1);
v_str1:=trim(LzhStr(num1,10,2));
v_str2:=trim(LzhStr(num2,4,2));
v_str3:=trim(IntTostr(num3));

l_str1:=length(v_str3);

i:=1;
result:='圆';
while i<=l_str1 do
begin
v_1:=StrToInt(copy(v_str3,l_str1-i+1,1));
s_1:=copy(num_str,v_1*2+1,2);
case i of
1:result:=s_1+result;
2:result:=S_1+iif(v_1=0,'','拾')+result;
3:result:=s_1+'佰'+result;
4:result:=s_1+'仟'+result;
5:result:=s_1+'万'+result;
6:result:=s_1+'拾'+result;
7:result:=s_1+'佰'+result;
8:result:=s_1+'仟'+result;
9:result:=s_1+'亿'+result;
10:result:=s_1+'拾'+result;
11:result:=s_1+'佰'+result;
12:result:=s_1+'仟'+result;
end;
i:=i+1;
end;

if trim(result)='圆' then result:='';
if num2<>0 then
begin
v_1:=StrToInt(copy(v_str2,3,1));
s_1:=copy(num_str,v_1*2+1,2);
result:=result+s_1+'角';
v_1:=StrToInt(copy(v_str2,4,1));
s_1:=copy(num_str,v_1*2+1,2);
result:=result+s_1+'分';
end
else
result:=result+iif(result='','','整');
end;

function RMBEx(vNum:Real):string;
const
d='零壹贰叁肆伍陆柒捌玖分角元拾佰仟万拾佰仟亿';
var
m,k:string;
j:integer;
begin
k:='';
vNum:=abs(vNum);
m:=floattostr(int(vNum*100));
for j:=length(m) downto 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];
result:=k;
end;

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Memo1: TMemo;
Label1: TLabel;
Label2: TLabel;
XPMenu1: TXPMenu;
procedure Button1Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject
var Key: Char);
procedure Edit1Change(Sender: TObject);
procedure Edit1Exit(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

//本函数用于将小于十万亿元的小写金额转换为大写
Function NtoC( n0 :real) :String;
Function IIF( b :boolean
s1,s2 :string) :string;
begin if b then IIF:= s1 else IIF:=s2;
end
//本函数的功能一目了然: 当b为真时返回s1,否则返回s2
Const c= '零壹贰叁肆伍陆柒捌玖◇分角圆拾佰仟万拾佰仟亿拾佰仟万';
var L,i,n, code :integer
Z :boolean
s,s1,s2 :string;
begin
s:= FormatFloat('0.00', n0);
L:= Length( s);
Z:= n0<1;
For i:= 1 To L-3 do
begin
Val( Copy( s, L-i-2, 1), n, code);
s1:=IIf( (n=0) And (Z Or (i=9) Or (i=5) Or (i=1)), '', Copy( c, n*2+1, 2))
+ IIf( (n=0) And ((i<>9) And (i<>5) And (i<>1) Or Z And (i=1)), '', Copy( c, (i+13)*2-1, 2))
+ s1;
Z:= (n=0);
end;
Z:= False;
For i:= 1 To 2 do
begin
Val( Copy( s, L-i+1, 1), n, code);
s2:= IIf( (n=0) And ((i=1) Or (i=2) And (Z Or (n0<1))), '', Copy( c, n*2+1, 2))
+ IIf( (n>0), Copy( c,(i+11)*2-1, 2), IIf( (i=2) Or Z, '', '整'))
+ s2;
Z:= (n=0);
end;
For i:= 1 To Length( s1) do If Copy(s1, i, 4) = '亿万' Then Delete(s1,i+2,2);
NtoC:= IIf(n0=0, '零', s1+s2);
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit2.Text :=NtoC(strTofloat(edit1.Text));
end;

procedure TForm1.Edit1KeyPress(Sender: TObject
var Key: Char);
begin
if key =Char(-24157) then key:=#46;
if not ( key in ['0'..'9','.',char(8),char(13)])then key:=#0;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
if trim(edit1.Text)='' then edit1.Text :='0';
end;

procedure TForm1.Edit1Exit(Sender: TObject);
begin
if trim(edit1.Text)='' then edit1.Text :='0';
Edit1.Text :=FloatToStr(StrToFloat(Edit1.Text));
end;

end.

人家都说了，我就不再贴了

to 代鱼：
《葵花宝典》上的不好，我改进了一点，但还是达不到要求
比如：我输个数字（10），他的结果是（壹十零元零角零分）
我要求结果是（壹十元）
其实就是如何处理‘0’的问题

分太少了， 呵呵，不过我也不知道！ 但是我有个控件！ 呵呵

呵呵， 原先我就是用它做蓝本， 后来发现问题， 也改啊。
怎么改的， 现在一时回忆不上。

加几个判断分支吧。它的问题就是对0的处理不灵活， 不能针对各个位的实际情况。

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
ShowMessage('最大数只可支持到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;

谢谢各位了，我已经找到答案了用的是 Jason law的方法