unit my_sys_function; interface uses SysUtils,Math,DateUtils,ADODB; 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 implementation 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; end.