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;
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;
