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

2012-11-10 17:02 UTC+0100 Viktor Szakats (harbour syenar.net)

Browse Source 
* extras/hbxlsxml/tests/example.prg
  * extras/hbxlsxml/tests/example2.prg
  * extras/hbxlsxml/tests/example3.prg
  * extras/hbxlsxml/xlsxml_s.prg
  * extras/hbxlsxml/xlsxml_y.prg
  * extras/hbxlsxml/xlsxml.prg
    + various cleanups, optimizations, one minor fix,
      improved bad parameter type handling
    + output to contain much less empty space in tags

  * tests/foreach.prg
  * tests/menutest.prg
    * cleanups ('=' operator still, hb_ntos())
This commit is contained in:
Viktor Szakats
2012-11-10 16:05:47 +00:00
parent df01fb28ec
commit 19df5c8b46
9 changed files with 252 additions and 252 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
harbour/ChangeLog
View File

@@ -16,6 +16,21 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-11-10 17:02 UTC+0100 Viktor Szakats (harbour syenar.net)
* extras/hbxlsxml/tests/example.prg
* extras/hbxlsxml/tests/example2.prg
* extras/hbxlsxml/tests/example3.prg
* extras/hbxlsxml/xlsxml_s.prg
* extras/hbxlsxml/xlsxml_y.prg
* extras/hbxlsxml/xlsxml.prg
+ various cleanups, optimizations, one minor fix,
improved bad parameter type handling
+ output to contain much less empty space in tags
* tests/foreach.prg
* tests/menutest.prg
* cleanups ('=' operator still, hb_ntos())
2012-11-10 15:33 UTC+0100 Viktor Szakats (harbour syenar.net)
* contrib/hbpre.hbm
* contrib/make.hb

6
harbour/extras/hbxlsxml/tests/example.prg
View File

@@ -269,10 +269,12 @@ PROCEDURE Main()
:writeString( nLinha, 4, "", "textLeft" )
:writeString( nLinha, 5, "", "textLeft" )
:writeString( nLinha, 6, "", "textLeft" )
:writeString( nLinha, 7, "TOTAL ==> " + Str( xqtddoc, 5 ) + " documentos", "textLeftBold" )
:writeString( nLinha, 7, "TOTAL ==> " + hb_ntos( xqtddoc ) + " document(s)", "textLeftBold" )
:writeString( nLinha, 8, "", "textLeft" )
:writeFormula( "Number", nLinha, 9, "=SUM(R[-40]C:R[-1]C)", "numberRightBold" )
//:writeNumber( nLinha, 9, xttotnot, "numberRightBold" )
#if 0
:writeNumber( nLinha, 9, xttotnot, "numberRightBold" )
#endif
:writeNumber( nLinha, 10, xtbascal, "numberRightBold" )
:writeNumber( nLinha, 11, xtvlricm, "numberRightBold" )
:writeNumber( nLinha, 12, xtbasipi, "numberRightBold" )

29
harbour/extras/hbxlsxml/tests/example2.prg
View File

