You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
DS7/Newprint/my_sys_function.pas

1159 lines
30 KiB
Plaintext

This file contains ambiguous Unicode characters!

This file contains ambiguous Unicode characters that may be confused with others in your current locale. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to highlight these characters.

unit my_sys_function;
interface
uses Windows, Messages,Variants, Classes,SysUtils,Math,DateUtils,ADODB,Mapi,StdCtrls, Controls, Forms,
Dialogs;
function ntoc(s:real;bool:boolean):string;//大小写转换,TRUE中文,false英文
function spart(s:String;k:integer;Isnil:boolean):String ;
Function change( data:extended; mode: Boolean;nocur:boolean=false): String;//中文大写转换
function numtoc(c:char):string; //数值转换成中文大写
Function numtoen(c:char):String; //数值转换成英文大写
Function s_w(w:integer;s:real):real; //四舍五入
function max_num(num:real):string;// 中文大写转换
function MoneyCn(num:real;lx:boolean=false):widestring;//币别大写转换函数
function MoneyCnUSD(f : String) : String;
function getstlDate(aetd:TDateTime;Cust,SaleID:String):TDatetime;//获取账期结算日期
function getstlday(aetd:TDateTime;Cust,SaleID:String):integer;//获取账期天数
function EngDateFmt(DT : TDateTime;Abbreviation , WordCase : Boolean;FDate:Boolean=true;MD:Boolean=false;DA:Boolean=false;MY:Boolean=false) : String;
Function EWords(Val:Extended;P_ce:smallint):String;
function CreateAdoQuery: TAdoQuery; //新建ADOQuery
function Amount2Str(amount:Real;numpos:Integer;curr:string):string;
function FloatToEnglish(ARMBCash: Real ; curr: string): string;
function SendEMail(Handle: THandle; Mail: TStrings): Cardinal;
implementation
function SendEMail(Handle: THandle; Mail: TStrings): Cardinal;
type
TAttachAccessArray = array [0..0] of TMapiFileDesc;
PAttachAccessArray = ^TAttachAccessArray;
var
MapiMessage: TMapiMessage;
Receip: TMapiRecipDesc;
Attachments: PAttachAccessArray;
AttachCount: Integer;
i1: integer;
FileName: string;
dwRet: Cardinal;
MAPI_Session: Cardinal;
WndList: Pointer;
begin
dwRet := MapiLogon(Handle,
PChar(''),
PChar(''),
MAPI_LOGON_UI or MAPI_NEW_SESSION,
0, @MAPI_Session);
if (dwRet <> SUCCESS_SUCCESS) then
begin
MessageBox(Handle,
PChar('Error while trying to send email'),
PChar('Error'),
MB_ICONERROR or MB_OK);
end
else
begin
FillChar(MapiMessage, SizeOf(MapiMessage), #0);
Attachments := nil;
FillChar(Receip, SizeOf(Receip), #0);
if Mail.Values['to'] <> '' then
begin
Receip.ulReserved := 0;
Receip.ulRecipClass := MAPI_TO;
Receip.lpszName := StrNew(PChar(Mail.Values['to']));
Receip.lpszAddress := StrNew(PChar( Mail.Values['to']));
Receip.ulEIDSize := 0;
MapiMessage.nRecipCount := 1;
MapiMessage.lpRecips := @Receip;
end;
AttachCount := 0;
for i1 := 0 to MaxInt do
begin
if Mail.Values['attachment' + IntToStr(i1)] = '' then
break;
Inc(AttachCount);
end;
if AttachCount > 0 then
begin
GetMem(Attachments, SizeOf(TMapiFileDesc) * AttachCount);
for i1 := 0 to AttachCount - 1 do
begin
FileName := Mail.Values['attachment' + IntToStr(i1)];
Attachments[i1].ulReserved := 0;
Attachments[i1].flFlags := 0;
Attachments[i1].nPosition := ULONG($FFFFFFFF);
Attachments[i1].lpszPathName := StrNew(PChar(FileName));
Attachments[i1].lpszFileName :=
StrNew(PChar(ExtractFileName(FileName)));
Attachments[i1].lpFileType := nil;
end;
MapiMessage.nFileCount := AttachCount;
MapiMessage.lpFiles := @Attachments^;
end;
if Mail.Values['subject'] <> '' then
MapiMessage.lpszSubject := StrNew(PChar(Mail.Values['subject']));
if Mail.Values['body'] <> '' then
MapiMessage.lpszNoteText := StrNew(PChar(Mail.Values['body']));
WndList := DisableTaskWindows(0);
try
Result := MapiSendMail(MAPI_Session, Handle,
MapiMessage, MAPI_DIALOG, 0);
finally
EnableTaskWindows( WndList );
end;
for i1 := 0 to AttachCount - 1 do
begin
StrDispose(Attachments[i1].lpszPathName);
StrDispose(Attachments[i1].lpszFileName);
end;
if Assigned(MapiMessage.lpszSubject) then
StrDispose(MapiMessage.lpszSubject);
if Assigned(MapiMessage.lpszNoteText) then
StrDispose(MapiMessage.lpszNoteText);
if Assigned(Receip.lpszAddress) then
StrDispose(Receip.lpszAddress);
if Assigned(Receip.lpszName) then
StrDispose(Receip.lpszName);
MapiLogOff(MAPI_Session, Handle, 0, 0);
end;
end;
function Amount2Str(amount:Real;numpos:Integer;curr:string):string;
var
tempstr,s:string;
lenlowamont:Integer;
begin
tempstr:=FormatFloat('0.00',amount);
lenlowamont:=length(tempstr);
delete(tempstr,lenlowamont-2,1);
lenlowamont:=length(tempstr)+1;
if (numpos<=lenlowamont) then begin
if (numpos=lenlowamont) then begin
if (curr='USD') then s:='$'
else if (curr='RMB') then s:='¥';
end else begin
s:=copy(tempstr,lenlowamont-numpos,1);
end;
end else s:='';
result:=s;
end;
Function s_w(w:integer;s:real):real;
{var
Mount:double;
Num:double;
begin
Num:=Power(10,w);
Mount:=round(s*Num);
result:=Mount/Num; }
var
str,str_new:string;
begin
str:=floattostr(s);
if str='' then
result:=0
else if pos('.',str)=0 then
begin
result:=s;
end
else
begin
if length(str)-pos('.',str)>w then
begin
str_new:=copy(str,1,pos('.',str)+w);
if strtoint(copy(str,pos('.',str)+w+1,1))>4 then
result:=strtofloat(str_new)+1/Power(10,w)
else
result:=strtofloat(str_new);
end
else
begin
result:=s;
end;
end;
end;
function numtoc(c:char):string;
var s: string;
begin
case c of
'0' : s:= '零';
'1' : s:= '壹';
'2' : s:= '贰' ;
'3' : s:= '叁' ;
'4' : s:= '肆' ;
'5' : s:= '伍' ;
'6' : s:= '陆' ;
'7' : s:= '柒' ;
'8' : s:= '捌' ;
'9' : s:= '玖' ;
end ;
numtoc:=s;
end;
function numtoen(c:char):String;
var s:String;
begin
case c of
'0' : s:= '' ;
'1' : s:= 'one';
'2' : s:= 'two';
'3' : s:= 'three';
'4' : s:= 'four';
'5' : s:= 'five';
'6' : s:= 'six';
'7' : s:= 'seven';
'8' : s:= 'eight';
'9' : s:= 'nine' ;
end ;
result:=s;
end;
Function change( data:extended; mode: Boolean;nocur:boolean=false): String;
const cunit:Array[0..12] of string=('万', '仟', '佰', '拾', '亿', '仟', '佰', '拾', '万', '仟', '佰', '拾', '元');
Eunit:array[0..3] of string=(' billion ', ' million ', ' thousand ','');
var
Sint,sdec,txtdec,txtint,s,intpart,decpart:String;
i,jj,lentxt:Integer;
tt:Boolean;
Sth:array[1..5] of string;
begin
if data>999999999999.99 then exit;
If mode = false then //选中中文模式
begin
txtint:=inttostr(trunc(data));
txtdec:=formatfloat('00',frac(data)*100);
lentxt := Length(txtint);
for i := 1 to lentxt do
s:= txtint[i] + s;
txtint := s;
tt := False ;
jj := 0;
//处理整数部分
if txtint <> '0' then
for i := lentxt downto 1 do
if txtint[i] = '0' Then
if i = 1 then
if not nocur then
Sint := Sint + cunit[12]
else
Sint := Sint +''
else if i = 9 then
Sint := Sint + cunit[4]
else if (i = 5) and (jj < 3) Then
Sint := Sint + cunit[8]
else if tt = False then
begin
tt := True;
jj := 1;
end
else
jj := jj + 1
else
if tt = True Then
begin
// if not nocur then
Sint := Sint + '零' + numtoc(txtint[i]) + cunit[13 - i];
{ else begin
if (13-i)<>12 then
Sint := Sint + '零' + numtoc(txtint[i]) + cunit[13 - i]
else
Sint := Sint + '零' + numtoc(txtint[i]);
end;
}
tt := False;
end
else begin
// if not nocur then
Sint := Sint + numtoc(txtint[i]) + cunit[13 - i];
{ else begin
if (13-i)<>12 then
Sint := Sint+numtoc(txtint[i]) + cunit[13 - i]
else
Sint := Sint + numtoc(txtint[i]);
end;
} end;
//处理小数部分并输出
if nocur then begin
if txtdec[2] = '0' Then
if txtdec[1] = '0' Then
if Sint = '0' Then
result := ''
else
result := Sint
else
begin
sdec := numtoc(txtdec[1]);
result := Sint + sdec;
end
else If txtdec[1] = '0' Then
If Sint[2]= '0' Then
begin
sdec := numtoc(txtdec[2]);
result:= sdec;
end
else
begin
sdec := '零' + numtoc(txtdec[2]) ;
result := Sint + sdec;
end
else
begin
sdec := numtoc(txtdec[1]) + numtoc(txtdec[2]) ;
result := Sint + sdec;
end
end else begin
if txtdec[2] = '0' Then
if txtdec[1] = '0' Then
if Sint = '0' Then
result := '零元整'
else
result := Sint + '整'
else
begin
sdec := numtoc(txtdec[1]) + '角整';
result := Sint + sdec;
end
else If txtdec[1] = '0' Then
If Sint[2]= '0' Then
begin
sdec := numtoc(txtdec[2]) + '分';
result:= sdec;
end
else
begin
sdec := '零' + numtoc(txtdec[2]) + '分';
result := Sint + sdec;
end
else
begin
sdec := numtoc(txtdec[1]) + '角' + numtoc(txtdec[2]) + '分';
result := Sint + sdec;
end
end;
end
// 英文模式
else If mode = True Then
begin
//处理整数
txtint:=formatfloat('000000000000.00',data);
tt:=true;
for i:=1 to 4 do
begin
Sth[i]:=txtint[3*i-2]+txtint[3*i-1]+txtint[3*i];
if Sth[i]<>'000' then
begin
intpart:=intpart+spart(Sth[i],i,tt)+eunit[i-1];
tt:=false
end
end;
if intpart='' then
intpart:='zero';
//处理小数
txtint[13]:='0';
sdec:=txtint[13]+txtint[14]+txtint[15];
decpart:=spart(sdec,1,true);
if decpart='' then
result:=intpart
else
result:=trim(intpart+' point '+decpart)
end
end;
function spart(s:String;k:integer;Isnil:boolean):String ;
var i:Integer;
begin
if s[2] <> '0' Then
if s[2] = '1' Then
begin
i:=strtoint(s[2]+s[3]);
case i of
10 :spart := 'ten';
11 :spart := 'eleven';
12 :spart := 'twelve';
13 :spart := 'thirteen';
14 :spart := 'fourteen';
15 :spart := 'fifteen';
16 :spart := 'sixteen';
17 :spart := 'seventeen';
18 :spart := 'eighteen';
19 :spart := 'nineteen'
end
end
else
begin
case s[2] of
'2':spart := 'twenty';
'3':spart := 'thirty';
'4':spart := 'forty';
'5':spart := 'fifty';
'6':spart := 'sixty' ;
'7':spart := 'seventy';
'8':spart := 'eighty';
'9':spart := 'ninety'
end ;
if s[3] <> '0' Then
if k=4 then
result:= result + '-' + numtoen(s[3])
else
result:= result+ ' ' + numtoen(s[3])
end
else
result := numtoen(s[3]);
if result <> '' Then
begin
if s[1]<>'0' then
result := numtoen(s[1]) + ' hundred and ' + result
else
if Isnil=false then
result:=' and '+result
end
else
if s[1]<>'0' then
result := numtoen(s[1])+ ' hundred '
end;
function ntoc(s:real;bool:boolean):string;
begin
if (s=0) and (bool=true) then
begin
result:='ZERO';
exit;
end;
if (s=0) and (bool=false) then
begin
result:='零元整';
exit;
end;
result:=trim(uppercase(change(s,bool)))+' ';
end;
function max_num(num:real):string;
var
i,p,k,t:integer;
str:string;
res:string;
x:real;
const
cunit:Array[0..12] of string=('万', '仟', '佰', '拾', '亿', '仟', '佰', '拾', '万', '仟', '佰', '拾', '元');
begin
i:=Trunc(num);
str:=inttostr(i);
res:='';
k:=length(str);
t:=0;
for p:=(length(str)-1) downto 0 do
begin
res:=numtoc(str[k])+cunit[12-t]+res;
k:=k-1;
t:=t+1;
end;
//处理千万
if i<1 then
res:='零仟零佰零拾零万零仟零佰零拾零元'+res;
if (i>=1) and (i<10)then
res:='零仟零佰零拾零万零仟零佰零拾'+res;
if (i>=10) and (i<100)then
res:='零仟零佰零拾零万零仟零佰'+res;
if (i>=100) and (i<1000)then
res:='零仟零佰零拾零万零仟'+res;
if (i>=1000) and (i<10000)then
res:='零仟零佰零拾零万'+res;
if (i>=10000) and (i<100000)then
res:='零仟零佰零拾'+res;
if (i>=100000) and (i<1000000)then
res:='零仟零佰'+res;
if (i>=1000000) and (i<10000000)then
res:='零仟'+res;
x:=s_w(2,(num-i));
if x>=0.01 then
begin
str:=floattostr(x);
if length(str)=3 then
res:=res+numtoc(str[3])+'角零分';
if length(str)=4 then
res:=res+numtoc(str[3])+'角'+numtoc(str[4])+'分';
end
else
res:=res+'零角'+'零分';
result:=res;
end;
function MoneyCn(num:real;lx:boolean=false):widestring;
begin
if lx then
begin
result:=max_num(num);
end
else
begin
result:=ntoc(num,false);
end;
end;
function MoneyCnUSD(f : String) : String;
var dx,d2,zs,xs,s1,s2,h,jg:string;
i,ws,l,w,j,lx:integer;
begin
f := Trim(f);
if copy(f,1,1)='0' then begin
Delete(f,1,1);end
else ;
dx:='零壹贰叁肆伍陆柒捌玖';
d2:='拾佰仟万亿';
i := AnsiPos('.',f); //小数点位置
If i = 0 Then
zs := f //整数
Else begin
zs:=copy(f,1,i - 1); //整数部分
xs:=copy(f,i + 1,200);
End;
ws:= 0; l := 0;
For i :=Length(zs) downTo 1 do begin
ws := ws + 1; h := '';
w:=strtoint(copy(zs, i, 1));
if (w=0) and (i=1) then jg:='零';
If w > 0 Then
Case ws of
2..5:h:=copy(d2,(ws-1)*2-1,2);
6..8:begin
h:=copy(d2,(ws-5)*2-1,2);
If AnsiPos('万',jg)=0 Then h:=h+'万';
end;
10..13:h :=copy(d2,(ws-9)*2-1, 2);
End;
jg:=copy(dx,(w+1)*2-1,2) + h + jg;
If ws=9 Then jg :=copy(jg,1,2)+'亿'+copy(jg,3,200);
end;
j:=AnsiPos('零零',jg);
While j>0 do begin
jg :=copy(jg, 1, j - 1)+copy(jg,j+2,200);
j :=AnsiPos('零零',jg);
end;
If (Length(jg)>1)And(copy(jg,length(jg)-1,2)='零')Then jg :=copy(jg,1,Length(jg)-2);
j := AnsiPos('零亿',jg);
If j > 0 Then jg:=copy(jg,1, j - 1)+copy(jg, j + 2,200);
//转换小数部分
If (Length(jg)>1) then //定义元
jg :=jg+'元'
else
jg:=jg;
lx := Length(xs);
If lx=0Then begin //如果小数为零
jg :=jg + '整' ;
End;
If lx=1Then begin //如果小数为一位
s1:=copy(dx, strtoint(copy(xs,1,1))*2 + 1, 2);
if s1<>'零' then
jg := jg+s1+'拾'+'美分' ;
if s1='零' then
jg := jg+'整' ;
End;
If lx>=2Then begin //小数为两位
s1:=copy(dx, strtoint(copy(xs,1,1))*2 + 1, 2);
s2:=copy(dx, strtoint(copy(xs,2,1))*2 + 1, 2) ;
if (s1='零')and (s2='零') then
jg := jg +'整' ;
if (s1<>'零')and (s2<>'零') then
jg := jg +s1+'拾'+s2+'美分' ;
if (s1<>'零')and (s2='零') then
jg := jg +s1+'拾'+'美分整' ;
if (s1='零')and (s2<>'零') then
jg := jg +s1+s2+'美分' ;
End;
result:='美元'+jg;
End;
function getstlday(aetd:TDateTime;Cust,SaleID:String):integer;
var
aStlDate:TDateTime;
begin
aStlDate:=getstlDate(aetd,Cust,SaleID);
if date>astldate then
result:=DaysBetween(date,aStlDate)
else
result:=-DaysBetween(date,aStlDate);
end;
function getstlDate(aetd:TDateTime;Cust,SaleID:String):TDatetime;
var
aQuery2:TADOQuery;
aYear,aMonth,aDay,bDay:word;
aStlDate:TDateTime;
bMonth:Integer;
begin
aQuery2:=CreateAdoQuery;
aStlDate:=aetd;
result:=aStlDate;
try
with aQuery2 do begin
Close;SQL.Clear;
SQL.Add('Select * from t_crm_client_sales where 开始日期<='''+FormatDateTime('YYYY-MM-DD',aetd)+''' and 结束日期>='''+FormatDateTime('YYYY-MM-DD',aetd)+''' and 客户简称='''+Cust+''' and 揽货人='''+SaleID+'''');
Open;
if IsEmpty then begin
Result:=aetd;
Exit;
end;
if FieldByName('结费类型').AsString='现结买单' then begin
Result:=aetd;
end else if FieldByName('结费类型').AsString='约定天数' then begin
result:=aStlDate+fieldByName('结费期限').AsInteger;
end else if FieldByName('结费类型').AsString='约定时间' then begin
if FieldByName('日期模式').AsString='固定' then begin
DecodeDate(IncMonth(aStlDate,StrToIntDef(FieldByName('类型模式').AsString,0)),aYear,aMonth,aDay);
bDay:=DaysInMonth(EncodeDate(aYear,aMonth,1));
if fieldByName('结费日期').AsInteger>bDay then
result:=EncodeDate(aYear,aMonth,bDay)
else
result:=EncodeDate(aYear,aMonth,fieldByName('结费日期').AsInteger);
end else
result:=IncMonth(aStlDate,StrToIntDef(FieldByName('类型模式').AsString,0));
end else if FieldByName('结费类型').AsString='分阶段付费' then begin
DecodeDate(IncMonth(aStlDate,StrToIntDef(FieldByName('类型模式').AsString,0)),aYear,aMonth,aDay);
if aDay>fieldByName('结束日期').AsInteger then begin
bDay:=DaysInMonth(EncodeDate(aYear,aMonth,1));
if fieldByName('结费日期2').AsInteger>bDay then
result:=EncodeDate(aYear,aMonth,bDay)
else
result:=EncodeDate(aYear,aMonth,fieldByName('结费日期2').AsInteger);
end else begin
bDay:=DaysInMonth(EncodeDate(aYear,aMonth,1));
if fieldByName('结费日期').AsInteger>bDay then
result:=EncodeDate(aYear,aMonth,bDay)
else
result:=EncodeDate(aYear,aMonth,fieldByName('结费日期').AsInteger);
result:=EncodeDate(aYear,aMonth,fieldByName('结费日期').AsInteger);
end;
end else begin
Result:=aetd;
end;
end;
finally
FreeAndNil(aQuery2);
end;
end;
function EngDateFmt(DT : TDateTime;Abbreviation , WordCase : Boolean;FDate:Boolean=true;MD:Boolean=false;DA:Boolean=false;MY:Boolean=false) : String;
var Y, M, D : Word;
S : String;
const EMonth : array[1..12] of String=('January','February','March','April','May'
,'June','July','August','September','October','November','December');
begin
DecodeDate(DT,Y,M,D);
S:=EMonth[M];
if Abbreviation then S:=Copy(S,1,3);
if WordCase then S:=UpperCase(S);
if MY then begin
S:=S+','+inttostr(Y);
end else begin
if FDate then
if DA then
S:=S+'.'+IntToStr(D)
else S:=S+' '+IntToStr(D)
else begin
S:=IntToStr(D)+' '+S;
end;
if not MD then
S:=S+', '+IntToStr(Y);
end;
Result:=S;
end;
function CreateAdoQuery: TAdoQuery;
begin
Result:=TAdoQuery.Create(nil);
with Result do begin
Close;SQL.Clear;
//connection:=frm_main.db;
end;
end;
Function EWords(Val:Extended;P_ce:smallint):String;
{ Params
Val money,Maxvalue=999999999.99
P_ce language (0-english,1-chinese)
}
Var
sEtmpRetStr, SEone2Ten, SETen2Nten, SETwt2Nty, StrVal:String ;
aEtmpVal:Array[1..4] Of String ;
alTmpFlag:Array[1..9] of Boolean ;
aNum_C: Array[1..10] of String;
aWord_C: Array[1..12] of String;
lTmpFlag:Boolean;
nTmpValSub1, nTmpValSub2, nTmpValSub3,I,nOnePos,nCTmpLSubVal,nCTmpSubVal,NSubVal:Integer;
sTmpValSub, sTmpStr2,sInterDept,StrDec:String;
Begin
if (Val > 999999999.99) OR (Val < 0) Then
Result:= 'overflow'
Else Begin
if (p_ce =0 ) Then Begin
sEtmpRetStr:= '';
SEone2Ten:= ' One Two Three Four Five Six Seven Eight Nine ';
SETen2Nten:='Ten Eleven Twelve Thirteen Fourteen Fifteen Sixteen SeventeenEighteen Nineteen ';
SETwt2Nty:= ' Twenty Thirty Forty Fifty Sixty Seventy Eighty Ninety ';
//SDec := Trunc( Round( Val-Int(Val)))*100;
//StrVal:= ReplChar(PadL(IntToStr(Trunc(Val)),9)+'.'+ PadL(IntToStr(Trunc( (Val-Int(Val) )*100)),2),' ','0');
StrVal:= FormatCurr('000000000.00',Val);
aEtmpVal[1] := Copy(StrVal, 1, 3) ;
aEtmpVal[2] := Copy(StrVal, 4, 3) ;
aEtmpVal[3] := Copy(StrVal, 7, 3);
aEtmpVal[4] := '0' + Copy(StrVal, 11, 2);
For I :=1 To 4 do Begin
sTmpValSub:= aEtmpVal[I];
nTmpValSub1:= StrToint(Copy(sTmpValSub, 1, 1));
nTmpValSub2:= StrToint(Copy(sTmpValSub, 2, 1));
nTmpValSub3:= StrToint(Copy(sTmpValSub, 3, 1));
sTmpStr2:= '';
if (nTmpValSub1 > 0) Then sTmpStr2:= sTmpStr2 + (Trim(Copy(SEone2Ten, nTmpValSub1 * 9+ 1, 9)) + ' Hundred ');
if (nTmpValSub2 > 1) Then
sTmpStr2:= sTmpStr2 + (Trim(Copy(SETwt2Nty, nTmpValSub2 * 9 + 1, 9)) + ' ')
Else Begin
if (nTmpValSub2 = 1) Then
sTmpStr2:= sTmpStr2 + (Trim(Copy(SETen2Nten, nTmpValSub3 * 9 + 1, 9)) + ' ');
End;
if (nTmpValSub3 > 0) AND (nTmpValSub2 <> 1) Then Begin
if (nTmpValSub2 = 0) AND (I < 4) Then Begin
if (Length(sEtmpRetStr) > 0) OR (Length(sTmpStr2) > 0) Then
sTmpStr2:= sTmpStr2 + ('and ' + Trim(Copy(SEone2Ten,nTmpValSub3 * 9 + 1, 9)) + ' ')
else
sTmpStr2:= sTmpStr2 + (Trim(Copy(SEone2Ten, nTmpValSub3 * 9 + 1, 9)) + ' ');
End
else Begin
sTmpStr2:= sTmpStr2 + (Trim(Copy(SEone2Ten, nTmpValSub3 * 9 + 1, 9)) + ' ');
End;
End ;
if (I = 3) AND (nTmpValSub1 = 0) AND (nTmpValSub2 > 0) AND (Length(sEtmpRetStr) > 0) Then
sTmpStr2:= 'and ' + sTmpStr2;
case I Of
1: if (Length(sTmpStr2) > 0) Then sEtmpRetStr:= sEtmpRetStr + (sTmpStr2 + 'Million ');
2: if (Length(sTmpStr2) > 0) Then sEtmpRetStr:= sEtmpRetStr + (sTmpStr2 + 'Thousand ');
3: if (Length(sTmpStr2) > 0) Then sEtmpRetStr:= sEtmpRetStr + sTmpStr2;
4: if (Length(sTmpStr2) > 0) Then sEtmpRetStr:= sEtmpRetStr + ('and Cents ' + sTmpStr2);
End ;
End; {End For Loop}
Result:= UpperCase(sEtmpRetStr);
End
Else Begin
{if Sale2FGSDM.InvoiceLanguage=1 then begin}
aNum_C[1] := '壹'; aNum_C[2] := '贰'; aNum_C[3] := '叁';
aNum_C[4] := '肆'; aNum_C[5] := '伍'; aNum_C[6] := '陆';
aNum_C[7] := '柒'; aNum_C[8] := '捌'; aNum_C[9] := '玖';
aNum_C[10] := '零'; aWord_C[1] := '亿'; aWord_C[2] := '仟';
aWord_C[3] := '佰'; aWord_C[4] := '拾'; aWord_C[5] := '万';
aWord_C[6] := '仟'; aWord_C[7] := '佰'; aWord_C[8] := '拾';
aWord_C[9] := '圆'; aWord_C[10] := '角'; aWord_C[11] := '分';
aWord_C[12] := '整';
{end;}
StrVal := Trim(FormatCurr('########0.00', Val)) ;
sInterDept:= InttoStr(Trunc(Val));
nOnePos := Length(SInterDept);
if (Copy(StrVal,1, 1) = '0') Then nOnePos:= 0;
sTrDec := Copy(StrVal,Length(StrVal)-1,2);
If StrDec = '00' Then
StrDec := '';
I:= 1 ;
While (I < nOnePos) Do Begin
if (Copy(sInterDept, nOnePos - I + 1, 1) = '0') Then
alTmpFlag[I]:= True
else
alTmpFlag[I]:= False;
I := I +1 ;
End ;
alTmpFlag[1]:= True;
alTmpFlag[5]:= True;
alTmpFlag[9]:= True;
sTmpStr2:= '' ;
I:= nOnePos ;
lTmpFlag:= False;
if (I = 9) AND (Copy(sInterDept, 2, 4) = '0000') Then
lTmpFlag:= True;
While (I >= 1) Do Begin
NSubVal:= StrToInt(Copy(sInterDept, nOnePos - I + 1, 1));
if (NSubVal = 0) Then Begin
If (Not alTmpFlag[I]) Then
sTmpStr2 := sTmpStr2 + aNum_C[10]
Else
if (I = 1) OR (I = 5) AND (Not lTmpFlag) Then sTmpStr2:= sTmpStr2 + aWord_C[10 - I];
End
else Begin
if (lTmpFlag) AND (I = 4) Then Begin
sTmpStr2:= sTmpStr2 + aNum_C[10];
lTmpFlag:= False ;
End;
sTmpStr2:= sTmpStr2 + (aNum_C[NSubVal] + aWord_C[10 - I]);
End;
I := I - 1;
End; {End While}
If StrDec<>'' Then Begin
if (Copy(StrDec,Length(StrDec),1) <> '0') Then Begin
nCTmpSubVal:= StrToInt(Copy(StrDec,Length(StrDec),1));
if (Copy(StrDec,1, 1) = '0') Then
sTmpStr2:= sTmpStr2 + (aNum_C[10] + aNum_C[nCTmpSubVal] + aWord_C[11])
else Begin
nCTmpLSubVal:= StrToInt(Copy(StrDec,1, 1));
sTmpStr2:= sTmpStr2 + (aNum_C[nCTmpLSubVal] + aWord_C[10] + aNum_C[nCTmpSubVal] + aWord_C[11]);
End;
End
Else Begin
if (Copy(StrDec,1, 1) <> '0') then Begin
nCTmpLSubVal:= StrToInt(Copy(StrDec,1, 1));
sTmpStr2:= sTmpStr2 + (aNum_C[nCTmpLSubVal] + aWord_C[10]);
End
else sTmpStr2:= sTmpStr2 + aWord_C[12];
End;
End
else sTmpStr2:= sTmpStr2 + aWord_C[12];
If (Copy(STmpStr2,Length(STmpStr2)-1,2)<>aWord_C[12]) and ((Copy(STmpStr2,Length(STmpStr2)-1,2)<>aWord_C[11])) Then
STmpStr2 := sTmpStr2 + aWord_C[12];
ReSult:= sTmpStr2;
End;
End;
End;
function FloatToEnglish(ARMBCash: Real ; curr:string): string;
function Left(const AStr: string; ACount: Integer): string;
begin
Result := Copy(astr,1,ACount);
end;
function Right(const AStr: string; ACount: Integer): string;
begin
Result := Copy(astr,Length(AStr)-acount+1, ACount);
end;
//将在1-19之间的数字转换成英文表示法
function DigitToEn1(strDigits: String): String;
begin
Case StrToInt(strDigits) of
1: Result := 'ONE';
2: Result := 'TWO';
3: Result := 'THREE';
4: Result := 'FOUR';
5: Result := 'FIVE';
6: Result := 'SIX';
7: Result := 'SEVEN';
8: Result := 'EIGHT';
9: Result := 'NINE';
10: Result := 'TEN';
11: Result := 'ELEVEN';
12: Result := 'TWELVE';
13: Result := 'THIRTEEN';
14: Result := 'FOURTEEN';
15: Result := 'FifTEEN';
16: Result := 'SIXTEEN';
17: Result := 'SEVENTEEN';
18: Result := 'EIGHTEEN';
19: Result := 'NINETEEN';
else
Result := '';
end;
end;
//将在1-99之间的数字转换成英文表示法
function DigitToEn2(strDigits: String): String;
var
strTemp: String;
begin
if StrToInt(strDigits) < 20 then
Result := DigitToEn1(strDigits)
else begin
Case StrToInt(Left(strDigits, 1)) of
2: strTemp := 'TWENTY';
3: strTemp := 'THIRTY';
4: strTemp := 'FORTY';
5: strTemp := 'FIFTY';
6: strTemp := 'SIXTY';
7: strTemp := 'SEVENTY';
8: strTemp := 'EIGHTY';
9: strTemp := 'NINETY';
else
strTemp := '';
end;
if Right(strDigits, 1) <> '0' then
strTemp := strTemp + '-' + DigitToEn1(Right(strDigits, 1));
Result := strTemp;
end;
end;
//将在1-999之间的数字转换成英文表示法
//如intFormat为1则在HUNDRED 后面就有 AND否则没有。
function DigitToEn3(strDigits: String; intFormat: Integer): String;
begin
//去掉数字串前面的0
strDigits := IntToStr(StrToInt(strDigits));
if StrToFloat(strDigits) <= 19 then
Result := DigitToEn1(strDigits)
else if (StrToFloat(strDigits) >= 20) and (StrToFloat(strDigits) <= 99) then
Result := DigitToEn2(strDigits)
else begin
Result := DigitToEn1(Left(strDigits, 1)) + ' HUNDRED AND';
if (StrToFloat(Right(strDigits, 2)) > 0) and
(StrToFloat(Right(strDigits, 2)) < 20) then
if intFormat = 1 then
Result := Result + ' '+DigitToEn1(Right(strDigits, 2)) //' AND ' +
else
Result := Result + ' ' + DigitToEn1(Right(strDigits, 2))
else if (StrToFloat(Right(strDigits, 2)) >= 20)
and (StrToFloat(Right(strDigits, 2)) <= 99) then
if intFormat = 1 then
Result := Result + ' ' + DigitToEn2(Right(strDigits, 2)) //AND
else
Result := Result + ' ' + DigitToEn2(Right(strDigits, 2));
end;
end;
var
// 整数部份 小数部份
strInteger, strDecimal: String;
strTemp: String;
strDigits :string;
begin
//只能到千亿,万亿其实是没有意义的
if (ARMBCash > 999999999999.99) or ( ARMBCash< 0.01) then
raise exception.Create('Out of range, must between 0.01 - 999999999999.99');
strDigits:= FloatToStr(ARMBCash);
//有整数部分及小数部分
if (Int(ARMBCash) > 0) and (ARMBCash - Int(ARMBCash) > 0) then
begin
strInteger := Left(strDigits, Pos('.', strDigits) - 1);
strDecimal := Right(strDigits, Length(strDigits) - Pos('.', strDigits));
end
//只有整数部分
else if Int(ARMBCash) > 0 then
strInteger := IntToStr(System.Round(ARMBCash))
//只有小数部分
else if ARMBCash - Int(ARMBCash) > 0 then
strDecimal := Right(strDigits, Length(strDigits) - Pos('.', strDigits));
//得到整数部分英文表示法
if strInteger <> '' then begin
strTemp := DigitToEn3(Right(strInteger, 3), 1);
if Length(strInteger) > 3 then begin
if curr='THB' then
strTemp := DigitToEn3(Left(Right(strInteger, 6),
Length(Right(strInteger, 6)) - 3), 2) + ' THOUSAND, ' + strTemp
else
strTemp := DigitToEn3(Left(Right(strInteger, 6),
Length(Right(strInteger, 6)) - 3), 2) + ' THOUSAND AND ' + strTemp;
//百万以上
if Length(strInteger) > 6 then
if curr='THB' then
strTemp := DigitToEn3(Left(strInteger, Length(strInteger) - 6), 2) +
' MILLION, ' + strTemp
else
strTemp := DigitToEn3(Left(strInteger, Length(strInteger) - 6), 2) +
' MILLION AND ' + strTemp;
//十亿以上
if Length(strInteger) > 9 then
strTemp := DigitToEn3(Left(strInteger, Length(strInteger) - 9), 2) +
' BILLION AND ' + strTemp;
end;
strInteger := strTemp;
end;
if (strDecimal <> '') and (Length(strDecimal) <= 3) then
strDecimal := DigitToEn3(strDecimal, 1);
if (strInteger <> '') and (strDecimal <> '') then begin
if curr='RMB' then
Result := strInteger + ' YUANS AND ' + strDecimal + ' CENTS ONLY'
else if curr='USD' then
Result := strInteger + ' DOLLARS AND ' + strDecimal + ' CENTS ONLY'
else if curr='THB' then begin
Result := strInteger + ' BAHT AND ' + strDecimal + ' SATANG ONLY'
end;
end else if strInteger <> '' then begin
if curr='RMB' then
Result := strInteger + ' YUANS ONLY'
else if curr='USD' then
Result := strInteger + ' DOLLARS ONLY'
else if curr='THB' then
Result := strInteger + ' BAHT ONLY'
else if strDecimal <> '' then
if curr='THB' then
Result := strDecimal + ' SATANG ONLY'
else
Result := strDecimal + ' CENTS ONLY'
end else
Result := 'ZERO';
end;
end.