FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin para Harbour/xHarbour Migracion automatica a Calc
Posts: 1
Joined: Mon Jun 08, 2009 01:47 PM
Migracion automatica a Calc
Posted: Mon Jun 08, 2009 08:30 PM
hola,

Posteo una clase que via polimorfismo permite tratar a Calc como si fuera OLE Excel.
Es una clase perfectamente funcional pero basica.
Seria muy interesante que entre todos la "extendieramos" dandole mayores capacidades.

Ejemplo de uso:

oExcel:= CreateObjectCalcLayer()
................................ // Tratamiento de objeto Excel o Calc
RETURN NIL




Code (fw): Select all Collapse
 



//--------------------------------------------------------------------------//
// Crea un objeto Excel o TCalcLayer segun este o no instalado Excel
FUNCTION CreateObjectCalcLayer()
Local oExcel:= NIL
Local oErr:= NIL

   TRY
       // 1§ pruebo con excel.. y si no funciona pruebo con Calc
       // Siempre crea objeto (evito algunos problemas pe. en saveas())

       oExcel:= CreateObject( "Excel.Application" )
   CATCH oErr



       oExcel:= TCalcLayer():New()
   END

RETURN oExcel
*


//--------------------------------------------------------------------------//


      #Define SIN_DEFINIR NIL
      #Define SIN_DEFINIR(x) x


CLASS TCalcLayer


  METHOD New()


  // Datas Excel simuladas ----------------------------------------
  // Estas datas seran las que se manjen desde fuera... pero aqui
  // dentro deben tener valores apropiados
  DATA WorkBooks

  DATA TmpWorkSheets          HIDDEN




  #Define ACTIVE_SHEET ::oOOCalc:getCurrentController():getActiveSheet()





  // De trabajo --------------
  METHOD MioNumberFormat()
  METHOD MioGetPropertyValue()
  METHOD MioVisible()
  DATA   cMioFileNameUrl
  //--------------------------





  // Excel simulado ----------
  METHOD WorkSheets(nSheet)
  ACCESS ActiveSheet INLINE TWorkSheetCalcLayer():New(Self, NIL, NIL, ACTIVE_SHEET)


  METHOD Quit()      INLINE Self:= NIL
  ASSIGN Visible(x)  INLINE ::MioVisible() //nil //(msginfo("hola", x))

  METHOD Get(cMessage) //INLINE msginfo(cMessage, "falta implementar !")


  //--------------------------


  //---------------------------------------------------------------



  // Datas Calc reales --------------------------------------------
     DATA oOOEngine         READONLY
     DATA oOOCore           READONLY
     DATA oOODesktop        READONLY
     DATA oOOCalc           READONLY
     DATA oOODispatcher     READONLY
  //---------------------------------------------------------------



   HIDDEN:
      METHOD Dispatch()

ENDCLASS
*
*

//--------------------------------------------------------------------------//
// Ojo con el tema de visible... que para Calc parece que no
// funciona como en Excel... en Excel cuando se indica
// oExcel:= .t. se abre la hoja de calculo;
// para Calc (creo) que se le dice al abrir la hoja de calculo pq
// no se existe una propiedad dinamica que haga esto
METHOD MioVisible()
Local aArg:= {}

IF ::cMioFileNameUrl != NIL
   ::oOOCalc:= NIL
   Aadd(aArg, ::MioGetPropertyValue(::oOOEngine, "Hidden", .f. ) )
   ::oOOCalc := ::oOODesktop:loadComponentFromURL("file:///"+ ::cMioFileNameUrl, "_blank", 0, aArg)
ENDIF
RETURN NIL

*
//--------------------------------------------------------------------------//
METHOD MioNumberFormat(cell, numberformatstring)
Local doc,sheet,numberformats,numberformatid,localsettings

// Parece que los campos numericos sin decimales... pe. campo tipo
// "veces" no cogen picture en d2e.prg apropiadamente (viene a nil)
IF numberformatstring == NIL
   RETURN -1
ENDIF
*
Doc:= ::oOOCalc

localsettings:= ::oOOCalc:GetPropertyValue("CharLocale")

