|
|
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;//大小写转换,ＴＲＵＥ中文,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 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 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.
|