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.
>
>