NumberFormats = Doc:NumberFormats
NumberFormatId = NumberFormats:queryKey(NumberFormatString, localsettings, .t.)
If NumberFormatId = -1
   NumberFormatId = NumberFormats:addNew(NumberFormatString, localsettings)
EndIf
RETURN NumberFormatId
*
*
//--------------------------------------------------------------------------//
METHOD WorkSheets(nSheet)
Local xRet:= NIL
#Define lCOMO_DATA PCount() == 0
IF lCOMO_DATA
   xRet:= ::TmpWorkSheets
ELSE
   xRet:= TWorkSheetCalcLayer():New(Self, NIL, nSheet- 1)
ENDIF
RETURN xRet

//--------------------------------------------------------------------------//
METHOD Get(cMessage)
Local xRet

cMessage:= Upper(cMessage)
DO CASE
   CASE cMessage == "ACTIVESHEET"
      xRet:= ::ActiveSheet
      *
   CASE .T.
      msginfo("Falta implementar mensaje", cMessage)
ENDCASE
RETURN xRet

*
//--------------------------------------------------------------------------//
METHOD New() CLASS TCalcLayer
Local oErr
Local aArg:= {}
*
TRY
    ::oOOEngine:= CreateObject( "com.sun.star.ServiceManager" )
CATCH oErr
    msginfo( "­ No se pudo conectar con Open Office !", OLE2TXTERROR() )

    RETURN NIL
END
::oOOcore   := ::oOOEngine:CreateInstance("com.sun.star.refelection.CoreReflection")
::oOODesktop := ::oOOEngine:createInstance("com.sun.star.frame.Desktop")
*
*

Aadd(aArg, ::MioGetPropertyValue(::oOOEngine, "Hidden", .t. ) )
::oOOCalc := ::oOODesktop:loadComponentFromURL("private:factory/scalc", "_blank", 0, aArg)





::oOODispatcher:= ::oOOEngine:CreateInstance( "com.sun.star.frame.DispatchHelper" )
*
*
*
*
*
*
::WorkBooks := TWorkBooksCalcLayer():New(Self)
::TmpWorkSheets:= TWorkSheetsCalcLayer():New(Self)




RETURN Self
*
*
/*-----------------------------------------------------------------------------------------------*/
METHOD MioGetPropertyValue(oService, cName, xValue ) CLASS TCalcLayer
   LOCAL oArg
   oArg := oService:Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
   oArg:Name  := cName
   oArg:Value := xValue
   RETURN oArg

/*-----------------------------------------------------------------------------------------------*/
METHOD Dispatch(oSender, cMethod, aArgs ) CLASS TCalcLayer
   DEFAULT aArgs := {}
   IF ValType( aArgs ) == "O"; aArgs := { aArgs }; ENDIF

   ::oOODispatcher:ExecuteDispatch( oSender, ".uno:" + cMethod, "", 0, aArgs )
   RETURN NIL



//--------------------------------------------------------------------------//
CLASS TWorkBooksCalcLayer




   EXPORTED:
      METHOD New()
      METHOD Add()

      METHOD Close() INLINE SIN_DEFINIR


   HIDDEN:
      DATA oCalcLayer

ENDCLASS


//--------------------------------------------------------------------------//
METHOD New(oCalcLayer) CLASS TWorkBooksCalcLayer
::oCalcLayer:= oCalcLayer
RETURN Self



//--------------------------------------------------------------------------//
METHOD Add() CLASS TWorkBooksCalcLayer
Local oBook

oBook:= TWorkBookCalcLayer():New(::oCalcLayer)
RETURN oBook

//--------------------------------------------------------------------------//
CLASS TWorkBookCalcLayer

   EXPORTED:
      METHOD New()

      METHOD SaveAs(cSaveAs) INLINE ::SaveToXls(cSaveAs)
      METHOD Close()         INLINE SIN_DEFINIR



   HIDDEN:
      DATA oCalcLayer
      DATA oWorkBooksCalcLayer

      METHOD ConvertToUrl()
      METHOD SaveToXLS( cFile )

ENDCLASS

//--------------------------------------------------------------------------//
METHOD New(oCalcLayer, oWorkBooksCalcLayer) CLASS TWorkBookCalcLayer
::oCalcLayer         := oCalcLayer
::oWorkBooksCalcLayer:= oWorkBooksCalcLayer

