The Code is updated on 28-Jan-2009
The code is almost ready. You may add this fuctionality to xBrowse class after verifying and ensuring that this does not cause damage to the existing xBrowse class. As you know my experience and knowledge in FiveWin is very limited and it is only few months back I have started with FiveWin, and there may be much better way of doing the coding part.
The ToCalc() method has more functionalities like "Export xBrowse Data to PDF format" or "MS Excel Format " or "HTML Format"
These are the additions required in xBrowse.Prg
A New Method
Method ToCalc( bProgress, nGroupBy, nPasteMode, aSaveAs )
Supporting Static Fuctions
STATIC FUNCTION GetPropertyValue(oService, cName, xValue ) // Creates OpenOffice ProperyValue Object
STATIC Function MakeColAlphabet(nCol) // Generate Alphabet equivalent of Column No Eg."AB"
STATIC Function GetNumberFormatId(oBook, cNumberFormat) // Set/Create OpenOffice Date & Number Format
STATIC FUNCTION CalcSubTotal(oCalc,oBook,oSheet,nGroupBy,aTotals,nRow,nCol) // To create the SubTotal and Grouping
STATIC Function PasteUnformattedText(oCalc,oBook,oSheet,aCols) // Default method used to transfer ClipBoard Data to Calc
E x p l a n a t i o n
Method ToCalc( bProgress, nGroupBy, nPasteMode, aSaveAs )
There are 2 methods to paste data to calc from clipboard to Calc
By default the value in nPasteMode is 2 ie xBrowse uses the Static function PasteUnformattedText(oCalc,oBook,oSheet,aCols) to paste/transfer xBrowse data from clipboard to calc.
IF nPasteMode 1 is used, then OpenOffice Uno:Paste technique is used. I have found that this method is much faster than the default method 2. But the problem with this method is that the OpenOffice calc will bring a Popup dialog and waits for the user to click on the Ok button to proceed further with the Paste/Transfer.
I tried a lot to find out the right API code to control this but unfortunately as it is not well documented, till now I have not got the appropriate API. I am sure that If we know the right API, we can avoid this nagging confirmation dialog and use this method as the default.
- Code: Select all Expand view
//----------------------------------------------------------------------------//
METHOD ToCalc( bProgress, nGroupBy, nPasteMode, aSaveAs ) CLASS TXBrowse
local oCalc, oDeskTop,oBook, oSheet, oWin, oLocal, oDispatcher
local nCol, nXCol, oCol, cType, uValue
local uBookMark, nRow
local nDataRows
local aCols
local oClip, cText, nPasteRow, nStep, cFormat,cFileName,cURL,i
local aTotals := {}, lAnyTotals := .f. , aProp:={} , aOOFilters:={} , nPos, oCharLocale
DEFAULT nPasteMode:=1
DEFAULT aSaveAs:={}
aOOFilters:={ {"PDF","calc_pdf_Export"},{"XLS","MS Excel 97"},{"HTML","XHTML Calc File"} }
nDataRows := EVAL( ::bKeyCount )
if nDataRows == 0
return nil
endif
aCols := ::GetVisibleCols()
if Empty( aCols )
return nil
endif
#ifdef __XHARBOUR__
TRY
oCalc := GetActiveObject( "com.sun.star.ServiceManager" )
CATCH
TRY
oCalc := CreateObject( "com.sun.star.ServiceManager" )
CATCH
MsgAlert( "Open Office Calc not installed" )
return Self
END
END
#else
oCalc := TOLEAuto():New( "com.sun.star.ServiceManager" )
#endif
lxlEnglish:=.T.
oDesktop := oCalc:CreateInstance( "com.sun.star.frame.Desktop" )
// Create OpenOffice Calc Instance with the Window Hidden Property
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "Hidden", .T. ) )
oBook := oDesktop:LoadComponentFromURL( "private:factory/scalc", "_blank", 0, aProp )
oSheet := oBook:GetSheets():GetByIndex( 0 )
oDispatcher:= oCalc:CreateInstance( "com.sun.star.frame.DispatchHelper" )
// Object to handle OpenOffice Language
oCharLocale = oBook:GetPropertyValue("CharLocale")
IF oCharLocale:Language == "de" // German
cxlSum:="=SUMME("
ELSEIF oCharLocale:Language == "fr" // French
cxlSum:="=SOMME("
ELSEIF oCharLocale:Language == "es" // Spanish
cxlSum:="=SUMA("
ELSEIF oCharLocale:Language == "pt" // Portugese
cxlSum:="=SOMA("
ELSEIF oCharLocale:Language == "it" // Italian
cxlSum:="=SOMMA("
ELSE
cxlSum:="=SUM("
ENDIF
// This routine blocks screen updating and therefore allows faster macro execution
oBook:addActionLock()
oBook:LockControllers()
uBookMark := EVAL( ::bBookMark )
nRow := 1
nCol := 0
for nXCol := 1 TO Len( aCols )
oCol := aCols[ nXCol ]
nCol ++
oSheet:GetCellByPosition( nCol-1, nRow-1 ):SetString = oCol:cHeader
cType := oCol:cDataType
DO CASE
CASE cType == 'N'
cFormat := If( lThouSep, If( lxlEnglish, "#,##0", "#.##0" ), "0" )
if oCol:cEditPicture != nil .AND. "." $ oCol:cEditPicture
cFormat += If( lxlEnglish, ".00", ",00" )
endif
oSheet:GetColumns():GetByIndex( nCol-1 ):NumberFormat:=GetNumberFormatId(oBook, cFormat, cType)
oSheet:GetColumns():GetByIndex( nCol-1 ):HoriJustify = 3 // 3 Right Alignement
CASE cType == 'D'
if lxlEnglish
if ValType( oCol:cEditPicture ) == 'C' .and. !( oCol:cEditPicture = '@' )
oSheet:GetColumns():GetByIndex( nCol-1 ):NumberFormat:=GetNumberFormatId(oBook, oCol:cEditPicture, oCol:cHeader, cType )
else
oSheet:GetColumns():GetByIndex( nCol-1 ):NumberFormat:=GetNumberFormatId(oBook, Set( _SET_DATEFORMAT ), oCol:cHeader, cType )
endif
oSheet:GetColumns():GetByIndex( nCol-1 ):HoriJustify = 3 // 3 Right Alignment
endif
CASE cType == 'L'
// leave as general format
OTHERWISE
oSheet:GetColumns():GetByIndex( nCol-1 ):NumberFormat:= "@"
ENDCASE
Next nXCol
oBook:CurrentController:select( oSheet:GetCellRangeByPosition( 0, 0, Len( aCols )-1,0 ) )
oSheet:getCellByPosition(0,0):Rows:Height=750 //1000 = 1cm
// Draw Bottom Border Line on the Header Row
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "OuterBorder.BottomBorder", {0,0,2,0} ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:SetBorderStyle", "", 0, aProp)
// Make Header Row Font Bold
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "Bold", .T. ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:Bold", "", 0, aProp)
// Make Setting for Paste Tab Delimited Text
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "FilterName", "Text" ) )
AAdd(aProp,GetPropertyValue(oCalc, "FilterOptions", "9,,MS_1257,0,2/2/2/2/2/2/2/2/2/2/2/2/2/2/2/2" ) )
if Empty( ::aSelected ) .or. Len( ::aSelected ) == 1
Eval( ::bGoTop )
if ::oRs != nil .AND. Len( aCols ) == ::oRs:Fields:Count()
::oRs:MoveFirst()
nRow := oSheet:GetCellByPosition( 2, 1 ):CopyFromRecordSet( ::oRs )
::oRs:MoveFirst()
nRow += 2
else
if bProgress == nil
if ::oWnd:oMsgBar == nil
bProgress := { || nil }
else
bProgress := { | n, t | ::oWnd:SetMsg( "To Calc : " + Ltrim( Str( n ) ) + "/" + Ltrim( Str( t ) ) ) }
endif
endif
nRow := 2
nPasteRow := 2
nStep := Max( 1, Min( 100, Int( nDataRows / 100 ) ) )
cText := ""
oClip := TClipBoard():New()
if oClip:Open()
Eval( bProgress, 0, nDataRows )
do while nRow <= ( nDataRows + 1 )
if ! Empty( cText )
cText += CRLF
endif
cText += ::ClpRow( .t. )
::Skip( 1 ) // Eval( ::bSkip, 1 )
nRow ++
if Len( cText ) > 16000
oClip:SetText( cText )
oBook:CurrentController:select( oSheet:GetCellByPosition( 0,nPasteRow-1 ) )
IF nPasteMode == 2
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:Paste", "", 0, aProp)
else
PasteUnformattedText(oCalc,oBook,oSheet,aCols)
Endif
oClip:Clear()
cText := ""
nPasteRow := nRow
endif
If ( nRow - 2 ) % nStep == 0
if Eval( bProgress, nRow - 2, nDataRows ) == .f.
Exit
endif
SysRefresh()
endif
enddo
if ! Empty( cText )
oClip:SetText( cText )
oBook:CurrentController:select( oSheet:GetCellByPosition( 0,nPasteRow-1 ) )
IF nPasteMode == 2
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:Paste", "", 0, aProp)
else
PasteUnformattedText(oCalc,oBook,oSheet,aCols)
Endif
oClip:Clear()
cText := ""
endif
oClip:Close()
Eval( bProgress, nDataRows, nDataRows )
SysRefresh()
endif
oClip:End()
endif
else
::Copy()
oBook:CurrentController:select( oSheet:GetCellByPosition( 2,1 ) )
IF nPasteMode == 2
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:Paste", "", 0, aProp)
else
PasteUnformattedText(oCalc,oBook,oSheet,aCols)
Endif
nRow := Len( ::aSelected ) + 2
ENDIF
nCol := 0 ; nRow:=nRow-2
oBook:CurrentController:select( oSheet:GetCellRangeByPosition( 0, nRow, Len( aCols )-1,nRow ) )
// Draw Bottom Border Line on the Bottom Row
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "OuterBorder.BottomBorder", {1,1,2,1} ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:SetBorderStyle", "", 0, aProp)
if ValType( nGroupBy ) == 'N'
for nxCol := 1 TO Len( aCols )
if aCols[ nxCol ]:lTotal
AAdd( aTotals, nxCol )
endif
next
if ! Empty( aTotals )
CalcSubTotal(oCalc,oBook,oSheet,nGroupBy,aTotals,nRow,Len(aCols)-1)
Endif
else
// If lTotal is .T. for any column then create the formula to Show the Column Total
for nXCol := 1 TO Len ( aCols )
oCol := aCols[ nXCol ]
nCol ++
if oCol:lTotal
oBook:CurrentController:select( oSheet:GetCellByPosition( nCol-1,nRow+1 ) )
aProp:={}
*AAdd(aProp,GetPropertyValue(oCalc, "StringName","=SUM("+ oSheet:getColumns():getByIndex(nCol)+"2:"+oSheet:getColumns():getByIndex(nCol)+LTrim(Str(nRow+1))+")" ) )
AAdd(aProp,GetPropertyValue(oCalc, "StringName",cxlSum+ MakeColAlphabet(nCol)+"2:"+MakeColAlphabet(nCol)+LTrim(Str(nRow+1))+")" ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:EnterString", "", 0, aProp)
lAnyTotals := .t.
endif
next nXCol
if lAnyTotals
oBook:CurrentController:select( oSheet:GetCellRangeByPosition( 0, nRow+1, Len( aCols )-1,nRow+1 ) )
// Draw Bottom Border Line on the Total Line Row
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "OuterBorder.BottomBorder", {1,1,2,1} ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:SetBorderStyle", "", 0, aProp)
// Make the Total Line Bold
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "Bold", .T. ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:Bold", "", 0, aProp)
ENDIF
Endif
oBook:CurrentController:select( oSheet:GetCellByPosition( 1,1 ) )
for nCol := 1 to Len( aCols )
oSheet:GetColumns():GetByIndex( nCol-1 ):OptimalWidth = .T.
next
oBook:CurrentController:select( oSheet:GetCellByPosition( 0,1 ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:FreezePanes", "", 0, {})
Eval( ::bBookMark, uBookMark )
::Refresh()
::SetFocus()
// This routine allows screen updating
oBook:UnlockControllers()
oBook:removeActionLock()
// If you want to convert this to other formats like PDF format or MS Excel
IF Len(aSaveAs) > 0
FOR I:=1 TO Len(aSaveAs)
cFormat:=Upper(aSaveAs[i][1])
cFileName:=aSaveAs[i][2]
* Ensure leading slash.
IF LEFT( cFilename, 1 ) != "/"
cFileName:= "/" + cFileName
ENDIF
cURL:= StrTran( cFilename, "\", "/" ) // change backslashes to forward slashes.
cURL = "file://" + cURL
aProp:={} ; nPos:=0
nPos:=AScan(aOOFilters,{ |x| x[1] == cFormat})
IF nPos > 0
AAdd(aProp,GetPropertyValue(oCalc, "FilterName", aOOFilters[nPos][2]) )
cURL:=cURL+"."+cFormat
oBook:StoreToURL( cURL, aProp )
Endif
Next
ENDIF
oBook:GetCurrentController():GetFrame():GetContainerWindow():SetVisible(.T.)
oBook:CurrentController:select( oSheet:GetCellByPosition( 0,0 ) )
* oBook:Close(1) // To Close OpenOffice Calc
Return Self
//----------------------------------------------------------------------------//
STATIC Function MakeColAlphabet(nCol)
LOCAL aColumns:={"A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R",;
"S","T","U","V","W","X","Y","Z"}
LOCAL cColAphabet,nInt
IF nCol <= 26
cColAphabet:=aColumns[nCol]
ELSEif nCol <= 676
nInt:=Int(nCol/26)
cColAphabet:=aColumns[nCol]
cColAphabet+=aColumns[nCol-(nInt*26)]
Endif
RETURN cColAphabet
//----------------------------------------------------------------------------//
STATIC FUNCTION GetPropertyValue(oService, cName, xValue )
LOCAL oArg
oArg := oService:Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
oArg:Name := cName
oArg:Value := xValue
RETURN oArg
//----------------------------------------------------------------------------//
STATIC Function GetNumberFormatId(oBook, cNumberFormat, cColHeader, cDataType)
LOCAL cCharLocale,nFormatId
cCharLocale = oBook:GetPropertyValue("CharLocale")
IF cDataType == "D" // Date
cNumberFormat:=Upper(cNumberFormat)
IF cCharLocale:Language == "es" .or. cCharLocale:Language == "pt" .or. cCharLocale:Language == "it" // Spanish,Portuguese,Italian,French
cNumberFormat:=StrTran(cNumberFormat,"Y","A") // All Y should be replaced to A
ELSEIF cCharLocale:Language == "de" // German
cNumberFormat:=StrTran(cNumberFormat,"D","T") // All D should be replaced to T
cNumberFormat:=StrTran(cNumberFormat,"Y","J") // All Y should be replaced to J
elseif cCharLocale:Language == "fr" // French
cNumberFormat:=StrTran(cNumberFormat,"D","J") // All D should be replaced to J
cNumberFormat:=StrTran(cNumberFormat,"Y","A") // All Y should be replaced to A
Endif
Endif
nFormatId = oBook:GetNumberFormats:QueryKey(cNumberFormat, cCharLocale, .F.)
IF nFormatId = -1 // 'Format is not yet defined
TRY
nFormatId = oBook:GetNumberFormats:AddNew(cNumberFormat, cCharLocale)
CATCH
MsgInfo("Could not set the format "+cNumberFormat+" to column "+cColHeader)
IF cDataType == "D" // Date
nFormatId:=37
Endif
END
ENDIF
RETURN nFormatId
//----------------------------------------------------------------------------//
STATIC FUNCTION CalcSubTotal(oCalc,oBook,oSheet,nGroupBy,aTotals,nRow,nCol)
LOCAL oRange, oSubTotDesc,oColumns,aArg:={},nCount
FOR nCount:=1 TO Len(aTotals)
oColumns := oCalc:Bridge_GetStruct( "com.sun.star.sheet.SubTotalColumn" )
//Description by columns : sum of 4th col should be 3, for 2 it should be 1
oColumns:Column := aTotals[nCount]-1
oColumns:Function :=2 // com.sun.star.sheet.GeneralFunction.SUM
AAdd(aArg,oColumns)
Next
oRange:= oSheet:getCellRangeByPosition( 0, 0, nCol,nRow )
oSubTotDesc:=oRange:createSubTotalDescriptor(.T.) // true creates an empty descriptor. false previous settings
//Group by: nGroupBy col-1
oSubTotDesc:addNew(aArg, nGroupBy-1)
oRange:applySubTotals(oSubTotDesc, .T.) // true = replaces previous subtotal
Return NIL
//----------------------------------------------------------------------------//
STATIC Function PasteUnformattedText(oCalc,oBook,oSheet,aCols)
LOCAL oClipContType,oClipContent,oClip,cStr,i,nClipColNo
LOCAL lFound,nRow,nCol,k,oCol
oClip = oCalc:CreateInstance("com.sun.star.datatransfer.clipboard.SystemClipboard")
oClipContType = oClip:Contents:getTransferDataFlavors
lFound = .F. ; i:= 1
DO while i <= Len(oClipContType) .AND. !lFound
if oClipContType[i]:HumanPresentableName = "OEM/ANSI Text"
lFound = .T.
k:=i
else
i:=i + 1
endif
Enddo
if lFound
nRow = oBook:CurrentSelection:getRangeAddress():startrow
oClipContent:=oClip:Contents:getTransferData( oClipContType[k] )
i:=1 ; cStr:="" ; nCol:=0
DO while i <= Len(oClipContent)
if oClipContent[i] = 0 .OR. oClipContent[i] = 13 .OR. oClipContent[i] = 10
i=i+2 ; nRow:=nRow + 1 ; cStr:="" ; nCol:=0
ELSEIF oClipContent[i] = 9 // Tab
oCol:=aCols[nCol+1]
IF oCol:cDataType == "C"
oSheet:getCellByposition(nCol,nRow):SetString(cStr)
ELSEIF oCol:cDataType == "N"
oSheet:getCellByposition(nCol,nRow):SetValue(cStr)
ELSEIF oCol:cDataType == "D"
oSheet:getCellByposition(nCol,nRow):SetFormula(cStr)
ELSE
oSheet:getCellByposition(nCol,nRow):SetString(cStr)
Endif
nCol:=nCol+1 ; cStr:="" ; i:=i+1
else
cStr:=cStr + chr(oClipContent[i])
i:=i+1
endif
Enddo
endif
RETURN NIL
//----------------------------------------------------------------------------//
Thanks & Regards
Anser
