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.