fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2011-10-28 11:23 UTC-0800 Pritpal Bedi (bedipritpal@hotmail.com)

Browse Source 
+ contrib/hbxlsxml
  + contrib/hbxlsxml/hbxlsxml.hbp
  + contrib/hbxlsxml/xlsxml.prg
  + contrib/hbxlsxml/xlsxml_s.prg
  + contrib/hbxlsxml/xlsxml_y.prg
    + Added: Fausto Di Creddo Trautwein's XML compliant interface 
             to generate native  files for Microsoft's Excel. The work 
             is based on Robert F Greer's PHP based interface. 
             Thanks to both of them.

  + contrib/hbxlsxml/tests
  + contrib/hbxlsxml/tests/example.prg
  + contrib/hbxlsxml/tests/example2.prg
  + contrib/hbxlsxml/tests/example3.prg
  + contrib/hbxlsxml/tests/hbmk.hbm
    + Added: user test code based on above library written by Fausto Di Creddo.

    ; NOTES: As I have found this library quite useful it is placed in 
             contrib section instead of in examples.

             I have simply formatted sources to Harbour standards tweaking 
             something here and there only. The sources have the potential 
             to further optimize, but as in its current state itself, 
             it is robust.
This commit is contained in:
Pritpal Bedi
2011-10-28 18:34:39 +00:00
parent 0a4bccada8
commit ac88e1f119
9 changed files with 2343 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
harbour/ChangeLog
View File

@@ -16,6 +16,32 @@
The license applies to all entries newer than 2009-04-28.
*/
2011-10-28 11:23 UTC-0800 Pritpal Bedi (bedipritpal@hotmail.com)
+ contrib/hbxlsxml
+ contrib/hbxlsxml/hbxlsxml.hbp
+ contrib/hbxlsxml/xlsxml.prg
+ contrib/hbxlsxml/xlsxml_s.prg
+ contrib/hbxlsxml/xlsxml_y.prg
+ Added: Fausto Di Creddo Trautwein's XML compliant interface
to generate native files for Microsoft's Excel. The work
is based on Robert F Greer's PHP based interface.
Thanks to both of them.
+ contrib/hbxlsxml/tests
+ contrib/hbxlsxml/tests/example.prg
+ contrib/hbxlsxml/tests/example2.prg
+ contrib/hbxlsxml/tests/example3.prg
+ contrib/hbxlsxml/tests/hbmk.hbm
+ Added: user test code based on above library written by Fausto Di Creddo.
; NOTES: As I have found this library quite useful it is placed in
contrib section instead of in examples.
I have simply formatted sources to Harbour standards tweaking
something here and there only. The sources have the potential
to further optimize, but as in its current state itself,
it is robust.
2011-10-28 01:26 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* src/rtl/tget.prg
! fixed RTE when setting :picture to NIL for

24
harbour/contrib/hbxlsxml/hbxlsxml.hbp Normal file
View File

@@ -0,0 +1,24 @@
#
# $Id$
#
-3rd=hbide_version=1.0
-3rd=hbide_type=Lib
-3rd=hbide_title=XmlExcel
-3rd=hbide_output=xlsxml
-inc
-hblib
-es2
-w3
xlsxml.prg
xlsxml_s.prg
xlsxml_y.prg
-ohbxlsxml

285
harbour/contrib/hbxlsxml/tests/example.prg Normal file
View File

