no i dont think, i think that this is only array name selected by programmer.
if you see FUNCTION JoinRTF, two line is in it
=UnionRTF(@cHead,@crt1,Landscape)
=UnionRTF(@cHead,@crt2,Landscape)
first line run correctly, but this error occure when second line run.
>I haven't seen this code before, but my guess is that you must add a line like
afont(afont0) to populate an array of available fonts.
>
>>thanks for your attention
>>in below section, at the last line.
>>
>>*** 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 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.
>>
>> *** will add this font in header and insert it's number in text
>> 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.
>>>>
>>>>