Ich habe den Code von Paul Squires genommen und es funktioniert.
Code: Alles auswählen
;Converted to PureBasic on 4.4.2006 by ABBKlaus
;
;Excel.inc - Include file for BIFF 2.1 specifications to write Excel files.
;
;Converted from VB source to PowerBasic, November 2001.
;Paul Squires (2001) support@planetsquires.com (Freeware)
;
;Copyright (c) 2001 by Paul Squires.
;Although this code is available for free, the author retains the copyright, which means that you
;cannot do anything with it that is not expressly allowed by the author. In general terms, the author
;would allow the programmer to incorporate the code into their applications. Selling the code by
;itself is prohibited.
;
;
;Class file for writing Microsoft Excel BIFF 2.1 files.
;
;This class is intended for users who do not want to use the huge
;Jet or ADO providers if they only want to export their data to
;an Excel compatible file.
;Newer versions of Excel use the OLE Structure Storage methods
;which are quite complicated.
;Paul Squires, November 10, 2001
;support@planetsquires.com
; ? = Byte 8 Bits PB = .b
; % = Integer 16 Bits PB = .w
; & = Long Integer 32 Bits PB = .l
; && = Quad Integer 64 Bits PB4 = .q
; ?? = Word 16 Bits PB = .w
; ??? = Double-Word 32 Bits PB = .l
; ! = Single-Float 32 Bits PB = .f
; # = Double-Float 64 Bits PB4 = .d
; ## = Ext.-Float 10 Bytes ?
; @ = Currency 64 Bits PB4 = .q
; @@ = Ext.-currency 64 Bits PB4 = .q
;==================================================================================================
; constants to hold cell alignment
#XLS_GeneralAlign = 0
#XLS_LeftAlign = 1
#XLS_CentreAlign = 2
#XLS_RightAlign = 3
#XLS_FillCell = 4
#XLS_LeftBorder = 8
#XLS_RightBorder = 16
#XLS_TopBorder = 32
#XLS_BottomBorder = 64
#XLS_Shaded = 128
; constants to handle selecting the font for the cell
;used by rgbAttr2
;bits 0-5 handle the *picture* formatting, not bold/underline etc...
;bits 6-7 handle the font number
#XLS_Font0 = 0
#XLS_Font1 = 64
#XLS_Font2 = 128
#XLS_Font3 = 192
;used by rgbAttr1
;bits 0-5 must be zero
;bit 6 locked/unlocked
;bit 7 hidden/not hidden
#XLS_CellNormal = 0
#XLS_CellLocked = 64
#XLS_CellHidden = 128
; set up variables to hold the spreadsheet;s layout
#XLS_LeftMargin = 38
#XLS_RightMargin = 39
#XLS_TopMargin = 40
#XLS_BottomMargin = 41
; add these enums together. For example: xlsBold + xlsUnderline
#XLS_NoFormat = 0
#XLS_Bold = 1
#XLS_Italic = 2
#XLS_Underline = 4
#XLS_Strikeout = 8
Structure XLS_FONT_RECORD
opcode.w ;49
length.w ;5+len(fontname)
FontHeight.w
FontAttributes1.b ; bit0 bold, bit1 italic, bit2 underline, bit3 strikeout, bit4-7 reserved
FontAttributes2.b ; reserved - always 0
FontNameLength.b
EndStructure
Structure XLS_PASSWORD_RECORD
opcode.w ;47
length.w ;len(password)
EndStructure
Structure XLS_HEADER_FOOTER_RECORD
opcode.w ;20 Header, 21 Footer
length.w ;1+len(text)
TextLength.b
EndStructure
Structure XLS_PROTECT_SPREADSHEET_RECORD
opcode.w ;18
length.w ;2
Protect.w
EndStructure
Structure XLS_FORMAT_COUNT_RECORD
opcode.w ;1f
length.w ;2
Count.w
EndStructure
Structure XLS_FORMAT_RECORD
opcode.w ; 1e
length.w ; 1+len(format)
FormatLength.b ; len(format) + followed by the Format-Picture
EndStructure
Structure XLS_COLWIDTH_RECORD
opcode.w ; 36
length.w ; 4
col1.b ;first column
col2.b ;last column
ColumnWidth.w ;at 1/256th of a character
EndStructure
;Beginning Of File record
Structure XLS_BEG_FILE_RECORD
opcode.w
length.w
version.w
ftype.w
EndStructure
;End Of File record
Structure XLS_END_FILE_RECORD
opcode.w
length.w
EndStructure
;true/false to print gridlines
Structure XLS_PRINT_GRIDLINES_RECORD
opcode.w
length.w
PrintFlag.w
EndStructure
;Integer record
Structure XLS_tInteger
opcode.w
length.w
Row.w ; unsigned integer
col.w
rgbAttr1.b ; handles whether cell is hidden and/or locked
rgbAttr2.b ; handles the Font# and Formatting assigned to this cell
rgbAttr3.b ; handles the Cell Alignment/borders/shading
intValue.w ; the actual integer value
EndStructure
;Number record
Structure XLS_tNumber
opcode.w
length.w
Row.w
col.w
rgbAttr1.b
rgbAttr2.b
rgbAttr3.b
NumberValue.d ; As Double ;8 Bytes
EndStructure
;Label (Text) record
Structure XLS_tText
opcode.w
length.w
Row.w
col.w
rgbAttr1.b
rgbAttr2.b
rgbAttr3.b
TextLength.b
EndStructure
Structure XLS_MARGIN_RECORD_LAYOUT
opcode.w
length.w
MarginValue.d ; As Double ;8 bytes
EndStructure
Structure XLS_HPAGE_BREAK_RECORD
opcode.w
length.w
NumPageBreaks.w
EndStructure
Structure XLS_DEF_ROWHEIGHT_RECORD
opcode.w
length.w
RowHeight.w
EndStructure
Structure XLS_ROW_HEIGHT_RECORD
opcode.w ; 08
length.w ; should always be 16 bytes
RowNumber.w
FirstColumn.w
LastColumn.w
RowHeight.w ; written to file as 1/20ths of a point
internal.w
DefaultAttributes.b ;set to zero for no default attributes
FileOffset.w
rgbAttr1.b
rgbAttr2.b
rgbAttr3.b
EndStructure
Global xlsFileNumber.l
Declare.l XLS_CloseFile()
Declare.l XLS_CreateFile(FileName$)
Declare.l IPF_DateToJulian(DateString$)
Declare XLS_End()
Declare XLS_Init()
Declare.l XLS_InsertHorizPageBreak(row.l)
Declare.l XLS_PrintGridLines(TrueFalse.l)
Declare.l XLS_ProtectSpreadsheet(TrueFalse.l)
Declare.l XLS_SetColumnWidth(FirstColumn.l, LastColumn.l, WidthValue.l)
Declare.l XLS_SetDefaultRowHeight(HeightValue.l)
Declare.l XLS_SetFilePassword(PasswordText$)
Declare.l XLS_SetFont(FontName$, FontHeight.l, FontFormat.l)
Declare.l XLS_SetFooter(FooterText$)
Declare.l XLS_SetHeader(HeaderText$)
Declare.l XLS_SetMargin(Margin.l, MarginValue.d)
Declare.l XLS_SetRowHeight(row.l, HeightValue.l)
Declare.d IPF_TimeToDouble(time$)
Declare.l XLS_WriteDate(DateString$, Dateformat$, row.l, col.l, CellFont.l, CellAlignment.l, HiddenLocked.l, CellFormat.l)
Declare.l IPF_WriteDefaultFormats()
Declare.l XLS_WriteInteger(value.w ,row.l ,col.l, CellFont.l, CellAlignment.l, HiddenLocked.l, CellFormat.l)
Declare.l XLS_WriteNumber(value.d, row.l, col.l, CellFont.l, CellAlignment.l, HiddenLocked.l, CellFormat.l)
Declare.l XLS_WriteText(text$, row.l, col.l, CellFont.l, CellAlignment.l, HiddenLocked.l, CellFormat.l)
Declare.l IPF_WriteToFile(*Buffer,length)
Declare.l IPF_WriteStringToFile(String.s)
ProcedureDLL XLS_Init()
;create an array that will hold the rows where a horizontal page
;break will be inserted just before.
Global NewList XLS_HorizPageBreakRows.l()
EndProcedure
ProcedureDLL XLS_End()
XLS_CloseFile()
ClearList(XLS_HorizPageBreakRows())
EndProcedure
Procedure.d IPF_TimeToDouble(time$)
hour=Val(StringField(time$,1,":"))
min=Val(StringField(time$,2,":"))
sec=Val(StringField(time$,3,":"))
timevalue.d=hour*3600+min*60+sec ; Range = 0 to 86399
secondsperday=86400
timevalue/secondsperday
ProcedureReturn timevalue
EndProcedure
ProcedureDLL.l XLS_CreateFile(FileName$)
If FileSize(FileName$)>=0
If DeleteFile(FileName$)=0
ProcedureReturn -1
EndIf
EndIf
Protected BEG_FILE_MARKER.XLS_BEG_FILE_RECORD
;beginning of file
BEG_FILE_MARKER\opcode=9
BEG_FILE_MARKER\length=4
BEG_FILE_MARKER\version=2
BEG_FILE_MARKER\ftype=10
xlsFileNumber=CreateFile_(@FileName$,#GENERIC_READ|#GENERIC_WRITE,#FILE_SHARE_READ,0,#CREATE_ALWAYS,#FILE_ATTRIBUTE_NORMAL,0)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
IPF_WriteToFile(BEG_FILE_MARKER,SizeOf(XLS_BEG_FILE_RECORD))
;create the Horizontal Page Break array
ClearList(XLS_HorizPageBreakRows())
;write the default formats to the file
IPF_WriteDefaultFormats()
EndProcedure
ProcedureDLL.l XLS_CloseFile()
If xlsFileNumber=0
ProcedureReturn #False
EndIf
hcount.l=ListSize(XLS_HorizPageBreakRows())
;write the horizontal page breaks If necessary
If hcount>0
;the Horizontal Page Break array must be in sorted order.
;Use a simple Bubble sort because the size of this array would
;be pretty small most of the time. A QuickSort would probably
;be overkill.
SortList(XLS_HorizPageBreakRows(),0)
;write the Horizontal Page Break Record
HORIZ_PAGE_BREAK.XLS_HPAGE_BREAK_RECORD
HORIZ_PAGE_BREAK\opcode=27
HORIZ_PAGE_BREAK\length=2+(hcount*2)
HORIZ_PAGE_BREAK\NumPageBreaks=hcount
If IPF_WriteToFile(HORIZ_PAGE_BREAK,SizeOf(XLS_HPAGE_BREAK_RECORD))=#False
ProcedureReturn #False
EndIf
;now write the actual page break values
ForEach XLS_HorizPageBreakRows()
buff.w=XLS_HorizPageBreakRows()
If IPF_WriteToFile(@buff,2)=#False
ProcedureReturn #False
EndIf
Next
EndIf
END_FILE_MARKER.XLS_END_FILE_RECORD
;end of file marker
END_FILE_MARKER\opcode=10
If IPF_WriteToFile(END_FILE_MARKER,SizeOf(XLS_END_FILE_RECORD))=#False
ProcedureReturn #False
EndIf
;Close the file
If CloseHandle_(xlsFileNumber)
xlsFileNumber=0
ClearList(XLS_HorizPageBreakRows())
ProcedureReturn #True
EndIf
EndProcedure
ProcedureDLL.l XLS_InsertHorizPageBreak(row.l)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
AddElement(XLS_HorizPageBreakRows())
;the row and column values are written to the excel file as
;unsigned integers. Therefore, must convert the longs to integer.
XLS_HorizPageBreakRows()=row & $FFFF
EndProcedure
ProcedureDLL.l XLS_WriteInteger(value.w, row.l, col.l, CellFont.l, CellAlignment.l, HiddenLocked.l, CellFormat.l)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
INTEGER_RECORD.XLS_tInteger
INTEGER_RECORD\opcode=2
INTEGER_RECORD\length=9
INTEGER_RECORD\row=row & $FFFF
INTEGER_RECORD\col=col & $FFFF
INTEGER_RECORD\rgbAttr1=HiddenLocked & $FF
INTEGER_RECORD\rgbAttr2=CellFont|CellFormat & $FF
INTEGER_RECORD\rgbAttr3=CellAlignment & $FF
INTEGER_RECORD\intValue=value
ProcedureReturn IPF_WriteToFile(INTEGER_RECORD,SizeOf(XLS_tInteger))
EndProcedure
ProcedureDLL.l XLS_WriteNumber(value.d, row.l, col.l, CellFont.l, CellAlignment.l, HiddenLocked.l, CellFormat.l)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
NUMBER_RECORD.XLS_tNumber
NUMBER_RECORD\opcode=3
NUMBER_RECORD\length=15
NUMBER_RECORD\row=row & $FFFF
NUMBER_RECORD\col=col & $FFFF
NUMBER_RECORD\rgbAttr1=HiddenLocked & $FF
NUMBER_RECORD\rgbAttr2=CellFont|CellFormat & $FF
NUMBER_RECORD\rgbAttr3=CellAlignment & $FF
NUMBER_RECORD\NumberValue=value
ProcedureReturn IPF_WriteToFile(NUMBER_RECORD,SizeOf(XLS_tNumber))
EndProcedure
ProcedureDLL.l XLS_WriteText(text$, row.l, col.l,CellFont.l, CellAlignment.l, HiddenLocked.l, CellFormat.l)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
TEXT_RECORD.XLS_tText
TEXT_RECORD\opcode=4
TEXT_RECORD\length=10
;Length of the text portion of the record
TEXT_RECORD\TextLength=Len(text$)
;Total length of the record
TEXT_RECORD\length=8+Len(text$)
TEXT_RECORD\row=row & $FFFF
TEXT_RECORD\col=col & $FFFF
TEXT_RECORD\rgbAttr1=HiddenLocked & $FF
TEXT_RECORD\rgbAttr2=CellFont|CellFormat & $FF
TEXT_RECORD\rgbAttr3=CellAlignment & $FF
res.l=0
;Put record header
If IPF_WriteToFile(TEXT_RECORD,SizeOf(XLS_tText))
;Then the actual string Data
If IPF_WriteStringToFile(text$)
res=1
EndIf
EndIf
ProcedureReturn res
EndProcedure
ProcedureDLL.l XLS_WriteDate(DateString$, Dateformat$, row.l, col.l, CellFont.l, CellAlignment.l, HiddenLocked.l, CellFormat.l)
If xlsFileNumber=0 Or DateString$=""
ProcedureReturn #False
EndIf
pbdate=ParseDate(Dateformat$,DateString$)
DateString$=FormatDate("%yyyy%mm%dd %hh:%ii:%ss",pbdate)
date$=StringField(DateString$,1," ")
time$=StringField(DateString$,2," ")
If time$=""
time$="00:00:00"
EndIf
;convert the DateString$ from YYYYMMDD To a Julian date number
temp1.d=(IPF_DateToJulian(Date$)-IPF_DateToJulian("19000100"))+1
;F64_Int(temp1.double,value)
;convert time to double
temp1+IPF_TimeToDouble(time$)
NUMBER_RECORD.XLS_tNumber
NUMBER_RECORD\opcode=3
NUMBER_RECORD\length=15
NUMBER_RECORD\row=row & $FFFF
NUMBER_RECORD\col=col & $FFFF
NUMBER_RECORD\rgbAttr1=HiddenLocked & $FF
NUMBER_RECORD\rgbAttr2=CellFont|CellFormat & $FF
NUMBER_RECORD\rgbAttr3=CellAlignment & $FF
NUMBER_RECORD\NumberValue=temp1
ProcedureReturn IPF_WriteToFile(NUMBER_RECORD,SizeOf(XLS_tNumber))
EndProcedure
ProcedureDLL.l XLS_SetMargin(Margin.l, MarginValue.d)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
MarginValue / 2.54 ; Umrechnung Inch in cm
;write the spreadsheet's layout information (in inches)
MARGINRECORD.XLS_MARGIN_RECORD_LAYOUT
;Margin should be one of the following....
; #XLS_LeftMargin = 38
; #XLS_RightMargin = 39
; #XLS_TopMargin = 40
; #XLS_BottomMargin = 41
MARGINRECORD\opcode=Margin
MARGINRECORD\length=8
MARGINRECORD\MarginValue=MarginValue ; in cm
ProcedureReturn IPF_WriteToFile(MARGINRECORD,SizeOf(XLS_MARGIN_RECORD_LAYOUT))
EndProcedure
ProcedureDLL.l XLS_SetColumnWidth(FirstColumn.l, LastColumn.l, WidthValue.l)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
COLWIDTH.XLS_COLWIDTH_RECORD
COLWIDTH\opcode=36
COLWIDTH\length=4
COLWIDTH\col1=FirstColumn & $FF
COLWIDTH\col2=LastColumn & $FF
COLWIDTH\ColumnWidth=WidthValue*256 ;values are specified as 1/256 of a characterIPF_WriteToFile
ProcedureReturn IPF_WriteToFile(COLWIDTH,SizeOf(XLS_COLWIDTH_RECORD))
EndProcedure
ProcedureDLL.l XLS_SetFont(FontName$, FontHeight.l, FontFormat.l)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
;you can set up to 4 fonts in the spreadsheet file. When writing a value such
;as a Text Or Number you can specify one of the 4 fonts (numbered 0 To 3)
FONTNAME_RECORD.XLS_FONT_RECORD
FONTNAME_RECORD\opcode=49
FONTNAME_RECORD\length=5+Len(FontName$)
FONTNAME_RECORD\FontHeight=FontHeight*20
FONTNAME_RECORD\FontAttributes1=FontFormat & $FF ;bold/underline etc...
FONTNAME_RECORD\FontAttributes2=0 ;reserved-always zero!!
FONTNAME_RECORD\FontNameLength=Len(FontName$) & $FF
If IPF_WriteToFile(FONTNAME_RECORD,SizeOf(XLS_FONT_RECORD))
;Then the actual font name data
ProcedureReturn IPF_WriteStringToFile(FontName$)
EndIf
EndProcedure
ProcedureDLL.l XLS_SetHeader(HeaderText$)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
HEADER_RECORD.XLS_HEADER_FOOTER_RECORD
HEADER_RECORD\opcode=20
HEADER_RECORD\length=1+Len(HeaderText$)
HEADER_RECORD\TextLength=Len(HeaderText$) & $FF
If IPF_WriteToFile(HEADER_RECORD,SizeOf(XLS_HEADER_FOOTER_RECORD))
;Then the actual Header text
ProcedureReturn IPF_WriteStringToFile(HeaderText$)
EndIf
EndProcedure
ProcedureDLL.l XLS_SetFooter(FooterText$)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
FOOTER_RECORD.XLS_HEADER_FOOTER_RECORD
FOOTER_RECORD\opcode=21
FOOTER_RECORD\length=1+Len(FooterText$)
FOOTER_RECORD\TextLength=Len(FooterText$) & $FF
If IPF_WriteToFile(FOOTER_RECORD,SizeOf(XLS_HEADER_FOOTER_RECORD))
;Then the actual Header text
ProcedureReturn IPF_WriteStringToFile(FooterText$)
EndIf
EndProcedure
ProcedureDLL.l XLS_SetFilePassword(PasswordText$)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
FILE_PASSWORD_RECORD.XLS_PASSWORD_RECORD
FILE_PASSWORD_RECORD\opcode=47
FILE_PASSWORD_RECORD\length=Len(PasswordText$)
If IPF_WriteToFile(FILE_PASSWORD_RECORD,SizeOf(XLS_PASSWORD_RECORD))
;Then the actual Password text
ProcedureReturn IPF_WriteStringToFile(PasswordText$)
EndIf
EndProcedure
ProcedureDLL.l XLS_PrintGridLines(TrueFalse.l)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
GRIDLINES_RECORD.XLS_PRINT_GRIDLINES_RECORD
GRIDLINES_RECORD\opcode=43
GRIDLINES_RECORD\length=2
If TrueFalse=0
GRIDLINES_RECORD\PrintFlag=0
Else
GRIDLINES_RECORD\PrintFlag=1
EndIf
ProcedureReturn IPF_WriteToFile(GRIDLINES_RECORD,SizeOf(XLS_PRINT_GRIDLINES_RECORD))
EndProcedure
ProcedureDLL.l XLS_ProtectSpreadsheet(TrueFalse.l)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
PROTECT_RECORD.XLS_PROTECT_SPREADSHEET_RECORD
PROTECT_RECORD\opcode=18
PROTECT_RECORD\length=2
If TrueFalse=0
PROTECT_RECORD\Protect=0
Else
PROTECT_RECORD\Protect=1
EndIf
ProcedureReturn IPF_WriteToFile(PROTECT_RECORD,SizeOf(XLS_PROTECT_SPREADSHEET_RECORD))
EndProcedure
Procedure.l IPF_WriteDefaultFormats()
If xlsFileNumber=0
ProcedureReturn #False
EndIf
cFORMAT_COUNT_RECORD.XLS_FORMAT_COUNT_RECORD
cFORMAT_RECORD.XLS_FORMAT_RECORD
lIndex.l
Dim aFormat.s(23)
l.l
q.s
q=Chr(34)
aFormat(0)="General"
aFormat(1)="0"
aFormat(2)="0.00"
aFormat(3)="#,##0"
aFormat(4)="#,##0.00"
aFormat(5)="#,##0\ "+q+"$"+q+";\-#,##0\ "+q+"$"+q
aFormat(6)="#,##0\ "+q+"$"+q+";[Red]\-#,##0\ "+q+"$"+q
aFormat(7)="#,##0.00\ "+q+"$"+q+";\-#,##0.00\ "+q+"$"+q
aFormat(8)="#,##0.00\ "+q+"$"+q+";[Red]\-#,##0.00\ "+q+"$"+q
aFormat(9)="0%"
aFormat(10)="0.00%"
aFormat(11)="0.00E+00"
aFormat(12)="yyyy-mm-dd"
aFormat(13)="dd/\ mmm\ yy"
aFormat(14)="dd/\ mmm"
aFormat(15)="mmm\ yy"
aFormat(16)="h:mm\ AM/PM"
aFormat(17)="h:mm:ss\ AM/PM"
aFormat(18)="hh:mm"
aFormat(19)="hh:mm:ss"
aFormat(20)="dd/mm/yy\ hh:mm"
aFormat(21)="##0.0E+0"
aFormat(22)="mm:ss"
aFormat(23)="@"
cFORMAT_COUNT_RECORD\opcode=$1F
cFORMAT_COUNT_RECORD\length=$02
cFORMAT_COUNT_RECORD\Count=23
If IPF_WriteToFile(cFORMAT_COUNT_RECORD,SizeOf(XLS_FORMAT_COUNT_RECORD))
For lIndex = 0 To 23
l=Len(aFormat(lIndex))
cFORMAT_RECORD\opcode=$1E
cFORMAT_RECORD\length=l+1
cFORMAT_RECORD\FormatLength=l
If IPF_WriteToFile(cFORMAT_RECORD,SizeOf(XLS_FORMAT_RECORD))=#False
Break
EndIf
;Then the actual format
If IPF_WriteStringToFile(aFormat(lIndex))=#False
Break
EndIf
Next
ProcedureReturn #True
EndIf
EndProcedure
ProcedureDLL.l XLS_SetDefaultRowHeight(HeightValue.l)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
;Height is defined in units of 1/20th of a point. Therefore, a 10-point font
;would be 200 (i.e. 200/20 = 10). This function takes a HeightValue such as
;14 point And converts it the correct size before writing it To the file.
DEFHEIGHT.XLS_DEF_ROWHEIGHT_RECORD
DEFHEIGHT\opcode=37
DEFHEIGHT\length=2
DEFHEIGHT\RowHeight=HeightValue*20 ;convert points To 1/20ths of point
ProcedureReturn IPF_WriteToFile(DEFHEIGHT,SizeOf(XLS_DEF_ROWHEIGHT_RECORD))
EndProcedure
ProcedureDLL.l XLS_SetRowHeight(row.l, HeightValue.l)
If xlsFileNumber=0
ProcedureReturn #False
EndIf
;Height is defined in units of 1/20th of a point. Therefore, a 10-point font
;would be 200 (i.e. 200/20 = 10). This function takes a HeightValue such as
;14 point And converts it the correct size before writing it To the file.
ROWHEIGHTREC.XLS_ROW_HEIGHT_RECORD
ROWHEIGHTREC\opcode=8
ROWHEIGHTREC\length=16
ROWHEIGHTREC\RowNumber=row & $FFFF
ROWHEIGHTREC\FirstColumn=0
ROWHEIGHTREC\LastColumn=256
ROWHEIGHTREC\RowHeight=HeightValue*20 ;convert points To 1/20ths of point
ROWHEIGHTREC\internal=0
ROWHEIGHTREC\DefaultAttributes=0
ROWHEIGHTREC\FileOffset=0
ROWHEIGHTREC\rgbAttr1=0
ROWHEIGHTREC\rgbAttr2=0
ROWHEIGHTREC\rgbAttr3=0
ProcedureReturn IPF_WriteToFile(ROWHEIGHTREC,SizeOf(XLS_ROW_HEIGHT_RECORD))
EndProcedure
Procedure.l IPF_DateToJulian(DateString$)
;DateString$ must be in YYYYMMDD
Protected Elapsed.l
If Len(DateString$)<>8
ProcedureReturn
EndIf
Year=Val(Left(DateString$,4))
month=Val(Mid(DateString$,5,2))
day=Val(Right(DateString$,2))
If month<3 ; January Or February?
month+12 ; 13th or 14th month ....
year-1 ; .... of prev. year
EndIf
Elapsed=Int((year+4712)*365.25) ; years elapsed
Elapsed=Elapsed-(year/100) ; substract century leapdays
Elapsed=Elapsed+(year/400) ; re-add valid ones
Elapsed=Elapsed+Int(30.6*(month-1)+0.2) ; months elapsed + adjustm.
ProcedureReturn Elapsed+day ; days of final month
EndProcedure
Procedure.l IPF_WriteToFile(*Buffer,length)
If WriteFile_(xlsFilenumber,*Buffer,length,@temp.l,0)
ProcedureReturn temp
EndIf
EndProcedure
Procedure.l IPF_WriteStringToFile(String.s)
Protected temp.l, *Buffer
*Buffer = AllocateMemory(Len(String)+2)
If *Buffer
PokeS(*Buffer,String,Len(String),#PB_Ascii)
WriteFile_(xlsFilenumber,*Buffer,Len(String),@temp,0)
FreeMemory(*Buffer)
EndIf
ProcedureReturn temp
EndProcedure
; ---------------------- Beispiel
; XLS_Init()
; XLS_CreateFile("C:\tmp\Test10.xls")
; XLS_SetFont("Arial",10,#XLS_NoFormat) ; #XLS_Font0
; XLS_SetFont("Arial",10,#XLS_Bold) ; #XLS_Font1
; row.l=0
; col.l=0
; CellAlignment.l = #XLS_RightAlign
; CellFormat.l=0 ; index aus aFormat(0)
; XLS_WriteText("Numéro d'article",row,col,#XLS_Font1,CellAlignment,#XLS_CellNormal,0)
; XLS_WriteText("Integer0",0,1,#XLS_Font1,#XLS_RightAlign,#XLS_CellNormal,0)
; ; Data
; XLS_WriteText("text",1,0,#XLS_Font0,#XLS_LeftAlign,#XLS_CellNormal,0)
; XLS_CloseFile()