RETURN Self

/*-----------------------------------------------------------------------------------------------*/
METHOD ConvertToURL( cFile ) CLASS TWorkBookCalcLayer
LOCAL nFor, nLen := Len( cFile )
FOR nFor := 1 TO nLen
   IF cFile[ nFor ] == "\"
      cFile[ nFor ] := "/"
   ENDIF
NEXT
RETURN cFile
*
//--------------------------------------------------------------------------//
METHOD SaveToXLS( cFile )
Local cUrl:= ::ConvertToURL( cFile )
::oCalcLayer:storeToURL( "file:///" + cUrl,;
      { ::oCalcLayer:MioGetPropertyValue(::oCalcLayer:oOOEngine, "FilterName", "MS Excel 97" ) } )

::oCalcLayer:cMioFileNameUrl:= cUrl
RETURN NIL
*
//--------------------------------------------------------------------------//
CLASS TWorkSheetsCalcLayer





   EXPORTED:
      METHOD New()

      ACCESS Count  INLINE ::oCalcLayer:oOOCalc:getSheets():getCount()

   HIDDEN:
      DATA oCalcLayer


ENDCLASS


//--------------------------------------------------------------------------//
METHOD New(oCalcLayer) CLASS TWorkSheetsCalcLayer
::oCalcLayer:= oCalcLayer
RETURN Self

*
//--------------------------------------------------------------------------//
CLASS TWorkSheetCalcLayer

   EXPORTED:
      METHOD New()


      METHOD Delete() INLINE ::oCalcLayer:oOOCalc:getSheets():removeByName(::oOOSheet:Name  )

      METHOD Cells(nCol, nRow) INLINE TCellCalcLayer():New(::oCalcLayer, ::oOOSheet:GetCellByPosition(nRow- 1, nCol- 1))

      METHOD Columns( nCol ) INLINE TColumnCalcLayer():New(::oCalcLayer, Self, nCol)


      ACCESS Name        INLINE ::oOOSheet:Name
      ASSIGN Name(cName) INLINE ::oOOSheet:Name:= cName


      DATA oOOSheet  READONLY


      ACCESS PageSetup INLINE ::oPageSetup


   HIDDEN:
      DATA oCalcLayer
      DATA oWorkSheetsCalcLayer
      DATA nSheet
      DATA oPageSetup


ENDCLASS

//--------------------------------------------------------------------------//
METHOD New(oCalcLayer, oWorkSheetsCalcLayer, nSheet, oOOSheet) CLASS TWorkSheetCalcLayer
::oCalcLayer          := oCalcLayer
::oWorkSheetsCalcLayer:= oWorkSheetsCalcLayer
::nSheet               := nSheet

DO CASE
   CASE ::nSheet != NIL
      ::oOOSheet:= ::oCalcLayer:oOOCalc:getSheets():getByIndex(nSheet)
   CASE oOOSheet != NIL
      ::oOOSheet:= oOOSheet
ENDCASE

::oPageSetup:= TPageSetupCalcLayer():New(::oCalcLayer, Self)
RETURN Self



//--------------------------------------------------------------------------//
CLASS TCellCalcLayer


   EXPORTED:
      METHOD New()

      ASSIGN Value(x) INLINE ::AsignaValor(x)




      ACCESS Font     INLINE ::oFont

      ACCESS Interior INLINE ::oInterior

      METHOD Borders  INLINE ::oBorders


      // Calc - Alineacion hoizontal
      //----------------------------
      // 0 - ¨ por defecto ?
      // 1 - Izda
      // 2 - Centrado
      // 3 - Dcha

      //
      // Excel - Alineacion hoizontal
      //-----------------------------
      // 3 - Centrado
      ASSIGN HorizontalAlignment(x) INLINE ::oOOCell:HoriJustify:= aPosEle(x, {1,2,3}, {1,3,2}, 0)

      ACCESS NumberFormat          INLINE ::oOOCell:NumberFormat
      ASSIGN NumberFormat(cFormat) INLINE ::oOOCell:NumberFormat:= ::oCalcLayer:MioNumberFormat(::oOOCell, cFormat) //(::NumberFormat:= "@")



   HIDDEN:
      DATA oCalcLayer


      DATA oOOCell

      METHOD AsignaValor


      DATA oFont
      DATA oInterior
      DATA oBorders

