求CELL近件，另求数字转换成大写的程序(200分)

F

flywing

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2002-05-04

• #1

各位大虾：
小弟求CELL控件，急！！！！
另求CELL在中将数字转换成汉字大写的方法，或数字转成汉字大写的程序也行！
分不是问题！！！

 

D

dopro

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2002-05-04

• #2

function dec(m:Currency):string;
var
j1,i,j:Integer;
ds:String;
xx: array[1..9] of string;
begin
xx[1]:='壹';
xx[2]:='贰';
xx[3]:='叁';
xx[4]:='肆';
xx[5]:='伍';
xx[6]:='陆';
xx[7]:='柒';
xx[8]:='捌';
xx[9]:='玖';
j:=0;
j1:=0;
if m < 0 then
m:=-m;
i:=trunc(m/10000000);
ds:='〈币';
if i >0 then
begin
ds:=trim(ds)+xx+'仟';
m:=m-i*10000000;
j:=1;
j1:=0;
end;
i:=trunc(m/1000000);
m:=m-i*1000000;
if i > 0 then
begin
ds:=trim(ds)+xx+'佰';
j:=1;
j1:=0;
end
else
if (j=1) and (m >0) then
j1:=1;
i:=trunc(m/100000);
m:=m-i*100000;
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'拾'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'拾';
end;
j:=1;
j1:=0;
end
else
if (j=1) and (m >0) and (j1=0) then
j1:=1;
i:=trunc(m/10000);
m:=m-i*10000;
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'万'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'万';
end;
j:=1;
j1:=0;
end
else
begin
if j=1 then
ds:=trim(ds)+'万';
if (j=1) and (m >0) and (j1=0) then
j1:=1;
end;
i:=trunc(m/1000);
m:=m-i*1000;
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'仟'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'仟';
end;
j:=1;
j1:=0;
end
else
if (j=1) and (m >0) and (j1=0) then
j1:=1;
i:=trunc(m/100);
m:=m-i*100;
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'佰'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'佰';
end;
j:=1;
j1:=0;
end
else
if (j=1) and (m >0) and (j1=0) then
j1:=1;
i:=trunc(m/10);
m:=m-i*10;
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'拾'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'拾';
end;
j:=1;
j1:=0;
end
else
if (j=1) and (m >0) and (j1=0) then
j1:=1;
i:=trunc(m);
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'元'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'元';
end;
j:=1;
j1:=0;
end
else
begin
if j=1 then
ds:=trim(ds)+'元';
if (j=1) and (m >0) and (j1=0) then
j1:=1;
end;
j1:=0;
m:=m*100-i*100;
//i:=round(m/10);
i:=trunc(m/10);
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'角'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'角';
end;
m:=m-i*10;
j:=1;
j1:=0;
end
else
if (j=1) and (m >0) and (j1=0) then
begin
ds:=trim(ds)+'零';
j1:=1;
end;
//i:=round(m);
i:=trunc(m);
if i > 0 then
begin
ds:=trim(ds)+xx+'分';
j:=1;
end;
if j=0 then
ds:=trim(ds)+'整';
ds:=trim(ds)+'〉';
result:=ds;
end;

 

H

hbezwwl

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2002-05-04

• #3

cell控件,好像新版本的没有,网上以前的版本可能还有的,

 

少

少爷的拐杖

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2002-05-04

• #4

http://www.delphibbs.com/delphibbs/dispq.asp?lid=1082571

 

W

wyb_star

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2002-05-04

• #5

cell控件好象没有破解的！

 

H

happyzhj

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2002-05-04

• #6

Delphi：

function FourNumToChnNum(Str:string;ChnNum:string;var Pre:boolean):string;
const
ChnNum2='零壹贰叁肆伍陆柒捌玖';
var
i,j,Len:integer;
begin
Result := '';
Len := Length(str) ;
for i:=1 to Len do begin
j := Ord(str)-48;
if j=0 then
Pre := True
else begin
if Pre then
Result := Result + '零';
Result := Result + Copy(ChnNum2,j*2+1,2) + Trim(Copy(ChnNum,(Len - i) * 2+1,2));
Pre := False;
end;
end;
end;

function StringToChnNum(str:string):string;
const
ChnNum1='圆万亿兆';
var
i,Len,Len1,Level,Start:integer;
s1,s:string;
Pre: Boolean;
begin
Result := '';
Len := Pos('.',str)-1;
Level := (Len + 3) div 4 ;
Len1 := Len mod 4 ;
if Len1=0 then
Len1 := 4;
Start := 1;
Pre := False;
for i := 1 to Level do begin
s := Copy(str,Start,Len1);
s1 := FourNumToChnNum(s,' 拾佰仟',Pre); // 注意有两个空格
if s1<>'' then
Result := Result + s1 + Copy(ChnNum1,(Level-i)*2+1,2);;
Start := Start + Len1;
Len1 := 4;
end;
s1 := FourNumToChnNum(Copy(str,Len+2,2),'分角',Pre);
if s1 = '' then
s1 := '整';
Result := Result + s1 ;
end;

function RealToChnNum(realnum:real;Width:integer):string;
var
s:string;
begin
Str(realnum:Width:2,s);
Result := StringToChnNum(Trim(s));
end;


Visual FoxPro:


FUNCTION RealToChnNum
PARAMETER PnRealNum
RETURN StringToChnNum(ALLTRIM(TRANSFORM(PnRealNum,'@R')))
ENDFUNC

FUNCTION StringToChnNum
PARAMETER PcStr
LOCAL ChnNum1,I,LnLen,LnLen1,LnLevel,LnStart,LlPre,S1,S,LcResult
STORE '' TO LcResult,S1,S
ChnNum1='圆万亿兆'
LnLen=AT('.',PcStr)-1
LnLevel=INT((LnLen+3) /4)
LnLen1=MOD(LnLen,4)
IF LnLen1=0
LnLen1=4
ENDIF
LnStart=1
LlPre=.F.
FOR I=1 TO LnLevel
S=SUBSTR(PcStr,LnStart,LnLen1)
S1=FourNumToChnNum(s,' 拾佰仟',LlPre) &amp;&amp; 注意有两个空格
IF ! EMPTY(S1)
LcResult=LcResult+S1+SUBSTR(ChnNum1,(LnLevel-i)*2+1,2)
ENDIF
LnStart=LnStart+LnLen1
LnLen1=4
NEXT
S1=FourNumToChnNum(SUBSTR(PcStr,LnLen+2,2),'分角',LlPre)
IF EMPTY(S1)
S1='整'
ENDIF
RETURN LcResult+S1
ENDFUNC

FUNCTION FourNumToChnNum
PARAMETER PcStr,PcChnNum,PlPre
LOCAL LcChnNum2,i,j,LnLen,LcResult
LcChnNum2='零壹贰叁肆伍陆柒捌玖'
LcResult=''
LnLen=LEN(PcStr)
FOR I=1 TO LnLen
j=ASC(SUBSTR(PcStr,i,1))-48
IF j=0
PlPre=.T.
ELSE
IF PlPre
LcResult=LcResult+ '零'
ENDIF
LcResult=LcResult+SUBSTR(LcChnNum2,J*2+1,2)+ALLTRIM(SUBSTR(PcChnNum,(LnLen-i)*2+1,2))
PlPre=.F.
ENDIF
NEXT
RETURN LcResult
ENDFUNC

 

F

flywing

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2002-07-19

• #7

多人接受答案了。