@@ -72,7 +72,9 @@ PROCEDURE Main()
/**
* Choose to show any formatting/input errors on a seperate sheet
*/
// xml:showErrorSheet( .T. )
#if 0
xml:showErrorSheet( .T. )
#endif
/**
* Show the style options
@@ -102,8 +104,9 @@ PROCEDURE Main()
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" )
#if 0
sheet1:writeString( 1, 4, "No style applied" )
#endif
sheet2 := xml:addSheet( "Formulas" )
/**
@@ -121,10 +124,14 @@ PROCEDURE Main()
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" )
#if 0
sheet2:addComment( 4, 2, "Here is my formula: =SUM(R[-3]C:R[-1]C)","My NAME" )
#endif
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)" )
#if 0
sheet2:addComment( 5, 2, "Here is my formula: =SUM(R1C1:R3C2)" )
#endif
sheet4 := xml:addSheet( "more formatting" )
format4 := xml:addStyle( "my style" )
@@ -134,18 +141,22 @@ PROCEDURE Main()
format4:bgColor( "Black" )
format4:setFontColor( "White" )
format4:setNumberFormatDateTime()
// mydate := sheet4:convertMysqlDateTime( "2008-02-14 19:30:00" )
#if 0
mydate := sheet4:convertMysqlDateTime( "2008-02-14 19:30:00" )
#endif
sheet4:writeDateTime( 1, 1, DToC( Date() ), format4 )
// Change the row1 height to 30 pixels
// 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
// 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()
#if 0
xml:sendHeaders()
#endif
xml:writeData( "example2.xml" )
RETURN

4
harbour/extras/hbxlsxml/tests/example3.prg
View File

@@ -75,7 +75,9 @@ PROCEDURE Main()
sheet1:writeString( 2, 1, "celula 2_1", format4 )
sheet1:writeString( 1, 1, "celula 1_1", format4 )
// sheet1:writeString( 1, 2, "celula 1_2", format4 )
#if 0
sheet1:writeString( 1, 2, "celula 1_2", format4 )
#endif
sheet1:writeString( 1, 3, "celula 1_3", format4 )
sheet1:cellMerge( 1, 1, 1, 0 )

6
harbour/extras/hbxlsxml/xlsxml.prg
View File

@@ -133,14 +133,10 @@ METHOD ExcelWriterXML:showErrorSheet( show )
METHOD ExcelWriterXML:addError( cFunction, cMessage )
LOCAL tmp
tmp := { ;
::formatErrors += { ;
"FUNCTION" => cFunction, ;
"MESSAGE" => cMessage }
::formatErrors += tmp
RETURN NIL
METHOD ExcelWriterXML:getDefaultStyle()

165
harbour/extras/hbxlsxml/xlsxml_s.prg
View File

@@ -52,7 +52,6 @@
*
*/
#include "hbclass.ch"
CREATE CLASS ExcelWriterXML_Sheet
@@ -99,14 +98,11 @@ METHOD ExcelWriterXML_Sheet:getID()
METHOD ExcelWriterXML_Sheet:addError( cFunction, cMessage )
LOCAL tmp
tmp := { "sheet" => ::id, ;
::formatErrors += { ;
"sheet" => ::id, ;
"FUNCTION" => cFunction, ;
"MESSAGE" => cMessage }
::formatErrors += tmp
RETURN NIL
METHOD ExcelWriterXML_Sheet:getErrors()
@@ -129,10 +125,10 @@ METHOD ExcelWriterXML_Sheet:writeString( row, column, xData, style )
METHOD ExcelWriterXML_Sheet:writeNumber( row, column, xData, style )
IF ! HB_ISNUMERIC( xData )
::writeData( "String", row, column, xData, style )
ELSE
IF HB_ISNUMERIC( xData )
::writeData( "Number", row, column, AllTrim( Str( xData, 18, 6 ) ), style )
ELSE
::writeData( "String", row, column, xData, style )
ENDIF
RETURN NIL
@@ -166,6 +162,7 @@ METHOD ExcelWriterXML_Sheet:writeData( type, row, column, xData, style, formula
"style" => styleID, ;
"data" => xData, ;
"formula" => formula }
IF hb_HPos( ::cells, row ) > 0
hcol := ::cells[ row ]
hcol[ column ] := cell
@@ -198,80 +195,77 @@ METHOD ExcelWriterXML_Sheet:getSheetXML( handle )
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 := hb_ntos( colIndex )
colWidth := hb_ntos( colWidth )
xml += ' <Column ss:Index="' + colIndex + '" ss:AutoFitWidth="0" ss:Width="' + colWidth + '"/>' + hb_eol()
NEXT
ENDIF
FOR EACH ic IN ::colWidth
colIndex := ic:__enumKey()
colWidth := ic:__enumValue()
colIndex := hb_ntos( colIndex )
colWidth := hb_ntos( colWidth )
xml += ' <Column ss:Index="' + colIndex + '" ss:AutoFitWidth="0" ss:Width="' + colWidth + '"/>' + hb_eol()
NEXT
FWrite( handle, xml )
xml := ""
IF Len( ::cells ) > 0
FOR ir := 1 TO Len( ::cells )
row := hb_HKeyAt( ::cells, ir )
rowData := hb_HValueAt( ::cells, ir )
FOR EACH ir IN ::cells
row := ir:__enumKey()
rowData := ir:__enumValue()
IF hb_HPos( ::rowHeight, row ) > 0
rowHeight := 'ss:AutoFitHeight="0" ss:Height="' + AllTrim( Str( ::rowHeight[ row ], 14, 2 ) ) + '"'
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="' + hb_ntos( row ) + '" ' + rowHeight + " >" + hb_eol()
FOR EACH ic IN rowData
column := ic:__enumKey()
cell := ic:__enumValue()
IF Empty( cell[ "formula" ] )
formula := ""
ELSE
rowHeight := ""
formula := 'ss:Formula="' + cell[ "formula" ] + '"'
ENDIF
xml += ' <Row ss:Index="' + hb_ntos( row ) + '" ' + rowHeight + " >" + hb_eol()
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 := ""
IF Empty( cell[ "style" ] )
style := ""
ELSE
style := 'ss:StyleID="' + cell[ "style" ] + '"'
ENDIF
URL := ""
mergeCell := ""
IF hb_HPos( ::mergeCells, row ) > 0
IF hb_HPos( ::mergeCells[ row ], column ) > 0
mergeCell := 'ss:MergeAcross="' + hb_ntos( ::mergeCells[ row ][ column ][ "width" ] ) + '" ss:MergeDown="' + hb_ntos( ::mergeCells[ row ][ column ][ "height" ] ) + '"'
ENDIF
IF ! Empty( cell[ "style" ] )
style := 'ss:StyleID="' + cell[ "style" ] + '"'
ELSE
style := ""
ENDIF
comment := ""
IF hb_HPos( ::comments, row ) > 0
IF hb_HPos( ::comments[ row ], column ) > 0
comment := ' <Comment ss:Author="' + ::comments[ row ][ column ][ "author" ] + '">' + hb_eol()
comment += ' <ss:Data xmlns="http://www.w3.org/TR/REC-html40">' + hb_eol()
comment += ' <B><Font html:Face="Tahoma" x:CharSet="1" html:Size="8" html:Color="#000000">' + ::comments[ row ][ column ][ "author" ] + ":</Font></B>" + hb_eol()
comment += ' <Font html:Face="Tahoma" x:CharSet="1" html:Size="8" html:Color="#000000">' + ::comments[ row ][ column ][ "comment" ] + "</Font>" + hb_eol()
comment += " </ss:Data>" + hb_eol()
comment += " </Comment>" + hb_eol()
ENDIF
URL := ""
mergeCell := ""
IF hb_HPos( ::mergeCells, row ) > 0
IF hb_HPos( ::mergeCells[ row ], column ) > 0
mergeCell := 'ss:MergeAcross="' + hb_ntos( ::mergeCells[ row ][ column ][ "width" ] ) + '" ss:MergeDown="' + hb_ntos( ::mergeCells[ row ][ column ][ "height" ] ) + '"'
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_eol()
comment += ' <ss:Data xmlns="http://www.w3.org/TR/REC-html40">' + hb_eol()
comment += ' <B><Font html:Face="Tahoma" x:CharSet="1" html:Size="8" html:Color="#000000">' + ::comments[ row ][ column ][ "author" ] + ":</Font></B>" + hb_eol()
comment += ' <Font html:Face="Tahoma" x:CharSet="1" html:Size="8" html:Color="#000000">' + ::comments[ row ][ column ][ "comment" ] + "</Font>" + hb_eol()
comment += " </ss:Data>" + hb_eol()
comment += " </Comment>" + hb_eol()
ENDIF
ENDIF
comment := ""
type := cell[ "type" ]
xData := cell[ "data" ]
ENDIF
comment := ""
type := cell[ "type" ]
xData := cell[ "data" ]
xml += " <Cell " + style + ' ss:Index="' + hb_ntos( column ) + '" ' + URL + " " + mergeCell + " " + formula + ">" + hb_eol()
xml += ' <Data ss:Type="' + type + '">'
xml += StrToHtmlSpecial( xData )
xml += "</Data>" + hb_eol()
xml += comment
xml += " </Cell>" + hb_eol()
xml += " <Cell " + AllTrim( style + ' ss:Index="' + hb_ntos( column ) + '" ' + URL + " " + mergeCell + " " + formula ) + ">" + hb_eol()
xml += ' <Data ss:Type="' + type + '">'
xml += StrToHtmlSpecial( xData )
xml += "</Data>" + hb_eol()
xml += comment
xml += " </Cell>" + hb_eol()
NEXT
xml += " </Row>" + hb_eol()
FWrite( handle, xml )
xml := ""
NEXT
ENDIF
xml += " </Row>" + hb_eol()
FWrite( handle, xml )
xml := ""
NEXT
xml += " </Table>" + hb_eol()
xml += "</Worksheet>" + hb_eol()
@@ -285,18 +279,16 @@ METHOD ExcelWriterXML_Sheet:cellWidth( row, col, width )
HB_SYMBOL_UNUSED( row )
HB_SYMBOL_UNUSED( col )
IF width == NIL
width := 48
ENDIF
hb_default( @width, 48 )
::columnWidth( col, width )
RETURN NIL
METHOD ExcelWriterXML_Sheet:columnWidth( col, width )
IF width == NIL
width := 48
ENDIF
hb_default( @width, 48 )
::colWidth[ col ] := width
RETURN NIL
@@ -305,18 +297,16 @@ METHOD ExcelWriterXML_Sheet:cellHeight( row, col, height )
HB_SYMBOL_UNUSED( col )
IF height == NIL
height := 12.5
ENDIF
hb_default( @height, 12.5 )
::setRowHeight( row, height )
RETURN NIL
METHOD ExcelWriterXML_Sheet:setRowHeight( row, height )
IF height == NIL
height := 12.5
ENDIF
hb_default( @height, 12.5 )
::rowHeight[ row ] := height
RETURN NIL
@@ -328,7 +318,9 @@ METHOD ExcelWriterXML_Sheet:cellMerge( row, col, width, height )
IF hb_HPos( ::mergeCells, row ) > 0
haux := ::mergeCells[ row ]
ENDIF
haux[ col ] := { "width" => width, ;
haux[ col ] := { ;
"width" => width, ;
"height" => height }
::mergeCells[ row ] := haux
@@ -339,8 +331,9 @@ METHOD ExcelWriterXML_Sheet:addComment( row, col, comment, author )
LOCAL haux := { => }
haux[ col ] := { "comment" => comment, ;
"author" => author }
haux[ col ] := { ;
"comment" => comment, ;
"author" => author }
::comments[ row ] := haux

189
harbour/extras/hbxlsxml/xlsxml_y.prg
View File

@@ -52,7 +52,6 @@
*
*/
#include "hbclass.ch"
CREATE CLASS ExcelWriterXML_Style
@@ -252,9 +251,9 @@ METHOD ExcelWriterXML_Style:getStyleXML()
'ss:Color="' + pData[ "Color" ] + '"', ;
"" )
bWeight := iif( hb_HPos( pData, "Weight" ) > 0, ;
'ss:Weight="' + Str( pData[ "Weight" ], 1 ) + '"', ;
'ss:Weight="' + hb_ntos( pData[ "Weight" ] ) + '"', ;
"" )
borders += '<Border ss:Position="' + position + '" ' + bLinestyle + " " + bColor + " " + bWeight + "/>" + hb_eol()
borders += '<Border ss:Position="' + AllTrim( position + '" ' + bLinestyle + " " + bColor + " " + bWeight ) + "/>" + hb_eol()
NEXT
borders += "</Borders>" + hb_eol()
ENDIF
@@ -269,24 +268,24 @@ METHOD ExcelWriterXML_Style:getStyleXML()
IF ! Empty( ::interiorPatternColor )
interiorPatternColor := 'ss:PatternColor="' + ::interiorPatternColor + '"'
ENDIF
interior := " <Interior " + interiorColor + " " + interiorPattern + " " + interiorPatternColor + "/>" + hb_eol()
interior := " <Interior " + AllTrim( interiorColor + " " + interiorPattern + " " + interiorPatternColor ) + "/>" + hb_eol()
ENDIF
IF ! Empty( ::numberFormat )
numberFormat := ' <NumberFormat ss:Format="' + ::numberFormat + '"/>' + hb_eol()
ELSE
IF Empty( ::numberFormat )
numberFormat := " <NumberFormat/>" + hb_eol()
ELSE
numberFormat := ' <NumberFormat ss:Format="' + ::numberFormat + '"/>' + hb_eol()
ENDIF
xml := ' <Style ss:ID="' + ::id + '" ' + name + ">" + hb_eol()
IF ::useAlignment
xml += " <Alignment " + valign + " " + halign + " " + rotate + " " + shrinktofit + " " + wraptext + " " + verticaltext + "/>" + hb_eol()
xml += " <Alignment " + AllTrim( valign + " " + halign + " " + rotate + " " + shrinktofit + " " + wraptext + " " + verticaltext ) + "/>" + hb_eol()
ENDIF
IF ::useBorder
xml += borders
ENDIF
IF ::useFont
xml += " <Font " + fontSize + " " + fontColor + " " + bold + " " + italic + " " + strikethrough + " " + underline + " " + shadow + " " + outline + " " + fontName + " " + fontFamily + "/>" + hb_eol()
xml += " <Font " + AllTrim( fontSize + " " + fontColor + " " + bold + " " + italic + " " + strikethrough + " " + underline + " " + shadow + " " + outline + " " + fontName + " " + fontFamily ) + "/>" + hb_eol()
ENDIF
IF ::useInterior
xml += interior
@@ -318,10 +317,10 @@ METHOD ExcelWriterXML_Style:setName( name )
METHOD ExcelWriterXML_Style:alignVertical( valign )
IF ( !( valign == "Automatic" ) .AND. ;
!( valign == "Top" ) .AND. ;
!( valign == "Bottom" ) .AND. ;
!( valign == "Center" ) )
IF !( valign == "Automatic" ) .AND. ;
!( valign == "Top" ) .AND. ;
!( valign == "Bottom" ) .AND. ;
!( valign == "Center" )
RETURN NIL
ENDIF
::valign := valign
@@ -331,10 +330,10 @@ METHOD ExcelWriterXML_Style:alignVertical( valign )
METHOD ExcelWriterXML_Style:alignHorizontal( halign )
IF ( !( halign == "Automatic" ) .AND. ;
!( halign == "Left" ) .AND. ;
!( halign == "Center" ) .AND. ;
!( halign == "Right" ) )
IF !( halign == "Automatic" ) .AND. ;
!( halign == "Left" ) .AND. ;
!( halign == "Center" ) .AND. ;
!( halign == "Right" )
halign := "Automatic"
ENDIF
::halign := halign
@@ -378,9 +377,8 @@ METHOD ExcelWriterXML_Style:alignWraptext()
METHOD ExcelWriterXML_Style:setFontSize( fontSize )
IF ! HB_ISNUMERIC( fontSize )
fontSize := 10
ENDIF
hb_default( @fontSize, 10 )
IF fontSize <= 0
fontSize := 10
ENDIF
@@ -402,9 +400,8 @@ METHOD ExcelWriterXML_Style:setFontColor( fontColor )
METHOD ExcelWriterXML_Style:setFontName( fontName )
IF fontname == NIL
fontname := "Arial"
ENDIF
hb_default( @fontname, "Arial" )
::fontName := fontName
::useFont := .T.
@@ -412,16 +409,14 @@ METHOD ExcelWriterXML_Style:setFontName( fontName )
METHOD ExcelWriterXML_Style:setFontFamily( fontFamily )
IF fontFamily == NIL
fontFamily := "Swiss"
ENDIF
hb_default( @fontFamily, "Swiss" )
IF ( !( fontFamily == "Automatic" ) .AND. ;
!( fontFamily == "Decorative" ) .AND. ;
!( fontFamily == "Modern" ) .AND. ;
!( fontFamily == "Roman" ) .AND. ;
!( fontFamily == "Script" ) .AND. ;
!( fontFamily == "Swiss" ) )
IF !( fontFamily == "Automatic" ) .AND. ;
!( fontFamily == "Decorative" ) .AND. ;
!( fontFamily == "Modern" ) .AND. ;
!( fontFamily == "Roman" ) .AND. ;
!( fontFamily == "Script" ) .AND. ;
!( fontFamily == "Swiss" )
RETURN NIL
ENDIF
::fontFamily := fontFamily
@@ -452,17 +447,16 @@ METHOD ExcelWriterXML_Style:setFontStrikethrough()
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" ) )
hb_default( @uStyle, "Single" )
IF !( uStyle == "None" ) .AND. ;
!( uStyle == "Single" ) .AND. ;
!( uStyle == "Double" ) .AND. ;
!( uStyle == "SingleAccounting" ) .AND. ;
!( uStyle == "DoubleAccounting" )
RETURN NIL
ENDIF
::underline := uStyle
::useFont := .T.
@@ -486,36 +480,24 @@ 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 MS Internet Explorer named colors
ENDIF
IF linestyle == NIL
linestyle := "Continuous" // None, Continuous, Dash, Dot, DashDot, DashDotDot, SlantDashDot, Double
ENDIF
hb_default( @position, "All" ) // All, Left, Top, Right, Bottom, DiagonalLeft, DiagonalRight
hb_default( @weight, 1 ) // 0-Hairline, 1-Thin, 2-Medium, 3-Thick
hb_default( @color, "Automatic" ) // Automatic, 6-hexadecimal digit number IN "#rrggbb" format OR it can be any of the MS Internet Explorer named colors
hb_default( @linestyle, "Continuous" ) // None, Continuous, Dash, Dot, DashDot, DashDotDot, SlantDashDot, Double
IF ( !( position == "All" ) .AND. ;
!( position == "Left" ) .AND. ;
!( position == "Top" ) .AND. ;
!( position == "Right" ) .AND. ;
!( position == "Bottom" ) .AND. ;
!( position == "DiagonalLeft" ) .AND. ;
!( position == "DiagonalRight" ) )
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
IF weight > 3 .OR. weight < 0
weight := 3
ENDIF
color := ::checkColor( color )
@@ -523,21 +505,21 @@ METHOD ExcelWriterXML_Style:border( position, weight, color, linestyle )
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" ) )
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, ;
"Color" => color, ;
"Weight" => weight }
IF position == "Top" .OR. position == "All"
@@ -546,10 +528,10 @@ METHOD ExcelWriterXML_Style:border( position, weight, color, linestyle )
IF position == "Bottom" .OR. position == "All"
::borderBottom := tmp
ENDIF
IF position == "Left" .OR. position == "All"
IF position == "Left" .OR. position == "All"
::borderLeft := tmp
ENDIF
IF position == "Right" .OR. position == "All"
IF position == "Right" .OR. position == "All"
::borderRight := tmp
ENDIF
IF position == "DiagonalLeft"
@@ -565,12 +547,8 @@ METHOD ExcelWriterXML_Style:border( position, weight, color, linestyle )
METHOD ExcelWriterXML_Style:bgColor( color, pattern, patternColor )
IF color == NIL
color := "Yellow"
ENDIF
IF pattern == NIL
pattern := "Solid"
ENDIF
hb_default( @color, "Yellow" )
hb_default( @pattern, "Solid" )
color := ::checkColor( color )
IF !( Left( color, 1 ) == "#" )
@@ -586,29 +564,27 @@ METHOD ExcelWriterXML_Style:bgColor( color, pattern, patternColor )
METHOD ExcelWriterXML_Style:bgPattern( pattern, color )
IF pattern == NIL
pattern := "None"
ENDIF
hb_default( @pattern, "None" )
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" ) )
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
@@ -623,9 +599,8 @@ METHOD ExcelWriterXML_Style:bgPattern( pattern, color )
METHOD ExcelWriterXML_Style:bgPatternColor( color )
IF color == NIL
color := "Yellow"
ENDIF
hb_default( @color, "Yellow" )
IF !( color == "Automatic" )
color := ::checkColor( color )
IF !( Left( color, 1 ) == "#" )

