Sorry, somehow I cannot attach files...
So here it is...
/***********************************************************************/
//Creates XLS 2.0 files...
//Source written in xHarbour 1.0
//EXAMPLE:
//xls_f := XLSOpen('C:\TEST.XLS')
//For x := 1 to 1024
// XLSWrite(xls_f,x,1,transform(x,'9999'),.F.,1,0)
//Next
//XLSClose(xls_f)
/***********************************************************************/
// Label Header
#define TXT_ELEMS 12
#define TXT_OPCO1 1
#define TXT_OPCO2 2
#define TXT_LEN1 3
#define TXT_LEN2 4
#define TXT_ROW1 5
#define TXT_ROW2 6
#define TXT_COL1 7
#define TXT_COL2 8
#define TXT_RGBAT1 9
#define TXT_RGBAT2 10
#define TXT_RGBAT3 11
#define TXT_LEN 12
function xlsOpen( cFile )
local nHandle
//Version 2.1
local cBof := Chr( 9 ) + Chr( 0 ) + Chr( 4 ) + Chr( 0 ) + ;
Chr( 2 ) + Chr( 0 ) + Chr( 10 ) + Chr( 0 )
nHandle := fCreate( cFile )
fWrite( nHandle, cBof, Len( cBof ))
return nHandle
function xlsClose( nHandle )
local cEof := Chr( 10 ) + Chr( 0 ) + Chr( 0 ) + Chr( 0 )
fWrite( nHandle, cEof, Len( cEof ))
fClose( nHandle )
return nil
FUNCTION XLSWRITE(nHandle, nRow, nCol,xData,Shade,nFont,Pic)
Do Case
Case VALTYPE(xData) = 'C'
XLSWriteS(nHandle,nRow,nCol,xData,Shade,nFont,Pic)
Case VALTYPE(xData) = 'N'
XLSWriteN(nHandle,nRow,nCol,xData,Shade,nFont,Pic)
Case VALTYPE(xData) = 'D'
XLSWriteS(nHandle,nRow,nCol,DTOC(xData),Shade,nFont,Pic)
EndCase
RETURN nil
function xlsWriteS( nHandle, nRow, nCol, cString,Shade,nFont,Pic) //String
Value...
Local xlsPat
//Rows and cols start at (1,1)
local anHeader
local nLen
local nI
Default Shade to .F.
Default nFont to 0
Default Pic to 0
nFont := nFont * 64 + Pic
anHeader := Array( TXT_ELEMS )
anHeader[ TXT_OPCO1 ] := 4
anHeader[ TXT_OPCO2 ] := 0
anHeader[ TXT_LEN1 ] := 10
anHeader[ TXT_LEN2 ] := 0
anHeader[ TXT_ROW2 ] := 0
anHeader[ TXT_COL2 ] := 0
anHeader[ TXT_RGBAT1 ] := 0
If Shade = .T.
anHeader[ TXT_RGBAT1 ] := 0
anHeader[ TXT_RGBAT2 ] := nFont
anHeader[ TXT_RGBAT3 ] := 192 //124
else
anHeader[ TXT_RGBAT2 ] := nFont
anHeader[ TXT_RGBAT3 ] := 0
EndIf
anHeader[ TXT_LEN ] := 2
nLen := Len(cString)
anHeader[ TXT_LEN ] := nLen
anHeader[ TXT_LEN1 ] := 8 + nLen
nI := nRow - 1
anHeader[ TXT_ROW1 ] := nI - (Int( nI / 256 ) * 256 )
anHeader[ TXT_ROW2 ] := Int( nI / 256 )
anHeader[ TXT_COL1 ] := nCol - 1
//Write de Header...
Aeval( anHeader, { | v | fWrite( nHandle, Chr( v ), 1 )})
//Write the Data...
for nI:=1 to nLen
fWrite( nHandle, SubStr( cString, nI, 1 ), 1 )
next nI
return nil
function xlsWriteI( nHandle, nRow, nCol,i,Shade,nFont,Pic) //INTEGER
Value...
//Rows and cols start at (1,1)
local anHeader
local nLen
local nI
Default Shade to .F.
Default nFont to 0
Default Pic to 0
nFont := nFont * 64 + Pic
anHeader := Array(4+9) //13=Length of Integer Value Body...
anHeader[ TXT_OPCO1 ] := 2
anHeader[ TXT_OPCO2 ] := 0
anHeader[ TXT_LEN1 ] := 9
anHeader[ TXT_LEN2 ] := 0
anHeader[ TXT_ROW2 ] := 0
anHeader[ TXT_COL2 ] := 0
If Shade = .T.
anHeader[ TXT_RGBAT2 ] := nFont
anHeader[ TXT_RGBAT3 ] := 192
else
anHeader[ TXT_RGBAT2 ] := nFont
anHeader[ TXT_RGBAT3 ] := 0
EndIf
anHeader[12] := i - (Int(i/256) * 256)
anHeader[13] := Int(i/256)
anHeader[ TXT_LEN1 ] := 9
nI := nRow - 1
anHeader[ TXT_ROW1 ] := nI - (Int( nI / 256 ) * 256 )
anHeader[ TXT_ROW2 ] := Int( nI / 256 )
anHeader[ TXT_COL1 ] := nCol - 1
//Write de Header...
Aeval( anHeader, { | v | fWrite( nHandle, Chr( v ), 1 )})
return nil
function xlsWriteN( nHandle, nRow, nCol,i,Shade,nFont,Pic) //Number Value...
//Rows and cols start at (1,1)
local anHeader
local nLen
local nI
Local r
Default Shade to .F.
Default nFont to 0
Default Pic to 0
nFont := nFont * 64 + Pic
anHeader := Array(4+15) //19=Length of Number Value Body...
anHeader[ TXT_OPCO1 ] := 3
anHeader[ TXT_OPCO2 ] := 0
anHeader[ TXT_LEN1 ] := 15
anHeader[ TXT_LEN2 ] := 0
anHeader[ TXT_ROW2 ] := 0
anHeader[ TXT_COL2 ] := 0
anHeader[ TXT_RGBAT1 ] := 42
If Shade = .T.
anHeader[ TXT_RGBAT2 ] := nFont
anHeader[ TXT_RGBAT3 ] := 192
else
anHeader[ TXT_RGBAT2 ] := nFont
anHeader[ TXT_RGBAT3 ] := 0
EndIf
r := A2Bin({i},'Double')
anHeader[12] := ASC(SubStr(r,1,1))
anHeader[13] := ASC(SubStr(r,2,1))
anHeader[14] := ASC(SubStr(r,3,1))
anHeader[15] := ASC(SubStr(r,4,1))
anHeader[16] := ASC(SubStr(r,5,1))
anHeader[17] := ASC(SubStr(r,6,1))
anHeader[18] := ASC(SubStr(r,7,1))
anHeader[19] := ASC(SubStr(r,8,1))
anHeader[ TXT_LEN1 ] := 15
nI := nRow - 1
anHeader[ TXT_ROW1 ] := nI - (Int( nI / 256 ) * 256 )
anHeader[ TXT_ROW2 ] := Int( nI / 256 )
anHeader[ TXT_COL1 ] := nCol - 1
//Write de Header...
Aeval( anHeader, { | v | fWrite( nHandle, Chr( v ), 1 )})
return nil
function xlsColSize(nHandle,nCol,n)
local anHeader
n := n*256
anHeader := Array(4+4)
anHeader[ TXT_OPCO1 ] := 36 //24h
anHeader[ TXT_OPCO2 ] := 0
anHeader[ TXT_LEN1 ] := 4
anHeader[ TXT_LEN2 ] := 0
anHeader[5] := nCol-1
anHeader[6] := nCol-1
anHeader[7] := n-(Int(n/256)*256)
anHeader[8] := Int(n/256)
//Write de Header...
Aeval( anHeader, { | v | fWrite( nHandle, Chr( v ), 1 )})
return nil
function
xlsFont(nHandle,FontName,Height,Bold,Italic,UnderLine,StrikeOut,Color)
local anHeader,nI,r
FontName := AllTrim(FontName)
r := Bold + Italic*2 + Underline*4 + StrikeOut*8
anHeader := Array(4+4)
anHeader[ TXT_OPCO1 ] := 49 //31h
anHeader[ TXT_OPCO2 ] := 0
anHeader[ TXT_LEN1 ] := 4+Len(FontName)
anHeader[ TXT_LEN2 ] := 0
anHeader[5] := Height
anHeader[6] := 0 //Reserved
anHeader[7] := r
anHeader[8] := Len(FontName)
//Write de Header...
Aeval(anHeader,{|v|fWrite(nHandle,Chr(v),1)})
//Write the Data...
for nI:=1 to Len(FontName)
fWrite( nHandle, SubStr(FontName,nI,1),1)
next nI
If Color <> NIL
anHeader := Array(4+2)
anHeader[ TXT_OPCO1 ] := 69 //45h
anHeader[ TXT_OPCO2 ] := 0
anHeader[ TXT_LEN1 ] := 2
anHeader[ TXT_LEN2 ] := 0
anHeader[5] := Color
anHeader[6] := 0
//Write de Header...
Aeval(anHeader,{|v|fWrite(nHandle,Chr(v),1)})
EndIf
return nil
function xlsFormat(nHandle,Pic)
local anHeader,nI,r
Pic := AllTrim(Pic)
anHeader := Array(4+1)
anHeader[ TXT_OPCO1 ] := 30 //1Eh
anHeader[ TXT_OPCO2 ] := 0
anHeader[ TXT_LEN1 ] := 1+Len(Pic)
anHeader[ TXT_LEN2 ] := 0
anHeader[5] := Len(Pic)
//Write de Header...
Aeval(anHeader,{|v|fWrite(nHandle,Chr(v),1)})
//Write the Data...
for nI:=1 to Len(Pic)
fWrite( nHandle, SubStr(Pic,nI,1),1)
next nI
return nil
_______________________________________________
Harbour-users mailing list (attachment size limit: 40KB)
[email protected]
http://lists.harbour-project.org/mailman/listinfo/harbour-users