@@ -0,0 +1,285 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
*
* Copyright 2011 Fausto Di Creddo Trautwein, ftwein@yahoo.com.br
* www - http://www.xharbour.org http://harbour-project.org
*
* Thanks TO Robert F Greer, PHP original version
* http://sourceforge.net/projects/excelwriterxml/
*
* This program is free software; you can redistribute it AND/OR modify
* it under the terms of the GNU General PUBLIC License as published by
* the Free Software Foundation; either version 2, OR( at your option )
* any later version.
*
* This program is distributed IN the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General PUBLIC License FOR more details.
*
* You should have received a copy of the GNU General PUBLIC License
* along WITH this software; see the file COPYING. IF NOT, write TO
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA( OR visit the web site http://www.gnu.org/ ).
*
* As a special exception, the Harbour Project gives permission FOR
* additional uses of the text contained IN its release of Harbour.
*
* The exception is that, IF you link the Harbour libraries WITH other
* files TO produce an executable, this does NOT by itself cause the
* resulting executable TO be covered by the GNU General PUBLIC License.
* Your use of that executable is IN no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does NOT however invalidate any other reasons why
* the executable file might be covered by the GNU General PUBLIC License.
*
* This exception applies only TO the code released by the Harbour
* Project under the name Harbour. IF you copy code FROM other
* Harbour Project OR Free Software Foundation releases into a copy of
* Harbour, as the General PUBLIC License permits, the exception does
* NOT apply TO the code that you add IN this way. TO avoid misleading
* anyone as TO the status of such modified files, you must delete
* this exception notice FROM them.
*
* IF you write modifications of your own FOR Harbour, it is your choice
* whether TO permit this exception TO apply TO your modifications.
* IF you DO NOT wish that, delete this exception notice.
*
*/
/*----------------------------------------------------------------------*/
FUNCTION main()
LOCAL oXml, oSheet, xarquivo := "example.xml"
LOCAL i, xqtddoc, xttotnot, xtbascal, xtvlricm, xtbasipi, xtvlripi, aDoc, nLinha
LOCAL xEmpresa
LOCAL xDataImp
LOCAL xTitulo
LOCAL xPeriodo
LOCAL xOrdem
SET DATE TO BRITISH
oXml:= ExcelWriterXML():New(xarquivo)
oXml:setOverwriteFile(.t.)
WITH OBJECT oXml:addStyle('textLeft')
:alignHorizontal('Left')
:alignVertical('Center')
:fontSize(10)
END WITH
WITH OBJECT oXml:addStyle('textLeftWrap')
:alignHorizontal('Left')
:alignVertical('Center')
:alignWraptext()
:fontSize(10)
END WITH
WITH OBJECT oXml:addStyle('textLeftBold')
:alignHorizontal('Left')
:alignVertical('Center')
:fontSize(10)
:setFontBold()
END WITH
WITH OBJECT oXml:addStyle('textLeftBoldCor')
:alignHorizontal('Left')
:alignVertical('Center')
:fontSize(10)
:setFontBold()
:bgColor('lightblue')
:alignWraptext()
END WITH
WITH OBJECT oXml:addStyle('textRight')
:alignHorizontal('Right')
:alignVertical('Center')
:fontSize(10)
END WITH
WITH OBJECT oXml:addStyle('textRightBold')
:alignHorizontal('Right')
:alignVertical('Center')
:fontSize(10)
:setFontBold()
END WITH
WITH OBJECT oXml:addStyle('textRightBoldCor')
:alignHorizontal('Right')
:alignVertical('Center')
:fontSize(10)
:setFontBold()
:bgColor('lightblue')
:alignWraptext()
END WITH
WITH OBJECT oXml:addStyle('numberRight')
:alignHorizontal('Right')
:alignVertical('Center')
:setNumberFormat('#,##0.00')
:fontSize(10)
END WITH
WITH OBJECT oXml:addStyle('numberRightBold')
:alignHorizontal('Right')
:alignVertical('Center')
:setNumberFormat('#,##0.00')
:fontSize(10)
:setFontBold()
END WITH
WITH OBJECT oXml:addStyle('numberRightBoldCor')
:alignHorizontal('Right')
:alignVertical('Center')
:setNumberFormat('#,##0.00')
:fontSize(10)
:setFontBold()
:bgColor('lightblue')
END WITH
WITH OBJECT oXml:addStyle('numberRightZero')
:alignHorizontal('Right')
:alignVertical('Center')
:setNumberFormat('#,##0.00;[Red]-#,##0.00;;@') //'#,###.00')
:fontSize(10)
:setFontBold()
END WITH
WITH OBJECT oXml:addStyle('Cabec')
:alignHorizontal('Left')
:alignVertical('Center')
:fontSize(12)
:setFontBold()
END WITH
WITH OBJECT oXml:addStyle('CabecRight')
:alignHorizontal('Right')
:alignVertical('Center')
:fontSize(12)
:setFontBold()
END WITH
oSheet := oXml:addSheet('Plan1')
WITH OBJECT oSheet
:columnWidth( 1, 70 ) // N.Fiscal
:columnWidth( 2, 20 ) // TM
:columnWidth( 3, 70 ) // Data Movto
:columnWidth( 4, 70 ) // Data Emis.
:columnWidth( 5, 50 ) // CFOP
:columnWidth( 6, 50 ) // C›d. Cliente/Fornecedor
:columnWidth( 7, 300 ) // Nome Cliente/Fornecedor
:columnWidth( 8, 20 ) // UF
:columnWidth( 9, 80 ) // Vlr.Tot.
:columnWidth(10, 80 ) // Base Calc.
:columnWidth(11, 80 ) // Vlr ICMS
:columnWidth(12, 80 ) // Base IPI
:columnWidth(13, 80 ) // Valor IPI
xEmpresa:= "EMPRESA DEMONSTRACAO LTDA"
xDataImp:= "22.03.2011"
xTitulo := "RELATORIO PARA DEMONSTRAR XML EXCEL"
xPeriodo:= "01.02.2011 a 28.02.2011"
xOrdem := "DATA DE EMISSAO"
nLinha:= 0
:writeString(++nLinha,1,xEmpresa ,'Cabec')
:cellMerge( nLinha,1, 5, 0)
:writeString( nLinha,12,"Data:"+xDataImp ,'CabecRight')
:cellMerge( nLinha,12, 1, 0)
:writeString(++nLinha,1,xTitulo ,'Cabec')
:cellMerge( nLinha,1, 5, 0)
:writeString(++nLinha,1,xPeriodo ,'Cabec')
:cellMerge( nLinha,1, 5, 0)
:writeString(++nLinha,1,xOrdem ,'Cabec')
:cellMerge( nLinha,1, 5, 0)
END WITH
WITH OBJECT oSheet
:writeString(++nLinha, 1,"N.Fiscal" ,'textLeftBoldCor' )
:writeString( nLinha, 2,"TM" ,'textLeftBoldCor' )
:writeString( nLinha, 3,"Data Movto" ,'textLeftBoldCor' )
:writeString( nLinha, 4,"Data Emis." ,'textLeftBoldCor' )
:writeString( nLinha, 5,"CFOP" ,'textLeftBoldCor' )
:writeString( nLinha, 6,"C›digo" ,'textLeftBoldCor' )
:writeString( nLinha, 7,"Cliente/Fornecedor",'textLeftBoldCor' )
:writeString( nLinha, 8,"UF" ,'textLeftBoldCor' )
:writeString( nLinha, 9,"Vlr.Tot." ,'textRightBoldCor')
:writeString( nLinha,10,"Base Calc." ,'textRightBoldCor')
:writeString( nLinha,11,"Vlr ICMS" ,'textRightBoldCor')
:writeString( nLinha,12,"Base IPI" ,'textRightBoldCor')
:writeString( nLinha,13,"Valor IPI" ,'textRightBoldCor')
END WITH
aDoc:= {}
FOR i:= 1 TO 40
AADD( aDoc,;
{ STRZERO(i,8),;
"VE",;
DATE()-49-i,;
DATE()-50-i,;
"5.102",;
STRZERO(i,5),;
"NOME DO CLIENTE TESTE "+ALLTRIM(STR(i,5,0)),;
"PR",;
i*100,;
i*100*0.90,;
i*100*0.90*0.12,;
i*100,;
i*100*0.10 } )
NEXT
xqtddoc:= xttotnot:= xtbascal:= xtvlricm:= xtbasipi:= xtvlripi:= 0
FOR i:= 1 TO 40
WITH OBJECT oSheet
:writeString(++nLinha, 1,aDoc[i,1],'textLeft')
:writeString( nLinha, 2,aDoc[i,2],'textLeft')
:writeString( nLinha, 3,DTOC(aDoc[i,3]),'textLeft')
:writeString( nLinha, 4,DTOC(aDoc[i,4]),'textLeft')
:writeString( nLinha, 5,aDoc[i,5],'textLeft')
:writeString( nLinha, 6,aDoc[i,6],'textLeft')
:writeString( nLinha, 7,aDoc[i,7],'textLeft')
:writeString( nLinha, 8,aDoc[i,8],'textLeft')
:writeNumber( nLinha, 9,aDoc[i,9],'numberRight')
:writeNumber( nLinha,10,aDoc[i,10],'numberRight')
:writeNumber( nLinha,11,aDoc[i,11],'numberRight')
:writeNumber( nLinha,12,aDoc[i,12],'numberRight')
:writeNumber( nLinha,13,aDoc[i,13],'numberRight')
END WITH
xqtddoc++
xttotnot+= aDoc[i,9]
xtbascal+= aDoc[i,10]
xtvlricm+= aDoc[i,11]
xtbasipi+= aDoc[i,12]
xtvlripi+= aDoc[i,13]
NEXT
WITH OBJECT oSheet
:writeString(++nLinha, 1,"",'textLeft')
:writeString( nLinha, 2,"",'textLeft')
:writeString( nLinha, 3,"",'textLeft')
:writeString( nLinha, 4,"",'textLeft')
:writeString( nLinha, 5,"",'textLeft')
:writeString( nLinha, 6,"",'textLeft')
:writeString( nLinha, 7,"TOTAL ==> "+STR(xqtddoc,5)+" documentos",'textLeftBold')
:writeString( nLinha, 8,"",'textLeft')
:writeFormula('Number',nLinha,9,'=SUM(R[-40]C:R[-1]C)','numberRightBold')
//:writeNumber( nLinha, 9,xttotnot,'numberRightBold')
:writeNumber( nLinha,10,xtbascal,'numberRightBold')
:writeNumber( nLinha,11,xtvlricm,'numberRightBold')
:writeNumber( nLinha,12,xtbasipi,'numberRightBold')
:writeNumber( nLinha,13,xtvlripi,'numberRightBold')
END WITH
oXml:writeData(xarquivo)
RETURN NIL
/*----------------------------------------------------------------------*/

152
harbour/contrib/hbxlsxml/tests/example2.prg Normal file
View File

@@ -0,0 +1,152 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
*
* Copyright 2011 Fausto Di Creddo Trautwein, ftwein@yahoo.com.br
* www - http://www.xharbour.org http://harbour-project.org
*
* Thanks TO Robert F Greer, PHP original version
* http://sourceforge.net/projects/excelwriterxml/
*
* This program is free software; you can redistribute it AND/OR modify
* it under the terms of the GNU General PUBLIC License as published by
* the Free Software Foundation; either version 2, OR( at your option )
* any later version.
*
* This program is distributed IN the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General PUBLIC License FOR more details.
*
* You should have received a copy of the GNU General PUBLIC License
* along WITH this software; see the file COPYING. IF NOT, write TO
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA( OR visit the web site http://www.gnu.org/ ).
*
* As a special exception, the Harbour Project gives permission FOR
* additional uses of the text contained IN its release of Harbour.
*
* The exception is that, IF you link the Harbour libraries WITH other
* files TO produce an executable, this does NOT by itself cause the
* resulting executable TO be covered by the GNU General PUBLIC License.
* Your use of that executable is IN no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does NOT however invalidate any other reasons why
* the executable file might be covered by the GNU General PUBLIC License.
*
* This exception applies only TO the code released by the Harbour
* Project under the name Harbour. IF you copy code FROM other
* Harbour Project OR Free Software Foundation releases into a copy of
* Harbour, as the General PUBLIC License permits, the exception does
* NOT apply TO the code that you add IN this way. TO avoid misleading
* anyone as TO the status of such modified files, you must delete
* this exception notice FROM them.
*
* IF you write modifications of your own FOR Harbour, it is your choice
* whether TO permit this exception TO apply TO your modifications.
* IF you DO NOT wish that, delete this exception notice.
*
*/
/*----------------------------------------------------------------------*/
FUNCTION main()
LOCAL xml, format1, format2, format3, format4
LOCAL sheet1, sheet2, sheet4
xml = ExcelWriterXML():new('my file.xml')
/**
* Add some general properties to the document
*/
xml:docTitle('My Demo Doc')
xml:docAuthor('Robert F Greer')
xml:docCompany('Greers.Org')
xml:docManager('Wife')
/**
* Choose to show any formatting/input errors on a seperate sheet
*/
//xml:showErrorSheet(.t.)
/**
* Show the style options
*/
format1 = xml:addStyle('left_rotate60_big')
format1:alignRotate(60)
format1:alignHorizontal('Left')
format1:setFontSize('18')
format2 = xml:addStyle('verticaltext_left')
format2:alignVerticaltext(45)
format2:alignHorizontal('Left')
format3 = xml:addStyle('wraptext_top')
format3:alignWraptext()
format3:alignVertical('Top')
/**
* Create a new sheet with the XML document
*/
sheet1 = xml:addSheet('Alignment')
/**
* Add three new cells of type String with difference alignment values.
* Notice that the style of the each cell can be explicity named or the style
* reference can be passed.
*/
sheet1:writeString(1,1,'left_rotate45',format1)
sheet1:writeString(1,2,'vertical left','verticaltext_left')
sheet1:writeString(1,3,'this text has been wrapped and is aligned at the top','wraptext_top')
//sheet1:writeString(1,4,'No style applied')
sheet2 = xml:addSheet('Formulas')
/**
* Wrote three numbers.
* Rows 4 and 5 show the formulas in R1C1 notation using the writeFormula()
* function.
* Also see how comments are added.
*/
sheet2:columnWidth(1,100)
sheet2:writeString(1,1,'Number')
sheet2:writeNumber(1,2,50)
sheet2:writeString(2,1,'Number')
sheet2:writeNumber(2,2,30)
sheet2:writeString(3,1,'Number')
sheet2:writeNumber(3,2,20)
sheet2:writeString(4,1,'=SUM(R[-3]C:R[-1]C)')
sheet2:writeFormula('Number',4,2,'=SUM(R[-3]C:R[-1]C)')
//sheet2:addComment(4,2,'Here is my formula: =SUM(R[-3]C:R[-1]C)','My NAME')
sheet2:writeString(5,1,'=SUM(R1C2:R3C2)')
sheet2:writeFormula('Number',5,2,'=SUM(R1C1:R3C2)')
//sheet2:addComment(5,2,'Here is my formula: =SUM(R1C1:R3C2)')
sheet4 = xml:addSheet('more formatting')
format4 = xml:addStyle('my style')
format4:setFontBold()
format4:setFontItalic()
format4:setFontUnderline('DoubleAccounting')
format4:bgColor('Black')
format4:setFontColor('White')
format4:setNumberFormatDateTime()
//mydate = sheet4:convertMysqlDateTime('2008-02-14 19:30:00')
sheet4:writeDateTime(1,1,DTOC(DATE()),format4)
// Change the row1 height to 30 pixels
sheet4:rowHeight(1,'30')
sheet4:writeString(2,1,'formatted text + cell color + merged + underlined',format4)
// Merge (2,1) with 4 columns to the right and 2 rows down
sheet4:cellMerge(2,1,4,2)
/**
* Send the headers, then output the data
*/
//xml:sendHeaders()
xml:writeData('example2.xml')
RETURN NIL
/*----------------------------------------------------------------------*/

85
harbour/contrib/hbxlsxml/tests/example3.prg Normal file
View File

@@ -0,0 +1,85 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
*
* Copyright 2011 Fausto Di Creddo Trautwein, ftwein@yahoo.com.br
* www - http://www.xharbour.org http://harbour-project.org
*
* Thanks TO Robert F Greer, PHP original version
* http://sourceforge.net/projects/excelwriterxml/
*
* This program is free software; you can redistribute it AND/OR modify
* it under the terms of the GNU General PUBLIC License as published by
* the Free Software Foundation; either version 2, OR( at your option )
* any later version.
*
* This program is distributed IN the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General PUBLIC License FOR more details.
*
* You should have received a copy of the GNU General PUBLIC License
* along WITH this software; see the file COPYING. IF NOT, write TO
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA( OR visit the web site http://www.gnu.org/ ).
*
* As a special exception, the Harbour Project gives permission FOR
* additional uses of the text contained IN its release of Harbour.
*
* The exception is that, IF you link the Harbour libraries WITH other
* files TO produce an executable, this does NOT by itself cause the
* resulting executable TO be covered by the GNU General PUBLIC License.
* Your use of that executable is IN no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does NOT however invalidate any other reasons why
* the executable file might be covered by the GNU General PUBLIC License.
*
* This exception applies only TO the code released by the Harbour
* Project under the name Harbour. IF you copy code FROM other
* Harbour Project OR Free Software Foundation releases into a copy of
* Harbour, as the General PUBLIC License permits, the exception does
* NOT apply TO the code that you add IN this way. TO avoid misleading
* anyone as TO the status of such modified files, you must delete
* this exception notice FROM them.
*
* IF you write modifications of your own FOR Harbour, it is your choice
* whether TO permit this exception TO apply TO your modifications.
* IF you DO NOT wish that, delete this exception notice.
*
*/
/*----------------------------------------------------------------------*/
FUNCTION main()
LOCAL xml, sheet1, format4
xml:= ExcelWriterXML():New('my file.xml')
sheet1 = xml:addSheet('Plan 1')
format4 = xml:addStyle('my style')
format4:setFontSize(20)
format4:setFontColor('yellow')
format4:bgColor('blue')
sheet1:columnWidth(1,150)
sheet1:columnWidth(2,150)
sheet1:columnWidth(3,150)
sheet1:writeString(2,3,'celula 2_3',format4)
sheet1:writeString(2,2,'celula 2_2',format4)
sheet1:writeString(2,1,'celula 2_1',format4)
sheet1:writeString(1,1,'celula 1_1',format4)
//sheet1:writeString(1,2,'celula 1_2',format4)
sheet1:writeString(1,3,'celula 1_3',format4)
sheet1:cellMerge(1,1,1,0)
xml:writeData('example3.xml')
RETURN NIL
/*----------------------------------------------------------------------*/

12
harbour/contrib/hbxlsxml/tests/hbmk.hbm Normal file
View File

@@ -0,0 +1,12 @@
#
# $Id$
#
-w3
-es2
-L../
-lhbxlsxml

511
harbour/contrib/hbxlsxml/xlsxml.prg Normal file
View File

@@ -0,0 +1,511 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
*
* Copyright 2011 Fausto Di Creddo Trautwein, ftwein@yahoo.com.br
* www - http://www.xharbour.org http://harbour-project.org
*
* Thanks TO Robert F Greer, PHP original version
* http://sourceforge.net/projects/excelwriterxml/
*
* This program is free software; you can redistribute it AND/OR modify
* it under the terms of the GNU General PUBLIC License as published by
* the Free Software Foundation; either version 2, OR( at your option )
* any later version.
*
* This program is distributed IN the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General PUBLIC License FOR more details.
*
* You should have received a copy of the GNU General PUBLIC License
* along WITH this software; see the file COPYING. IF NOT, write TO
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA( OR visit the web site http://www.gnu.org/ ).
*
* As a special exception, the Harbour Project gives permission FOR
* additional uses of the text contained IN its release of Harbour.
*
* The exception is that, IF you link the Harbour libraries WITH other
* files TO produce an executable, this does NOT by itself cause the
* resulting executable TO be covered by the GNU General PUBLIC License.
* Your use of that executable is IN no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does NOT however invalidate any other reasons why
* the executable file might be covered by the GNU General PUBLIC License.
*
* This exception applies only TO the code released by the Harbour
* Project under the name Harbour. IF you copy code FROM other
* Harbour Project OR Free Software Foundation releases into a copy of
* Harbour, as the General PUBLIC License permits, the exception does
* NOT apply TO the code that you add IN this way. TO avoid misleading
* anyone as TO the status of such modified files, you must delete
* this exception notice FROM them.
*
* IF you write modifications of your own FOR Harbour, it is your choice
* whether TO permit this exception TO apply TO your modifications.
* IF you DO NOT wish that, delete this exception notice.
*
*/
/*----------------------------------------------------------------------*/
#include "hbclass.ch"
#include "fileio.ch"
/*----------------------------------------------------------------------*/
CREATE CLASS ExcelWriterXML
DATA styles INIT {}
DATA formatErrors INIT {=>}
DATA sheets INIT {}
DATA lShowErrorSheet INIT .f.
DATA overwriteFile INIT .f.
DATA docFileName
DATA cDocTitle
DATA cDocSubject
DATA cDocAuthor
DATA cDocCreated
DATA cDocManager
DATA cDocCompany
DATA cDocVersion INIT "11.9999"
DATA cError INIT ""
DATA errors INIT .f.
METHOD New( fileName )
METHOD setOverwriteFile( overwrite )
METHOD showErrorSheet( show )
METHOD addError( cFunction, cMessage )
METHOD getDefaultStyle()
METHOD addStyle( id )
METHOD addSheet( id )
METHOD checkSheetID( id )
METHOD checkStyleID( id )
METHOD writeData( target )
METHOD docTitle( title )
METHOD docSubject( subject )
METHOD docAuthor( author )
METHOD docManager( manager )
METHOD docCompany( company )
ENDCLASS
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:new( fileName )
LOCAL style
style := ::addStyle( 'DEFAULT' )
style:name( 'Normal' )
style:alignVertical( 'Bottom' )
IF empty( fileName )
fileName := 'file.xml'
ENDIF
::docFileName := fileName
::cDocCreated := DTOS( DATE() ) + 'T' + TIME() + 'Z'
RETURN SELF
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:setOverwriteFile( overwrite )
IF ! ( VALTYPE( overwrite ) == "L" )
::overwriteFile := .f.
ELSE
::overwriteFile := overwrite
ENDIF
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:showErrorSheet( show )
IF ! ( VALTYPE( show ) == "L" )
::lShowErrorSheet := .t.
ELSE
::lShowErrorSheet := show
ENDIF
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:addError( cFunction, cMessage )
LOCAL tmp
tmp := { 'FUNCTION' => cFunction,;
'MESSAGE' => cMessage }
::formatErrors += tmp
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:getDefaultStyle()
RETURN ::styles[ 1 ]
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:addStyle( id )
LOCAL style
STATIC styleNum := 1
IF alltrim( id ) == ''
id := NIL
ENDIF
IF id == NIL
id := 'CustomStyle' + ALLTRIM( STR( styleNum, 3 ) )
styleNum++
ENDIF
WHILE ! ::checkStyleID( id )
id := 'CustomStyle' + ALLTRIM( STR( styleNum, 3 ) )
styleNum++
ENDDO
style := ExcelWriterXML_Style():new( id )
AADD( ::styles, style )
RETURN style
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:addSheet( id )
LOCAL sheet
STATIC sheetNum:= 1
IF id == NIL
id := 'Sheet' + ALLTRIM( STR( sheetNum, 3 ) )
sheetNum++
ENDIF
WHILE ! ::checkSheetID( id )
id := 'Sheet' + ALLTRIM( STR( sheetNum, 3 ) )
sheetNum++
ENDDO
sheet := ExcelWriterXML_Sheet():New( id )
AADD( ::sheets, sheet )
RETURN sheet
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:checkSheetID( id )
LOCAL sheet
IF len( ::sheets ) > 0
FOR EACH sheet IN ::sheets
IF id == sheet:getID()
RETURN .f.
ENDIF
NEXT
ELSE
RETURN .t.
ENDIF
RETURN .t.
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:checkStyleID( id )
LOCAL style
IF LEN( ::styles ) > 0
FOR EACH style IN ::styles
IF id == style:getID()
RETURN .f.
ENDIF
NEXT
ELSE
RETURN .t.
ENDIF
RETURN .t.
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:writeData( target )
LOCAL style, sheet, xml := "", handle, fileExists, format
LOCAL docTitle := ''
LOCAL docSubject := ''
LOCAL docAuthor := ''
LOCAL docCreated := ''
LOCAL docManager := ''
LOCAL docCompany := ''
IF target == NIL
::cError := "Target filename missing!" )
::errors := .t.
RETURN .t.
ENDIF
fileExists := hb_fileExists( target )
IF ( fileExists == .t. .AND. ::overwriteFile == .f. )
::cError := target + " exists and overwriteFile is set to false"
::errors := .t.
RETURN .f.
ENDIF
handle := hb_fcreate( target, FC_NORMAL, FO_EXCLUSIVE )
IF handle == -1
::cError := "Not able to open " + target + " for writing"
::errors := .t.
RETURN .f.
ENDIF
IF ::lShowErrorSheet == .t.
format := ::addStyle( "formatErrorsHeader" )
format:setFontBold()
format:bgColor( "red" )
ENDIF
IF ! empty( ::cDocTitle ); docTitle := "<Title>" + OemToHtmlEspecial( ::cDocTitle ) + "</Title>" + HB_OsNewLine(); ENDIF
IF ! empty( ::cDocSubject ); docSubject := "<Subject>" + OemToHtmlEspecial( ::cDocSubject ) + "</Subject>" + HB_OsNewLine(); ENDIF
IF ! empty( ::cDocAuthor ); docAuthor := "<Author>" + OemToHtmlEspecial( ::cDocAuthor ) + "</Author>" + HB_OsNewLine(); ENDIF
IF ! empty( ::cDocCreated ); docCreated := "<Created>" + OemToHtmlEspecial( ::cDocCreated ) + "</Created>" + HB_OsNewLine(); ENDIF
IF ! empty( ::cDocManager ); docManager := "<Manager>" + OemToHtmlEspecial( ::cDocManager ) + "</Manager>" + HB_OsNewLine(); ENDIF
IF ! empty( ::cDocCompany ); docCompany := "<Company>" + OemToHtmlEspecial( ::cDocCompany ) + "</Company>" + HB_OsNewLine(); ENDIF
xml := '<?xml version="1.0"?>' + HB_OsNewLine()
xml += '<?mso-application progid="Excel.Sheet"?>' + HB_OsNewLine()
xml += '<Workbook' + HB_OsNewLine()
xml += 'xmlns="urn:schemas-microsoft-com:office:spreadsheet"' + HB_OsNewLine()
xml += 'xmlns:o="urn:schemas-microsoft-com:office:office"' + HB_OsNewLine()
xml += 'xmlns:x="urn:schemas-microsoft-com:office:excel"' + HB_OsNewLine()
xml += 'xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"' + HB_OsNewLine()
xml += 'xmlns:html="http://www.w3.org/TR/REC-html40">' + HB_OsNewLine()
xml += '<DocumentProperties xmlns="urn:schemas-microsoft-com:office:office">' + HB_OsNewLine()
IF ! empty( ::cDocTitle ); xml += ' ' + docTitle ; ENDIF
IF ! empty( ::cDocSubject ); xml += ' ' + docSubject; ENDIF
IF ! empty( ::cDocAuthor ); xml += ' ' + docAuthor ; ENDIF
IF ! empty( ::cDocCreated ); xml += ' ' + docCreated; ENDIF
IF ! empty( ::cDocManager ); xml += ' ' + docManager; ENDIF
IF ! empty( ::cDocCompany ); xml += ' ' + docCompany; ENDIF
xml += ' <Version>' + ::cDocVersion + '</Version>' + HB_OsNewLine()
xml += '</DocumentProperties>' + HB_OsNewLine()
xml += '<ExcelWorkbook xmlns="urn:schemas-microsoft-com:office:excel" />' + HB_OsNewLine()
xml += '<Styles>' + HB_OsNewLine()
fwrite( handle,xml )
xml := ""
FOR EACH style IN ::styles
xml += style:getStyleXML()
NEXT
xml += '</Styles>'+HB_OsNewLine()
fwrite( handle, xml )
xml := ""
IF LEN( ::sheets ) == 0
::addSheet()
ENDIF
IF len( ::sheets ) > 0
FOR EACH sheet IN ::sheets
xml += sheet:getSheetXML( handle )
IF LEN( sheet:getErrors() ) > 0
::errors := .t.
ENDIF
NEXT
ENDIF
IF LEN( ::formatErrors ) > 0
::errors := .t.
ENDIF
xml += '</Workbook>'
fwrite( handle, xml )
xml := ""
fclose( handle )
RETURN .t.
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:docTitle( title )
IF hb_isChar( title )
::cDocTitle := title
ENDIF
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:docSubject( subject )
IF hb_isChar( subject )
::cDocSubject := subject
ENDIF
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:docAuthor( author )
IF hb_isChar( author )
::cDocAuthor := author
ENDIF
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:docManager( manager )
IF hb_isChar( manager )
::cDocManager := manager
ENDIF
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML:docCompany( company )
IF hb_isChar( company )
::cDocCompany := company
ENDIF
RETURN NIL
/*----------------------------------------------------------------------*/
FUNCTION AnsiToHtml( x )
RETURN( x )
/*----------------------------------------------------------------------*/
FUNCTION OEMTOHTML( xtxt )
LOCAL afrm, i, xret:= "", xpos
afrm := {;
{ " ", "&aacute;" },;
{ "ƒ", "&acirc;" },;
{ "…", "&agrave;" },;
{ "Æ", "&atilde;" },;
{ "‡", "&ccedil;" },;
{ "‚", "&eacute;" },;
{ "ˆ", "&ecirc;" },;
{ "¡", "&iacute;" },;
{ "¢", "&oacute;" },;
{ "“", "&ocirc;" },;
{ "ä", "&otilde;" },;
{ "£", "&uacute;" },;
{ "<22>", "&uuml;" },;
{ "µ", "&Aacute;" },;
{ "¶", "&Acirc;" },;
{ "·", "&Agrave;" },;
{ "Ç", "&Atilde;" },;
{ "€", "&Ccedil;" },;
{ "<22>", "&Eacute;" },;
{ "Ò", "&Ecirc;" },;
{ "Ö", "&Iacute;" },;
{ "à", "&Oacute;" },;
{ "â", "&Ocirc;" },;
{ "å", "&Otilde;" },;
{ "é", "&Uacute;" },;
{ "š", "&Uuml;" },;
{ "-", "&ndash;" } ;
}
FOR i:= 1 TO LEN( xtxt )
IF( xpos:= ASCAN( afrm, {|x| SUBS( xtxt,i,1 ) == x[1] } ) ) > 0
xret+= afrm[xpos,2]
ELSE
xret+= SUBS( xtxt,i,1 )
ENDIF
NEXT
RETURN( xret )
/*----------------------------------------------------------------------*/
FUNCTION OEMTOHTMLESPECIAL( xtxt )
LOCAL afrm, i, xret:= "", xpos
xtxt := exretiraAcentos( xtxt )
afrm := {;
{ '&', "&amp;" },;
{ '"', "&quot;" },;
{ "'", "&#039;" },;
{ "<", "&lt;" },;
{ ">", "&gt;" } ;
}
FOR i := 1 TO LEN( xtxt )
IF ( xpos := ASCAN( afrm, {|x| SUBSTR( xtxt, i, 1 ) == x[ 1 ] } ) ) > 0
xret += afrm[xpos,2]
ELSE
xret += SUBSTR( xtxt,i,1 )
ENDIF
NEXT
RETURN xret
/*----------------------------------------------------------------------*/
FUNCTION EXRETIRAACENTOS( xtxt )
LOCAL afrm, i, xret:= "", xpos
afrm := {;
{ " ", "a" },;
{ "ƒ", "a" },;
{ "…", "a" },;
{ "Æ", "a" },;
{ "‡", "c" },;
{ "‚", "e" },;
{ "ˆ", "e" },;
{ "¡", "i" },;
{ "¢", "o" },;
{ "“", "o" },;
{ "ä", "o" },;
{ "£", "u" },;
{ "<22>", "u" },;
{ "µ", "A" },;
{ "¶", "A" },;
{ "·", "A" },;
{ "Ç", "A" },;
{ "€", "C" },;
{ "<22>", "E" },;
{ "Ò", "E" },;
{ "Ö", "I" },;
{ "à", "O" },;
{ "â", "O" },;
{ "å", "O" },;
{ "é", "U" },;
{ "š", "U" },;
{ CHR( 166 ), "." },;
{ CHR( 167 ), "." },;
{ CHR( 248 ), "." },;
{ CHR( 141 ), "" } ;
}
FOR i := 1 TO LEN( xtxt )
IF ( xpos:= ASCAN( afrm, { |x| SUBSTR( xtxt, i, 1 ) == x[ 1 ] } ) ) > 0
xret += afrm[ xpos, 2 ]
ELSE
xret += SUBSTR( xtxt, i, 1 )
ENDIF
NEXT
RETURN xret
/*----------------------------------------------------------------------*/

379
harbour/contrib/hbxlsxml/xlsxml_s.prg Normal file
View File

@@ -0,0 +1,379 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
*
* Copyright 2011 Fausto Di Creddo Trautwein, ftwein@yahoo.com.br
* www - http://www.xharbour.org http://harbour-project.org
*
* Thanks TO Robert F Greer, PHP original version
* http://sourceforge.net/projects/excelwriterxml/
*
* This program is free software; you can redistribute it AND/OR modify
* it under the terms of the GNU General PUBLIC License as published by
* the Free Software Foundation; either version 2, OR( at your option )
* any later version.
*
* This program is distributed IN the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General PUBLIC License FOR more details.
*
* You should have received a copy of the GNU General PUBLIC License
* along WITH this software; see the file COPYING. IF NOT, write TO
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA( OR visit the web site http://www.gnu.org/ ).
*
* As a special exception, the Harbour Project gives permission FOR
* additional uses of the text contained IN its release of Harbour.
*
* The exception is that, IF you link the Harbour libraries WITH other
* files TO produce an executable, this does NOT by itself cause the
* resulting executable TO be covered by the GNU General PUBLIC License.
* Your use of that executable is IN no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does NOT however invalidate any other reasons why
* the executable file might be covered by the GNU General PUBLIC License.
*
* This exception applies only TO the code released by the Harbour
* Project under the name Harbour. IF you copy code FROM other
* Harbour Project OR Free Software Foundation releases into a copy of
* Harbour, as the General PUBLIC License permits, the exception does
* NOT apply TO the code that you add IN this way. TO avoid misleading
* anyone as TO the status of such modified files, you must delete
* this exception notice FROM them.
*
* IF you write modifications of your own FOR Harbour, it is your choice
* whether TO permit this exception TO apply TO your modifications.
* IF you DO NOT wish that, delete this exception notice.
*
*/
/*----------------------------------------------------------------------*/
#include "hbclass.ch"
/*----------------------------------------------------------------------*/
CREATE CLASS ExcelWriterXML_Sheet
DATA id
DATA cells INIT {=>}
DATA colWidth INIT {=>}
DATA rowHeight INIT {=>}
DATA URLs INIT {=>}
DATA mergeCells INIT {=>}
DATA comments INIT {=>}
DATA formatErrors INIT {=>}
DATA ldisplayRightToLeft INIT .f.
METHOD new( id )
METHOD getID()
METHOD addError( cFunction, cMessage )
METHOD getErrors()
METHOD writeFormula( dataType, row, column, xData, style )
METHOD writeString( row, column, xData, style )
METHOD writeNumber( row, column, xData, style )
METHOD writeDateTime( row, column, xData, style )
METHOD writeData( type, row, column, xData, style, formula )
METHOD displayRightToLeft()
METHOD getSheetXML( handle )
METHOD cellWidth( row, col, width )
METHOD columnWidth( col, width )
METHOD cellHeight( row, col, height )
METHOD setRowHeight( row, height )
METHOD cellMerge( row,col, width, height )
METHOD addComment( row, col, comment, author )
ENDCLASS
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:new( id )
::id := id
RETURN SELF
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:getID()
RETURN ::id
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:addError( cFunction, cMessage )
LOCAL tmp
tmp := { 'sheet' => ::id,;
'FUNCTION' => cFunction,;
'MESSAGE' => cMessage }
::formatErrors += tmp
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:getErrors()
RETURN ::formatErrors
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:writeFormula( dataType, row, column, xData, style )
HB_SYMBOL_UNUSED( dataType )
::writeData( 'String', row, column, '', style, xData )
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:writeString( row, column, xData, style )
::writeData( 'String', row, column, xData, style )
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:writeNumber( row, column, xData, style )
IF !( VALTYPE( xData ) == "N" )
::writeData( 'String', row, column, xData, style )
ELSE
::writeData( 'Number', row ,column, ALLTRIM( STR( xData, 18, 6 ) ), style )
ENDIF
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:writeDateTime( row, column, xData, style )
IF VALTYPE( xData ) == "D"
::writeData( 'DateTime', row, column, DTOC( xData ), style )
ELSE
::writeData( 'String', row, column, xData, style )
ENDIF
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:writeData( type, row, column, xData, style, formula )
LOCAL hcol, cell, styleID
IF style != NIL
IF HB_IsObject( style )
styleID := style:getID()
ELSE
styleID := style
ENDIF
ELSE
styleID := NIL
ENDIF
cell := { 'type' => type ,;
'style' => styleID,;
'data' => xData ,;
'formula' => formula }
IF hb_hPos( ::cells, row ) > 0
hcol := ::cells[ row ]
hcol[ column ] := cell
::cells[ row ] := hcol
ELSE
hcol := {=>}
hcol[ column ] := cell
::cells[ row ] := hcol
ENDIF
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:displayRightToLeft()
::ldisplayRightToLeft := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:getSheetXML( handle )
LOCAL displayRightToLeft, ir, ic, xml, url
LOCAL column, cell, xData, type, mergecell, comment, style, colIndex, colWidth
LOCAL row, rowData, rowHeight, formula
displayRightToLeft := IIF( ::ldisplayRightToLeft, 'ss:RightToLeft="1"', "" )
xml := '<Worksheet ss:Name="' + ::id + '" ' + displayRightToLeft + '>' + HB_OsNewLine()
xml += ' <Table>' + HB_OsNewLine()
fwrite( handle,xml )
xml := ""
IF len( ::colWidth ) > 0
FOR ic := 1 TO LEN( ::colWidth )
colIndex := hb_hKeyAt( ::colWidth, ic )
colWidth := hb_HValueAt( ::colWidth, ic )
colIndex := ALLTRIM( STR( colIndex, 10 ) )
colWidth := ALLTRIM( STR( colWidth, 10 ) )
xml += ' <Column ss:Index="' + colIndex + '" ss:AutoFitWidth="0" ss:Width="' + colWidth + '"/>' + HB_OsNewLine()
NEXT
ENDIF
fwrite( handle, xml )
xml := ""
IF len( ::cells ) > 0
FOR ir := 1 TO LEN( ::cells )
row := hb_hKeyAt( ::cells, ir )
rowData := hb_HValueAt( ::cells, ir )
IF hb_hPos( ::rowHeight, row ) > 0
rowHeight := 'ss:AutoFitHeight="0" ss:Height="' + ALLTRIM( STR( ::rowHeight[ row ], 14, 2 ) ) + '"'
ELSE
rowHeight := ''
ENDIF
xml += ' <Row ss:Index="' + ALLTRIM( STR( row, 10 ) ) + '" ' + rowHeight + ' >' + HB_OsNewLine()
FOR ic := 1 TO LEN( rowData )
column := hb_hKeyAt( rowData, ic )
cell := hb_HValueAt( rowData, ic )
IF !empty( cell[ 'formula' ] )
formula := 'ss:Formula="' + cell['formula'] + '"'
ELSE
formula := ''
ENDIF
IF !empty( cell[ 'style' ] )
style := 'ss:StyleID="' + cell[ 'style' ] + '"'
ELSE
style := ''
ENDIF
URL := ''
mergeCell := ''
IF hb_hPos( ::mergeCells,row ) > 0
IF hb_hPos( ::mergeCells[row],column ) > 0
mergeCell:= 'ss:MergeAcross="' + ALLTRIM( STR( ::mergeCells[row][column]['width'], 10 ) ) + '" ss:MergeDown="' + ALLTRIM( STR( ::mergeCells[row][column]['height'], 10 ) ) + '"'
ENDIF
ENDIF
comment:= ''
IF hb_hPos( ::comments,row ) > 0
IF hb_hPos( ::comments[row],column ) > 0
comment := ' <Comment ss:Author="' + ::comments[ row ][ column ][ 'author' ] + '">' + HB_OsNewLine()
comment += ' <ss:Data xmlns="http://www.w3.org/TR/REC-html40">' + HB_OsNewLine()
comment += ' <B><Font html:Face="Tahoma" x:CharSet="1" html:Size="8" html:Color="#000000">' + ::comments[row][column]['author'] + ':</Font></B>' + HB_OsNewLine()
comment += ' <Font html:Face="Tahoma" x:CharSet="1" html:Size="8" html:Color="#000000">' + ::comments[row][column]['comment'] + '</Font>' + HB_OsNewLine()
comment += ' </ss:Data>' + HB_OsNewLine()
comment += ' </Comment>' + HB_OsNewLine()
ENDIF
ENDIF
comment := ''
type := cell[ 'type' ]
xData := cell[ 'data' ]
xml += ' <Cell ' + style + ' ss:Index="' + ALLTRIM( STR( column,10 ) ) + '" ' + URL + ' ' + mergeCell + ' ' + formula + '>' + HB_OsNewLine()
xml += ' <Data ss:Type="' + type + '">'
xml += oemToHtmlEspecial( xData )
xml += '</Data>' + HB_OsNewLine()
xml += comment
xml += ' </Cell>' + HB_OsNewLine()
NEXT
xml += ' </Row>' + HB_OsNewLine()
fwrite( handle, xml )
xml := ""
NEXT
ENDIF
xml += ' </Table>'+HB_OsNewLine()
xml += '</Worksheet>'+HB_OsNewLine()
fwrite( handle, xml )
xml := ""
RETURN xml
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:cellWidth( row, col, width )
HB_SYMBOL_UNUSED( row )
HB_SYMBOL_UNUSED( col )
IF width == NIL
width := 48
ENDIF
::columnWidth( col,width )
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:columnWidth( col, width )
IF width == NIL
width := 48
ENDIF
::colWidth[ col ] := width
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:cellHeight( row, col, height )
HB_SYMBOL_UNUSED( col )
IF height == NIL
height := 12.5
ENDIF
::setRowHeight( row, height )
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:setRowHeight( row, height )
IF height == NIL
height := 12.5
ENDIF
::rowHeight[ row ] := height
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:cellMerge( row,col, width, height )
LOCAL haux := {=>}
IF hb_hPos( ::mergeCells, row ) > 0
haux := ::mergeCells[ row ]
ENDIF
haux[ col ] := { 'width' => width, ;
'height' => height }
::mergeCells[ row ] := haux
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Sheet:addComment( row, col,comment,author )
LOCAL haux := {=>}
haux[ col ] := { 'comment' => comment,;
'author' => author }
::comments[ row ]:= haux
RETURN NIL
/*----------------------------------------------------------------------*/

869
harbour/contrib/hbxlsxml/xlsxml_y.prg Normal file
View File

@@ -0,0 +1,869 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
*
* Copyright 2011 Fausto Di Creddo Trautwein, ftwein@yahoo.com.br
* www - http://www.xharbour.org http://harbour-project.org
*
* Thanks TO Robert F Greer, PHP original version
* http://sourceforge.net/projects/excelwriterxml/
*
* This program is free software; you can redistribute it AND/OR modify
* it under the terms of the GNU General PUBLIC License as published by
* the Free Software Foundation; either version 2, OR( at your option )
* any later version.
*
* This program is distributed IN the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General PUBLIC License FOR more details.
*
* You should have received a copy of the GNU General PUBLIC License
* along WITH this software; see the file COPYING. IF NOT, write TO
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA( OR visit the web site http://www.gnu.org/ ).
*
* As a special exception, the Harbour Project gives permission FOR
* additional uses of the text contained IN its release of Harbour.
*
* The exception is that, IF you link the Harbour libraries WITH other
* files TO produce an executable, this does NOT by itself cause the
* resulting executable TO be covered by the GNU General PUBLIC License.
* Your use of that executable is IN no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does NOT however invalidate any other reasons why
* the executable file might be covered by the GNU General PUBLIC License.
*
* This exception applies only TO the code released by the Harbour
* Project under the name Harbour. IF you copy code FROM other
* Harbour Project OR Free Software Foundation releases into a copy of
* Harbour, as the General PUBLIC License permits, the exception does
* NOT apply TO the code that you add IN this way. TO avoid misleading
* anyone as TO the status of such modified files, you must delete
* this exception notice FROM them.
*
* IF you write modifications of your own FOR Harbour, it is your choice
* whether TO permit this exception TO apply TO your modifications.
* IF you DO NOT wish that, delete this exception notice.
*
*/
/*----------------------------------------------------------------------*/
#include "hbclass.ch"
/*----------------------------------------------------------------------*/
CREATE CLASS ExcelWriterXML_Style
DATA id
DATA name
DATA useAlignment INIT .f.
DATA useFont INIT .f.
DATA useBorder INIT .f.
DATA useInterior INIT .f.
DATA valign
DATA halign
DATA rotate
DATA shrinktofit INIT 0
DATA verticaltext INIT 0
DATA wraptext INIT 0
DATA fontColor INIT 'Automatic'
DATA fontName
DATA fontFamily
DATA fontSize
DATA bold
DATA italic
DATA underline
DATA strikethrough
DATA shadow
DATA outline
DATA borderTop INIT {=>}
DATA borderBottom INIT {=>}
DATA borderLeft INIT {=>}
DATA borderRight INIT {=>}
DATA borderDL INIT {=>}
DATA borderDR INIT {=>}
DATA interiorColor
DATA interiorPattern
DATA interiorPatternColor
DATA numberFormat
DATA formatErrors INIT {=>}
DATA namedColorsIE INIT {=>}
METHOD new( id )
METHOD getID()
METHOD getStyleXML()
METHOD checkColor( color )
METHOD setName( name )
METHOD alignVertical( valign )
METHOD alignHorizontal( halign )
METHOD alignRotate( rotate )
METHOD alignShrinktofit()
METHOD alignVerticaltext()
METHOD alignWraptext()
METHOD setFontSize( fontSize )
METHOD setFontColor( fontColor )
METHOD setFontName( fontName )
METHOD setFontFamily( fontFamily )
METHOD setFontBold()
METHOD setFontItalic()
METHOD setFontStrikethrough()
METHOD setFontUnderline( uStyle )
METHOD setFontShadow()
METHOD setFontOutline()
METHOD border( position, weight, color, linestyle )
METHOD bgColor( color, pattern, patternColor )
METHOD bgPattern( pattern, color )
METHOD bgPatternColor( color )
METHOD setNumberFormat( formatString )
METHOD setNumberFormatDate()
METHOD setNumberFormatTime()
METHOD setNumberFormatDatetime()
ENDCLASS
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:New( id )
::id:= id
::namedColorsIE := getColorIE()
RETURN SELF
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:getID()
RETURN ::id
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:getStyleXML()
LOCAL fontcolor, positions, position, auxdata, pData, bLinestyle, bColor, bWeight, xml
LOCAL numberFormat
LOCAL name := ''
LOCAL valign := ''
LOCAL halign := ''
LOCAL rotate := ''
LOCAL shrinktofit := ''
LOCAL verticaltext := ''
LOCAL wraptext := ''
LOCAL bold := ''
LOCAL italic := ''
LOCAL strikethrough := ''
LOCAL underline := ''
LOCAL outline := ''
LOCAL shadow := ''
LOCAL fontName := ''
LOCAL fontFamily := ''
LOCAL fontSize := ''
LOCAL borders := ''
LOCAL interior := ''
LOCAL interiorColor := ''
LOCAL interiorPattern := ''
LOCAL interiorPatternColor := ''
IF ! empty( ::name )
name := 'ss:Name="'+::name+'"'
ENDIF
IF ::useAlignment
IF ! empty( ::valign )
valign := 'ss:Vertical="' + ::valign + '"'
ENDIF
IF ! empty( ::halign )
halign := 'ss:Horizontal="' + ::halign + '"'
ENDIF
IF ! empty( ::rotate )
rotate := 'ss:Rotate="' + ::rotate + '"'
ENDIF
IF ! empty( ::shrinktofit )
shrinktofit := 'ss:ShrinkToFit="1"'
ENDIF
IF ! empty( ::verticaltext )
verticaltext := 'ss:VerticalText="1"'
ENDIF
IF ! empty( ::wraptext )
wraptext := 'ss:WrapText="1"'
ENDIF
ENDIF
IF( ::useFont )
IF ! empty( ::fontColor )
fontColor := 'ss:Color="' + ::fontColor + '"'
ENDIF
IF ! empty( ::bold )
bold := 'ss:Bold="1"'
ENDIF
IF ! empty( ::italic )
italic := 'ss:Italic="1"'
ENDIF
IF ! empty( ::strikethrough )
strikethrough := 'ss:StrikeThrough="' + ::strikethrough + '"'
ENDIF
IF ! empty( ::underline )
underline := 'ss:Underline="' + ::underline + '"'
ENDIF
IF ! empty( ::outline )
outline := 'ss:Outline="1"'
ENDIF
IF ! empty( ::shadow )
shadow := 'ss:Shadow="1"'
ENDIF
IF ! empty( ::fontName )
fontName := 'ss:FontName="' + ::fontName + '"'
ENDIF
IF ! empty( ::fontFamily )
fontFamily := 'x:Family="' + ::fontFamily + '"'
ENDIF
IF ! empty( ::fontSize )
fontSize := 'ss:Size="' + ALLTRIM( STR( ::fontSize, 10 ) ) + '"'
ENDIF
ENDIF
IF ::useBorder
borders := ' <Borders>'+HB_OsNewLine()
positions := { ;
'Top' => ::borderTop, ;
'Bottom' => ::borderBottom, ;
'Left' => ::borderLeft, ;
'Right' => ::borderRight, ;
'DiagonalLeft' => ::borderDL, ;
'DiagonalRight' => ::borderDR }
auxdata := NIL
FOR EACH auxdata IN positions
position := auxdata:Key
pData := auxdata:Value
IF empty( pData )
LOOP
ENDIF
bLinestyle := IIF( hb_hPos( pData, 'LineStyle' ) > 0,;
'ss:LineStyle="' + pData[ 'LineStyle' ] + '"', ;
'' )
bColor := IIF( hb_hPos( pData, 'Color' ) > 0,;
'ss:Color="' + pData[ 'Color' ] + '"',;
'' )
bWeight := IIF( hb_hPos( pData, 'Weight' ) > 0,;
'ss:Weight="' + STR( pData[ 'Weight' ], 1 ) + '"',;
'' )
borders += '<Border ss:Position="' + position + '" ' + bLinestyle + ' ' + bColor + ' ' + bWeight + '/>' + HB_OsNewLine()
NEXT
borders += '</Borders>' + HB_OsNewLine()
ENDIF
IF ::useInterior
IF ! empty( ::interiorColor )
interiorColor := 'ss:Color="' + ::interiorColor + '"'
ENDIF
IF ! empty( ::interiorPattern )
interiorPattern := 'ss:Pattern="' + ::interiorPattern + '"'
ENDIF
IF ! empty( ::interiorPatternColor )
interiorPatternColor := 'ss:PatternColor="' + ::interiorPatternColor + '"'
ENDIF
interior := ' <Interior ' + interiorColor + ' ' + interiorPattern + ' ' + interiorPatternColor + '/>' + HB_OsNewLine()
ENDIF
IF ! empty( ::numberFormat )
numberFormat := ' <NumberFormat ss:Format="' + ::numberFormat + '"/>' + HB_OsNewLine()
ELSE
numberFormat := ' <NumberFormat/>' + HB_OsNewLine()
ENDIF
xml := ' <Style ss:ID="' + ::id + '" ' + name + '>' + HB_OsNewLine()
IF ::useAlignment
xml += ' <Alignment ' + valign + ' ' + halign + ' ' + rotate + ' ' + shrinktofit + ' ' + wraptext + ' ' + verticaltext + '/>' + HB_OsNewLine()
ENDIF
IF ::useBorder
xml += borders
ENDIF
IF ::useFont
xml += ' <Font ' +fontSize + ' ' + fontColor + ' ' + bold + ' ' + italic + ' ' + strikethrough + ' ' + underline + ' ' + shadow + ' ' + outline + ' ' + fontName + ' ' + fontFamily + '/>' + HB_OsNewLine()
ENDIF
IF ::useInterior
xml += interior
ENDIF
xml += numberFormat
xml += ' <Protection/>'+HB_OsNewLine()
xml += ' </Style>'+HB_OsNewLine()
RETURN( xml )
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:checkColor( color )
IF LEFT( color, 1 ) == "#"
RETURN color
ELSEIF hb_hPos( ::namedColorsIE, lower( color ) ) > 0
color := ::namedColorsIE[ lower( color ) ]
RETURN color
ELSE
RETURN ''
ENDIF
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setName( name )
::name := name
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:alignVertical( valign )
IF ( valign != 'Automatic' .AND.;
valign != 'Top' .AND.;
valign != 'Bottom' .AND.;
valign != 'Center' )
RETURN NIL
ENDIF
::valign := valign
::useAlignment := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:alignHorizontal( halign )
IF ( halign != 'Automatic' .AND.;
halign != 'Left' .AND.;
halign != 'Center' .AND.;
halign != 'Right' )
halign := 'Automatic'
ENDIF
::halign := halign
::useAlignment := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:alignRotate( rotate )
IF !HB_IsNumeric( rotate )
RETURN NIL
ENDIF
IF abs( rotate ) > 90
rotate := rotate % 90
ENDIF
::rotate := ALLTRIM( STR( rotate, 3 ) )
::useAlignment := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:alignShrinktofit()
::shrinktofit := 1
::useAlignment := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:alignVerticaltext()
::verticaltext := 1
::useAlignment := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:alignWraptext()
::wraptext := 1
::useAlignment := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setFontSize( fontSize )
IF ! HB_IsNumeric( fontSize )
fontSize := 10
ENDIF
IF fontSize <= 0
fontSize := 10
ENDIF
::fontSize := fontSize
::useFont := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setFontColor( fontColor )
fontColor := ::checkColor( fontColor )
IF LEFT( fontColor,1 ) != "#"
fontColor := 'Automatic'
ENDIF
::fontColor := fontColor
::useFont := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setFontName( fontName )
IF fontname == NIL
fontname := 'Arial'
ENDIF
::fontName := fontName
::useFont := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setFontFamily( fontFamily )
IF fontFamily == NIL
fontFamily:= 'Swiss'
ENDIF
IF ( fontFamily != 'Automatic' .AND.;
fontFamily != 'Decorative' .AND.;
fontFamily != 'Modern' .AND.;
fontFamily != 'Roman' .AND.;
fontFamily != 'Script' .AND.;
fontFamily != 'Swiss' )
RETURN NIL
ENDIF
::fontFamily := fontFamily
::useFont := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setFontBold()
::bold := 1
::useFont := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setFontItalic()
::italic := 1
::useFont := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setFontStrikethrough()
::strikethrough := 1
::useFont := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setFontUnderline( uStyle )
IF uStyle == NIL
uStyle := 'Single'
ENDIF
IF ( uStyle != 'None' .AND.;
uStyle != 'Single' .AND.;
uStyle != 'Double' .AND.;
uStyle != 'SingleAccounting' .AND.;
uStyle != 'DoubleAccounting' )
RETURN NIL
ENDIF
::underline := uStyle
::useFont := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setFontShadow()
::shadow := 1
::useFont := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setFontOutline()
::outline := 1
::useFont := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:border( position,weight,color,linestyle )
LOCAL tmp
IF position == NIL
position := 'All' // All, Left, Top, Right, Bottom, DiagonalLeft, DiagonalRight
ENDIF
IF weight == NIL
weight := '1' // 0—Hairline, 1—Thin, 2—Medium, 3—Thick
ENDIF
IF color == NIL
color := 'Automatic' // Automatic, 6-hexadecimal digit number IN "#rrggbb" format OR it can be any of the Microsoft® Internet Explorer named colors
ENDIF
IF linestyle == NIL
linestyle := 'Continuous' // None, Continuous, Dash, Dot, DashDot, DashDotDot, SlantDashDot, Double
ENDIF
IF ( position != 'All' .AND.;
position != 'Left' .AND.;
position != 'Top' .AND.;
position != 'Right' .AND.;
position != 'Bottom' .AND.;
position != 'DiagonalLeft' .AND.;
position != 'DiagonalRight' )
position := 'All'
ENDIF
IF HB_IsNumeric( weight )
IF abs( weight ) > 3
weight := 3
ENDIF
ELSE
weight := 1
ENDIF
color:= ::checkColor( color )
IF LEFT( color,1 ) != "#"
color := 'Automatic'
ENDIF
IF ( linestyle != 'None' .AND.;
linestyle != 'Continuous' .AND.;
linestyle != 'Dash' .AND.;
linestyle != 'Dot' .AND.;
linestyle != 'DashDot' .AND.;
linestyle != 'DashDotDot' .AND.;
linestyle != 'SlantDashDot' .AND.;
linestyle != 'Double' )
linestyle:= 'Continuous'
ENDIF
tmp := { ;
'LineStyle' => linestyle,;
'Color' => color, ;
'Weight' => weight }
IF position == 'Top' .OR. position == 'All'
::borderTop := tmp
ENDIF
IF position == 'Bottom' .OR. position == 'All'
::borderBottom := tmp
ENDIF
IF position == 'Left' .OR. position == 'All'
::borderLeft := tmp
ENDIF
IF position == 'Right' .OR. position == 'All'
::borderRight := tmp
ENDIF
IF position == 'DiagonalLeft'
::borderDL := tmp
ENDIF
IF position == 'DiagonalRight'
::borderDR := tmp
ENDIF
::useBorder := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:bgColor( color, pattern, patternColor )
IF color == NIL
color := 'Yellow'
ENDIF
IF pattern == NIL
pattern := 'Solid'
ENDIF
color := ::checkColor( color )
IF LEFT( color,1 ) != "#"
color := 'Yellow'
ENDIF
::interiorColor := color
IF pattern != 'None'
::bgPattern( pattern, patternColor )
ENDIF
::useInterior:= .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:bgPattern( pattern, color )
IF pattern == NIL
pattern := 'None'
ENDIF
IF ( pattern != 'None' .AND.;
pattern != 'Solid' .AND.;
pattern != 'Gray75' .AND.;
pattern != 'Gray50' .AND.;
pattern != 'Gray25' .AND.;
pattern != 'Gray125' .AND.;
pattern != 'Gray0625' .AND.;
pattern != 'HorzStripe' .AND.;
pattern != 'VertStripe' .AND.;
pattern != 'ReverseDiagStripe' .AND.;
pattern != 'DiagStripe' .AND.;
pattern != 'DiagCross' .AND.;
pattern != 'ThickDiagCross' .AND.;
pattern != 'ThinHorzStripe' .AND.;
pattern != 'ThinVertStripe' .AND.;
pattern != 'ThinReverseDiagStripe' .AND.;
pattern != 'ThinDiagStripe' .AND.;
pattern != 'ThinHorzCross' .AND.;
pattern != 'ThinDiagCross' )
pattern:= 'None'
ENDIF
::interiorPattern := pattern
IF color != NIL
::bgPatternColor( color )
ENDIF
::useInterior := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:bgPatternColor( color )
IF color == NIL
color := 'Yellow'
ENDIF
IF color != 'Automatic'
color := ::checkColor( color )
IF LEFT( color,1 ) != "#"
color := 'Automatic'
ENDIF
ENDIF
::interiorPatternColor := color
::useInterior := .t.
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setNumberFormat( formatString )
::numberFormat := formatString
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setNumberFormatDate()
::setNumberFormat( 'mm/dd/yy' )
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setNumberFormatTime()
::setNumberFormat( 'hh:mm:ss' )
RETURN NIL
/*----------------------------------------------------------------------*/
METHOD ExcelWriterXML_Style:setNumberFormatDatetime()
::setNumberFormat( 'mm/dd/yy\ hh:mm:ss' )
RETURN NIL
/*----------------------------------------------------------------------*/
FUNCTION getColorIE()
LOCAL hcolor:= { => }
hcolor[ 'aliceblue' ] := '#F0F8FF'
hcolor[ 'antiquewhite' ] := '#FAEBD7'
hcolor[ 'aqua' ] := '#00FFFF'
hcolor[ 'aquamarine' ] := '#7FFFD4'
hcolor[ 'azure' ] := '#F0FFFF'
hcolor[ 'beige' ] := '#F5F5DC'
hcolor[ 'bisque' ] := '#FFE4C4'
hcolor[ 'black' ] := '#000000'
hcolor[ 'blanchedalmond' ] := '#FFEBCD'
hcolor[ 'blue' ] := '#0000FF'
hcolor[ 'blueviolet' ] := '#8A2BE2'
hcolor[ 'brown' ] := '#A52A2A'
hcolor[ 'burlywood' ] := '#DEB887'
hcolor[ 'cadetblue' ] := '#5F9EA0'
hcolor[ 'chartreuse' ] := '#7FFF00'
hcolor[ 'chocolate' ] := '#D2691E'
hcolor[ 'coral' ] := '#FF7F50'
hcolor[ 'cornflowerblue' ] := '#6495ED'
hcolor[ 'cornsilk' ] := '#FFF8DC'
hcolor[ 'crimson' ] := '#DC143C'
hcolor[ 'cyan' ] := '#00FFFF'
hcolor[ 'darkblue' ] := '#00008B'
hcolor[ 'darkcyan' ] := '#008B8B'
hcolor[ 'darkgoldenrod' ] := '#B8860B'
hcolor[ 'darkgray' ] := '#A9A9A9'
hcolor[ 'darkgreen' ] := '#006400'
hcolor[ 'darkkhaki' ] := '#BDB76B'
hcolor[ 'darkmagenta' ] := '#8B008B'
hcolor[ 'darkolivegreen' ] := '#556B2F'
hcolor[ 'darkorange' ] := '#FF8C00'
hcolor[ 'darkorchid' ] := '#9932CC'
hcolor[ 'darkred' ] := '#8B0000'
hcolor[ 'darksalmon' ] := '#E9967A'
hcolor[ 'darkseagreen' ] := '#8FBC8F'
hcolor[ 'darkslateblue' ] := '#483D8B'
hcolor[ 'darkslategray' ] := '#2F4F4F'
hcolor[ 'darkturquoise' ] := '#00CED1'
hcolor[ 'darkviolet' ] := '#9400D3'
hcolor[ 'deeppink' ] := '#FF1493'
hcolor[ 'deepskyblue' ] := '#00BFFF'
hcolor[ 'dimgray' ] := '#696969'
hcolor[ 'dodgerblue' ] := '#1E90FF'
hcolor[ 'firebrick' ] := '#B22222'
hcolor[ 'floralwhite' ] := '#FFFAF0'
hcolor[ 'forestgreen' ] := '#228B22'
hcolor[ 'fuchsia' ] := '#FF00FF'
hcolor[ 'gainsboro' ] := '#DCDCDC'
hcolor[ 'ghostwhite' ] := '#F8F8FF'
hcolor[ 'gold' ] := '#FFD700'
hcolor[ 'goldenrod' ] := '#DAA520'
hcolor[ 'gray' ] := '#808080'
hcolor[ 'green' ] := '#008000'
hcolor[ 'greenyellow' ] := '#ADFF2F'
hcolor[ 'honeydew' ] := '#F0FFF0'
hcolor[ 'hotpink' ] := '#FF69B4'
hcolor[ 'indianred' ] := '#CD5C5C'
hcolor[ 'indigo' ] := '#4B0082'
hcolor[ 'ivory' ] := '#FFFFF0'
hcolor[ 'khaki' ] := '#F0E68C'
hcolor[ 'lavender' ] := '#E6E6FA'
hcolor[ 'lavenderblush' ] := '#FFF0F5'
hcolor[ 'lawngreen' ] := '#7CFC00'
hcolor[ 'lemonchiffon' ] := '#FFFACD'
hcolor[ 'lightblue' ] := '#ADD8E6'
hcolor[ 'lightcoral' ] := '#F08080'
hcolor[ 'lightcyan' ] := '#E0FFFF'
hcolor[ 'lightgoldenrodyellow' ] := '#FAFAD2'
hcolor[ 'lightgreen' ] := '#90EE90'
hcolor[ 'lightgrey' ] := '#D3D3D3'
hcolor[ 'lightpink' ] := '#FFB6C1'
hcolor[ 'lightsalmon' ] := '#FFA07A'
hcolor[ 'lightseagreen' ] := '#20B2AA'
hcolor[ 'lightskyblue' ] := '#87CEFA'
hcolor[ 'lightslategray' ] := '#778899'
hcolor[ 'lightsteelblue' ] := '#B0C4DE'
hcolor[ 'lightyellow' ] := '#FFFFE0'
hcolor[ 'lime' ] := '#00FF00'
hcolor[ 'limegreen' ] := '#32CD32'
hcolor[ 'linen' ] := '#FAF0E6'
hcolor[ 'magenta' ] := '#FF00FF'
hcolor[ 'maroon' ] := '#800000'
hcolor[ 'mediumaquamarine' ] := '#66CDAA'
hcolor[ 'mediumblue' ] := '#0000CD'
hcolor[ 'mediumorchid' ] := '#BA55D3'
hcolor[ 'mediumpurple' ] := '#9370DB'
hcolor[ 'mediumseagreen' ] := '#3CB371'
hcolor[ 'mediumslateblue' ] := '#7B68EE'
hcolor[ 'mediumspringgreen' ] := '#00FA9A'
hcolor[ 'mediumturquoise' ] := '#48D1CC'
hcolor[ 'mediumvioletred' ] := '#C71585'
hcolor[ 'midnightblue' ] := '#191970'
hcolor[ 'mintcream' ] := '#F5FFFA'
hcolor[ 'mistyrose' ] := '#FFE4E1'
hcolor[ 'moccasin' ] := '#FFE4B5'
hcolor[ 'navajowhite' ] := '#FFDEAD'
hcolor[ 'navy' ] := '#000080'
hcolor[ 'oldlace' ] := '#FDF5E6'
hcolor[ 'olive' ] := '#808000'
hcolor[ 'olivedrab' ] := '#6B8E23'
hcolor[ 'orange' ] := '#FFA500'
hcolor[ 'orangered' ] := '#FF4500'
hcolor[ 'orchid' ] := '#DA70D6'
hcolor[ 'palegoldenrod' ] := '#EEE8AA'
hcolor[ 'palegreen' ] := '#98FB98'
hcolor[ 'paleturquoise' ] := '#AFEEEE'
hcolor[ 'palevioletred' ] := '#DB7093'
hcolor[ 'papayawhip' ] := '#FFEFD5'
hcolor[ 'peachpuff' ] := '#FFDAB9'
hcolor[ 'peru' ] := '#CD853F'
hcolor[ 'pink' ] := '#FFC0CB'
hcolor[ 'plum' ] := '#DDA0DD'
hcolor[ 'powderblue' ] := '#B0E0E6'
hcolor[ 'purple' ] := '#800080'
hcolor[ 'red' ] := '#FF0000'
hcolor[ 'rosybrown' ] := '#BC8F8F'
hcolor[ 'royalblue' ] := '#4169E1'
hcolor[ 'saddlebrown' ] := '#8B4513'
hcolor[ 'salmon' ] := '#FA8072'
hcolor[ 'sandybrown' ] := '#F4A460'
hcolor[ 'seagreen' ] := '#2E8B57'
hcolor[ 'seashell' ] := '#FFF5EE'
hcolor[ 'sienna' ] := '#A0522D'
hcolor[ 'silver' ] := '#C0C0C0'
hcolor[ 'skyblue' ] := '#87CEEB'
hcolor[ 'slateblue' ] := '#6A5ACD'
hcolor[ 'slategray' ] := '#708090'
hcolor[ 'snow' ] := '#FFFAFA'
hcolor[ 'springgreen' ] := '#00FF7F'
hcolor[ 'steelblue' ] := '#4682B4'
hcolor[ 'tan' ] := '#D2B48C'
hcolor[ 'teal' ] := '#008080'
hcolor[ 'thistle' ] := '#D8BFD8'
hcolor[ 'tomato' ] := '#FF6347'
hcolor[ 'turquoise' ] := '#40E0D0'
hcolor[ 'violet' ] := '#EE82EE'
hcolor[ 'wheat' ] := '#F5DEB3'
hcolor[ 'white' ] := '#FFFFFF'
hcolor[ 'whitesmoke' ] := '#F5F5F5'
hcolor[ 'yellow' ] := '#FFFF00'
hcolor[ 'yellowgreen' ] := '#9ACD32'
RETURN hcolor
/*----------------------------------------------------------------------*/