[转]Delphi12种大小写转换的方法

function TPrintfrm.NumToChar(n: Real): wideString; //可以到万亿,并可随便扩大
const
cNum: WideString = '零壹贰叁肆伍陆柒捌玖-万仟佰拾亿仟佰拾万仟佰拾元角分';
cCha: array[0..1, 0..11] of string =
(('零仟','零佰','零拾','零零零','零零',
'零亿','零万','零元','亿万','零角','零分','零整'),
( '零','零','零','零','零','亿','万','元','亿','零','整','整'));
var
i: Integer;
sNum :WideString;
begin
Result := '';
//n := Round(n*10)/10;
//FormatFloat('0.0',)
sNum := FormatFloat('0',n*100);
for i := 1 to Length(sNum) do
Result := Result + cNum[ord(sNum[i])-47] + cNum[26-Length(sNum)+i];
for i:= 0 to 11 do // 去掉多余的零
Result := StringReplace(result, cCha[0,i], cCha[1,i], [rfReplaceAll]);
end;

function TSnnofrm.LowToUpcase(xx: Real): string;
var
i: Integer;
j,dxhj: string;
zero: boolean;
begin
j := FormatFloat('0.0',xx);
j := Trim(IntToStr(Round(xx*100)));
if pos('.',j) <> 0 then
j := Copy(j,1,pos('.',j)-1);
if j = '' then
j:='0';
if copy(j,length(j),1) = '0' then
begin
dxhj := '整';
zero := True;
end
else
begin
dxhj := '';
zero := False;
end;

for i := 0 to Length(j)-1 do
begin
if StrToInt(Copy(j,Length(j)-i,1)) <> 0 then
case i of
0: dxhj := '分'+dxhj;
1: dxhj := '角'+dxhj;
2: dxhj := '元'+dxhj;
3: dxhj := '拾'+dxhj;
4: dxhj := '佰'+dxhj;
5: dxhj := '仟'+dxhj;
6: dxhj := '万'+dxhj;
7: dxhj := '拾'+dxhj;
8: dxhj := '佰'+dxhj;
9: dxhj := '仟'+dxhj;
10: dxhj := '亿'+dxhj;
11: dxhj := '拾'+dxhj;
end;

case StrToInt(Copy(j,Length(j)-i,1)) of
0:
begin
if not zero then
dxhj := '零'+dxhj;
zero := True;
end;
1:
begin
dxhj := '壹'+dxhj;
zero := False;
end;
2:
begin
dxhj := '贰'+dxhj;
zero := False;
end;
3:
begin
dxhj := '叁'+dxhj;
zero := False;
end;
4:
begin
dxhj := '肆'+dxhj;
zero := False;
end;
5:
begin
dxhj := '五'+dxhj;
zero := False;
end;
6:
begin
dxhj := '六'+dxhj;
zero := False;
end;
7:
begin
dxhj := '七'+dxhj;
zero := False;
end;
8:
begin
dxhj := '八'+dxhj;
zero := False;
end;
9:
begin
dxhj := '玖'+dxhj;
zero := False;
end;
end;
end;
if dxhj = '整' then
dxhj := '';
Result := dxhj;
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[I]) + 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[I]) + 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;

给你个函数吧
function Tjfdy.SmallTOBig(small:real):string;
var
SmallMonth,BigMonth:string;
wei1,qianwei1:string[2];
qianwei,dianweizhi,qian:integer;
begin
{------- 修改参数令值更精确 -------}
{小数点后的位数，需要的话也可以改动该值}
qianwei:=-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;

{判断大写位置，可以继续增大到real类型的最大值，可是谁有那么多钱}
case qianwei of
-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;

Function TFormFhdCw.XxToDx(const hjnum:real):String;
var Vstr,zzz,cc,cc1,Presult:string;

xxbb:array[1..12]of string;

uppna:array[0..9] of string;

iCount,iZero,vPoint,vdtlno:integer;

begin

//*设置大写中文数字和相应单位数组*//

xxbb[1]:='亿';

xxbb[2]:='仟';

xxbb[3]:='佰';

xxbb[4]:='拾';

xxbb[5]:='万';

xxbb[6]:='仟';

xxbb[7]:='佰';

xxbb[8]:='拾';

xxbb[9]:='元';

xxbb[10]:='.';

xxbb[11]:='角';

xxbb[12]:='分';

uppna[0]:='零';

uppna[1]:='壹';

uppna[2]:='贰';

uppna[3]:='叁';

uppna[4]:='肆';

uppna[5]:='伍';

uppna[6]:='陆';

uppna[7]:='柒';

uppna[8]:='捌';

uppna[9]:='玖';

Str(hjnum:12:2,Vstr);

cc:='';

cc1:='';

zzz:='';

result:='';

presult:='';

iZero:=0;

vPoint:=0;

for iCount:=1 to 10 do

begin

cc:=Vstr[iCount];

if cc<>' ' then

begin

zzz:=xxbb[iCount];

if cc='0' then

begin

if iZero<1 then //*对“零”进行判断*//

cc:='零'

else

cc:='';

if iCount=5 then //*对万位“零”的处理*//

if copy(result,length(result)-1,2)='零' then

result:=copy(result,1,length(result)-2)+xxbb[iCount]

+'零'

else

result:=result+xxbb[iCount];

cc1:=cc;

zzz:='';

iZero:=iZero+1;

end

else

begin

if cc='.' then

begin

cc:='';

if (cc1='') or (cc1='零') then

begin

Presult:=copy(result,1,Length(result)-2);

result:=Presult;

iZero:=15;

end;

if iZero>=1 then

zzz:=xxbb[9]

else

zzz:='';

vPoint:=1;

end

else

begin

iZero:=0;

cc:=uppna[StrToInt(cc)];

end

end;

result:=result+(cc+zzz)

end;

end;

If Vstr[11]='0' then //*对小数点后两位进行处理*//

begin

if Vstr[12]<>'0' then

begin

cc:='零';

result:=result+cc;

cc:=uppna[StrToInt(Vstr[12])];

result:=result+(uppna[0]+cc+xxbb[12]);

end

end

else

begin

if iZero=15 then

begin

cc:='零';

result:=result+cc;

end;

cc:=uppna[StrToInt(Vstr[11])];

result:=result+(cc+xxbb[11]);

if Vstr[12]<>'0' then

begin

cc:=uppna[StrToInt(Vstr[12])];

result:=result+(cc+xxbb[12]);

end;

end;

result:=result+'正';

end;

给你一段很短的代码吧，好用，我用过的
function TForm1.xTOd(i:Real):string;
const
d='零壹贰叁肆伍陆柒捌玖分角元拾佰仟万拾佰仟亿';
var
m,k:string;
j:integer;
begin
k:='';
m:=floattostr(int(i*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];
xTOd:=k;
end;

调用：
procedure TForm1.Button1Click(Sender: TObject);
var
Sum:real;
begin
sum:=12.34;
showmessage('人民币大写:'+xTOd(Sum));
end;

客服电话

电子邮件

请发表评论

全部评论

上一篇：

下一篇：

Matlab编程-基本命令行语句 - 在苏州的城边

dustinvtran/ml-videos: A collection of v

CVE-2022-26479

ravikumar001/maven

更的笔顺,体会更的笔画,理会更的部首

剪的笔顺,诠释剪的笔画,认识剪的部首

六六分期app的软件客服如何联系？(六六分期

florent37/ViewAnimator: A fluent Android

florent37/Shrine-MaterialDesign2: implem

CVE-2020-36276

SimpleSoftwareIO/simple-sms: Send and re

关于我们

产品与服务

解决方案

139-2527-9053