thanks for your attention
in below section, at the last line.
IF !EMPTY(nDeffH+nDeffT) .AND. ArrLen(@aFont2)>0
nDeffH=aFont0[VAL(nDeffH)+1]
Error Message is : File 'aFont0' does not exist.
if found this remarked line in this function:
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.
IF nj>0 .AND. !nDeffT==nDeffH
>Which line gives the error?
>
>>Thank you dear sergey,
>>When i test this useful function, i get an error, but if i ignor it, the result is correct!
>>Can you see this please?
>>unfortunatly his website address is rong.
>>
>>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
>>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)
>> 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
>> nCount=nCount+1
>> nBuf1=ni-1
>> ni=ni+2
>> cim=SUBSTR(cText2,ni,1)
>> IF ISDIGIT(cim)
>> 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
>> ENDIF
>> ELSE
>> EXIT
>> ENDIF
>>ENDDO
>>
>>** RTF - Font Colors searching and correction
>>nCount=1
>>DO WHILE .T.
>> ni=AT("\cf",cText2,nCount)
>> IF ni>0
>> nCount=nCount+1
>> nBuf1=ni-1
>> ni=ni+3
>> cim=SUBSTR(cText2,ni,1)
>> IF ISDIGIT(cim)
>> 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
>> ENDIF
>> ELSE
>> EXIT
>> ENDIF
>>ENDDO
>>
>>** RTF - Colors Back searching and correction
>>nCount=1
>>DO WHILE .T.
>> ni=AT("\cb",cText2,nCount)
>> IF ni>0
>> nCount=nCount+1
>> nBuf1=ni-1
>> ni=ni+3
>> cim=SUBSTR(cText2,ni,1)
>> IF ISDIGIT(cim)
>> 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
>> ENDIF
>> ELSE
>> EXIT
>> ENDIF
>>ENDDO
>>
>>** RTF - HightLight Colors searching and correction
>>nCount=1
>>DO WHILE .T.
>> ni=AT("\highlight",cText2,nCount)
>> IF ni>0
>> nCount=nCount+1
>> nBuf1=ni-1
>> ni=ni+10
>> cim=SUBSTR(cText2,ni,1)
>> IF ISDIGIT(cim)
>> 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
>> 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]
>> ENDIF
>> *** will add this font in header and insert it's number in text
>> IF nj>0 .AND. !nDeffT==nDeffH
>> 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
>> * ***************** 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
>> nBuf1=ni-1
>> ** search with digital parameter
>> IF lDigit
>> ni=ni+LEN(cContr)
>> cim=SUBSTR(cOut2,ni,1)
>> nBuf2=ni-1
>> IF ISDIGIT(cim)
>> *** 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
>> nBuf2=ni+LEN(cContr)
>> ** Replace/delete in text
>> cOut1=cOut1+SUBSTR(cOut2,1,nBuf1)+cNew
>> cOut2=SUBSTR(cOut2,nBuf2)
>> ENDIF
>> 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
>>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"
>> 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.
>>
>>