怎样解决edit中的数字转化为人民币?(100分)

例如:在FORM1上放两个EDIT控件,EDIT1用于输入,EDIT2用于输出.
另外在放一个BUTTON1控件.当点击它时EDIT2输出人民币.
举例:在EDIT1中输入1234.56,
当点击BUTTON1时,EDIT2中输出壹千二佰叁拾肆块伍角陆分
当输入其他时类似.
整体意思是:转化为常用的人民币形式.

unit func;

interface

uses
SysUtils, Classes,Dialogs,shellapi, ComCtrls,dbtables,BDE;

function RMB(NN:real):string;

implementation

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;

end.

这是一个金额转大写的问题嘛，我们先看看前面这位兄台的，回头再试试。

以"人民币"或"大写"查找一下

绝对可用。只不过入口参数是Float型。

// 浮点数转化为大写金额
function FloatToRMB(Value:Extended): string;

implementation

function FloatToRMB(Value: Extended): string;
const
SectionLen: array [1..5] of Integer = (4, 4, 4, 1, 1);
SectionNames: array [1..5] of string = ('亿','万','元','角','分');
Grades: array [1..4] of string = ('','拾','佰','仟');
CNumbers: array [0..9] of string = ('零','壹','贰','叁','肆','伍','陆','柒','捌','玖');

// 得到每段的结果
function GetSection(Section, SectionName: string): string;
var
i, GradeIndex: Integer;
LowBitZero: Boolean;
begin
Result := '';
// 如果整段金额全为零, 则结果为空串
if (StrToInt(Section) = 0) then
begin
// 但是 '元' 部分不能为空串, 必须加上 '元'
if (SectionName = '元') then Result := SectionName;
Exit;
end;
// 逐字进行替换, GradeIndex 为数量级('','拾','佰','仟')
i := Length(Section); GradeIndex := 1;
while (i > 0) do
begin
// 如果数字不为 '0'
if (Section <> '0') then
begin
// 每个数字替换成中文数字, 并加上中文数量级
Result := CNumbers[StrToInt(Section)] + Grades[GradeIndex] + Result;
Dec(i); Inc(GradeIndex);
end
// 否则如果数字为 '0'
else
begin
// 判断 '0' 是否在最低位
if (i = Length(Section)) then LowBitZero := True else LowBitZero := False;
// 略过所有的 '0'
while (i > 0) do
begin
if (Section <> '0') then Break;
Dec(i); Inc(GradeIndex);
end;
// 如果 '0' 不是在最低位, 则用 '零' 代替所有的 '0'
if not LowBitZero then Result := '零' + Result;
end;
end;
// 把结果加上段名
Result := Result + SectionName;
end;

var
SubMoney, MoneyString, SectionResult: string;
i, DotPos: Integer;
WholeMoney: Boolean;
begin
if Value = 0 then begin Result := '零元整'; Exit; end;
Result := '';
Value := Abs(Value);
MoneyString := FloatToStr(Value, 14, 2, True, True, False);
// 判断金额是否为整数
WholeMoney := (Trunc(Value) = Value);
// 去掉小数点
DotPos := Pos('.', MoneyString);
if (DotPos > 0) then Delete(MoneyString, DotPos, 1);
// 限制金额不能超过 14 位长 (十万亿元以上)
if (Length(MoneyString) > 14) then Exit;
i := 5;
// 把金额分成五段, 即'亿','万','元','角','分')
// SectionLen 数组为段长, 即4, 4, 4, 1, 1)
while (i > 0) and (MoneyString <> '') do
begin
// SubMoney 保存每段的金额数字
if (Length(MoneyString) > SectionLen) then
begin
SubMoney := Copy(MoneyString, Length(MoneyString)-SectionLen+1, SectionLen);
Delete(MoneyString, Length(MoneyString)-SectionLen+1, SectionLen);
end
else
begin
SubMoney := MoneyString;
MoneyString := '';
end;
// 得到每段的结果并累加
SectionResult := GetSection(SubMoney, SectionNames);
Result := SectionResult + Result;
// 如果存在 '分' , 但是不存在 '角' , 则在 '分' 之前插入 '零'
if (i = 4) and (SectionResult = '') and (Result <> '') then
Result := '零' + Result;
// 如果 '元' 以上整段金额全为零, 则插入不多于一个的 '零'
if (i < 4) and (SectionResult = '') and (LeftString(Result, 2) <> '零') then
Result := '零' + Result;
// 继续下一段
Dec(i);
end;
// 最后如果为整数金额, 则加上 '整'
if WholeMoney then Result := Result + '整';
end;

add to 英国病人:
否则出错：0.123456--——> ??


