//以下函数能将小于十万亿元的小写金额转换为大写 //作者 方小庆（inrm@263.net） Function NtoC(n0 :real) :String; Function IIF(b :boolean; s1,s2:string):string; begin //本函数在VFP和VB中均为系统内部函数 if b then IIF:=s1 else IIF:=s2; end; Const c = '零壹贰叁肆伍陆柒捌玖◇分角圆拾佰仟万拾佰仟亿拾佰仟万'; var L,i,n, code :integer; Z :boolean; s, st,st1 :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); st:=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)) + st; Z := (n=0); end; Z := False; For i:= 1 To 2 do begin Val(Copy(s, L-i+1, 1), n, code); st1:= 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, ', '整')) + st1; Z := (n=0); end; For i := 1 To Length(st) do If Copy(st, i, 4) = '亿万' Then Delete(st,i+2,2); NtoC := IIf( n0=0, '零', st + st1); End;
type TForm1 = class(TForm) Button1: TButton; Edit1: TEdit; Edit2: TEdit; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end;
var Form1: TForm1;
implementation
{$R *.DFM} function SmallToBig(Small:Real):string; Var Str:String; DotPos:Integer; i:Integer; bStart:Boolean; sResult:WideString; SmallDit:Double; begin Result:='零圆整'; SmallDit:=Round((Small-INT(Small))*100)/100; Small:=INT(Small)+SmallDit; if SmallDit<0.01 then Exit; Str:=FormatFloat('#.##',Small); DotPos:=Pos('.',Str); if DotPos=0 then DotPos:=length(Str)+1; bStart:=False; For i:=DotPos-1 downto 1 do begin if (Str[i]<>'0') and (not bStart) then bStart:=True; if ABS(i-DotPos) MOD 4=1 then begin if (Str[i]='0') and (DotPos-i<>1) then sResult:='零'+sResult; Case DotPos-i of 1:sResult:='圆'+sResult; 5:sResult:='万'+sResult; 9:sResult:='亿'+sResult; 13:sResult:='兆'+sResult; end; bStart:=False; end; if (Str[i]<>'0') then begin Case ABS(i-DotPos) MOD 4 of 0:sResult:='仟'+sResult; 2:sResult:='拾'+sResult; 3:sResult:='佰'+sResult; end; end; if i=3 then Application.ProcessMessages; Case Str[i] of '0':if bStart and (sResult[1]<>'零') then begin sResult:='零'+sResult; bStart:=False; end; '1':sResult:='壹'+sResult; '2':sResult:='贰'+sResult; '3':sResult:='叁'+sResult; '4':sResult:='肆'+sResult; '5':sResult:='伍'+sResult; '6':sResult:='陆'+sResult; '7':sResult:='柒'+sResult; '8':sResult:='捌'+sResult; '9':sResult:='玖'+sResult; end; if Str[i]<>'0' then bStart:=True; end; Delete(Str,1,DotPos); if Length(Str)>0 then begin Case Str[1] of '0':if sResult<>' then sResult:=sResult+'零'; '1':sResult:=sResult+'壹'; '2':sResult:=sResult+'贰'; '3':sResult:=sResult+'叁'; '4':sResult:=sResult+'肆'; '5':sResult:=sResult+'伍'; '6':sResult:=sResult+'陆'; '7':sResult:=sResult+'柒'; '8':sResult:=sResult+'捌'; '9':sResult:=sResult+'玖'; end; if Str[1]<>'0' then sResult:=sResult+'角'; if Length(Str)>1 then begin Case Str[2] of '1':sResult:=sResult+'壹'; '2':sResult:=sResult+'贰'; '3':sResult:=sResult+'叁'; '4':sResult:=sResult+'肆'; '5':sResult:=sResult+'伍'; '6':sResult:=sResult+'陆'; '7':sResult:=sResult+'柒'; '8':sResult:=sResult+'捌'; '9':sResult:=sResult+'玖'; end; if Str[2]<>'0' then sResult:=sResult+'分'; end else sResult:=sResult+'整'; end else sResult:=sResult+'整'; Result:=sResult; end;
procedure TForm1.Button1Click(Sender: TObject); begin Edit2.Text:=SmallToBig(StrToCurr(Edit1.Text)); end;
procedure TForm1.Button2Click(Sender: TObject); begin Close; end;
function NumToChar(const n: Real): string; //可以到万亿，并且可以随便扩大范围 const cNum: WideString=’零壹贰叁肆伍陆柒捌玖--万仟佰拾亿仟佰拾万仟佰拾元角分’; cCha:array[0..1, 0..15]of string = (('零元’,’零拾’,’零佰’,’零仟’,’零万’,’零亿’,’亿万’,’零零零’, '零零’,’零万’,’零亿’,’亿万’,’零元’,’零角’,’零分’,’零整’), ('元’,’零’,’零’,’零’,’万’,’亿’,’亿’,’零’, '零’,’万’,’亿’,’亿’,’元’,’零’,’整’,’整’)); var i : Integer; sNum,sTemp : WideString; begin result :='’; sNum := format(’%15d’,[round(n * 100)]); for i := 0 to 14 do begin stemp := copy(snum,i+1,1); if stemp=’' then continue else result := result + cNum[strtoint(stemp)+1] + cNum[i+13]; end; for i:= 0 to 15 do //去掉多余的零 Result := StringReplace(Result, cCha[0,i], cCha[1,i], [rfReplaceAll]); end;