80
harbour/tests/foreach.prg
View File

@@ -2,6 +2,8 @@
* $Id$
*/
#define LEFTEQUAL( l, r ) ( Left( l, Len( r ) ) == r )
PROCEDURE Main()
LOCAL A := { "one ", "two ", "three" }
@@ -11,23 +13,23 @@ PROCEDURE Main()
LOCAL bb, cc
LOCAL i
/*
#if 0
test( @a, b )
test( a, @b )
test( @a, @b )
*/
#endif
? "========================================================"
? "before loop: ENUM=", ENUM
? "before loop: a[1]=", a[ 1 ], "a[2]=", a[ 2 ], "a[3]=", a[ 3 ]
FOR EACH enum IN A
? "start: ENUM=", ENUM
IF ENUM = "two"
ENUM := Upper( ENUM )
? "start: ENUM=", enum
IF LEFTEQUAL( enum, "two" )
enum := Upper( enum )
ENDIF
? "end: ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", ValType( ENUM:__enumBase )
? "end: ENUM=", enum, "| index:", enum:__enumIndex(), "| value:", enum:__enumValue(), "| base: ", ValType( enum:__enumBase() )
NEXT
? "after loop ENUM=", ENUM
? "after loop ENUM=", enum
? "after loop: a[1]=", a[ 1 ], "a[2]=", a[ 2 ], "a[3]=", a[ 3 ]
? "-----------------"
?
@@ -36,51 +38,51 @@ PROCEDURE Main()
? "========================================================"
? "Testing passing by reference"
? "before loop: ENUM=", ENUM
? "before loop: ENUM=", enum
? "after loop: a[1]=", a[ 1 ], "a[2]=", a[ 2 ], "a[3]=", a[ 3 ]
FOR EACH ENUM IN A
IF Upper( ENUM ) = "TWO"
ENUM := Upper( ENUM )
? "before passing by @ | ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", ValType( ENUM:__enumBase )
testBYREF( @ENUM )
? " after passing by @ | ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", ValType( ENUM:__enumBase )
FOR EACH enum IN A
IF LEFTEQUAL( Upper( enum ), "TWO" )
enum := Upper( enum )
? "before passing by @ | ENUM=", enum, "| index:", enum:__enumIndex(), "| value:", enum:__enumValue(), "| base: ", ValType( enum:__enumBase() )
testBYREF( @enum )
? " after passing by @ | ENUM=", enum, "| index:", enum:__enumIndex(), "| value:", enum:__enumValue(), "| base: ", ValType( enum:__enumBase() )
ENDIF
NEXT
? "after loop ENUM=", ENUM
? "after loop ENUM=", enum
? "after loop: a[1]=", a[ 1 ], "a[2]=", a[ 2 ], "a[3]=", a[ 3 ]
Inkey( 0 )
? "========================================================"
? "Testing BREAK"
? "before loop: ENUM=", ENUM
? "before loop: ENUM=", enum
? "after loop: a[1]=", a[ 1 ], "a[2]=", a[ 2 ], "a[3]=", a[ 3 ]
BEGIN SEQUENCE
FOR EACH enum IN A DESCEND
? "loop: ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", ValType( ENUM:__enumBase )
TESTbreak( ENUM )
? "loop: ENUM=", enum, "| index:", enum:__enumIndex(), "| value:", enum:__enumValue(), "| base: ", ValType( enum:__enumBase() )
TESTbreak( enum )
NEXT
RECOVER USING i
? "after loop ENUM=", ENUM
? "after loop ENUM=", enum
? "after loop: a[1]=", a[ 1 ], "a[2]=", a[ 2 ], "a[3]=", a[ 3 ]
? "recover variable i=", i
END SEQUENCE
Inkey( 0 )
? "========================================================"
? "before loop: ENUM=", ENUM
? "before loop: ENUM=", enum
? "before loop: c=", c
BEGIN SEQUENCE
FOR EACH enum IN c
? "start: ENUM=", ENUM
IF enum = "d"
? "start: ENUM=", enum
IF LEFTEQUAL( enum, "d" )
enum := Upper( enum )
ENDIF
Testbreak( enum )
? "end: ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", ValType( ENUM:__enumBase )
? "end: ENUM=", enum, "| index:", enum:__enumIndex(), "| value:", enum:__enumValue(), "| base: ", ValType( enum:__enumBase() )
NEXT
RECOVER USING i
? "after loop ENUM=", ENUM
? "after loop ENUM=", enum
? "after loop: c=", c
? "recover variable i=", i
END SEQUENCE
@@ -88,22 +90,22 @@ PROCEDURE Main()
? "========================================================"
FOR EACH enum, bb, cc IN A, AA, c
? enum, enum:__enumIndex, enum:__enumValue
? bb, bb:__enumIndex, bb:__enumValue
? cc, cc:__enumIndex, cc:__enumValue
? enum, enum:__enumIndex(), enum:__enumValue()
? bb, bb:__enumIndex(), bb:__enumValue()
? cc, cc:__enumIndex(), cc:__enumValue()
NEXT
Inkey( 0 )
? "========================================================"
FOR EACH enum, bb, cc IN A, AA, c DESCEND
? enum, enum:__enumIndex, enum:__enumValue
? bb, bb:__enumIndex, bb:__enumValue
? cc, cc:__enumIndex, cc:__enumValue
? enum, enum:__enumIndex(), enum:__enumValue()
? bb, bb:__enumIndex(), bb:__enumValue()
? cc, cc:__enumIndex(), cc:__enumValue()
NEXT
FOR EACH enum IN a
BEGIN SEQUENCE
IF enum = "2"
IF LEFTEQUAL( enum, "2" )
BREAK
ENDIF
END SEQUENCE
@@ -111,7 +113,7 @@ PROCEDURE Main()
FOR EACH enum IN a
BEGIN SEQUENCE
IF enum = "2"
IF LEFTEQUAL( enum, "2" )
? "Breaking... enum=", enum
BREAK enum
ENDIF
@@ -124,7 +126,7 @@ PROCEDURE Main()
PROCEDURE TESTbreak( v )
IF v = "2" .OR. v = "d"
IF LEFTEQUAL( v, "2" ) .OR. LEFTEQUAL( v, "d" )
? "issuing break"
Break( v )
ENDIF
@@ -133,12 +135,12 @@ PROCEDURE TESTbreak( v )
PROCEDURE TESTBYREF( enum )
? "start of testBYREF ENUM=", ENUM
FOR EACH ENUM IN { 1, 2, 3 }
? " -testBYREF=", ENUM
? "start of testBYREF ENUM=", enum
FOR EACH enum IN { 1, 2, 3 }
? " -testBYREF=", enum
NEXT
? "end of loop: ENUM=", ENUM
ENUM := "22222"
? "end of testBYREF ENUM=", ENUM
? "end of loop: ENUM=", enum
enum := "22222"
? "end of testBYREF ENUM=", enum
RETURN

10
harbour/tests/menutest.prg
View File

@@ -2,6 +2,10 @@
* $Id$
*/
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
#include "inkey.ch"
PROCEDURE Main()
@@ -24,7 +28,7 @@ PROCEDURE Main()
MENU TO testvar
@ 9, 10 SAY "Your Choice = " + Str( testvar, 1 )
@ 9, 10 SAY "Your Choice = " + hb_ntos( testvar )
Inkey( 0 )
@@ -42,7 +46,7 @@ PROCEDURE Main()
MENU TO ptestvar
@ 9, 10 SAY "Your Choice = " + Str( ptestvar, 1 )
@ 9, 10 SAY "Your Choice = " + hb_ntos( ptestvar )
RETURN
@@ -63,7 +67,7 @@ PROCEDURE RECURSE()
@ 7, 10 SAY "Press F8 to recurse into MENU TO"
@ 9, 50 SAY "Your Choice = " + Str( testvar, 1 )
@ 9, 50 SAY "Your Choice = " + hb_ntos( testvar )
SET KEY K_F8 TO RECURSE()