procedure TForm1.Edit1Change(Sender: TObject);
var num:real;
str:string;
i:integer;
begin
edit2.text:='';
str:=edit1.text;
if str<>'' then
try
num:=strtofloat(str);
if num<>0 then
begin
i:=0;
repeat
i:=i+1;
until (i=length(str)) or(str[i+1]='.');
if length(str)>i+3 then
delete(str,i+4,length(str)-i-3);
end;
num:=strtofloat(str);
edit2.text:=rmb(num);
except
on econverterror do
begin
showmessage('check your input.');
edit1.text:='';
end;
end;
end;

钱达智先生写了一个，找一下， 这里也贴过的。

我的程序:
type

TMoneyKinds=(isSTAND, isSHORT, isLONG);


function ChangeMoney(Const InMoney: double; Const InKind: TMoneyKinds): string;
const
UNITAGE_STR : String = '分角元拾佰仟万拾佰仟亿拾佰仟'; // 单位大写中文字符串
// '分角元拾佰仟万拾佰仟亿拾佰仟' '仟佰拾亿仟佰拾万仟佰拾元角分'
UPPER_STR : String = '零壹贰叁肆伍陆柒捌玖'; // 数值大写中文字符串
ZERO_STR : String = '零';
var
LowString: string; //小写金额字符串
HighString: string; //大写金额字符串
LabelString: string; //符号位
MidString, BzString: string;
StrLeng: integer;
Loop1, Num1,Num2: integer;

begin
LabelString:='';
HighString:='';
if InMoney<>0
then begin
if InMoney<0 then LabelString:='负';
LowString:=Trim(Format('%15.2f',[ABS(InMoney)]));
StrLeng:=Length(LowString);
LowString:=Copy(LowString,1,StrLeng-3)+Copy(LowString,Strleng-1,2); //去掉小数点
StrLeng:=Strleng-1;
MidString:='';
BzString:='';
for Loop1:=StrLeng downto 1
do begin
num1:=StrToInt(Copy(LowString,Loop1,1));
Num2:=StrLeng-Loop1+1;
case InKind of
isSHORT: HighString:=Copy(UPPER_STR,2*Num1+1,2)+HighString;
isLONG: HighString:=Copy(UPPER_STR,2*Num1+1,2)
+Copy(UNITAGE_STR,Num2*2-1,2)+HighString;
else begin // "isSTAND"
case Num2 of
1: begin
if Num1=0
then BzString:=ZERO_STR
else HighString:=Copy(UPPER_STR,2*Num1+1,2)
+Copy(UNITAGE_STR,Num2*2-1,2);
end; {1}
2: begin
if Num1=0
then begin
if BzString=ZERO_STR
then HighString:='整'
else HighString:='零'+HighString;
end
else HighString:=Copy(UPPER_STR,2*Num1+1,2)
+Copy(UNITAGE_STR,Num2*2-1,2)+HighString;
BzString:='';
end; {2}
3: begin
HighString:=Copy(UNITAGE_STR,Num2*2-1,2)+HighString;
if Num1=0
then BzString:=ZERO_STR
else begin
HighString:=Copy(UPPER_STR,2*Num1+1,2)+HighString;
BzString:='';
end;
end; {3}
7: begin
if Num1=0
then begin
if BzString<>ZERO_STR
then begin
BzString:=ZERO_STR;
HighString:=ZERO_STR+HighString;
end;
if (StrLeng>=11) and (copy(LowString,Loop1-3,4)<>'0000')
then HighString:=Copy(UNITAGE_STR,Num2*2-1,2)+HighString;
end
else begin
HighString:=Copy(UPPER_STR,2*Num1+1,2)
+Copy(UNITAGE_STR,Num2*2-1,2)+HighString;
BzString:='';
end;
end; {7}
11: begin
if Num1=0
then begin
if BzString<>ZERO_STR
then begin
BzString:=ZERO_STR;
HighString:=ZERO_STR+HighString;
end;
HighString:=Copy(UNITAGE_STR,Num2*2-1,2)+HighString;
end
else begin
HighString:=Copy(UPPER_STR,2*Num1+1,2)
+Copy(UNITAGE_STR,Num2*2-1,2)+HighString;
BzString:='';
end;
end; {11}
4,5,6,8,9,10,12,13,14: begin
if Num1=0
then begin
if BzString<>ZERO_STR
then begin
BzString:=ZERO_STR;
HighString:=ZERO_STR+HighString;
end;
end
else begin
BzString:='';
HighString:=Copy(UPPER_STR,2*Num1+1,2)
+Copy(UNITAGE_STR,Num2*2-1,2)+HighString;
end;
end; {4,5,6,8,9,10,12,13,14}
end; {case Num2 of}
end; {isSTAND}
end; {case InKind of}
end; {for Loop1:=StrLeng to 1}
end; {if InMoney<>0}
Result:=LabelString+HighString;
end;

怎么还没结束，我试过

