FiveTech Software tech support forums

by **FARLEY RIBEIRO** » Thu Sep 25, 2008 8:29 pm

Hello, everyone,

Thanks to Kleyber by Tword indicate the class.

The examples found in the forum are restricted to fill in the fields of a document ready, like a mail merge.

Now I want to convert a text file for standard word (doc, rtf), but with some settings that I will pass this text file, such as color, font, size, etc..

Ex: LIST OF CUSTOMERS
I would like to Source Arial, 20, Blue color, bold, italic, underline.

I tried this way and not succeeded.
DEFINE FONT oFont1 NAME 'Arial' SIZE 0, -12 OF oWord
oWord: Say (2, 45, 'Class TWORD Say method. Displays text in a box.', oFont1)

Someone could help me or suggest any hint.

Grateful

Farley

by **Antonio Linares** » Fri Oct 03, 2008 10:49 am

Farley,

Whats the Class TWord source code that you are using ?

Please copy it here, thanks

by **FARLEY RIBEIRO** » Mon Oct 06, 2008 2:17 pm

Antônio,

See the source of class tword that I use.

Code: Select all Expand view: // Clase TWord // Mira el documento TWord.doc para información // 2003 Sebastián Almirón /* 5-Diciembre-2003 Clase TWord Modificada por : Víctor Manuel Tomás Díaz [ Vikthor ] vikthor@creswin.com He quitado todas las llamadas a las funciones OleGetProperty() , OleSetProperty() , OleInvoke(). Ahora es usada la clase TOleAuto() y sus Metodos :Get , :Set , :Invoke ++ METHOD Sendmail( lAttach ) ++ METHOD HeaderFooter( nOption ) ++ METHOD OpenDataSource( cFile ) ++ METHOD AddField( cField ) ++ METHOD WebPagePreview() 09-Mar-2004 ++ Data oTables ++ METHOD AddTables() 08-Jun-2004 ++ METHOD View( nView ) oWord:View( 1 ) Vista Normal oWord:View( 3 ) Vista Diseño oWord:View( 6 ) Vista Web ++ METHOD Zoom( nPercent ) 03-Dic-2004 ** Modificación al Metodo New usando TRY y CATCH para recuperar una instacia abierta crearla o enviar un mensaje de error. */ #include "FiveWin.Ch" #define TAB chr(9) #define ENTER chr(13) #define ALI_LEFT 0 #define ALI_CENTER 1 #define ALI_RIGHT 2 #define ALI_JUSTIFY 3 #define LOGPIXELSX 88 #define LOGPIXELSY 90 // Registros y delimitadores de campos de la estructura GTF #define SP_REG Chr( 5 ) #define SP_FIELD Chr( 7 ) #define TP_FONT Chr( 15 ) #define TP_COLOR Chr( 16 ) #define TP_ALIGN Chr( 17 ) // Identificador y versión de las ficheros GTF #define FORMAT_TEXT_TYPE "GTF" #define FORMAT_TEXT_VERSION "1" // LA CLASE TWORD CLASS TWord DATA oWord DATA oDocs DATA oActiveDoc DATA oTexto DATA oSelection DATA cNombreDoc DATA nLinea,nCol, nPage DATA nYoffset, nXoffset DATA lstartpag DATA oLastSay DATA lOverflowing DATA nlastrow DATA cTextOverflow DATA lSetCm DATA oOptions // Objeto Options DATA oMailMerge // Combinar correspondencia DATA oDataSource // Objeto MailMergeDataSource DATA oDataFields // Objeto MailMergeDataFields DATA oFields // Objeto MailMergeFields DATA oTables // Objeto Tables DATA lWord METHOD AddImagen( nTop, nLeft, nBottom, nRight, cImagen, alinea, ntipo, nrotacion ) METHOD addtabulador(npos, ocuadrotext) METHOD Box( nTop, nLeft, nBottom, nRight, afondo, alinea, ntipo, nrotation, lsimple ) METHOD close() METHOD CmSay( nLin,nCol,cTexto,oFuente,nSizeHorz,nClrText,nBkMode,nPad, naltura, nColorIndex, lVertAdjust ) METHOD CheckSpelling() METHOD End() METHOD EndPage() METHOD FillRect( aRect, oBrush ) METHOD GetTextHeight( oFont ) METHOD GetTextWidth(cText, oFont) METHOD GoBottom() INLINE ::oTexto:Invoke( 'EndKey', 6) METHOD GoTop() INLINE ::oTexto:Invoke( 'HomeKey', 6) METHOD JustificaDoc( nJustify, otext ) METHOD Line( nTop, nLeft, nBottom, nRight, oPen, nColor, nStyle ) METHOD New() METHOD NewDoc( cNombreDoc ) METHOD nLogPixelX() INLINE 55.38 METHOD nLogPixelY() INLINE 55.38 METHOD OpenDoc( cNombreDoc ) METHOD Preview() METHOD PrintDoc(lbackground, lappend, nRange, cOutputFile, nfrom, nto, nitem, ncopias, cpages) METHOD Protect(cpassword,nmodo) METHOD Replace( cOld, cNew ) METHOD Combinar( cWildCards ) METHOD Save(cnombredoc) METHOD Say( nLin,nCol,cTexto,oFuente,nSizeHorz,nClrText,nBkMode,nPad, naltura, nColorIndex, lvertadjust ) METHOD Say2( nLin,nCol,cTexto,oFuente, nSize, lBold, lShadow, nColor ) METHOD SayGTF( nTop,nLeft, cTextFormat, nBottom,nRight ) METHOD SetCm() METHOD SetHeader() METHOD SetLandScape() METHOD SetMainDoc() METHOD SetPortrait() METHOD SetUl() METHOD StartPage() METHOD TabClearAll(ocuadrotext) METHOD TabPredeterminado(ncada) METHOD TextBox( nTop, nLeft, nBottom, nRight, cTexto, oFuente, nclrtext, nClrBack, nJustify, afondo, alinea, lvertadjust, norientacion) METHOD UnProtect(cpassword) METHOD VistaCompleta() METHOD Visualizar INLINE ::oWord:Visible := .T. METHOD Write( cTexto, cFuente, cSize, lBold, lShadow, nColor ) METHOD Sendmail( lAttach ) // Vikthor METHOD HeaderFooter( nOption ) // Vikthor METHOD OpenDataSource( cFile ) // Vikthor METHOD AddField( cField ) // Vikthor METHOD WebPagePreview() INLINE ::oActiveDoc:Invoke("WebPagePreview") // [ Vikthor ] Genera una vista en HTML del libro. METHOD AddTables( aDatos , nPos ) // [ Vikthor ] METHOD AddBar(aDatos) METHOD Find( cText ) // [ Vikthor ] METHOD Hide() INLINE ::oWord:Visible := .F. // [ Vikthor ] METHOD IsVisible() INLINE ::oWord:Visible // [ Vikthor ] METHOD View( nView ) // [ Vikthor ] METHOD Zoom( nPercent ) // [ Vikthor ] ENDCLASS METHOD AddImagen( nTop, nLeft, nBottom, nRight, cImagen, alinea, ntipo, nrotacion ) CLASS TWord ::Box(nTop, nLeft, nBottom, nRight, {,,,,,,,cImagen}, alinea, ntipo, nrotacion, .t.) RETURN nil METHOD addtabulador(npos, ocuadrotext) CLASS TWord local otabstop, oParagraphFormat DEFAULT ocuadrotext := ::oTexto if ::lsetcm npos := nnpos*28.35 endif oParagraphFormat := oCuadroText:Get( 'ParagraphFormat') otabstop := oParagraphFormat:Get( 'TabStops') oTabstop:Invoke('Add',npos) release oParagraphFormat, otabstop RETURN nil METHOD Box( nTop, nLeft, nBottom, nRight, afondo, alinea, ntipo, nrotation, lPicTextured ) CLASS TWord LOCAL oShapes,oShapBox, oFill, oFillColor, olinea , n DEFAULT afondo := {}, alinea := {}, ntipo := 1, nrotation := 0, lPicTextured := .f. ::nLastRow := nBottom if ::lsetcm nTop := nTop*28.35 nLeft := nLeft*28.35 nBottom := nBottom*28.35 nRight := nRight*28.35 endif nRight := nRight - nLeft nBottom := nBottom - nTop oShapes := ::oSelection:Get( "Shapes" ) oShapBox := oShapes:Invoke( "AddShape",ntipo,nLeft,nTop,nRight,nBottom ) //oShapBox:Set('RelativeHorizontalPosition', 1 ) // No //oShapBox:Set('RelativeVerticalPosition', 1 ) // No oFill := oShapBox:Get( "Fill" ) oShapBox:Set('Rotation', nRotation ) for n = 1 to len(afondo) do case case n = 1 .and. afondo[n] <> NIL oFillColor := oFill:Get("ForeColor") oFillColor:Set( 'RGB', aFondo[1] ) case n = 2 .and. afondo[n] <> NIL oFillColor := oFill:Get("BackColor") oFillColor:Set( 'RGB', afondo[2] ) case n = 3 .and. afondo[n] <> NIL oFillColor:Set( 'Transparency', afondo[3]) case n = 4 .and. afondo[n] <> NIL oFill:Invoke( 'TwoColorGradient', afondo[4], afondo[5] ) case n = 6 .and. afondo[n] <> NIL oFill:Invoke( 'Patterned', afondo[6] ) case n = 7 .and. afondo[n] <> NIL oFill:Invoke( 'PresetTextured', afondo[7] ) case n = 8 .and. afondo[n] <> NIL if lPicTextured = .t. oFill:Invoke( 'UserPicture', afondo[8] ) else oFill:Invoke( 'UserTextured' , afondo[8] ) endif endcase next n oLinea := oShapBox:Get( "Line" ) for n = 1 to len(alinea) do case case n = 1 oLinea:Set( "Weight", alinea[1] ) case n = 2 oLinea:Set( "ForeColor", alinea[2] ) case n = 3 oLinea:Set( "BackColor", alinea[3] ) case n = 4 oLinea:Set( "Transparency", alinea[4]) case n = 5 oLinea:Set( "DashStyle", alinea[5] ) case n = 5 oLinea:Set( "Style", alineas[6] ) endcase next n release oShapes,oShapBox, oFill, oFillColor, olinea RETURN nil METHOD close(oDoc) CLASS TWord DEFAULT oDoc := ::oActiveDoc oDoc:Invoke('Close',0) RETURN METHOD CmSay( nLin,nCol,cTexto,oFuente,nSizeHorz,nClrText,nBkMode,nPad, naltura, nColorIndex, lVertAdjust ) CLASS TWord local lsetcm := ::lsetcm ::lSetCm := .t. ::Say( nLin,nCol,cTexto,oFuente,nSizeHorz,nClrText,nBkMode,nPad, naltura, nColorIndex, lVertAdjust ) ::lSetcm := lsetcm RETURN Nil METHOD CheckSpelling() CLASS TWord ::oActiveDoc:Invoke( 'CheckSpelling') RETURN nil METHOD End() CLASS TWord ::oDocs:Invoke('Close') ::oWord:Invoke( "Quit",0) ::oTexto := NIL ::oActiveDoc := NIL ::oDocs := NIL ::oWord := NIL #IFNDEF __XHARBOUR__ OleUninitialize() #ENDIF RETURN nil METHOD EndPage() CLASS TWord RETURN nil METHOD FillRect( aRect, oBrush ) CLASS TWord LOCAL oShapes,oShapBox, oFill, oFillColor if ::lsetcm arect[1] := arect[1]*28.35 arect[2] := arect[2]*28.35 arect[3] := arect[3]*28.35 arect[4] := arect[4]*28.35 endif oShapes := ::oSelection:Get( "Shapes" ) oShapBox := oShapes:Invoke( "AddShape",1,arect[2],arect[1],arect[4]-arect[2],aRect[3]-arect[1] ) oCuadro:Set( 'RelativeHorizontalPosition',1) oCuadro:Set( 'RelativeVerticalPosition',1) oFill := oShapBox:Get( "Fill") oFillColor := oFill:Get( "ForeColor") oFillColor:Set( "RGB",oBrush:nRGBColor ) oBrush:End() release oFillColor,oFill,oShapBox,oShapes RETURN nil METHOD GetTextHeight( oFont ) CLASS TWord local sal if ::lsetcm sal := oFont:nHeight/28.35 else sal := oFont:nHeight endif RETURN sal METHOD GetTextWidth(cText, oFont) CLASS TWord local nancho if oFont:nHeight > 0 nancho := (oFont:nHeight/1.6)*len(ctext) else nancho :=((oFont:nHeight*-1)/1.6)*len(ctext) endif RETURN nancho METHOD JustificaDoc( nJustify, otext ) CLASS TWord LOCAL oParagraph DEFAULT oText := ::oTexto oParagraph := oText:Get("ParagraphFormat") oParagraph:Set( "Alignment", nJustify ) RELEASE oParagraph RETURN ( Nil ) METHOD Line( nTop, nLeft, nBottom, nRight, oPen, nColor, nStyle ) CLASS TWord local oShapes,oShapLinea, oLinea, oRGB if ::lsetcm nTop := nTop*28.35 nLeft := nLeft*28.35 nBottom := nBottom*28.35 nRight := nRight*28.35 endif if oPen = NIL DEFINE PEN oPen if nStyle = Nil nStyle := 1 endif if nColor = Nil nColor := nRGB(0,0,0) endif else if nStyle = Nil do case case oPen:nStyle = 0 nStyle := 1 case oPen:nStyle = 1 nStyle := 4 case oPen:nStyle = 2 nstyle := 2 case oPen:nStyle = 3 nstyle := 5 case oPen:nStyle = 4 nstyle := 6 endcase endif if nColor = Nil nColor := oPen:nColor endif endif oShapes := ::oSelection:Get( "Shapes" ) oShapLinea := oShapes:Invoke( "AddLine", nLeft,nTop,nRight,nBottom ) oShapLinea:Set( 'RelativeHorizontalPosition',1) oShapLinea:Set( 'RelativeVerticalPosition',1) oLinea := oShapLinea:Get( "Line" ) * oLinea:Set( "Weight", oPen:nWidth-2 ) // No anda OK oRGB := oLinea:Get( 'ForeColor') oRGB:Set('RGB', nColor ) oLinea:Set( "DashStyle", nStyle) oPen:End() release oLinea,oShapLinea,oShapes, oRGB RETURN nil METHOD NEW() CLASS TWord ::lWord := .T. #IFDEF __XHARBOUR__ TRY ::oWord := GetActiveObject( "Word.Application" ) CATCH TRY ::oWord := CreateObject( "Word.Application" ) CATCH Alert( "ERROR! Word no está instaldo en esta PC.") ::lWord := .F. END END #ELSE ::oWord := TOleAuto():New("Word.Application") IF ::oWord:hObj == 0 Alert( "ERROR! Word no está instaldo en esta PC.") ::lWord := .F. ENDIF #ENDIF RETURN( Self ) METHOD NewDoc( cNombreDoc ) CLASS TWord DEFAULT cNombreDoc := 'Documento1' ::oDocs := ::oWord:Get( "Documents") ::oDocs:Invoke( "Add" ) ::oActiveDoc := ::oWord:Get("ActiveDocument") ::oTexto := ::oWord:Get("Selection") ::oOptions := ::oWord:Get("Options") // Vikthor ::oTables := ::oActiveDoc:Get( "Tables") // Vikthor ::oMailMerge := ::oActiveDoc:Get( "MailMerge") // Vikthor ::cNombreDoc := cNombreDoc ::nLinea := 0 ::nCol := 0 ::nPage := 0 ::nYoffset := 0 ::nXoffset := 0 ::lstartpag := .t. ::oSelection := ::oActiveDoc ::lSetcm := .f. ::lOverflowing := .f. ::nlastrow := 0 ::ctextoverflow := '' RETURN nil *METHOD nLogPixelX() * RETURN 55.38 *METHOD nLogPixelY() * RETURN 55.38 METHOD OpenDoc( cNombreDoc ) CLASS TWord local sal := .t. ::oDocs := ::oWord:Get( "Documents" ) if file( cNombreDoc ) ::oActiveDoc := ::oDocs:Invoke( "Open",cNombreDoc ) if valtype(::oActiveDoc) <> 'O' sal := .f. endif else sal := .f. endif ::oTexto := ::oWord:Get( "Selection" ) ::oOptions := ::oWord:Get("Options") // Vikthor ::oMailMerge := ::oActiveDoc:Get( "MailMerge") // Vikthor ::oTables := ::oActiveDoc:Get( "Tables") // Vikthor ::cNombreDoc := cNombreDoc ::nLinea := 0 ::nCol := 0 ::nPage := 0 ::nYoffset := 0 ::nXoffset := 0 ::oSelection := ::oActiveDoc ::lstartpag := .t. ::lsetcm := .f. ::lOverflowing := .f. ::nlastrow := 0 ::ctextoverflow := '' RETURN sal METHOD Preview() CLASS TWord ::oWord:Set( "PrintPreview", .F.) ::oActiveDoc:Invoke( "PrintPreview") ::Visualizar() RETURN nil METHOD PrintDoc(lbackground, lappend, nRange, cOutputFile, nfrom, nto, nitem, ncopias, cpages) CLASS TWord local csinpath, cpath DEFAULT lbackground := .f., lappend := .f., nRange := 0, cOutputFile := '',; nfrom := '', nto := '' ,; nitem := 0, ncopias := 1, cpages := '' if !empty(nFrom) .or. !empty(nTo) nRange := 3 nFrom := alltrim(str(int(nFrom))) nTo := alltrim(str(int(nTo))) endif if empty(cOutputFile) ::oActiveDoc:Invoke( "PrintOut" , lbackground,lappend,int(nRange),'',nfrom, nto, nitem,ncopias, cpages ) else cpath := cFilePath(cOutputFile) if !empty(cpath) .and. cpath <>'' ::oWord:Invoke( 'ChangeFileOpenDirectory',cpath) endif csinpath := cFileNoPath(cOutputFile) ::oWord:Invoke( "PrintOut",lbackground,lappend,int(nRange),csinpath, nfrom, nto, nitem, ncopias, cpages ) endif RETURN nil METHOD Protect(cpassword,nmodo) CLASS TWord DEFAULT nmodo := 1 ::oActiveDoc:Invoke( "Protect", nmodo, .F., cpassword ) RETURN nil METHOD Replace( cOld, cNew ) CLASS TWord LOCAL oTexto, oFind, oReplace //::oSelection := ::oActiveDoc // Vikthor oTexto := ::oSelection:Range() oFind := oTexto:Get( "Find" ) oFind:Set( "Text", cOld ) oFind:Set( "Forward", .T. ) oFind:Set( "Wrap", INT(1) ) oFind:Set( "Format", .f. ) oFind:Set( "MatchCase", .f. ) oFind:Set( "MatchWholeWord", .f. ) oFind:Set( "MatchWildcards", .f. ) oFind:Set( "MatchSoundsLike", .f. ) oFind:Set( "MatchAllWordForms", .f. ) oFind:Invoke( "Execute") DO WHILE oFind:Get( "Found" ) // Reemplaza todas las ocurrencias que coincidan oTexto:Set( "Text", cNew ) oFind:Invoke( "Execute") Enddo Release oReplace,oFind,oTexto RETURN nil METHOD Combinar( cOld, cNew ) CLASS TWord LOCAL oTexto, oFind, oReplace LOCAL cFound, x_pos //::oSelection := ::oActiveDoc // Vikthor oTexto := ::oSelection:Range() oFind := oTexto:Get( "Find" ) oFind:Set( "Text", cOld ) oFind:Set( "Forward", .T. ) oFind:Set( "Wrap", INT(1) ) oFind:Set( "Format", .f. ) oFind:Set( "MatchCase", .f. ) oFind:Set( "MatchWholeWord", .f. ) oFind:Set( "MatchWildcards", .t. ) oFind:Set( "MatchSoundsLike", .f. ) oFind:Set( "MatchAllWordForms", .f. ) oFind:Invoke( "Execute") DO WHILE oFind:Get( "Found" ) // Reemplaza todas las ocurrencias que coincidan cFound:=Alltrim(SubStr(oTexto:Text,2,Len(Alltrim(oTexto:Text))-2)) //Extrae el nombre de los campos cNew := search_tab(cFound) //? cNew oTexto:Set( "Text", cNew ) oFind:Invoke( "Execute") Enddo Release oReplace,oFind,oTexto RETURN nil /* METHOD Combinar( cWildCards , cNew) CLASS TWord //Busca todas las ocurrencias con comodines LOCAL oTexto, oFind, oReplace //::oSelection := ::oActiveDoc // Vikthor oTexto := ::oSelection:Range() oFind := oTexto:Get( "Find" ) //oFind:Set("ClearFormatting") //Quita todos los formatos especificados como parte de una operación de búsqueda y sustitución. oFind:Set( "Text", cWilCards ) oFind:Set( "Forward", .T. ) //True para buscar hacia abajo es decir hacia el final del documento. oFind:Set( "Wrap", INT(1) ) //Establece lo que ocurre si la búsqueda se inicia en un punto distinto al principio del documento. oFind:Set( "Format", .f. ) //Devuelve o establece el formato del objeto especificado oFind:Set( "MatchCase", .f. ) //True si la búsqueda distingue mayúsculas de minúsculas. oFind:Set( "MatchWholeWord", .f. ) //True si la operación de búsqueda sólo busca palabras completas y no texto que forme parte de una palabra. oFind:Set( "MatchWildcards", .t. ) //True si el texto va a buscarse contiene comodines de búsqueda oFind:Set( "MatchSoundsLike", .f. ) //Recibe el valor True si la operación de búsqueda encuentra las palabras que tienen un sonido parecido al del texto buscado oFind:Set( "MatchAllWordForms", .f. ) //Recibe el valor True si la operación de búsqueda encuentra todas las formas del texto que se debe buscar oFind:Invoke( "Execute") //Ejecuta la operación de busqueda específica. Devuelve true si la operación de busqueda tuvo éxito. DO WHILE oFind:Get( "Found" ) //Objeto Find: True si la búsqueda produce una coincidencia. Antes hay que ejecutar el comando find. /* */ // oTexto:Set( "ReplaceWith", "Encontrado") // oTexto:Set( "Text", cNew ) // oFind:Invoke( "Execute") // Enddo // Release oReplace,oFind,oTexto // RETURN nil METHOD Save(cnombredoc) CLASS TWord DEFAULT cnombredoc := ::cNombreDoc ::oActiveDoc:Invoke( "SaveAs", cNombreDoc ) RETURN nil METHOD Say( nLin,nCol,cTexto,oFuente,nSizeHorz,nClrText,nBkMode,nPad, naltura, nClrIndex, lvertadjust ) CLASS TWord if oFuente = Nil DEFINE FONT oFuente NAME 'Arial' SIZE 0, -12 OF Self endif DEFAULT nBkMode := 2 DEFAULT nSizeHorz := ::GetTextWidth(ctexto,oFuente) DEFAULT naltura := if(::lsetcm, 1, 28.35) if ::lsetcm nSizeHorz := nSizeHorz/28.35 endif if nBkMode = 2 nBkMode = 0 else nBkMode = 1 endif do case case npad = 1 ncol := ncol - nSizeHorz npad := 2 case npad = 2 ncol = ncol - (nSizeHorz/2) npad := 1 endcase ::TextBox(nLin, nCol, nLin+nAltura, nCol+nSizeHorz, ctexto, oFuente, nClrText, nClrIndex, npad,{,,nPad},{0},lVertAdjust) RETURN Nil METHOD Say2( nLin,nCol,cTexto,oFuente, nSize, lBold, lShadow, nColor ) CLASS TWord local cfuente := oFuente:cFaceName do whil ::nLinea < nLin ::oTexto:Invoke( "TypeText", chr(13) ) ::nlinea := ::nlinea + 1 enddo ::nCol := 0 do whil ::nCol < nCol ::oTexto:Invoke( "TypeText", chr(9) ) ::nCol := ::nCol + 1 enddo ::Write( cTexto, cFuente, nSize, lBold, lShadow, nColor ) RETURN nil METHOD SayGTF( nTop,nLeft, cTextFormat, nBottom,nRight ) CLASS TWord local cText := "", nPos := 1, nLen := 0, nCrLf, cFormat, cVersion, cType local afuentes := {}, nColorText := 0 local cFacename, cHeight, cWidth, lBold, lItalic, lUnderline, lStrikeout local nJustify, nFont local oShapes, oCuadro, oFill, oLine, oCuadrotext local oFont := ::oTexto:Get( "Font" ) local aSal := {.f.,''}, lnocabe := .f. if ::lsetcm nTop := nTop*28.35 nLeft := nLeft*28.35 nBottom := nBottom*28.35 nRight := nRight*28.35 endif nLen := AT( SP_REG, SubStr( cTextFormat, nPos ) ) cFormat := SubStr( cTextFormat, nPos, nLen - 1 ) nPos += nLen nLen := At( SP_FIELD, SubStr( cTextFormat, nPos ) ) cVersion := SubStr( cTextFormat, nPos, nLen - 1 ) nPos += nLen if !( cFormat == FORMAT_TEXT_TYPE ) asal[1] := .f. RETURN asal endif do whil .t. if Substr( cTextFormat, npos, 1 ) == SP_FIELD nPos += 1 exit endif cFacename := Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 ) nLen := At( SP_REG, SubStr( cTextFormat, nPos ) ) nPos += nLen cHeight := Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 ) nLen := At( SP_REG, SubStr( cTextFormat, nPos ) ) nPos += nLen cWidth := Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 ) nLen := At( SP_REG, SubStr( cTextFormat, nPos ) ) nPos += nLen lBold := if(val(Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )) = 0, .f.,.t.) nLen := At( SP_REG, SubStr( cTextFormat, nPos ) ) nPos += nLen lItalic := if(val(Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )) = 0, .f.,.t.) nLen := At( SP_REG, SubStr( cTextFormat, nPos ) ) nPos += nLen lUnderline := if(val(Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )) = 0, .f.,.t.) nLen := At( SP_REG, SubStr( cTextFormat, nPos ) ) nPos += nLen lStrikeOut := if(val(Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )) = 0, .f.,.t.) nLen := At( SP_REG, SubStr( cTextFormat, nPos ) ) nPos += nLen aadd( afuentes, {cFacename, cHeight, cWidth, lBold, lItalic, lUnderline, lStrikeOut}) enddo oShapes := ::oSelection:Get( "Shapes" ) oCuadro := oShapes:Invoke( "AddTextbox", 1,INT(nLeft),INT(nTop),INT(nRight-nLeft),INT(nBottom-nTop)) oCuadro:Set( 'RelativeHorizontalPosition',1) oCuadro:Set( 'RelativeVerticalPosition',1) oFill := oCuadro:Get( "Fill" ) oFill:Set( "Transparency",0) oFill:Set( "Visible",0) oLine := oCuadro:Get( "Line" ) oLine:Set( "Transparency",0) oLine:Set( "Visible",0) oCuadroText := oCuadro:Get( "TextFrame" ) oText := oCuadroText:Get( "TextRange" ) oCuadro:Invoke('Select') do while ( cType := SubStr( cTextFormat, nPos, 1 ) ) != SP_FIELD if cType == TP_ALIGN .or. cType == TP_FONT .or. cType == TP_COLOR if cType == TP_ALIGN njustify := Val(Substr( cTextFormat, npos +1, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )) ::Justificadoc(njustify) endif if cType == TP_FONT nfont := val(SubStr( cTextFormat, nPos + 1, nLen -1 )) oFont:Set( "Name", afuentes[nfont,1] ) oFont:Set( "Size", if( val(afuentes[nfont,2]) < 0, val(afuentes[nfont,2])*-1, val(afuentes[nfont,2]) ) ) oFont:Set( "Bold", afuentes[nfont,4] ) oFont:Set( "Italic", afuentes[nfont,5] ) oFont:Set( "Underline", afuentes[nfont,6] ) oFont:Set( "StrikeThrough", afuentes[nfont,7] ) endif if cType == TP_COLOR ncolortext := Val(Substr( cTextFormat, npos +1, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )) oFont:Set( "Color", ncolortext ) endif nLen := At( SP_REG, SubStr( cTextFormat, nPos ) ) nPos += nLen else nLen := At( SP_REG, SubStr( cTextFormat, nPos ) ) nCrLf := At( CRLF, SubStr( cTextFormat, nPos ) ) if nLen == 0 if nCrLf == 0 nLen := At( SP_FIELD, SubStr( cTextFormat, nPos ) ) - 1 else nLen := nCrLf + 1 endif else if nCrLf == 0 .or. nCrLf > nLen do while SubStr( ctextformat, nPos + --nLen - 1, 1 ) > Chr( 32 ) enddo --nLen else nLen := nCRLf + 1 endif endif cText = SubStr( cTextFormat, nPos, nLen ) ::oActiveDoc:Invoke( 'ComputeStatistics',2,.t.) lnocabe := oCuadroText:Get( 'Overflowing') if lnocabe asal[2] := substr( ctextformat,1, 4 ) asal[2] := asal[2] + substr( ctextformat, 5, At( SP_FIELD, Substr( cTextformat, 5) )) asal[2] := asal[2] + substr( ctextformat, nPos + nLen) exit endif cText = SubStr( cTextFormat, nPos, nLen ) ::oTexto:Invoke( "Typetext", cText ) nPos += nLen endif enddo oFont:Invoke( "Reset" ) release oShapes, oCuadro, oFill, oLine, oCuadrotext, oFont RETURN asal METHOD SetCm() CLASS TWord ::lSetCm := .t. RETURN METHOD SetHeader() CLASS TWord local oWindow := ::oActiveDoc:Get( "ActiveWindow" ) local oView := oWindow:Get( "View") oView:Set( "SeekView" , 10 ) // 9 Header 10 Footer ::oSelection := ::oTexto:Get( "HeaderFooter") release oWindow, oView RETURN nil METHOD SetLandScape() CLASS TWord local oPageSetup := ::oActiveDoc:Get( 'PageSetup') oPageSetup:Set( 'Orientation','1') release oPageSetup RETURN nil METHOD SetMainDoc() CLASS TWord local oWindow := ::oActiveDoc:Get( "ActiveWindow" ) local oView := oWindow:Get( "View") oView:Set( "SeekView" , 0 ) ::oSelection := ::oActiveDoc release oWindow, oView RETURN nil METHOD SetPortrait() CLASS TWord local oPageSetup := ::oActiveDoc:Get( 'PageSetup') oPageSetup:Set( 'Orientation','0') release oPageSetup RETURN nil METHOD SetUl() CLASS TWord ::lSetCm := .f. RETURN METHOD StartPage() CLASS TWord if ::lstartpag = .t. ::lstartpag := .f. else ::oTexto:Invoke( "EndKey" , 6 , 0 ) ::oTexto:Invoke( "InsertBreak" ) ::oTexto:Invoke( "GotoNext" , 1 ) ::nPage++ ::nLinea:=0 ::nCol :=0 endif ::Write(chr(31)) //Es necesario para ponder vincular los cuadros de texto a una pagina determinada. RETURN nil METHOD TabClearAll(ocuadrotext) CLASS TWord local oparagraphformat, otabstop DEFAULT ocuadrotext := ::oTexto oParagraphformat := oCuadroText:Get( 'ParagraphFormat') oTabstop := oParagraphformat:Get( 'TabStops') oTabstop:Invoke('ClearAll') release oparagraphformat, otabstop RETURN nil METHOD TabPredeterminado(ncada) CLASS TWord if ::lsetcm ncada := ncada*28.35 endif ::oActiveDoc:Set( 'DefaultTabStop', ncada ) RETURN nil METHOD TextBox( nTop, nLeft, nBottom, nRight, cTexto, oFuente, nclrtext, nClrBack, nJustify, afondo, alinea, lvertadjust, norientacion) CLASS TWord local oShapes,oCuadro,oFill,oLinea, oFontC, oText, oCuadroText local nPad := 0, n, oWrap, nheighttext,; lnocabe := .f., nheightbox:= 0 DEFAULT nTop := 0, nLeft := 0, nBottom := 10, nRight := 10,; cTexto := ' ', oFuente := TFont():New(),; nClrText := nRGB(0,0,0), nJustify := 0,; afondo := {}, alinea := {}, lvertadjust := .f.,; norientacion := 1 nheighttext := oFuente:nHeight if norientacion > 3 norientacion := 1 endif do case case nJustify = 1 nPad := 2 case nJustify = 2 nPad := 1 case nJustify = 6 nPad := 0 endcase if ::lsetcm nTop := nTop*28.35 nLeft := nLeft*28.35 nBottom := nBottom*28.35 nRight := nRight*28.35 endif oShapes := ::oSelection:Get( "Shapes" ) oCuadro := oShapes:Invoke( "AddTextbox", norientacion,INT(nLeft),INT(nTop),INT(nRight-nLeft),INT(nBottom-nTop) ) oFill := oCuadro:Get( "Fill" ) oCuadro:Set( 'RelativeHorizontalPosition',1) oCuadro:Set( 'RelativeVerticalPosition',1) //Fill for n = 1 to len(afondo) do case case n = 1 .and. afondo[n] <> NIL oFillColor := oFill:Get( "ForeColor") oFillColor:Set( 'RGB', afondo[1] ) case n = 2 .and. afondo[n] <> NIL oFillColor := oFill:Get( "BackColor") oFillColor:Set( 'RGB', afondo[2] ) case n = 3 .and. afondo[n] <> NIL oFill:Set( 'Transparency', afondo[3]) case n = 4 .and. afondo[n] <> NIL oFill:Invoke( 'TwoColorGradient', afondo[4], afondo[5] ) case n = 6 .and. afondo[n] <> NIL oFill:Invoke( 'Patterned', afondo[6] ) case n = 7 .and. afondo[n] <> NIL oFill:Invoke( 'PresetTextured', afondo[7] ) case n = 8 .and. afondo[n] <> NIL oFill:Invoke( 'UserTextured' , afondo[8] ) endcase next n //Linea de contorno oLinea := oCuadro:Get( "Line" ) for n = 1 to len(alinea) do case case n = 1 oLinea:Set( "Weight", alinea[1] ) case n = 2 oLinea:Set( "ForeColor", alinea[2] ) case n = 3 oLinea:Set( "BackColor", alinea[3] ) case n = 4 oLinea:Set( "Transparency", alinea[4]) case n = 5 oLinea:Set( "DashStyle", alinea[5] ) case n = 5 oLinea:Set( "Style", alineas[6] ) endcase next n oCuadroText := oCuadro:Get( "TextFrame" ) oText := oCuadroText:Get( "TextRange" ) oFontC := oText:Get( "Font") oFontC:Set( "Name" , oFuente:cFaceName ) oFontC:Set( "Size" , INT(oFuente:nHeight) ) oFontC:Set( "Bold" , oFuente:lBold ) oFontC:Set( "Color" , nclrtext ) oText:Set( 'HighlightColorIndex', nClrBack ) oText:Set( "Text", cTexto ) oParagraph := oText:Get( "ParagraphFormat") oParagraph:Set( "Alignment", nPad ) if lvertadjust nheightbox := 0 oCuadro:Set( 'Height', nheightbox) ::oActiveDoc:Invoke( 'ComputeStatistics',2,.t.) lnocabe := oCuadroText:Get( 'Overflowing') nheightbox := nheightbox + nHeighttext //+ OleGetProperty(oParagraph,'SpaceBefore') do whil lnocabe = .t. .and. nheightbox <= nBottom - nTop oCuadro:Set( 'Height', nheightbox) oText:Set( "Text", cTexto ) ::oActiveDoc:Invoke( 'ComputeStatistics',2,.t.) lnocabe := oCuadroText:Get( 'Overflowing') nheightbox := nheightbox + nHeighttext //+ OleGetProperty(oParagraph,'SpaceBefore') enddo else ::oActiveDoc:Invoke( 'ComputeStatistics',2,.t.) lnocabe := oCuadroText:Get( 'Overflowing') nheightbox := nBottom endif lcorta := lnocabe ctexto2 := ctexto do whil lcorta .and. !empty(ctexto2) ctexto2 := Dellastword(ctexto2) oText:Set( 'Text', ctexto2) ::oActiveDoc:Invoke('ComputeStatistics',2,.t.) lcorta := oCuadroText:Get( 'Overflowing') enddo ::ctextoverflow := strtran(ctexto, ctexto2, '') ::loverflowing := lnocabe ::oLastSay := otext release oParagraph, OLinea, oFillColor, oFill, oFontC, oText,oCuadroText, oCuadro if ::lsetcm ::nlastrow := nBottom/28.35 else ::nlastrow := nBottom endif RETURN Nil METHOD UnProtect(cpassword) CLASS TWord ::oActiveDoc:Invoke( "UnProtect", cpassword ) RETURN nil METHOD VistaCompleta() CLASS TWord LOCAL oWindow, oView oWindow := ::oActiveDoc:Get( "ActiveWindow" ) oView := oWindow:Get( "View" ) oView:Set( "FullScreen", .T. ) ::Visualizar() release oView RETURN nil METHOD Write( cTexto, cFuente, nSize, lBold, lShadow, nColor ) CLASS TWord LOCAL oFont := ::oTexto:Get("Font") oFont:Set( "Name", cFuente ) oFont:Set( "Size", nSize ) oFont:Set( "Bold", lBold ) oFont:Set( "Emboss", lShadow ) oFont:Set( "Color", nColor ) ::oTexto:Invoke( "TypeText", cTexto ) oFont:Invoke( "Reset" ) RELEASE oFont RETURN( Nil ) static function dellastword(ctexto) sal := rtrim(ctexto) do whil !empty(sal) sal := substr(sal,1, len(sal)-1) if substr(sal, len(sal), 1) = chr(32) .or. substr(sal, len(sal), 1) = chr(13) exit endif enddo RETURN sal METHOD SendMail( lAttach ) CLASS TWord // [ Vikthor ] DEFAULT lAttach := .T. ::oOptions:Set( "SendMailAttach" , lAttach ) ::oActiveDoc:Invoke( "SendMail" ) RETURN Self METHOD HeaderFooter( nOption ) CLASS TWord // Vikthor /* wdSeekCurrentPageFooter 10 wdSeekCurrentPageHeader 9 wdSeekEndnotes 8 wdSeekEvenPagesFooter 6 wdSeekEvenPagesHeader 3 wdSeekFirstPageFooter 5 wdSeekFirstPageHeader 2 wdSeekFootnotes 7 wdSeekMainDocument 0 wdSeekPrimaryFooter 4 wdSeekPrimaryHeader 1 */ LOCAL oWindow := ::oActiveDoc:Get( "ActiveWindow" ) LOCAL oView := oWindow:Get( "View" ) DEFAULT nOption := 9 oView:Set( "SeekView", nOption ) IF( nOption == 0 , ; ::oSelection := ::oActiveDoc , ; // Graba los datos al Documento ::oSelection := ::oTexto:Get( "HeaderFooter") ) // Abre el metodo para escritura release oWindow, oView RETURN( Nil ) METHOD OpenDataSource( cFile ) CLASS TWord // Vikthor /****** * Adjunta un origen de datos al documento especificado, que se convierte en documento principal si aún no lo es. * <cFile> : Nombre del archivo del origen de datos ******/ LOCAL oDField LOCAL cText, nItem , i , oRange DEFAULT cFile := "file.xls" ::oMailMerge:Invoke( 'OpenDataSource' , cFile , 0 , .F. ) ::oDataSource := ::oMailMerge:Get("DataSource") // Regresa el Objeto MailMergeDataSource ::oDataFields := ::oDataSource:Get("DataFields") // Regresa el Objeto MailMergeDataFields ::oFields := ::oMailMerge:Get("Fields") // Regresa el Objeto MailMergeFields /* cText := "Hay " nItem := ::oDataFields:Count() // Devuelve cuantos campos hay cText += Ltrim(Str( nItem )) + " campos para combinar correspondecia "+ CRLF + CRLF FOR i := 1 TO nItem oDField := ::oDataFields:Item( i ) // Regresa el Objeto MailMergeDataField cText += Str( i ) + ".-"+ oDField:Name() + CRLF NEXT ::Write( chr(13)+chr(13)+ cText ) */ RETURN( Nil ) METHOD AddField( cField , cFuente, nSize, lBold, lShadow, nColor ) CLASS TWord // Vikthor LOCAL oRange := ::oSelection:Range() LOCAL nEnd := oRange:Get("End") LOCAL oFont oRange:SetRange( nEnd , nEnd ) oFont := oRange:Get("Font") DEFAULT cFuente := "Tahoma" ,; nSize := 10 ,; lBold := .F. ,; lShadow := .F. ,; nColor := 0 oFont:Set( "Name", cFuente ) oFont:Set( "Size", nSize ) oFont:Set( "Bold", lBold ) oFont:Set( "Emboss", lShadow ) oFont:Set( "Color", nColor ) ::oFields:Invoke("Add", oRange , cField ) oFont:Invoke( "Reset" ) RELEASE oFont , oRange RETURN( Nil ) METHOD AddTables( aDatos , nPos ) CLASS TWord // Vikthor LOCAL oRange := ::oSelection:Range() LOCAL oTable , oCell , oCellRange , oCells LOCAL nRows , nCols LOCAL x , y nRows:=Len( aDatos ) nCols:=Len( aDatos[1] ) oRange:SetRange( nPos , nPos ) oTable:= ::oTables:Invoke("Add", oRange , nRows , nCols ) FOR x := 1 TO nRows FOR y := 1 TO nCols oCell := oTable:Cell( x , y) oCellRange := oCell:Range() oCellRange:Invoke( 'InsertAfter' , aDatos[x,y] ) SysRefresh() NEXT NEXT oColumns:=oTable:Columns:Select() oSelection:= ::oWord:Get("Selection") oFont:=oSelection:Font() oFont:Name:='Tahoma' oFont:Size:=9 oColumns:=oTable:Columns:AutoFit() oCol:=oTable:Columns:Item(3) oCol:Select() oSelection:= ::oWord:Get("Selection") oFont:=oSelection:Font() oFont:Name:='Tahoma' oFont:Size:=9 FOR x := 1 TO nCols // Len( aDatos ) oCol:=oTable:Columns:Item(x) oCol:Select() oParagraph := oSelection:Get("ParagraphFormat") oParagraph:Set( "Alignment", 2 ) SysRefresh() NEXT oTable:AutoFormat(1) RETURN( oTable ) METHOD AddBar( cName, Position, MenuBar, Temporary ) /*************** * * Crea una nueva barra de comandos y la agrega a la colección de barras de comandos. * <Name> : Variant opcional. Nombre de la nueva barra de comandos. Si se omite este argumento, Word asignará un nombre predeterminado a la barra de comandos, por ejemplo, Custom 1. * <Position> : Variant opcional. Posición o tipo de la nueva barra de comandos. * Puede ser una de las constantes MsoBarPosition que aparecen en la siguiente tabla: * - msoBarLeft, msoBarTop, msoBarRight, msoBarBottom Indica las coordenadas izquierda, derecha, superior e inferior de la nueva barra de comandos. * - msoBarFloating Indica que la nueva barra de comandos no estará acoplada. * - msoBarPopup Indica que la nueva barra de comandos será un menú contextual. * - msoBarMenuBar Sólo para Macintosh. * <MenuBar> : Variant opcional. True para reemplazar la barra de menú activa con la nueva barra de comandos. El valor predeterminado es False. * <Temporary> : Variant opcional. True para que la nueva barra de comandos sea temporal. Las barras de comandos temporales se eliminan al cerrar la aplicación contenedora. El valor predeterminado es False. ***************/ LOCAL oCommandBar:= oWord:Get( "CommandBars" ) //LOCAL oNewButton := oWord:Get( "CommandBarsButton") oCommandBar:Set("Name",cName) oCommandBar:Set("Position", msoBarFloting) oCommandBar:Set("MenuBar",.f.) oCommandBar:Set("Temporary", .t.) RETURN( Nil ) METHOD View( nView ) CLASS TWord // Vikthor local oWindow := ::oActiveDoc:Get( "ActiveWindow" ) local oView := oWindow:Get( "View") oView:Set( "Type" , nView ) release oWindow, oView RETURN ( Nil ) METHOD Zoom( nPercent ) CLASS TWord // Vikthor local oWindow := ::oActiveDoc:Get( "ActiveWindow" ) local oView := oWindow:Get( "View") DEFAULT nPercent := 100 oView:Set( "Zoom" , nPercent ) release oWindow, oView RETURN ( Nil ) METHOD Find( cText ) CLASS TWord // Vikthor LOCAL oTexto, oFind, nEnd oTexto := ::oSelection:Range() oFind := oTexto:Get( "Find" ) oFind:Set("ClearFormatting") oFind:Set( "Text", cText ) oFind:Set( "Forward", .T. ) oFind:Set( "Wrap", INT(1) ) //Establece lo que ocurre si la búsqueda se inicia en un punto distinto al principio del documento oFind:Set( "Format", .f. ) //Devuelve o establece el formato del objeto especificado oFind:Set( "MatchCase", .f. ) //True si la búsqueda distingue mayúsculas de minúsculas. oFind:Set( "MatchWholeWord", .f. ) //True si la operación de búsqueda sólo busca palabras completas y no texto que forme parte de una palabra. oFind:Set( "MatchWildcards", .t. ) //True si el texto va a buscarse contiene comodines de búsqueda oFind:Set( "MatchSoundsLike", .f. ) //Recibe el valor True si la operación de búsqueda encuentra las palabras que tienen un sonido parecido al del texto buscado oFind:Set( "MatchAllWordForms", .f. ) //Recibe el valor True si la operación de búsqueda encuentra todas las formas del texto que se debe buscar oFind:Invoke( "Execute") DO WHILE oFind:Get( "Found" ) oTexto:Set( "Text",cText ) oFind:Invoke( "Execute") Enddo nEnd := oTexto:Get("End") Release oTexto , oFind RETURN( nEnd ) ********************************* STATIC Function sSwap( cChar, c1, c2 ) LOCAL n1,n2:=-1,ac1,f IF ValType(c1)="A" ac1:=c1 FOR f=1 TO Len(ac1) c1:=ac1[f] WHILE .T. n1:=At(Upper( c1 ),Upper( cChar )) IF n1=0 .OR. n1=n2 EXIT ENDIF cChar:=SubStr( cChar, 1, n1-1 )+c2+SubStr( cChar, n1+Len(c1), Len(cChar)-Len(c1) ) n2:=n1 ENDDO NEXT ELSE WHILE .T. n1:=At(Upper( c1 ),Upper( cChar )) IF n1=0 .OR. n1=n2 EXIT ENDIF cChar:=SubStr( cChar, 1, n1-1 )+c2+SubStr( cChar, n1+Len(c1), Len(cChar)-Len(c1) ) n2:=n1 ENDDO ENDIF RETU cChar ******************************** Function sBreak(o,c,x,lShowAlert,lQuit) DEFAULT c:="ERROR",x:="",lQuit:=.f. IF lShowAlert=NIL MsgStop(If(Empty(x),"",x+CRLF+CRLF)+AllTrim(o:Description)+": "+AllTrim(o:Operation),c) ENDIF IF lQuit MemoWrit("Error.log",If(Empty(x),"",x+CRLF+CRLF)+AllTrim(o:Description)+": "+AllTrim(o:Operation)) QUIT ENDIF BREAK RETU NIL ******************************** Function V(x) LOCAL y:=ValType(x),cRetu:="" DO CASE CASE y=="C" ; RETU x CASE y=="M" ; RETU x CASE y=="N" ; RETU If(Empty(x),"",LTrim(Str(x))) CASE y=="D" ; RETU If(Empty(x),"",DtoC(x)) CASE y=="A" ; RETU (AEval(x,{|a|cRetu+=RTrim(V(a))+","}),SubStr(cRetu,1,Len(cRetu)-1)) CASE y=="L" ; RETU If(x,".T.",".F.") CASE y=="U" ; RETU "_NIL_!" CASE y=="B" ; RETU V({Eval(x)}) CASE y=="O" ; RETU "_OBJECT_!" OTHER ; RETU "?" ENDCASE RETU x

Thanks

Farley

FiveTech Software tech support forums

create a document with the tword

create a document with the tword

Who is online