怎么样把小写转换成大写?(100分)

  • 主题发起人 主题发起人 pokar
  • 开始时间 开始时间
P

pokar

Unregistered / Unconfirmed
GUEST, unregistred user!
如:
4810054001.12元,要译成壹仟零伍万肆仟零壹元,
按照一个一个替换为:壹仟零佰零拾零伍万肆仟零佰零拾壹元壹角贰分

怎样做?
 

代码来自32位深度历险台湾钱达智先生

unit cutils;

interface

uses
SysUtils;

function CNum2Num(sChineseNum: string; var dblArabic: double): boolean;
function Num2CNum(dblArabic: double): string;

implementation

(* -------------------------------------------------- *)
(* Num2CNum 将阿拉伯数字转成中文数字字串
(* 使用示例:
(* Num2CNum(10002.34) ==> 一万零二点三四
(*
(* Author: Wolfgang Chien <wolfgang@ms2.hinet.net>
(* Date: 1996/08/04
(* Update Date:
(* -------------------------------------------------- *)
function Num2CNum(dblArabic: double): string;
const
_ChineseNumeric = '零一二三四五六七八九';
var
sArabic: string;
sIntArabic: string;
iPosOfDecimalPoint: integer;
i: integer;
iDigit: integer;
iSection: integer;
sSectionArabic: string;
sSection: string;
bInZero: boolean;
bMinus: boolean;

(* 将字串反向, 例如: 传入 '1234', 传回 '4321' *)
function ConvertStr(const sBeConvert: string): string;
var
x: integer;
begin
Result := '';
for x := Length(sBeConvert) downto 1 do
AppendStr(Result, sBeConvert[x]);
end; { of ConvertStr }
begin
Result := '';
bInZero := True;
sArabic := FloatToStr(dblArabic); (* 将数字转成阿拉伯数字字串 *)
{$ifdef __Debug}
ShowMessage('FloatToStr(dblArabic): ' + sArabic);
{$endif}
if sArabic[1] = '-' then
begin
bMinus := True;
sArabic := Copy(sArabic, 2, 254);
end
else
bMinus := False;
iPosOfDecimalPoint := Pos('.', sArabic); (* 取得小数点的位置 *)
{$ifdef __Debug}
ShowMessage('Pos(''.'', sArabic) ' + IntToStr(iPosOfDecimalPoint));
{$endif}

(* 先处理整数的部分 *)
if iPosOfDecimalPoint = 0 then
sIntArabic := ConvertStr(sArabic)
else
sIntArabic := ConvertStr(Copy(sArabic, 1, iPosOfDecimalPoint - 1));
(* 从个位数起以每四位数为一小节 *)
for iSection := 0 to ((Length(sIntArabic) - 1) div 4) do
begin
sSectionArabic := Copy(sIntArabic, iSection * 4 + 1, 4);
sSection := '';
(* 以下的 i 控制: 个十百千位四个位数 *)
for i := 1 to Length(sSectionArabic) do
begin
iDigit := Ord(sSectionArabic) - 48;
if iDigit = 0 then
begin
(* 1. 避免 '零' 的重覆出现 *)
(* 2. 个位数的 0 不必转成 '零' *)
if (not bInZero) and (i <> 1) then sSection := '零' + sSection;
bInZero := True;
end
else
begin
case i of
2: sSection := '十' + sSection;
3: sSection := '百' + sSection;
4: sSection := '千' + sSection;
end;
sSection := Copy(_ChineseNumeric, 2 * iDigit + 1, 2) +
sSection;
bInZero := False;
end;
end;

(* 加上该小节的位数 *)
if Length(sSection) = 0 then
begin
if (Length(Result) > 0) and (Copy(Result, 1, 2) <> '零') then
Result := '零' + Result;
end
else
begin
case iSection of
0: Result := sSection;
1: Result := sSection + '万' + Result;
2: Result := sSection + '亿' + Result;
3: Result := sSection + '兆' + Result;
end;
end;
{$ifdef __Debug}
ShowMessage('sSection: ' + sSection);
ShowMessage('Result: ' + Result);
{$endif}
end;

(* 处理小数点右边的部分 *)
if iPosOfDecimalPoint > 0 then
begin
AppendStr(Result, '点');
for i := iPosOfDecimalPoint + 1 to Length(sArabic) do
begin
iDigit := Ord(sArabic) - 48;
AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
end;
end;

{$ifdef __Debug}
ShowMessage('Result before 其他例外处理: ' + Result);
{$endif}
(* 其他例外状况的处理 *)
if Length(Result) = 0 then Result := '零';
if Copy(Result, 1, 4) = '一十' then Result := Copy(Result, 3, 254);
if Copy(Result, 1, 2) = '点' then Result := '零' + Result;

(* 是否为负数 *)
if bMinus then Result := '负' + Result;
{$ifdef __Debug}
ShowMessage('Result before Exit: ' + Result);
{$endif}
end;


(* -------------------------------------------------- *)
(* CNum2Num 将中文数字字串转成阿拉伯数字
(* 使用示例:
(* if CNum2Num('一千三百万零四十点一零三', dblTest)
(* dblTest ==> 13000040.103
(*
(* 注意事项:
(* 1. 转换成功, 函数传回 True; 否则为 False
(* 2. 不支援 '四万万' 等的说法, 必须为标准的记数方式
(*
(* Author: Wolfgang Chien <wolfgang@ms2.hinet.net>
(* Date: 1996/08/04
(* Update Date:
(* -------------------------------------------------- *)
function CNum2Num(sChineseNum: string; var dblArabic: double): boolean;
const
_ChineseNumeric = '十百千万亿兆点零一二三四五六七八九';
{_ChineseNumeric = '1十3百5千7万9亿11兆13点15零17一19二21三四五六七八九';}
var
i: integer;
iPos: integer;
dblBuffer: double;
sMultiChar: string;
iDigit: integer;
iRightOfDecimal: integer;
bMinus: boolean;

(* 简单的十次方函数, 取 10^n, where n: byte and n >= 0 *)
function EasyPower10(iPower: byte): double;
var
i: integer;
begin
Result := 1;
try
for i := 1 to iPower do Result := Result * 10;
except
Result := 0;
end;
end;
begin
Result := False;
dblArabic := 0;
dblBuffer := 0;
iDigit := -1;
iRightOfDecimal := -1;

if Copy(sChineseNum, 1, 2) = '负' then
begin
sChineseNum := Copy(sChineseNum, 3, 254);
bMinus := True;
end
else
bMinus := False;

i := 1;
while i < Length(sChineseNum) do
begin
(* 如果不是中文字 ==> Fail *)
if sChineseNum < #127 then Exit;
sMultiChar := Copy(sChineseNum, i, 2);
iPos := Pos(sMultiChar, _ChineseNumeric);
if iPos = 0 then Exit;
if (iDigit = -1) and (iPos > 13) then
iDigit := (iPos - 15) div 2;
case iPos of
1, 3, 5:
begin
(* 十百千 *)
if iDigit = -1 then iDigit := 1;
dblBuffer := dblBuffer + iDigit * EasyPower10((iPos + 1) div 2);
iDigit := -1;
end;
7, 9, 11:
begin
(* 万亿兆 *)
if (iDigit > 0) and (iDigit < 10) then
dblBuffer := dblBuffer + iDigit;
dblArabic := dblArabic + dblBuffer * EasyPower10((iPos-5) div 2 * 4);
iDigit := -1;
dblBuffer := 0;
end;
13:
begin
(* 小数点 *)
if (iDigit > 0) and (iDigit < 10) then
dblBuffer := dblBuffer + iDigit;
dblArabic := dblArabic + dblBuffer;
dblBuffer := 0;
iDigit := -1;
iRightOfDecimal := 0;
end;
15: (* 零 *)
begin
if iRightOfDecimal > -1 then Inc(iRightOfDecimal);
iDigit := -1;
end;
else
begin
if iRightOfDecimal > -1 then
begin
(* 小数点右边的部分 *)
Inc(iRightOfDecimal);
try
dblArabic := dblArabic + iDigit / EasyPower10(iRightOfDecimal);
except
Exit;
end;
iDigit := -1;
end;
end;
end;

{$ifdef __Debug}
ShowMessage(IntToStr(i) + 'th dblArabic: ' + FloatToStr(dblArabic));
ShowMessage(IntToStr(i) + 'th dblBuffer: ' + FloatToStr(dblBuffer));
ShowMessage(IntToStr(i) + 'th iDigit: ' + IntToStr(iDigit));
{$endif}

Inc(i, 2);
end;

if (iDigit > 0) and (iDigit < 10) then
dblBuffer := dblBuffer + iDigit;
if dblBuffer <> 0 then dblArabic := dblArabic + dblBuffer;
if bMinus then
begin
{$ifdef __SafeMode}
sChineseNum := '负' + sChineseNum;
{$endif}
dblArabic := dblArabic * -1;
end;
{$ifdef __SafeMode}
Result := sChineseNum = Num2CNum(dblArabic);
{$else}
Result := True;
{$endif}
end;

end.
http://www.delphibbs.com/delphibbs/dispq.asp?lid=75718
 
贴一个Lao tian大侠的函数

function My_StrToRMB(curs: string) :string ;
var
daxie,danwei,minuscurs:string;
i,j,deccount :integer ;
rmb :int64;

begin
curs:=trim(curs);
if (curs='-') or (curs='.') or (curs='') then // '.','-',''错
begin
result:='ERROR';
exit;
end;
deccount :=0;
for i:=1 to length(curs) do
begin
if not (curs in ['0'..'9','.','-']) then //'123w2'错
begin
result:='ERROR';
exit;
end;
if (curs='.') and (deccount>0) then //'12313.324.23'错
begin
result:='ERROR';
exit;
end;
if (curs='-') and (i>1) then //'-123-123'错
begin
result:='ERROR';
exit;
end;
if curs='.' then inc(deccount);
end;
rmb:=round(StrToFloat(curs)*100);
minuscurs:=''; //负数标志
if rmb<0 then
begin
minuscurs:='(负数)' ;
rmb:=(-1)*rmb;
end;
if rmb>=1E18 then //超过9千万亿
begin
result:='ERROR';
exit;
end;
curs:='';
i:=0;
while rmb>0 do
begin
j:= rmb mod 10;
case j of
0 : daxie :='零' ;
1 : daxie :='壹' ;
2 : daxie :='贰' ;
3 : daxie :='叁' ;
4 : daxie :='肆' ;
5 : daxie :='伍' ;
6 : daxie :='陆' ;
7 : daxie :='柒' ;
8 : daxie :='捌' ;
9 : daxie :='玖' ;
end;
case i of
0 : danwei :='分' ;
1 : danwei :='角' ;
2 : danwei :='圆' ;
3 : danwei :='拾' ;
4 : danwei :='佰' ;
5 : danwei :='仟' ;
6 : danwei :='万' ;
7 : danwei :='拾' ;
8 : danwei :='佰' ;
9 : danwei :='仟' ;
10 : danwei :='亿' ;
11 : danwei :='拾' ;
12 : danwei :='佰' ;
13 : danwei :='仟' ;
14 : danwei :='万' ;
15 : danwei :='拾' ;
16 : danwei :='佰' ;
17 : danwei :='仟' ;
end;
rmb:=rmb div 10;
if j<>0 then curs:=daxie+danwei+curs; //该位上不为0
if (j=0) and (not (i in [2,6,10,14])) then //该位为0,是一般位
curs:=daxie+curs;
if (j=0) and (i in [2,6,10,14]) then //该位为0,是敏感位
curs:=danwei+curs;
inc(i);
end;
while pos('零零',curs)>0 do curs:=stringreplace(curs,'零零','零',[]);
curs:=stringreplace(curs,'零圆','圆',[]);
while pos('零万',curs)>0 do curs:=stringreplace(curs,'零万','万',[]); //上万亿后可能两个'零万'
curs:=stringreplace(curs,'零亿','亿',[]);
curs:=stringreplace(curs,'角零','角',[]);
if copy(curs,length(curs)-3,4)='圆零' then //最后两位是圆零.
curs:=stringreplace(curs,'圆零','圆整',[]); //小数点后
curs:=stringreplace(curs,'亿万','亿',[]);
result:=minuscurs+curs;
end;
 
如下为一个简单的小写金额转换为大写的函数,其思路简单(可以说烂
,居然利用了位置来转换),但是它几乎可以无限制的转换,只要你能
读得出来和写得进去:
function Tform1.SmallTOBig(small:real):string;
var SmallMonth,BigMonth:string;
wei1,qianwei1:string[2];
wei,qianwei,dianweizhi,qian:integer;
begin
{------- 修改参数令值更精确 -------}
qianwei:=-2;{小数点后的位置,需要的话也可以改动-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;
case qianwei of{判断大写位置,可以继续增大到real类型的最大值}
-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;
调用如下“edit1.text:=SmallTOBig(1234567890.1234);”他自动默
认小数点后两位
 
jswqg这种方法绝对不行
 
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;
 
呵呵,好像可以吧!
 
這東西很早很早...以前寫了1996年吧.只記得,
只要注意處理 0 零 就好了.
 
function GetChineseMoney(NowMoney:double):string;
var ChineseDigital: array[1..10] of string;
ChineseUnit: array[1..4] of string;
ChineseX: array[1..3] of string;
ChineseY: array[1..2] of string;
rs,SS1,SS2,SS,Nowz:string;
NowMoneyLen,wz,pi,i,wi:integer;
begin
RS:='';
ChineseDigital[1]:='壹';
ChineseDigital[2]:='贰';
ChineseDigital[3]:='叁';
ChineseDigital[4]:='肆';
ChineseDigital[5]:='伍';
ChineseDigital[6]:='陆';
ChineseDigital[7]:='柒';
ChineseDigital[8]:='捌';
ChineseDigital[9]:='玖';
ChineseDigital[10]:='拾';
ChineseUnit[1]:='元';
ChineseUnit[2]:='万';
ChineseUnit[3]:='亿';
ChineseUnit[4]:='万亿';
ChineseX[1]:='拾';
ChineseX[2]:='佰';
ChineseX[3]:='仟';
ChineseY[1]:='角';
ChineseY[2]:='分';
SS:=TRIM(FloatToStr(nowmoney));
nowmoneyLEN:=Length(SS);
if nowmoneyLEN>15 then
begin
Application.MessageBox('金额太大,转换将不能正确描述','注意',MB_OK+MB_ICONINFORMATION);
result:='金额太大,无法显示';
Exit;
end;
WZ:=pos('.',SS);
IF WZ>0 then
begin
SS1:=copy(SS,1,WZ-1);
SS2:=copy('00'+trim(copy(SS,WZ+1,2)),length(trim(copy(SS,WZ+1,2)))+1,2);
end
ELSE
begin
SS1:=SS ;
SS2:='00' ;
end;
nowmoneyLEN:=Length(SS1);
for i:=nowmoneyLEN downto 1 do
begin
pi:=i mod 4 ;
wi:=trunc(i/4);
if wi>=4 then wi:=3-(wi mod 4);
nowz:=copy(SS1,nowmoneyLEN-i+1,1);
IF nowz='0' then
begin
if copy(RS,length(rs)-1,2)='零' then rs:=copy(rs,1,length(rs)-2);
if pi=0 then PI:=4;
if pi=1 then
begin
if wi>0 then
RS:=RS+ChineseUnit[WI+1]+'零'
else
RS:=RS+ChineseUnit[WI+1];
end
else
RS:=RS+'零';

end
else
begin
if pi=0 then PI:=4;
if pi=1 then
RS:=RS+ChineseDigital[strtoint(nowz)]+ChineseUnit[WI+1]
else
RS:=RS+ChineseDigital[strtoint(nowz)]+ChineseX[pi-1];
end;
end;
// IF copy(RS,length(rs)-1,2)='零' then Rs:=copy(rs,1,length(RS)-2)+'元 ';
IF SS2='00' then RS:=TRIM(RS)+'整'
ELSE
begin
FOR I:=1 TO 2 do
begin
NOWZ:=copy(SS2,I,1);
IF NOWZ='0' then
RS:=RS+'零'+ChineseY
ELSE
RS:=RS+ChineseDigital[strtoint(NOWZ)]+ChineseY;
end;
end;
if copy(rs,1,2)='元' then rs:='零'+rs;
if rs='元整' then rs:='零元整';
result:=RS;
end;
 
都说了,我来晚了,很简单用case去判断一下就可以了
 
如下,对传入的小写数字 case 就可

function GetDaXieJinE( s: string ):string;//s为小写金额
var
i,
iLeng, //s 的长度
iLengZS, //整数长度
iLengXS: integer;//小数长度
sZS, //整数
sXS:string;//小数
begin
iLeng := Length( s );
iLengZS := iLeng - 3;
iLengXS := 2;
sZS := copy( s, 1, iLengZS );
sXS := copy( s, iLengZS + 2, iLengXS );
for i := 1 to iLengZS do begin
case sZS[ i ] 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 + '玖';
end;
case (iLengZS - i ) 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 + '拾';
end;
end;
for i := 1 to iLengXS do begin
case sXS[ i ] 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 + '玖';
end;
case i of
1: result := result + '角';
2: result := result + '分';
3: result := result + '厘';
4: result := result + '毫';
end;
end;
end;
不知合你意否。
 
呜呜呜呜,看来我最懒。
我写的转换程序只有25行。
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部