*** deffN - defaul font definition correction in text IF !EMPTY(nDeffH+nDeffT) .AND. ArrLen(@aFont2)>0 *** search font definition "\f"+nDEffT+"\" for header nDeffH=aFont0[VAL(nDeffH)+1] && ôîíò â çàãîëîâêåError Message is : File 'aFont0' does not exist.
IF .F. DECLARE aFont0(1),aFont2(1),aColor0(1),aColor2(1) ENDIFwhen i change IF .F. to IF .T., another error was occured in below line. error message is Operator/operand type mismatch.
*** will add this font in header and insert it's number in text IF nj>0 .AND. !nDeffT==nDeffH && fonts are different !>Which line gives the error?
>>cText1 = "{\rtf1\fbidis\ansi\ansicpg1256\deff0\deflang1025{\fonttbl{\f0\fnil\fcharset0 Arial;}}\viewkind4\uc1\pard\ltrpar\qc\fs32 First Line\par }" >>cText2 = "{\rtf1\fbidis\ansi\ansicpg1256\deff0\deflang1025{\fonttbl{\f0\fnil\fcharset0 Arial;}}\viewkind4\uc1\pard\ltrpar\fs18 Second Line\par }" >>Landscape = .F. >>nPage = 0 >> >>= STRTOFILE(JoinRTF(cText1,cText2,Landscape,nPage),"C:\new.rtf") >> >>RETURN >> >> >> >> >>************** Some usefull RTF functions ************ >>*** (c) 1999, Dmitry Bayanov >> >>*** RtfPSize() - To get RTF-string with pointed Page Size Settings >>*** JoinRTF() - Join two RTF-documents into one (UnionRTF function is used) >>*** UnionRTF() - RTF-documents union function - create common header and joined text body >>*** RTFCreTab() - Creates RTF-table skeleton code >>*** RtfTab() - Creates RTF-code for MS Word Table Line (to be adde to table skeleton code) >>*** RtfFilRow() - Adding new line to RTF-table and filling it with values >>*** TChar_Wide - To convert Wide in CHARS to wide in PITS (1cm = 567 pit) >>*** TWide_Char - To convert Wide in PITS to wide in CHARS >> >>*** ArrLen - To get Array Length (0 - if not artray) >>*** ArrDel - To delete an element from LOCAL array >>*** aADD - To Add an element to the end of array >> >> >> >>*********************************************************************** >>* To get string with Page Size Settings -> RTF-code for MS Word >>* cCode: "L","P", nPage=0(A4), 1(A3), nmT,nmB,nmL,nmR - ïîëÿ â ñì >>* in DoAnyRap & Make_Rap : >>* nPage=0(A4) npWide=14855,9638 (paperh-margl-margr)16840,1418 >>* nPage=1(A3) npWide=21829,14571(paperh-margl-margr)23814,16840 >>FUNCTION RtfPsize(cOrient,nPage,nmT,nmB,nmL,nmR) >>LOCAL cBuf >>cBuf="" >>IF EMPTY(cOrient) >> cOrient="P" >>ENDIF >>IF EMPTY(nPage) >> nPage=0 && A4 >>ENDIF >>IF !TYPE("nmT")=="N" >> nmT=1.5 >>ENDIF >>IF !TYPE("nmB")=="N" >> nmB=1.7 >>ENDIF >>IF !TYPE("nmL")=="N" >> nmL=2.5 >>ENDIF >>IF !TYPE("nmR")=="N" >> nmR=1.5 >>ENDIF >>DO CASE >> CASE cOrient=="L" .AND. EMPTY(nPage) >> cBuf="\paperw16840\paperh11907\margl"+ALLTRIM(STR(nmL*567))+; >> "\margr"+ALLTRIM(STR(nmR*567))+"\margt"+ALLTRIM(STR(nmT*567))+; >> "\margb"+ALLTRIM(STR(nmB*567))+"\lndscpsxn " >> CASE cOrient=="P" .AND. EMPTY(nPage) >> cBuf="\paperw11907\paperh16840\margl"+ALLTRIM(STR(nmL*567))+; >> "\margr"+ALLTRIM(STR(nmR*567))+"\margt"+ALLTRIM(STR(nmT*567))+; >> "\margb"+ALLTRIM(STR(nmB*567))+" " >> CASE cOrient=="L" .AND. nPage==1 >> cBuf="\paperw23814\paperh16840\margl"+ALLTRIM(STR(nmL*567))+"\margr"+; >> ALLTRIM(STR(nmR*567))+"\margt"+ALLTRIM(STR(nmT*567))+"\margb"+; >> ALLTRIM(STR(nmB*567))+"\lndscpsxn " >> CASE cOrient=="P" .AND. nPage==1 >> cBuf="\paperw16840\paperh23814\margl"+ALLTRIM(STR(nmL*567))+"\margr"+; >> ALLTRIM(STR(nmR*567))+"\margt"+ALLTRIM(STR(nmT*567))+"\margb"+; >> ALLTRIM(STR(nmB*567))+" " >>ENDCASE >>RETURN cBuf >> >> >>************************************************************* >>* Join two RTF-documents into one >>FUNCTION JoinRTF(cText1,cText2,Landscape,nPage,nmT,nmB,nmL,nmR) >>LOCAL cOut,cBuf,cHead,crt1,crt2 >>cHead="" >>cBuf="" >>crt1=cText1 >>crt2=cText2 >>=UnionRTF(@cHead,@crt1,Landscape) >>=UnionRTF(@cHead,@crt2,Landscape) >>cOut=cHead+RtfPsize(IIF(Landscape,"L","P"),nPage,nmT,nmB,nmL,nmR)+crt1+"\par "+crt2+"}" >>RETURN cOut >> >> >>********************************************************************************** >>* RTF-documents union function - create common header and joined text body: >>* Fonts and Colors definition in text body. >>* Input arguments - Common capacited Header cHead and text Body cRTF >>* cRtf - returned by referenca without header, without resulting symbol "}" and >>* with corrected numbers Font, ColorTable (fN,cfN,cbN), >>* in cRTF code we find \deffN\ and {\fN\, insert in header and after all >>* \plain insert \fN in cRTF, if it's not equal Header's Deff >>* (c) Dm.Bayanov, 1998 >>FUNCTION UnionRTF(cHead,cRTF,Landscape,cFontName) >>LOCAL aFont2,aColor2,cHead2,cText2,ni,nj,nk,nCount,cim,aFont0,aColor0, cContr,cDeff >>LOCAL cHPart1,cHPart2,cBuf,lAdd,cBuf1,cBuf2,nBuf1,nBuf2,nParam,cParam,nNum,nDeffH,nDeffT >> >>IF EMPTY(cFontName) >> cFontName="Arial Cyr" >>ENDIF >> >>IF EMPTY(cHead) >> cHead="{\rtf1\ansi\ansicpg1252\deff0\deftab720{\fonttbl{\f0\fswiss "+cFontName+";}}{\colortbl\red0\green0\blue0;}{\info{\author Created by DBRAD32 Report Generator}}" >>ENDIF >> >>IF EMPTY(cRTF) >> cRTF="\viewkind1" >> RETURN .F. >>ENDIF >> >>IF .F. >> DECLARE aFont0(1),aFont2(1),aColor0(1),aColor2(1) >>ENDIF >> >>*** Split Header from text body >>ni=RTFHeadCount(cHead) >>cHead=SUBSTR(cHead,1,ni) >>ni=RTFHeadCount(cRTF) >>cHead2=SUBSTR(cRTF,1,ni) >>cText2=SUBSTR(cRTF,ni+1,LEN(cRTF)-ni) >>cHPart1="" >>cHPart2="" >> >>IF EMPTY(cHead2) .OR. EMPTY(cText2) >> cRTF="" >> RETURN .F. >>ENDIF >> >>*** Find default fonts >>nDeffH="" >>nDeffT="" >>cDeff="" >>ni=AT("\deff",cHead) >>IF ni>0 >> cBuf=SUBSTR(cHead,ni+5,10) >> ni=AT("\",cBuf) >> nDeffH=SUBSTR(cBuf,1,ni-1) >>ENDIF >>ni=AT("\deff",cHead2) >>IF ni>0 >> cBuf=SUBSTR(cHead2,ni+5,10) >> ni=AT("\",cBuf) >> nDeffT=SUBSTR(cBuf,1,ni-1) >>ENDIF >> >>*** Getting Header befor and after fonttbl,colortbl >>**************** cHead ****************** >>** Font cHead processing >>nj=AT("{\fonttbl",cHead) >>IF nj>0 >> ** first part of header cHead1 >> cHPart1=SUBSTR(cHead,1,nj-1) >> nj=nj+9 >> nCount=0 >> lAdd=.F. >> FOR ni=nj TO LEN(cHead) >> cim=SUBSTR(cHead,ni,1) >> nCount=IIF(cim=="{",nCount+1,IIF(cim=="}",nCount-1,nCount)) >> DO CASE >> *** begin of new font >> CASE cim=="{" .AND. nCount==1 >> *** begin of new font >> cBuf="" >> lAdd=.T. >> >> *** End of font >> CASE cim=="}" .AND. nCount==0 >> ** number cutting >> nj=AT("\",cBuf,2) >> cBuf=SUBSTR(cBuf,nj+1,LEN(cBuf)-nj)+"}" >> >> * ***************** font cyrillisation *********** >> * ** "Cyr" word adding >> * IF nCodePage==1251 and. RAT(" Cyr;}",cBuf)==0 >> * cBuf=SUBSTR(cBuf,1,LEN(cBuf)-2)+" Cyr;}" >> * ENDIF >> >> ** adding font in array >> =AADD(@aFont0,cBuf) >> lAdd=.F. >> >> *** font collection process >> CASE lAdd >> cBuf=cBuf+cim >> ENDCASE >> >> *** no more fonts >> IF nCount<0 >> EXIT >> ENDIF >> NEXT >>ENDIF >> >>*** Color cHead processing >>nj=AT("{\colortbl",cHead) >>IF nj>0 >> nj=nj+10 >> cBuf="" >> FOR ni=nj TO LEN(cHead) >> cim=SUBSTR(cHead,ni,1) >> cBuf=cBuf+cim >> *** End of color >> IF cim==";" >> =AADD(@aColor0,cBuf) >> cBuf="" >> ENDIF >> *** no more colors >> IF cim=="}" >> EXIT >> ENDIF >> NEXT >> ** second part of header cHead >> IF ni<LEN(cHead) >> ** no color definition colortbl >> cHPart2=SUBSTR(cHead,ni+1,LEN(cHead)-ni) >> ENDIF >>ENDIF >> >>**************** cHead2 ****************** >>** Font cHead2 processing >>nj=AT("{\fonttbl",cHead2) >>IF nj>0 >> nj=nj+9 && !!! >> nCount=0 >> lAdd=.F. >> FOR ni=nj TO LEN(cHead2) >> cim=SUBSTR(cHead2,ni,1) >> nCount=IIF(cim=="{",nCount+1,IIF(cim=="}",nCount-1,nCount)) >> DO CASE >> *** Begin of new font >> CASE cim=="{" .AND. nCount==1 >> *** Begin of new font >> cBuf="" >> lAdd=.T. >> >> *** End of font >> CASE cim=="}" .AND. nCount==0 >> >> * ***************** font cyrillisation *********** >> * ** "Cyr" word adding >> * IF nCodePage==1251 and. RAT(" Cyr;",cBuf)==0 >> * cBuf=SUBSTR(cBuf,1,LEN(cBuf)-1)+" Cyr;" >> * ENDIF >> >> ** adding font in array >> =AADD(@aFont2,"{"+cBuf+"}") >> lAdd=.F. >> >> *** font linking >> CASE lAdd >> cBuf=cBuf+cim >> ENDCASE >> *** no more fonts >> IF nCount<0 >> EXIT >> ENDIF >> NEXT >>ENDIF >> >>*** Color cHead2 processing >>nj=AT("{\colortbl",cHead2) >>IF nj>0 >> nj=nj+10 >> cBuf="" >> FOR ni=nj TO LEN(cHead2) >> cim=SUBSTR(cHead2,ni,1) >> cBuf=cBuf+cim >> *** end of color >> IF cim==";" >> =AADD(@aColor2,cBuf) && adding color in array >> cBuf="" >> ENDIF >> *** no more colors >> IF cim=="}" >> EXIT >> ENDIF >> NEXT >>ENDIF >> >>****************** Passing through RTF-texts and Font & Color parameters union >>******************************* RTFtext ************************************** >>** RTF - fonts searching and correction >>nCount=1 >>DO WHILE .T. >> ni=AT("\f",cText2,nCount) >> IF ni>0 && somethig was found - check in parameter >> nCount=nCount+1 >> nBuf1=ni-1 && last char number before Control >> ni=ni+2 && LEN(control+1) >> cim=SUBSTR(cText2,ni,1) >> IF ISDIGIT(cim) && font number digit - font definition was found >> cParam="" >> *** Font number correction in text >> DO WHILE .T. >> cim=SUBSTR(cText2,ni,1) >> ni=ni+1 >> IF ISDIGIT(cim) >> cParam=cParam+cim >> ELSE >> EXIT >> ENDIF >> ENDDO >> nBuf2=ni-1 >> *** searching font definition "\f"+cParam+"\" in aFont array >> SET EXACT OFF >> nj=ASCAN(aFont2,"{\f"+cParam+"\") >> SET EXACT ON >> IF nj>0 >> cBuf=aFont2[nj] >> ** number cutting >> nj=AT("\",cBuf,2) >> cBuf=SUBSTR(cBuf,nj+1,LEN(cBuf)-nj) >> *** check in if exist such font in common aFont0 array >> nj=0 >> IF ArrLen(@aFont0)>0 >> nj=ASCAN(aFont0,cBuf) >> ENDIF >> ** ok - this number exists >> IF nj>0 >> nNum=nj-1 >> ELSE >> =AADD(@aFont0,cBuf) >> nNum=ArrLen(@aFont0)-1 >> ENDIF >> ** number correction in text >> cText2=SUBSTR(cText2,1,nBuf1)+; >> "\f"+ALLTRIM(STR(nNum))+; >> SUBSTR(cText2,nBuf2,LEN(cText2)-nBuf2+1) >> ENDIF >> ELSE >> LOOP && it's not font >> ENDIF >> ELSE >> EXIT >> ENDIF >>ENDDO >> >>** RTF - Font Colors searching and correction >>nCount=1 >>DO WHILE .T. >> ni=AT("\cf",cText2,nCount) >> IF ni>0 && somethig was found - check in parameter >> nCount=nCount+1 >> nBuf1=ni-1 && last char number before Control >> ni=ni+3 && LEN(control+1) >> cim=SUBSTR(cText2,ni,1) >> IF ISDIGIT(cim) && color number digit - color definition was found >> cParam="" >> *** Color number correction in text >> DO WHILE .T. >> cim=SUBSTR(cText2,ni,1) >> ni=ni+1 >> IF ISDIGIT(cim) >> cParam=cParam+cim >> nParam=VAL(cParam)+1 >> ELSE >> EXIT >> ENDIF >> ENDDO >> nBuf2=ni-1 >> *** Color definition - in aColor2 array >> IF nParam<=ArrLen(@aColor2) >> cBuf=aColor2[nParam] >> *** check in if exist such Color in common aColor0 array >> nj=0 >> IF ArrLen(@aColor0)>0 >> nj=ASCAN(aColor0,cBuf) >> ENDIF >> ** such color is exist >> IF nj>0 >> nNum=nj-1 >> ELSE >> =AADD(@aColor0,cBuf) >> nNum=ArrLen(@aColor0)-1 >> ENDIF >> cBuf="\cf"+ALLTRIM(STR(nNum)) >> *** bad color number >> ELSE >> cBuf="" >> ENDIF >> ** number correction in text >> cText2=SUBSTR(cText2,1,nBuf1)+cBuf+SUBSTR(cText2,nBuf2,LEN(cText2)-nBuf2+1) >> ELSE >> LOOP && it is not color >> ENDIF >> ELSE >> EXIT >> ENDIF >>ENDDO >> >>** RTF - Colors Back searching and correction >>nCount=1 >>DO WHILE .T. >> ni=AT("\cb",cText2,nCount) >> IF ni>0 && somethig was found - check in parameter >> nCount=nCount+1 >> nBuf1=ni-1 && last char number before Control >> ni=ni+3 && LEN(control+1) >> cim=SUBSTR(cText2,ni,1) >> IF ISDIGIT(cim) && color number digit - color definition was found >> cParam="" >> *** Color number correction in text >> DO WHILE .T. >> cim=SUBSTR(cText2,ni,1) >> ni=ni+1 >> IF ISDIGIT(cim) >> cParam=cParam+cim >> nParam=VAL(cParam)+1 >> ELSE >> EXIT >> ENDIF >> ENDDO >> nBuf2=ni-1 >> *** Color definition - in aColor2 array >> IF nParam<=ArrLen(@aColor2) >> cBuf=aColor2[nParam] >> *** check in if exist such Color in common aColor0 array >> nj=0 >> IF ArrLen(@aColor0)>0 >> nj=ASCAN(aColor0,cBuf) >> ENDIF >> ** such color is exist >> IF nj>0 >> nNum=nj-1 >> ELSE >> =AADD(@aColor0,cBuf) >> nNum=ArrLen(@aColor0)-1 >> ENDIF >> cBuf="\cb"+ALLTRIM(STR(nNum)) >> *** bad color number >> ELSE >> cBuf="" >> ENDIF >> ** number correction in text >> cText2=SUBSTR(cText2,1,nBuf1)+cBuf+SUBSTR(cText2,nBuf2,LEN(cText2)-nBuf2+1) >> ELSE >> LOOP && it is not color >> ENDIF >> ELSE >> EXIT >> ENDIF >>ENDDO >> >>** RTF - HightLight Colors searching and correction >>nCount=1 >>DO WHILE .T. >> ni=AT("\highlight",cText2,nCount) >> IF ni>0 && somethig was found - check in parameter >> nCount=nCount+1 >> nBuf1=ni-1 && last char number before Control >> ni=ni+10 && LEN(control+1) >> cim=SUBSTR(cText2,ni,1) >> IF ISDIGIT(cim) && color number digit - color definition was found >> cParam="" >> *** Color number correction in text >> DO WHILE .T. >> cim=SUBSTR(cText2,ni,1) >> ni=ni+1 >> IF ISDIGIT(cim) >> cParam=cParam+cim >> nParam=VAL(cParam)+1 >> ELSE >> EXIT >> ENDIF >> ENDDO >> nBuf2=ni-1 >> *** Color definition - in aColor2 array >> IF nParam<=ArrLen(@aColor2) >> cBuf=aColor2[nParam] >> *** check in if exist such Color in common aColor0 array >> nj=0 >> IF ArrLen(@aColor0)>0 >> nj=ASCAN(aColor0,cBuf) >> ENDIF >> ** such color is exist >> IF nj>0 >> nNum=nj-1 >> ELSE >> =AADD(@aColor0,cBuf) >> nNum=ArrLen(@aColor0)-1 >> ENDIF >> cBuf="\highlight"+ALLTRIM(STR(nNum)) >> *** bad color number >> ELSE >> cBuf="" >> ENDIF >> ** number correction in text >> cText2=SUBSTR(cText2,1,nBuf1)+cBuf+SUBSTR(cText2,nBuf2,LEN(cText2)-nBuf2+1) >> ELSE >> LOOP && it is not color >> ENDIF >> ELSE >> EXIT >> ENDIF >>ENDDO >> >>*** deffN - defaul font definition correction in text >>IF !EMPTY(nDeffH+nDeffT) .AND. ArrLen(@aFont2)>0 >> *** search font definition "\f"+nDEffT+"\" for header >> nDeffH=aFont0[VAL(nDeffH)+1] && ôîíò â çàãîëîâêå >> *** search font definition "\f"+nDEffT+"\" for text >> SET EXACT OFF >> nj=ASCAN(aFont2,"{\f"+nDeffT+"\") >> SET EXACT ON >> IF nj>0 >> nDeffT=aFont2[nj] && font in text >> ENDIF >> *** will add this font in header and insert it's number in text >> IF nj>0 .AND. !nDeffT==nDeffH && fonts are different ! >> cBuf=nDeffT >> ** number cutting >> nj=AT("\",cBuf,2) >> cBuf=SUBSTR(cBuf,nj+1,LEN(cBuf)-nj) >> *** check in if exist such Font in common aFont0 array >> nj=0 >> IF ArrLen(@aFont0)>0 >> nj=ASCAN(aFont0,cBuf) >> ENDIF >> ** Such is exist >> IF nj>0 >> nNum=nj-1 >> ELSE >> =AADD(@aFont0,cBuf) >> nNum=ArrLen(@aFont0)-1 >> ENDIF >> cDeff="\plain\f"+ALLTRIM(STR(nNum)) && +" " >> *** will insert \fN in cText2 after \plain >> cText2=STRTRAN(cText2,"\plain",cDeff) >> ENDIF >>ENDIF >> >> >>************* Common header cHead0 linking ************ >> >>*** Fonts definition >>cHead=cHPart1+"{\fonttbl" >>FOR ni=1 TO ArrLen(@aFont0) >> cBuf=aFont0[ni] >> * IF nCodePage==1251 && Russian >> * ***************** Fonts cyrillisation *********** >> * ** replacement \fcharset shift with russian 204 >> * cBuf=AllStuff(cBuf,"\fcharset","\fcharset204",.t.) >> * cHead=cHead+"{\f"+ALLTRIM(STR(ni-1))+"\"+cBuf >> * ENDIF >>NEXT >>cHead=cHead+"}" >> >>*** Colors definition >>cHead=cHead+"{\colortbl" >>FOR ni=1 TO ArrLen(@aColor0) >> cHead=cHead+aColor0[ni] >>NEXT >>cHead=cHead+"}"+cHPart2 >>cHead=cHead+"{\info{\author Created by DBRAD32 Report Generator}}" >> >>************* Common text cText2 linking ************ >>** viewkind1 - to enabling vertical text in Word >>** viewzk2 - autoscale, otherwise - 100% >>* cText2="\viewkind1\viewzk2"+cText2 >>cText2="\viewkind1"+cText2 >>** Styles pointers deleting StyleSheet - \sNN >>cText2=AllStuff(cText2,"\s","",.T.) >>** Set DocumentView mode in 1 (Page Layout View) >>cText2=AllStuff(cText2,"\viewkind","\viewkind1",.T.) >>** Page settings deleting >>cText2=AllStuff(cText2,"\paperw","",.T.) >>cText2=AllStuff(cText2,"\paperh","",.T.) >>cText2=AllStuff(cText2,"\margl","",.T.) >>cText2=AllStuff(cText2,"\margr","",.T.) >>cText2=AllStuff(cText2,"\margt","",.T.) >>cText2=AllStuff(cText2,"\margb","",.T.) >>cText2=AllStuff(cText2,"\lndscpsxn","",.F.) >>IF Landscape >> cText2=AllStuff(cText2,"\sectd\","\sectd\lndscpsxn\",.F.) >> cText2=AllStuff(cText2,"\sectd ","\sectd\lndscpsxn ",.F.) >>ENDIF >>*** Resulting char "}" cutting in RTF text >>nj=RAT("}",cText2) >>cText2=SUBSTR(cText2,1,nj-1) >>cRTF=cText2 >>RETURN .T. >> >> >>**************************************************************** >>** Searching and replacement substring [cContr] in text [cRtfText] >>* lDigit==.t. - cContr with digital parameter >>FUNCTION AllStuff(cText,cContr,cNew,lDigit) >>LOCAL ni,nBuf1,nBuf2,cim,cOut1,nCount,cOut2 >>cOut1="" >>cOut2=cText >>IF EMPTY(cNew) >> cNew="" >>ENDIF >>** search \contr >>DO WHILE .T. >> ni=AT(cContr,cOut2,1) >> IF ni>0 && smth was found - check by parameter >> nBuf1=ni-1 && last digit number before Control >> ** search with digital parameter >> IF lDigit >> ni=ni+LEN(cContr) >> cim=SUBSTR(cOut2,ni,1) >> nBuf2=ni-1 >> IF ISDIGIT(cim) && next char - digit ? >> *** Full number collecting >> DO WHILE ISDIGIT(cim) >> cim=SUBSTR(cOut2,ni,1) >> ni=ni+1 >> ENDDO >> nBuf2=ni-1 >> ** Replace/delete in text >> cOut1=cOut1+SUBSTR(cOut2,1,nBuf1)+cNew >> cOut2=SUBSTR(cOut2,nBuf2) >> ELSE >> ** replace in text >> cOut1=cOut1+SUBSTR(cOut2,1,nBuf2) >> cOut2=SUBSTR(cOut2,nBuf2+1) >> ENDIF >> ** exuct search >> ELSE && !lDigit >> nBuf2=ni+LEN(cContr) >> ** Replace/delete in text >> cOut1=cOut1+SUBSTR(cOut2,1,nBuf1)+cNew >> cOut2=SUBSTR(cOut2,nBuf2) >> ENDIF && lDigit >> ELSE >> EXIT >> ENDIF >>ENDDO >>RETURN cOut1+cOut2 >> >> >>******************************************************************* >>*** Creates RTF-code for MS Word Table Line >>** @aRow(7): >>** aRow[1] - Cell value (character) >>** aRow[2] - Cell Width (ñm) >>** aRow[3] - Font Size (def=10) >>** aRow[4] - Alignment: Center,Left,Right (def="c") >>** aRow[5] - Bold (def=.f.) >>** aRow[6] - Italic (def=.f.) >>** aRow[7] - Vertical text (def=.f.) >>*** [lHeader] - this flag means that Line is a Table Header and will (def=.f.) >>*** [nMargin] - Left table margin in cm (def=0) >>*** [nMinHeight] - Minimal Height for vertical text case ( aRow[7]==.t. ) >>*** [lDoubleLine] - Double (vs. single) separate line between header and table body >>*** [lcUnVisible] - Hidden lines from mentioned as string "tblrhv" , .t. - âñå >>FUNCTION RtfTab(aRow,lHeader,nMargin,nMinHeight,lDoubleLine,lcUnvisible) >>LOCAL cOut,ni,nWide,cAlin,cFontSize,cMinh, cDop1,cDop2,nTol >>IF .F. >> DECLARE aRow(1,1) >>ENDIF >>IF !ArrLen(@aRow,.T.) == 7 >> RETURN "\par RtfTab()- Wrong cells array length ! \par" >>ENDIF >>IF TYPE("lcUnVisible")=="C" >> lcUnvisible=LOWER(lcUnvisible) >>ELSE >> lcUnvisible=IIF(EMPTY(lcUnvisible),"","tblrhv") >>ENDIF >>IF TYPE("nMargin")=="N" >> nMargin=nMargin*567 >>ELSE >> nMargin=0 >>ENDIF >>nWide=0 >>cMinh="" >>IF TYPE("nMinHeight")=="N" >> cMinh="\trrh"+ALLTRIM(STR(nMinHeight*567)) >>ENDIF >>** ôîðìèðîâàíèå ñêåëåòà òàáëèöû >>cOut=CRLF+"\plain\lang1049\trowd\trgaph50"+cMinh+"\trleft"+ALLTRIM(STR(nMargin))+IIF(lHeader,"\trhdr","")+"\trkeep\deflang1049"+CRLF+; >> IIF("t"$lcUnvisible,"","\trbrdrt\brdrs\brdrw10")+; >> IIF("l"$lcUnvisible,"","\trbrdrl\brdrs\brdrw10")+; >> IIF("b"$lcUnvisible,"","\trbrdrb\brdrs\brdrw10")+; >> IIF("r"$lcUnvisible,"","\trbrdrr\brdrs\brdrw10")+; >> IIF("h"$lcUnvisible,"","\trbrdrh\brdrs\brdrw10")+; >> IIF("v"$lcUnvisible,"","\trbrdrv\brdrs\brdrw10")+; >> "\clvertalt"+CRLF >> >>FOR ni=1 TO ArrLen(@aRow) >> IF aRow[ni,2]==0 .OR. aRow[ni,2] < 0.0001 >> LOOP >> ENDIF >> ** Wideth count >> nWide=nWide+aRow[ni,2]*567 >> cOut=cOut+; >> IIF("t"$lcUnvisible,"","\clbrdrt\brdrs\brdrw10")+; >> IIF("l"$lcUnvisible,"","\clbrdrl\brdrs\brdrw10")+; >> IIF("b"$lcUnvisible,"","\clbrdrb\brdrs\brdrw10")+; >> IIF("r"$lcUnvisible,"","\clbrdrr\brdrs\brdrw10")+; >> IIF(aRow[ni,7],"\cltxbtlr","\cltxlrtb")+; >> "\cellx"+ALLTRIM(STR(nWide+nMargin))+"\clvertalt"+CRLF >>NEXT >>cOut=cOut+"\cgrid" >>IF lDoubleLine >> cOut=cOut+"\trbrdrh\brdrdb" >>ENDIF >>cOut=cOut+"\pard\intbl{" >>** Cells filling in >>FOR ni=1 TO ArrLen(@aRow) >> IF aRow[ni,2]==0 .OR. aRow[ni,2] < 0.0001 >> LOOP >> ENDIF >> cDop1=IIF(aRow[ni,7],"{\pard\li50\ri50\intbl","") >> cDop2=IIF(aRow[ni,7],"}","") >> cAlin="\q"+IIF(EMPTY(aRow[ni,4]),"r",LOWER(aRow[ni,4])) >> cFontSize="\fs"+IIF(EMPTY(aRow[ni,3]),"20",ALLTRIM(STR(2*aRow[ni,3],4,0))) >> cOut=cOut+cDop1+"\plain"+cFontSize+cAlin+IIF(!EMPTY(aRow[ni,5]),"\b","")+IIF(!EMPTY(aRow[ni,6]),"\i","")+" "+aRow[ni,1]+"\cell "+cDop2+CRLF >>NEXT >>cOut=cOut+"}{\row }\pard" >>IF lDoubleLine >> cOut=cOut+"\trbrdrh\brdrs " >>ENDIF >>cOut=cOut+CRLF >>RETURN cOut >> >> >>************************************************************************** >>* Creates RTF-table skeleton >>* @aWide[nWide] , aWide[1]=Len cm, aWide[2]=lVert >>* @noWide - Table Width >>* code RTF is returned from this function >>*** [cUnVisible] - Hidden lines from mentioned string as - "tblrhv" >>FUNCTION RTFCreTab(aWide,nSize,noWide,nMargin,lHead,nMinHeight,cUnvisible) >>LOCAL ni,cBuf,nWide,nBuf,nMargin,cMinh >>IF .F. >> DECLARE aWide(ArrLen(@aWide)) >>ENDIF >>IF TYPE("cUnVisible")=="C" >> cUnvisible=LOWER(cUnvisible) >>ELSE >> cUnvisible=IIF(EMPTY(cUnvisible),"","tblrhv") >>ENDIF >>IF EMPTY(nSize) >> nSize=12 >>ENDIF >>IF TYPE("nMargin")=="N" >> nMargin=nMargin*567 >>ELSE >> nMargin=0 >>ENDIF >>cMinh="" >>IF TYPE("nMinHeight")=="N" >> cMinh="\trrh"+ALLTRIM(STR(nMinHeight*567)) >>ENDIF >> >>cBuf="\trowd\trgaph50"+cMinh+"\trleft"+ALLTRIM(STR(nMargin))+IIF(lHead,"\trhdr","")+"\deflang1049"+CRLF+; >> IIF("t"$cUnvisible,"","\trbrdrt\brdrs\brdrw10")+; >> IIF("b"$cUnvisible,"","\trbrdrb\brdrs\brdrw10")+; >> IIF("r"$cUnvisible,"","\trbrdrr\brdrs\brdrw10")+; >> IIF("l"$cUnvisible,"","\trbrdrl\brdrs\brdrw10")+; >> IIF("h"$cUnvisible,"","\trbrdrh\brdrs\brdrw10")+; >> IIF("v"$cUnvisible,"","\trbrdrv\brdrs\brdrw10")+; >> "\clvertalt"+CRLF >> >>nWide=0 >>noWide=0.0 >>FOR ni=1 TO ArrLen(@aWide) >> IF aWide[ni,1]==0 .OR. aWide[ni,1] < 0.0001 >> LOOP >> ENDIF >> ** Wide Count >> noWide=noWide+aWide[ni,1] >> nWide=nWide+aWide[ni,1]*567 >> cBuf=cBuf+; >> IIF(!EMPTY(cMinh).AND.aWide[ni,2],"\cltxbtlr","\cltxlrtb")+; >> IIF("t"$cUnvisible,"","\clbrdrt\brdrs\brdrw10")+; >> IIF("b"$cUnvisible,"","\clbrdrb\brdrs\brdrw10")+; >> IIF("l"$cUnvisible,"","\clbrdrl\brdrs\brdrw10")+; >> IIF("r"$cUnvisible,"","\clbrdrr\brdrs\brdrw10")+; >> "\cellx"+ALLTRIM(STR(nWide+nMargin))+"\clvertalt"+CRLF >>NEXT >>cBuf=cBuf+"\cgrid\plain\lang1049\fs"+ALLTRIM(STR(nSize*2))+" "+CRLF >>RETURN cBuf >> >> >>**************************************************************** >>** To convert Wide in CHARS to wide in PITS (1cm = 567 pit) >>FUNC TChar_Wide(cFont,nFont,nChars) >>LOCAL nWide >>IF nChars==0 >> RETURN 0 >>ENDIF >>** Wide count >>nChars=IIF(nChars<1,1,nChars) >>nWide=FONTMETRIC(6,cFont,nFont)*nChars*25+100 && [trgaph50+nWide+trgap50] >>RETURN nWide >> >>************************************ >>** To convert Wide in PITS to wide in CHARS >>FUNC TWide_Char(cFont,nFont,nWide) >>LOCAL nChars >>IF nWide==0 >> RETURN 0 >>ENDIF >>** Wide count in chars >>nChars=(nWide-100)/(FONTMETRIC(6,cFont,nFont)*25) >>RETURN nChars >> >> >>*********************************************************************** >>* Adding new line to RTF-table and filling it with values - from aRow array >>* @aRow[cValue,cAlingmentType(c/l/r),nWide,fsize,bold,italic,vert] >>FUNCTION RtfFilRow(aRow,lHeader,lBold,lItalic,nStart,nStop,nSize) >>LOCAL ni,cBuf,cAlin,cFont,lSluz,cDop1,cDop2 >>IF .F. >> DECLARE aRow(1,6) >>ENDIF >>cBuf="" >>cFont="" >>IF lHeader >> cBuf=cBuf+"\trbrdrh\brdrdb" >>ENDIF >>cBuf=cBuf+"\pard\intbl{" >>IF !TYPE("nStart")=="N" >> nStart=1 >>ENDIF >>IF !TYPE("nStop")=="N" >> nStop=ArrLen(@aRow) >>ENDIF >>FOR ni=nStart TO nStop >> ** skip zero-width >> IF TYPE("aRow[ni,3]")=="N" >> IF aRow[ni,3]==0 >> LOOP >> ENDIF >> ENDIF >> IF !TYPE("aRow[ni,5]")=="L" >> aRow[ni,5]=.F. >> ENDIF >> IF !TYPE("aRow[ni,6]")=="L" >> aRow[ni,6]=.F. >> ENDIF >> >> IF TYPE("aRow[ni,4]")=="N" >> cFont="\fs"+ALLTRIM(STR(2*aRow[ni,4],2,0)) >> ELSE >> IF TYPE("nSize")=="N" >> cFont="\fs"+ALLTRIM(STR(2*nSize,2,0)) >> lSluz=.T. >> ELSE >> lSluz=.F. >> ENDIF >> ENDIF >> >> cDop1=IIF(aRow[ni,7],"{\pard\li50\ri50\intbl","") >> cDop2=IIF(aRow[ni,7],"}","") >> cAlin="\q"+IIF(EMPTY(aRow[ni,2]),"r",LOWER(aRow[ni,2])) >> cBuf=cBuf+cDop1+"\plain"+cFont+cAlin+IIF((lSluz.AND.lBold).OR.aRow[ni,5],"\b","")+IIF(!lSluz.AND.(lItalic.OR.aRow[ni,6]),"\i","")+" "+aRow[ni,1]+"\cell "+cDop2+CRLF >> >>NEXT >>cBuf=cBuf+"}{\row }\pard" >>IF lHeader >> cBuf=cBuf+"\trbrdrh\brdrs " >>ENDIF >>cBuf=cBuf+CRLF >>RETURN cBuf >> >> >>************************************* >>*** To count number of bytes in RTF-text Header >>FUNCTION RTFHeadCount(cRTF) >>LOCAL nCount,nj >>nj=AT("{\info",cRTF) >>IF nj==0 >> nj=AT("{\revtbl",cRTF) >>ENDIF >>IF nj==0 >> nj=AT("{\listtables",cRTF) >>ENDIF >>IF nj==0 >> nj=AT("{\stylesheet",cRTF) >>ENDIF >>IF nj==0 >> nj=AT("{\colortbl",cRTF) >>ENDIF >>IF nj==0 >> nj=AT("{\filetbl",cRTF) >>ENDIF >>IF nj==0 >> nj=AT("{\fonttbl",cRTF) >>ENDIF >>nCount=0 >>FOR ni=nj TO LEN(cRTF) >> cim=SUBSTR(cRTF,ni,1) >> nCount=IIF(cim=="{",nCount+1,IIF(cim=="}",nCount-1,nCount)) >> IF nCount==0 >> EXIT >> ENDIF >>NEXT >>RETURN ni >> >> >> >>********************************************************************************* >>*** To get Array Length (0 - if not artray) >>*** l2 - to get length of second dimension >>*** call aName_ as a referenced parameter ! (like ArrLen(@aArray) ) >>*** (c) Dm.Bayanov , 1998 >>FUNCTION ArrLen(aName_,l2) >>LOCAL nLen >>IF .F. >> DECLARE aName_(1) >>ENDIF >>nLen=0 >>IF !TYPE("aName_[1]")=="U" && Boo ! >> IF l2 >> nLen=ALEN(aName_,2) >> ELSE >> nLen=ALEN(aName_,1) >> ENDIF >> nLen=IIF(nLen==1.AND.ISNULL(aName_[1]),0,nLen) >>ENDIF >>RETURN nLen >> >>*********************************************************************************** >>** Delete ni element from LOCAL array, n2 - second dimension length (should be pointed) >>** @aName ! >>FUNCTION ArrDel(aName,ni,n2) >>IF ArrLen(@aName)==1 .AND. ni==1 >> aName[1]=NULL >>ELSE >> IF ni<=ArrLen(@aName) >> ADEL(aName,ni) >> IF TYPE("n2")=="N" >> DECLARE aName(ArrLen(@aName)-1,n2) >> ELSE >> DECLARE aName(ArrLen(@aName)-1) >> ENDIF >> ENDIF >>ENDIF >>RETURN >> >> >>********************************************************************************** >>*** To Add element to the end of array @aNameAr >>*** xVal - added value, nLen2 - second dimension length >>FUNCTION AADD(aNameAr,xVal,nLen2) >>LOCAL nLen,nBuf >>nLen=ArrLen(@aNameAr) >>nLen2=IIF(EMPTY(nLen2),0,nLen2) >>IF nLen==0 >> *** 2-nd dimension length >> IF nLen2>0 >> DECLARE aNameAr(1,nLen2) >> aNameAr[1,1]=xVal >> ELSE >> DECLARE aNameAr(1) >> aNameAr[1]=xVal >> ENDIF >>ELSE >> nBuf=ArrLen(@aNameAr,.T.) >> nLen2=IIF(nBuf>0,nBuf,nLen2) >> *** 2-nd dimension length >> IF nLen2>0 >> DECLARE aNameAr(nLen+1,nLen2) >> aNameAr[nLen+1,1]=xVal >> ELSE >> DECLARE aNameAr(nLen+1) >> aNameAr[nLen+1]=xVal >> ENDIF >>ENDIF >>RETURN .T. >> >>