ENDCLASS

//--------------------------------------------------------------------------//
METHOD New(oCalcLayer, oOOCell) CLASS TCellCalcLayer
::oCalcLayer         := oCalcLayer

IF oOOCell != NIL
   ::oOOCell:= oOOCell
ENDIF
::oFont    := TFontCalcLayer():New(oCalcLayer, oOOCell)
::oInterior:= TInteriorCalcLayer():New(oCalcLayer, oOOCell)
::oBorders := TBordersCalcLayer():New(oCalcLayer, oOOCell)
RETURN Self
*
*
//--------------------------------------------------------------------------//
METHOD AsignaValor(x) CLASS TCellCalcLayer
Local cType:= ValType(x)
Local xTmp
DO CASE
   CASE cType == "N"
      ::oOOCell:SetValue(x)
      *
   CASE cType == "C"
      ::oOOCell:SetString(x)
      *
   CASE cType == "D"
      xTmp:= DToc(x)
      SET DATE TO AMERICAN
      xTmp:= CToD(SubStr(xTmp, 4, 2)+ "/"+ Left(xTmp, 2)+ "/"+ SubStr(xTmp, 7) )
      *
      ::oOOCell:SetValue(xTmp)
      ::oOOCell:NumberFormat:= 37
      SET DATE TO BRITISH // Aqui faltaria asegurar el SET DATE !!!
      *
   CASE .t.
      ::oOOCell:SetValue(x)
      *

ENDCASE
RETURN NIL
*
*
*
//--------------------------------------------------------------------------//
CLASS TFontCalcLayer

   EXPORTED:
      METHOD New()







      ASSIGN Italic(l) INLINE If(l, ::Italic(), msginfo("Falta apagar !!", l) )
      ASSIGN Bold(l)   INLINE If(l, ::Bold(), msginfo("Falta apagar !!", l) )





   HIDDEN:
      DATA oCalcLayer
      DATA oOOCell

      METHOD Italic
      METHOD Bold


ENDCLASS



//--------------------------------------------------------------------------//
METHOD New(oCalcLayer, oOOCell) CLASS TFontCalcLayer
::oCalcLayer:= oCalcLayer
::oOOCell   := oOOCell

RETURN Self
*
*
*
//--------------------------------------------------------------------------//
METHOD Bold()
::oOOCell:CharWeight:= 150
RETURN NIL
*
*
//--------------------------------------------------------------------------//
METHOD Italic()
::oOOCell:CharPosture:= 100
RETURN NIL
*

*
//--------------------------------------------------------------------------//
CLASS TInteriorCalcLayer

   EXPORTED:
      METHOD New()




      ASSIGN Color(nColor) INLINE ::oOOCell:CellBackColor:= nColor



   HIDDEN:
      DATA oCalcLayer

      DATA oOOCell
ENDCLASS



//--------------------------------------------------------------------------//
//METHOD New(oCalcLayer, oOOFont) CLASS TFontCalcLayer
METHOD New(oCalcLayer, oOOCell) CLASS TInteriorCalcLayer
::oCalcLayer:= oCalcLayer
::oOOCell   := oOOCell
RETURN Self
*
*
*
*
//--------------------------------------------------------------------------//
CLASS TBordersCalcLayer

   EXPORTED:
      METHOD New()




      ASSIGN LineStyle(nLineStyle) INLINE ::LineStyle(nLineStyle)





   HIDDEN:
      DATA oCalcLayer
      DATA oOOCell

      DATA oOOBorder


      METHOD LineStyle


ENDCLASS



//--------------------------------------------------------------------------//
METHOD New(oCalcLayer, oOOCell) CLASS TBordersCalcLayer
::oCalcLayer:= oCalcLayer
::oOOCell   := oOOCell
::oOOBorder:= ::oCalcLayer:oOOEngine:Bridge_GetStruct( "com.sun.star.table.BorderLine" )

RETURN Self
*
*

//--------------------------------------------------------------------------//
METHOD LineStyle(nLineStyle)

