hanxuntao
/
D7QUANTAI
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
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.
main
dev
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '1840483600'
${ noResults }
D7QUANTAI/Newprint/my_sys_function.pas

1159 lines
30 KiB
Plaintext
Raw Normal View History Unescape Escape

12
10 months ago
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;//<2F><>Сдת<D0B4><D7AA>,<2C>ԣңգ<D2A3><D5A3><EFBFBD><EFBFBD><EFBFBD>,falseӢ<65><D3A2>
function spart(s:String;k:integer;Isnil:boolean):String ;
Function change( data:extended; mode: Boolean;nocur:boolean=false): String;//<2F><><EFBFBD>Ĵ<EFBFBD>дת<D0B4><D7AA>
function numtoc(c:char):string; //<2F><>ֵת<D6B5><D7AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ĵ<EFBFBD>д
Function numtoen(c:char):String; //<2F><>ֵת<D6B5><D7AA><EFBFBD><EFBFBD>Ӣ<EFBFBD>Ĵ<EFBFBD>д
Function s_w(w:integer;s:real):real; //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
function max_num(num:real):string;// <20><><EFBFBD>Ĵ<EFBFBD>дת<D0B4><D7AA>
function MoneyCn(num:real;lx:boolean=false):widestring;//<2F>ұ<EFBFBD><D2B1><EFBFBD>дת<D0B4><D7AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
function MoneyCnUSD(f : String) : String;
function getstlDate(aetd:TDateTime;Cust,SaleID:String):TDatetime;//<2F><>ȡ<EFBFBD><C8A1><EFBFBD>ڽ<EFBFBD><DABD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
function getstlday(aetd:TDateTime;Cust,SaleID:String):integer;//<2F><>ȡ<EFBFBD><C8A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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; //<2F>½<EFBFBD>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:='<27><>';
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:= '<27><>';
'1' : s:= 'Ҽ';
'2' : s:= '<27><>' ;
'3' : s:= '<27><>' ;
'4' : s:= '<27><>' ;
'5' : s:= '<27><>' ;
'6' : s:= '½' ;
'7' : s:= '<27><>' ;
'8' : s:= '<27><>' ;
'9' : s:= '<27><>' ;
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=('<27><>', 'Ǫ', '<27><>', 'ʰ', '<27><>', 'Ǫ', '<27><>', 'ʰ', '<27><>', 'Ǫ', '<27><>', 'ʰ', 'Ԫ');
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 //ѡ<><D1A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ģʽ
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;
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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 + '<27><>' + numtoc(txtint[i]) + cunit[13 - i];
{ else begin
if (13-i)<>12 then
Sint := Sint + '<27><>' + numtoc(txtint[i]) + cunit[13 - i]
else
Sint := Sint + '<27><>' + 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;
//<2F><><EFBFBD><EFBFBD>С<EFBFBD><D0A1><EFBFBD><EFBFBD><EFBFBD>ֲ<EFBFBD><D6B2><EFBFBD><EFBFBD><EFBFBD>
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 := '<27><>' + 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 := '<27><>Ԫ<EFBFBD><D4AA>'
else
result := Sint + '<27><>'
else
begin
sdec := numtoc(txtdec[1]) + '<27><><EFBFBD><EFBFBD>';
result := Sint + sdec;
end
else If txtdec[1] = '0' Then
If Sint[2]= '0' Then
begin
sdec := numtoc(txtdec[2]) + '<27><>';
result:= sdec;
end
else
begin
sdec := '<27><>' + numtoc(txtdec[2]) + '<27><>';
result := Sint + sdec;
end
else
begin
sdec := numtoc(txtdec[1]) + '<27><>' + numtoc(txtdec[2]) + '<27><>';
result := Sint + sdec;
end
end;
end
// Ӣ<><D3A2>ģʽ
else If mode = True Then
begin
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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';
//<2F><><EFBFBD><EFBFBD>С<EFBFBD><D0A1>
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:='<27><>Ԫ<EFBFBD><D4AA>';
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=('<27><>', 'Ǫ', '<27><>', 'ʰ', '<27><>', 'Ǫ', '<27><>', 'ʰ', '<27><>', 'Ǫ', '<27><>', 'ʰ', 'Ԫ');
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;
//<2F><><EFBFBD><EFBFBD>ǧ<EFBFBD><C7A7>
if i<1 then
res:='<27><>Ǫ<EFBFBD><C7AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʰ<EFBFBD><CAB0><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ǫ<EFBFBD><C7AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʰ<EFBFBD><CAB0>Ԫ'+res;
if (i>=1) and (i<10)then
res:='<27><>Ǫ<EFBFBD><C7AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʰ<EFBFBD><CAB0><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ǫ<EFBFBD><C7AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʰ'+res;
if (i>=10) and (i<100)then
res:='<27><>Ǫ<EFBFBD><C7AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʰ<EFBFBD><CAB0><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ǫ<EFBFBD><C7AA><EFBFBD><EFBFBD>'+res;
if (i>=100) and (i<1000)then
res:='<27><>Ǫ<EFBFBD><C7AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʰ<EFBFBD><CAB0><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ǫ'+res;
if (i>=1000) and (i<10000)then
res:='<27><>Ǫ<EFBFBD><C7AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʰ<EFBFBD><CAB0><EFBFBD><EFBFBD>'+res;
if (i>=10000) and (i<100000)then
res:='<27><>Ǫ<EFBFBD><C7AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʰ'+res;
if (i>=100000) and (i<1000000)then
res:='<27><>Ǫ<EFBFBD><C7AA><EFBFBD><EFBFBD>'+res;
if (i>=1000000) and (i<10000000)then
res:='<27><>Ǫ'+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])+'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
if length(str)=4 then
res:=res+numtoc(str[3])+'<27><>'+numtoc(str[4])+'<27><>';
end
else
res:=res+'<27><><EFBFBD><EFBFBD>'+'<27><><EFBFBD><EFBFBD>';
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:='<27><>Ҽ<EFBFBD><D2BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>½<EFBFBD><C2BD><EFBFBD>ƾ<EFBFBD>';
d2:='ʰ<><CAB0>Ǫ<EFBFBD><C7AA><EFBFBD><EFBFBD>';
i := AnsiPos('.',f); //С<><D0A1><EFBFBD><EFBFBD>λ<EFBFBD><CEBB>
If i = 0 Then
zs := f //<2F><><EFBFBD><EFBFBD>
Else begin
zs:=copy(f,1,i - 1); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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:='<27><>';
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('<27><>',jg)=0 Then h:=h+'<27><>';
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)+'<27><>'+copy(jg,3,200);
end;
j:=AnsiPos('<27><><EFBFBD><EFBFBD>',jg);
While j>0 do begin
jg :=copy(jg, 1, j - 1)+copy(jg,j+2,200);
j :=AnsiPos('<27><><EFBFBD><EFBFBD>',jg);
end;
If (Length(jg)>1)And(copy(jg,length(jg)-1,2)='<27><>')Then jg :=copy(jg,1,Length(jg)-2);
j := AnsiPos('<27><><EFBFBD><EFBFBD>',jg);
If j > 0 Then jg:=copy(jg,1, j - 1)+copy(jg, j + 2,200);
//ת<><D7AA>С<EFBFBD><D0A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
If (Length(jg)>1) then //<2F><><EFBFBD><EFBFBD>Ԫ
jg :=jg+'Ԫ'
else
jg:=jg;
lx := Length(xs);
If lx=0Then begin //<2F><><EFBFBD><EFBFBD>С<EFBFBD><D0A1>Ϊ<EFBFBD><CEAA>
jg :=jg + '<27><>' ;
End;
If lx=1Then begin //<2F><><EFBFBD><EFBFBD>С<EFBFBD><D0A1>Ϊһλ
s1:=copy(dx, strtoint(copy(xs,1,1))*2 + 1, 2);
if s1<>'<27><>' then
jg := jg+s1+'ʰ'+'<27><><EFBFBD><EFBFBD>' ;
if s1='<27><>' then
jg := jg+'<27><>' ;
End;
If lx>=2Then begin //С<><D0A1>Ϊ<EFBFBD><CEAA>λ
s1:=copy(dx, strtoint(copy(xs,1,1))*2 + 1, 2);
s2:=copy(dx, strtoint(copy(xs,2,1))*2 + 1, 2) ;
if (s1='<27><>')and (s2='<27><>') then
jg := jg +'<27><>' ;
if (s1<>'<27><>')and (s2<>'<27><>') then
jg := jg +s1+'ʰ'+s2+'<27><><EFBFBD><EFBFBD>' ;
if (s1<>'<27><>')and (s2='<27><>') then
jg := jg +s1+'ʰ'+'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>' ;
if (s1='<27><>')and (s2<>'<27><>') then
jg := jg +s1+s2+'<27><><EFBFBD><EFBFBD>' ;
End;
result:='<27><>Ԫ'+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 <20><>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD><='''+FormatDateTime('YYYY-MM-DD',aetd)+''' and <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>>='''+FormatDateTime('YYYY-MM-DD',aetd)+''' and <20>ͻ<EFBFBD><CDBB><EFBFBD><EFBFBD><EFBFBD>='''+Cust+''' and <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>='''+SaleID+'''');
Open;
if IsEmpty then begin
Result:=aetd;
Exit;
end;
if FieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').AsString='<27>ֽ<EFBFBD><D6BD><EFBFBD><EFBFBD><EFBFBD>' then begin
Result:=aetd;
end else if FieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').AsString='Լ<><D4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD>' then begin
result:=aStlDate+fieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').AsInteger;
end else if FieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').AsString='Լ<><D4BC>ʱ<EFBFBD><CAB1>' then begin
if FieldByName('<27><><EFBFBD><EFBFBD>ģʽ').AsString='<27>̶<EFBFBD>' then begin
DecodeDate(IncMonth(aStlDate,StrToIntDef(FieldByName('<27><><EFBFBD><EFBFBD>ģʽ').AsString,0)),aYear,aMonth,aDay);
bDay:=DaysInMonth(EncodeDate(aYear,aMonth,1));
if fieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').AsInteger>bDay then
result:=EncodeDate(aYear,aMonth,bDay)
else
result:=EncodeDate(aYear,aMonth,fieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').AsInteger);
end else
result:=IncMonth(aStlDate,StrToIntDef(FieldByName('<27><><EFBFBD><EFBFBD>ģʽ').AsString,0));
end else if FieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').AsString='<27>ֽ׶θ<D7B6><CEB8><EFBFBD>' then begin
DecodeDate(IncMonth(aStlDate,StrToIntDef(FieldByName('<27><><EFBFBD><EFBFBD>ģʽ').AsString,0)),aYear,aMonth,aDay);
if aDay>fieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').AsInteger then begin
bDay:=DaysInMonth(EncodeDate(aYear,aMonth,1));
if fieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>2').AsInteger>bDay then
result:=EncodeDate(aYear,aMonth,bDay)
else
result:=EncodeDate(aYear,aMonth,fieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>2').AsInteger);
end else begin
bDay:=DaysInMonth(EncodeDate(aYear,aMonth,1));
if fieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').AsInteger>bDay then
result:=EncodeDate(aYear,aMonth,bDay)
else
result:=EncodeDate(aYear,aMonth,fieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').AsInteger);
result:=EncodeDate(aYear,aMonth,fieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').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] := '<27><>'; aNum_C[3] := '<27><>';
aNum_C[4] := '<27><>'; aNum_C[5] := '<27><>'; aNum_C[6] := '½';
aNum_C[7] := '<27><>'; aNum_C[8] := '<27><>'; aNum_C[9] := '<27><>';
aNum_C[10] := '<27><>'; aWord_C[1] := '<27><>'; aWord_C[2] := 'Ǫ';
aWord_C[3] := '<27><>'; aWord_C[4] := 'ʰ'; aWord_C[5] := '<27><>';
aWord_C[6] := 'Ǫ'; aWord_C[7] := '<27><>'; aWord_C[8] := 'ʰ';
aWord_C[9] := 'Բ'; aWord_C[10] := '<27><>'; aWord_C[11] := '<27><>';
aWord_C[12] := '<27><>';
{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;
//<2F><><EFBFBD><EFBFBD>1-19֮<39><D6AE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ת<EFBFBD><D7AA><EFBFBD><EFBFBD>Ӣ<EFBFBD>ı<EFBFBD>ʾ<EFBFBD><CABE>
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;
//<2F><><EFBFBD><EFBFBD>1-99֮<39><D6AE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ת<EFBFBD><D7AA><EFBFBD><EFBFBD>Ӣ<EFBFBD>ı<EFBFBD>ʾ<EFBFBD><CABE>
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;
//<2F><><EFBFBD><EFBFBD>1-999֮<39><D6AE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ת<EFBFBD><D7AA><EFBFBD><EFBFBD>Ӣ<EFBFBD>ı<EFBFBD>ʾ<EFBFBD><CABE>
//<2F><>intFormatΪ1<CEAA><31><EFBFBD><EFBFBD><EFBFBD><EFBFBD>HUNDRED <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> AND<4E><44><EFBFBD><EFBFBD><EFBFBD><EFBFBD>û<EFBFBD>С<EFBFBD>
function DigitToEn3(strDigits: String; intFormat: Integer): String;
begin
//ȥ<><C8A5><EFBFBD><EFBFBD><EFBFBD>ִ<EFBFBD>ǰ<EFBFBD><C7B0><EFBFBD><EFBFBD>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
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> С<><D0A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
strInteger, strDecimal: String;
strTemp: String;
strDigits :string;
begin
//ֻ<>ܵ<EFBFBD>ǧ<EFBFBD><C7A7>,<2C><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʵ<EFBFBD><CAB5>û<EFBFBD><C3BB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if (ARMBCash > 999999999999.99) or ( ARMBCash< 0.01) then
raise exception.Create('Out of range, must between 0.01 - 999999999999.99');
strDigits:= FloatToStr(ARMBCash);
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ּ<EFBFBD>С<EFBFBD><D0A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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
//ֻ<><D6BB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
else if Int(ARMBCash) > 0 then
strInteger := IntToStr(System.Round(ARMBCash))
//ֻ<><D6BB>С<EFBFBD><D0A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
else if ARMBCash - Int(ARMBCash) > 0 then
strDecimal := Right(strDigits, Length(strDigits) - Pos('.', strDigits));
//<2F>õ<EFBFBD><C3B5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ӣ<EFBFBD>ı<EFBFBD>ʾ<EFBFBD><CABE>
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;
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
//ʮ<><CAAE><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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.