>>*** 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] && ôîíò â çàãîëîâêå >>>>
>>IF .F. >> DECLARE aFont0(1),aFont2(1),aColor0(1),aColor2(1) >>ENDIF >>>>when 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 ! >>>>
>>>>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. >>>> >>>>