function RMB(NN:real):string;

implementation

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;

调用时：

procedure TForm1.Edit1Change(Sender: TObject);
var num:real;
str:string;
i:integer;
begin
edit2.text:='';
str:=edit1.text;
if str<>'' then
try
num:=strtofloat(str);
if num<>0 then
begin
i:=0;
repeat
i:=i+1;
until (i=length(str)) or(str[i+1]='.');
if length(str)>i+3 then
delete(str,i+4,length(str)-i-3);
end;
num:=strtofloat(str);
edit2.text:=rmb(num);
except
on econverterror do
begin
showmessage('check your input.');
edit1.text:='';
end;
end;
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
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;

function MoneyToWord(Money: Real): String;
var
Words: array[0..9] of string;
Units: array[0..9] of string;
iMoney, fMoney, Jiao, Fen: integer;
i: integer;
Digits: array[0..9] of integer;
begin
Words[0] := '零'; Words[1] := '壹';
Words[2] := '贰'; Words[3] := '叁';
Words[4] := '肆'; Words[5] := '伍';
Words[6] := '陆'; Words[7] := '柒';
Words[8] := '捌'; Words[9] := '玖';
Units[0] := '元'; Units[1] := '拾';
Units[2] := '佰'; Units[3] := '仟';
Units[4] := '万'; Units[5] := '拾';
Units[6] := '佰'; Units[7] := '仟';
iMoney := Trunc(Money);
fMoney := Round((Money - iMoney) * 100);
Jiao := fMoney div 10;
Fen := fMoney mod 10;
if iMoney >= 100000000 then
begin
Result := '超出表示范围';
Exit;
end;
Result := '';
i := 0;
while iMoney <> 0 do
begin
Digits := iMoney mod 10;
iMoney := iMoney div 10;
Inc(i);
end;
Dec(i);
while i >= 0 do
begin
if Digits <> 0 then
begin
Result := Result + Words[Digits] + Units
end
else
begin
if i mod 4 <> 0 then
begin
if Digits[i-1] <> 0 then Result := Result + Words[Digits];
end
else
begin
Result := Result + Units;
end
end;
Dec(i);
end;
if Jiao <> 0 then Result := Result + Words[Jiao] + '角'
else if (Fen <> 0) and (Result <> '') then Result := Result + '零';
if Fen <> 0 then Result := Result + Words[Fen] + '分';
if Result = '' then Result := '零元零角零分';
Result := Result + '整';
end;

可能是最容易的程序,如果采用请通知我 yang_gq@16.net

function DaToXiao(Value:Real):String;
var
DanW:Array [1..10] of string;
JINTemp,JIN:String[20];
I,SLength:Integer;
begin
DanW[1]:='F';
DanW[2]:='J';
DanW[3]:='Y';
DanW[4]:='S';
DanW[5]:='B';
DanW[6]:='Q';
DanW[7]:='W';
DanW[8]:='S';
DanW[9]:='B';
DanW[10]:='Q';

JIN:=IntToStr(Round(Value*100));
SLength:=Length(JIN);
JINTemp:='';
for I:=1 to SLength do begin
if JIN<>'0' then
JINTemp:=JINTemp+JIN+DanW[SLength-I+1]
else begin
if (JIN[I-1]<>'0')or(DanW[SLength-I+1]='Q')or(DanW[SLength-I+1]='J') then
JINTemp:=JINTemp+'0';
if (DanW[SLength-I+1]='W')or(DanW[SLength-I+1]='Y') then
JINTemp:=JINTemp+DanW[SLength-I+1];
end;
end;
Result:='';
SLength:=Length(JINTemp);
for I:=1 to SLength do begin
if JINTemp='0' then
if (JINTemp[I+1]='W')or(JINTemp[I+1]='Y')or(I=SLength) then
JINTemp:='-';
case JINTemp of
'0':Result:=Result+'零';
'1':Result:=Result+'壹';
'2':Result:=Result+'贰';
'3':Result:=Result+'叁';
'4':Result:=Result+'肆';
'5':Result:=Result+'伍';
'6':Result:=Result+'陆';
'7':Result:=Result+'柒';
'8':Result:=Result+'捌';
'9':Result:=Result+'玖';
'Q':Result:=Result+'仟';
'B':Result:=Result+'佰';
'S':Result:=Result+'拾';
'W':Result:=Result+'万';
'Y':Result:=Result+'元';
'J':Result:=Result+'角';
'F':Result:=Result+'分';
end;
end;
Result:=Result+'整';
end;

我的好象要简单，但是懒得找，给我发个信，我给你。
mail to:loopy@netease.com

干吗这么麻烦！
按你EDIT1里的数字去买张彩票，中了特奖，不就转换成人民币了？
到时别忘了分我一点！

接受答案了.