//MDEBUG_(nlinestyle, ::oooborder,::oOOBorder:OuterLineWidth)
DO CASE
   CASE nLineStyle == 1
      // recuadro completo
      ::oOOBorder:innerlinewidth:= 0
      ::oOOBorder:OuterLineWidth:= 2
      ::oooborder:LineDistance  := 0

      ::oOOCell:TopBorder   := ::oOOBorder
      ::oOOCell:BottomBorder:= ::oOOBorder
      ::oOOCell:LeftBorder  := ::oOOBorder
      ::oOOCell:RightBorder := ::oOOBorder
ENDCASE
RETURN NIL

*
*
//--------------------------------------------------------------------------//
CLASS TColumnCalcLayer

   EXPORTED:
      METHOD New()




      METHOD AutoFit() INLINE ::oOOColumn:OptimalWidth:= .t.



      // Factor de relacion pixel-cms... pero * 100 pq en calc
      // el width esta en milimetros
      #Define FACTOR_ (4.7181* 100)


      ACCESS ColumnWidth         INLINE ( ::OOOCOLUMN:WIDTH * FACTOR_) //(::oOOColumn:Width* FACTOR_)
      ASSIGN ColumnWidth(nWidth) INLINE ( ::oOOColumn:Width:= (nWidth/ FACTOR_) )





   HIDDEN:
      DATA oCalcLayer
      DATA oWorkSheetCalcLayer


      DATA oOOColumn
ENDCLASS



//--------------------------------------------------------------------------//
//METHOD New(oCalcLayer, oOOFont) CLASS TFontCalcLayer
METHOD New(oCalcLayer, oWorkSheetCalcLayer, nColumn) CLASS TColumnCalcLayer
::oCalcLayer         := oCalcLayer
::oWorkSheetCalcLayer    := oWorkSheetCalcLayer
::oOOColumn:= ::oWorkSheetCalcLayer:oOOSheet:GetColumns():GetByIndex(nColumn- 1)
RETURN Self
*
*
//--------------------------------------------------------------------------//
CLASS TPageSetupCalcLayer


   METHOD New()

   ASSIGN LeftHeader(c)   INLINE ::Header(1, c)
   ASSIGN CenterHeader(c) INLINE ::Header(2, c)
   ASSIGN RightHeader(c)  INLINE ::Header(3, c)

   ASSIGN PrintTitleRows(c) INLINE NIL

   HIDDEN:

      DATA oCalcLayer
      DATA oWorkSheetCalcLayer

      METHOD Header()



ENDCLASS
*
//--------------------------------------------------------------------------//
METHOD New(oCalcLayer, oWorkSheetCalcLayer) CLASS TPageSetupCalcLayer
::oCalcLayer          := oCalcLayer
::oWorkSheetCalcLayer:= oWorkSheetCalcLayer
RETURN Self
*

//--------------------------------------------------------------------------//
// Ahora mismo esto no funciona pq no se como definir
// en Calc las macros de header y footer de Excel... pejemplo...
// como se traduce a Calc el &P para pintar la pagina ???
METHOD Header(nCual, cTexto) CLASS TPageSetupCalcLayer


Local Doc, StyleFamilies,EstilosPagina,PaginaPredeterminada
Local ContenidoEnc,TextoEnc

Doc:= ::oCalcLayer:oOOCalc
StyleFamilies:= Doc:StyleFamilies
EstilosPagina:= StyleFamilies:getByName("PageStyles")

PaginaPredeterminada:= EstilosPagina:getByName("Default")


PaginaPredeterminada:HeaderIsOn:= .T.

PaginaPredeterminada:HeaderShared:= .t.












ContenidoEnc:= PaginaPredeterminada:RightPageHeaderContent

   DO CASE
      CASE nCual == 1
         ContenidoEnc:GetleftText:setString(cTexto)


      CASE nCual == 2
         ContenidoEnc:GetCenterText:setString(cTexto)


      CASE nCual == 3
         ContenidoEnc:GetRightText:setString(cTexto)


   ENDCASE

     PaginaPredeterminada:RightPageHeaderContent:= contenidoenc


RETURN NIL

Continue the discussion