XLS_CreateFile ich bin verzweifelt

Anfängerfragen zum Programmieren mit PureBasic.
Benutzeravatar
marcelx
Beiträge: 424
Registriert: 19.02.2010 20:19
Wohnort: Darmstadt

XLS_CreateFile ich bin verzweifelt

Beitrag von marcelx »

Hallo,
ich musste Windows 10 neue installieren und danach PB5.31

Soviel ich mich erinnern kann hatte ich Excel_Writer105_PB46X86 oder Excel_Writer105_PB43X86 verwendet
und in den Verzeichnis von PureBasic die Dateien kopiert
- PureLibraries\UserLibraries\ExcelWriter
- Residents\ExcelWriter_res.res

Mein folgende code

Code: Alles auswählen

fileNameExport.s="test"
XLS_CreateFile(fileNameExport)
lässt sich nicht mehr compilieren.
Ich bekomme die Meldung
POLINK: error: Unresolved external symbol 'SYS_FreeStringStructureArray'
Gleich für SYS_AllocateArray und SYS_AllocateString

Kann mir bitte jemand helfen!
Danke und Gruß
MarcelX
Win-10, PB 5.31 (Windows - x86)
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: XLS_CreateFile ich bin verzweifelt

Beitrag von mk-soft »

Die UserLibrary ist nicht mit der PB-Version kompatible...

Diese muss auch entfernt werden. Vieleicht findest du eine aktuelle UserLib oder wechsel auf eine Version als Include und nicht als UserLib.

P.S.
Das ist auch der nachteil von User Libraries, da diese mit einer neuen Version von Purebasic auch die User Library neu angepasst und compiliert werden muss.
Vor allem, wenn sich intern was an PB ändert, wie die interen funktionen für String...
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
marcelx
Beiträge: 424
Registriert: 19.02.2010 20:19
Wohnort: Darmstadt

Re: XLS_CreateFile ich bin verzweifelt

Beitrag von marcelx »

Danke mk-soft
ich suche nach eine passende UserLib

EDIT: der UserLib Excel_Writer ist von ABBKlaus
Seine Webseite http://www.purebasicpower.de gibt es nicht mehr
Win-10, PB 5.31 (Windows - x86)
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: XLS_CreateFile ich bin verzweifelt

Beitrag von mk-soft »

Alternativen:

Weiss nicht ob diese aktuell ist...
COMatePlus Excel: viewtopic.php?f=8&t=23254

Oder ActiveScript...

Link: https://www.purebasic.fr/english/viewto ... 12&t=71399

Es gibt viele VB-Script Beispiele für Excel.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
BI2
Beiträge: 145
Registriert: 26.11.2006 19:07

Re: XLS_CreateFile ich bin verzweifelt

Beitrag von BI2 »

Das habe ich in meiner Sammlung noch gefunden. Ist zwar schon ziemlich alt, dafür keine Userlib. Vielleicht kann man was draus machen.

Gruß, BI2

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
PB 5.7x (x64), LinuxMint 18.3 - Xfce (x64)

Einsteigerbuch: PureBasic - Eine Einführung in die Computer Programmierung
Benutzeravatar
marcelx
Beiträge: 424
Registriert: 19.02.2010 20:19
Wohnort: Darmstadt

Re: XLS_CreateFile ich bin verzweifelt

Beitrag von marcelx »

soviel ich weis, COMatePlus benötigt Excel.
Ich habe ExcelWriter v3.94 (auch von 'ABBKlaus') aus http://www.purearea.net/pb/german/userlibs.php ausprobiert und es funktioniert.
Ich muss nur mein alte Code entsprechend anpassen.
Ich benötigt nur die Excel-Ausgabe ohne groß Formattiereung und so reicht es mir.

EDIT: Danke BI2 für dein Code, das werde ich auch probieren
Win-10, PB 5.31 (Windows - x86)
Benutzeravatar
BI2
Beiträge: 145
Registriert: 26.11.2006 19:07

Re: XLS_CreateFile ich bin verzweifelt

Beitrag von BI2 »

@marcelx: Habe gerade gesehen, dass der Code den ich gepostet habe von Deinem Link stammt (rechts kann man den Quellcode der LIB herunterladen), ich wusste nicht mehr wo ich ihn her hatte.
PB 5.7x (x64), LinuxMint 18.3 - Xfce (x64)

Einsteigerbuch: PureBasic - Eine Einführung in die Computer Programmierung
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: XLS_CreateFile ich bin verzweifelt

Beitrag von mk-soft »

Quellcode passt

Mit etwas Aufwand bekommt man das auch für alle OS als Include umgebaut und nicht mehr als LIB :wink:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
marcelx
Beiträge: 424
Registriert: 19.02.2010 20:19
Wohnort: Darmstadt

Re: XLS_CreateFile ich bin verzweifelt

Beitrag von marcelx »

Ich habe den Code von Paul Squires genommen und es funktioniert.
(Am Ende habe ich ein Codebeispiel eingebaut)

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()

Win-10, PB 5.31 (Windows - x86)
Michael Vogel
Beiträge: 71
Registriert: 16.03.2006 11:20

Re: XLS_CreateFile ich bin verzweifelt

Beitrag von Michael Vogel »

Ich glaube, die Routinen wurden später noch verändert, in der Hoffnung, auch Farben setzen zu können...
Der Vollständigkeit halber füge ich auch meine Sicherheitskopie an (schwer zu sagen, ob alle Zeilen noch im Originalzustand sind)...

Code: Alles auswählen

; Define (Excel Writer Version 1.50)

	; Excel.inc - Include file for BIFF 2.1 specifications to write Excel files converted to PureBasic on 4.4.2006 by ABBKlaus
	;
	; Copyright (c) 2001 by Paul Squires (support@planetsquires.com)
	; 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.

	; ?   = 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

	#XlsMaxStringLen		=	255
	#XlsDebugging		=	0
	#XlsFormatNumber	=	23
	#XlsFormatNumberMax=	25

	; constants to hold cell alignment
	#XlsNoAlignment		=	0
	#XlsAlignmentNull		=	0
	#XlsAlignmentLeft		=	1
	#XlsAlignmentCenter	=	2
	#XlsAlignmentRight	=	3
	#XlsCellFill				=	4
	#XlsNoBorder			=	0
	#XlsBorderNull			=	0
	#XlsBorderLeft		=	8
	#XlsBorderRight		=	16
	#XlsBorderTop			=	32
	#XlsBorderBottom		=	64
	#XlsCellShaded		=	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
	#XlsFont1			=	0
	#XlsFont2			=	64
	#XlsFont3			=	128
	#XlsFont4			=	192

	; used by rgbAttr1
	; bits 0-5 must be zero (XF index)
	; bit 6 locked/unlocked
	; bit 7 hidden/not hidden
	#XlsCellNormal	=	0
	#XlsCellLocked	=	64
	#XlsCellHidden	=	128

	; set up variables to hold the spreadsheet;s layout
	#XlsMarginLeft	=	38
	#XlsMarginRight	=	39
	#XlsMarginTop		=	40
	#XlsMarginBottom	=	41

	; add these enums together. For example: xlsBold + xlsUnderline
	#XlsNoFormat		=	0
	#XlsBold			=	1
	#XlsItalic			=	2
	#XlsUnderline		=	4
	#XlsStrikeout		=	8

	Global XlsActiveFile

	Structure XlsFontType
		opcode.w;			49 (0x31)
		length.w;			5+len(fontname)
		FontHeight.w;		height/20 point (2 byte)
		FontAttributes1.b;		extended [7], condensed [6], shadowed [5], outlined [4], strikeout [3], underline [2], italic [1], bold [0]
		FontAttributes2.b;		reserved - always 0 (1 byte)
		FontNameLength.b;	(1 byte)
	EndStructure

	Structure XlsFFType
		opcode.w;		67 (0x43)
		length.w;		4 (0x04)
		Font.b;			Index to font record (offset 21) (1 byte)
		NotUsed.b;	zero (1 byte)
		Format.b;		hidden [7], locked [6], index to format record [0-5] (1 byte)
		Style.b;		shade [7], borders [3-6], alignment [0-2] (1 byte)
	EndStructure

	Structure XlsFontColorType
		opcode.w; 	69 (0x45)
		length.w; 		2 (0x02)
		Color.w; 		color-code (2 byte)
	EndStructure

	Structure XlsPASSWORD_RECORD
		opcode.w  ;47
		length.w  ;len(password)
	EndStructure

	Structure XlsHEADER_FOOTER_RECORD
		opcode.w  ;20 Header, 21 Footer
		length.w  ;1+len(text)
		TextLength.b
	EndStructure

	Structure XlsPROTECT_SPREADSHEET_RECORD
		opcode.w  ;18
		length.w  ;2
		Protect.w
	EndStructure

	Structure XlsFORMAT_COUNT_RECORD
		opcode.w  ;1f
		length.w  ;2
		Count.w
	EndStructure

	Structure XlsFORMAT_RECORD
		opcode.w       ; 1e
		length.w       ; 1+len(format)
		FormatLength.b ; len(format) + followed by the Format-Picture
	EndStructure

	Structure XlsCOLWIDTH_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 XlsBEG_FILE_RECORD
		opcode.w
		length.w
		version.w
		ftype.w
	EndStructure

	;End Of File record
	Structure XlsEND_FILE_RECORD
		opcode.w
		length.w
	EndStructure

	;true/false to print gridlines
	Structure XlsPRINT_GRIDLINES_RECORD
		opcode.w
		length.w
		PrintFlag.w
	EndStructure

	;Integer record
	Structure XlstInteger
		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

	Structure XlsNumberType
		opcode.w;		03 (0x03)
		length.w;		15 (0x0F)
		Row.w;		row (2 byte)
		col.w;			column (2 byte)
		rgbAttr1.b;		hidden [7], locked [6], XF-index [0-5] (1 byte)
		rgbAttr2.b;		font [6-7], format [0-5] (1 byte)
		rgbAttr3.b;		shade [7], borders [3-6], alignment [0-2] (1 byte)
		Value.d;		double (8 bytes)
	EndStructure

	; Label (Text) record
	Structure XlsTextType
		opcode.w;		4 (0x04)
		length.w;		8+string length
		Row.w;		row (2 byte)
		col.w;			column (2 byte)
		rgbAttr1.b;		hidden [7], locked [6], XF-index [0-5] (1 byte)
		rgbAttr2.b;		font [6-7], format [0-5] (1 byte)
		rgbAttr3.b;		shade [7], borders [3-6], alignment [0-2] (1 byte)
		TextLength.b;	string len (1 byte)
	EndStructure

	Structure XlsMARGIN_RECORD_LAYOUT
		opcode.w
		length.w
		MarginValue.d ; As Double  ;8 bytes
	EndStructure

	Structure XlsHPAGE_BREAK_RECORD
		opcode.w
		length.w
		NumPageBreaks.w
	EndStructure

	Structure XlsDEF_ROWHEIGHT_RECORD
		opcode.w
		length.w
		RowHeight.w
	EndStructure

	Structure XlsROW_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

	; in XLS_Create & XLS_Close integriert...
	; ProcedureDLL XLS_Init()

	;	Global NewList XLS_HorizPageBreakRows.l()

	; EndProcedure
	; ProcedureDLL XLS_End()

	; XLS_CloseFile()
	; ClearList(XLS_HorizPageBreakRows())

	; EndProcedure

; EndDefine
Procedure.d IpfTimeToDouble(hour,minute,second)

	ProcedureReturn (hour*3600+minute*60+second)/86400.0

EndProcedure
Procedure.l IpfDateToJulian(year,month,day)

	Protected Elapsed=day

	If month<3
		month+12
		year-1
	EndIf

	Elapsed+Int((year+4712)*365.25)
	Elapsed-year/100
	Elapsed+year/400
	Elapsed+Int(30.6*month-30.4)

	ProcedureReturn Elapsed

EndProcedure
Procedure.l IpfWriteToFile(*Buffer,length)

	Protected Bytes.l

	If WriteFile_(XlsActiveFile,*Buffer,length,@Bytes,0)
		ProcedureReturn Bytes
	EndIf

EndProcedure
Procedure.l IpfWriteStringToFile(String.s)

	Protected Bytes.l

	CompilerIf #PB_Compiler_Unicode

		Protected *Buffer=AllocateMemory(Len(String)+2)

		If *Buffer
			PokeS(*Buffer,String,Len(String),#PB_Ascii)
			WriteFile_(XlsActiveFile,*Buffer,Len(String),@Bytes,0)
			FreeMemory(*Buffer)
		EndIf

	CompilerElse

		WriteFile_(XlsActiveFile,@String,Len(String),@Bytes,0)

	CompilerEndIf

	ProcedureReturn Bytes

EndProcedure
Procedure.l IpfWriteDefaultFormats()

	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	cFORMAT_COUNT_RECORD.XlsFORMAT_COUNT_RECORD
	cFORMAT_RECORD.XlsFORMAT_RECORD
	lIndex.l
	Dim aFormat.s(#XlsFormatNumberMax)
	l.l

	#Q=Chr(34)

	Enumeration
		#XlsFormat_Nil
		#XlsFormat_General
		#XlsFormat_Number1
		#XlsFormat_Number2
		#XlsFormat_Number3
		#XlsFormat_Number4
		#XlsFormat_Currency1
		#XlsFormat_Currency2
		#XlsFormat_Currency3
		#XlsFormat_Currency4
		#XlsFormat_Percent1
		#XlsFormat_Percent2
		#XlsFormat_Scientific
		#XlsFormat_DateLong
		#XlsFormat_DateStandard
		#XlsFormat_DateShort
		#XlsFormat_TimeShort
		#XlsFormat_TimeLong
		#XlsFormat_TimeShort24
		#XlsFormat_TimeLong24
		#XlsFormat_DateTime
		#XlsFormat_Scientific2
		#XlsFormat_TimeMinutes
		#XlsFormat_Text
		#XlsFormat_PrivateNumber
		#XlsFormat_PrivateTime
	EndEnumeration

	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/yyyy\ hh:mm"

	aFormat(21)="##0.0E+0"
	aFormat(22)="mm:ss"
	aFormat(23)="@"
	aFormat(24)="#,##0.000000"
	aFormat(25)="mm:ss"


	cFORMAT_COUNT_RECORD\opcode=$1F
	cFORMAT_COUNT_RECORD\length=$02
	cFORMAT_COUNT_RECORD\Count=#XlsFormatNumber

	If IpfWriteToFile(cFORMAT_COUNT_RECORD,SizeOf(XlsFORMAT_COUNT_RECORD))
		For lIndex = 0 To #XlsFormatNumber
			l=Len(aFormat(lIndex))
			cFORMAT_RECORD\opcode=$1E
			cFORMAT_RECORD\length=l+1
			cFORMAT_RECORD\FormatLength=l
			If IpfWriteToFile(cFORMAT_RECORD,SizeOf(XlsFORMAT_RECORD))=#False
				Break
			EndIf
			;Then the actual format
			If IpfWriteStringToFile(aFormat(lIndex))=#False
				Break
			EndIf
		Next
		ProcedureReturn #True
	EndIf

EndProcedure

Procedure.l XlsCreateFile(FileName$)

	; XLS_Init:
	;create an array that will hold the rows where a horizontal page
	;break will be inserted just before.
	Global NewList XlsHorizPageBreakRows.l()

	If FileSize(FileName$)>=0
		If DeleteFile(FileName$)=0
			ProcedureReturn -1
		EndIf
	EndIf

	Protected BEG_FILE_MARKER.XlsBEG_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

	XlsActiveFile=CreateFile_(@FileName$,#GENERIC_READ|#GENERIC_WRITE,#FILE_SHARE_READ,0,#CREATE_ALWAYS,#FILE_ATTRIBUTE_NORMAL,0)

	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	IpfWriteToFile(BEG_FILE_MARKER,SizeOf(XlsBEG_FILE_RECORD))
	;create the Horizontal Page Break array
	ClearList(XlsHorizPageBreakRows())

	;write the default formats to the file
	IpfWriteDefaultFormats()

	;Debug "HU"
	;End

EndProcedure
Procedure.l XlsCloseFile()

	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	hcount.l=ListSize(XlsHorizPageBreakRows())

	;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(XlsHorizPageBreakRows(),0)

		;write the Horizontal Page Break Record
		HORIZ_PAGE_BREAK.XlsHPAGE_BREAK_RECORD
		HORIZ_PAGE_BREAK\opcode=27
		HORIZ_PAGE_BREAK\length=2+(hcount*2)
		HORIZ_PAGE_BREAK\NumPageBreaks=hcount

		If IpfWriteToFile(HORIZ_PAGE_BREAK,SizeOf(XlsHPAGE_BREAK_RECORD))=#False
			ProcedureReturn #False
		EndIf
		;now write the actual page break values
		ForEach XlsHorizPageBreakRows()
			buff.w=XlsHorizPageBreakRows()
			If IpfWriteToFile(@buff,2)=#False
				ProcedureReturn #False
			EndIf
		Next
	EndIf
	END_FILE_MARKER.XlsEND_FILE_RECORD
	;end of file marker
	END_FILE_MARKER\opcode=10

	If IpfWriteToFile(END_FILE_MARKER,SizeOf(XlsEND_FILE_RECORD))=#False
		ProcedureReturn #False
	EndIf

	;Close the file
	If CloseHandle_(XlsActiveFile)
		XlsActiveFile=0
		ClearList(XlsHorizPageBreakRows())
		ProcedureReturn #True
	EndIf

	; XLS_End:
	ClearList(XlsHorizPageBreakRows())

EndProcedure
Procedure.l XlsInsertHorizPageBreak(row.l)
	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	AddElement(XlsHorizPageBreakRows())
	;the row and column values are written to the excel file as
	;unsigned integers. Therefore, must convert the longs to integer.
	XlsHorizPageBreakRows()=row & $FFFF
EndProcedure
Procedure.l XlsWriteInteger(value.w,row.l,col.l,CellFont.l,CellAlignment.l,HiddenLocked.l,CellFormat.l)
	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	INTEGER_RECORD.XlstInteger
	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 IpfWriteToFile(INTEGER_RECORD,SizeOf(XlstInteger))
EndProcedure
Procedure.l XlsWriteNumber(value.d,row.l,col.l,CellFont.l,CellAlignment.l,HiddenLocked.l,CellFormat.l)

	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	XlsNumberData.XlsNumberType
	XlsNumberData\opcode=3
	XlsNumberData\length=15
	XlsNumberData\row=row & $FFFF
	XlsNumberData\col=col & $FFFF
	XlsNumberData\rgbAttr1=HiddenLocked & $FF
	XlsNumberData\rgbAttr2=CellFont|CellFormat & $FF
	XlsNumberData\rgbAttr3=CellAlignment & $FF
	XlsNumberData\Value=value

	ProcedureReturn IpfWriteToFile(XlsNumberData,SizeOf(XlsNumberType))
EndProcedure
Procedure.l XlsWriteText(text.s,row.l,col.l,CellFont.l,CellAlignment.l,HiddenLocked.l,CellFormat.l)

	If XlsActiveFile

		text=Left(text,#XlsMaxStringLen)

		XlsTextData.XlsTextType
		XlsTextData\opcode=4
		XlsTextData\length=10
		XlsTextData\TextLength=Len(text);	length of the text portion of the record
		XlsTextData\length=8+Len(text);		total length of the record
		XlsTextData\row=row&$FFFF
		XlsTextData\col=col&$FFFF
		XlsTextData\rgbAttr1=HiddenLocked&$FF
		XlsTextData\rgbAttr2=CellFont|CellFormat&$FF
		XlsTextData\rgbAttr3=CellAlignment&$FF

		If IpfWriteToFile(XlsTextData,SizeOf(XlsTextType));	put record header
			If IpfWriteStringToFile(text);					actual string data
				ProcedureReturn #True
			EndIf
		EndIf

	EndIf

	ProcedureReturn #False

EndProcedure
Procedure.l XlsWriteDate(year,month,day,hour,minute,second,row.l,col.l,CellFont.l,CellAlignment.l,HiddenLocked.l,CellFormat.l)

	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	XlsNumberData.XlsNumberType
	XlsNumberData\opcode=3
	XlsNumberData\length=15
	XlsNumberData\row=row & $FFFF
	XlsNumberData\col=col & $FFFF
	XlsNumberData\rgbAttr1=HiddenLocked & $FF
	XlsNumberData\rgbAttr2=CellFont|CellFormat & $FF
	XlsNumberData\rgbAttr3=CellAlignment & $FF
	XlsNumberData\Value=IpfDateToJulian(year,month,day)-IpfDateToJulian(1899,12,30)+IpfTimeToDouble(hour,minute,second)

	ProcedureReturn IpfWriteToFile(XlsNumberData,SizeOf(XlsNumberType))

EndProcedure
Procedure.l XlsWriteDateString(Date.s,DateFormat.s,row.l,col.l,CellFont.l,CellAlignment.l,HiddenLocked.l,CellFormat.l)

	Protected o

	o=ParseDate(DateFormat,Date)

	If o
		ProcedureReturn XlsWriteDate(Year(o),Month(o),Day(o),Hour(o),Minute(o),Second(o),row.l,col.l,CellFont.l,CellAlignment.l,HiddenLocked.l,CellFormat.l)
	Else
		ProcedureReturn #False
	EndIf

EndProcedure
Procedure.l XlsSetMargin(Margin.l,MarginValue.d)
	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	;write the spreadsheet's layout information (in inches)
	MARGINRECORD.XlsMARGIN_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 inches

	ProcedureReturn IpfWriteToFile(MARGINRECORD,SizeOf(XlsMARGIN_RECORD_LAYOUT))
EndProcedure
Procedure.l XlsSetColumnWidth(FirstColumn.l,LastColumn.l,WidthValue.l)
	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	COLWIDTH.XlsCOLWIDTH_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 IpfWriteToFile(COLWIDTH,SizeOf(XlsCOLWIDTH_RECORD))
EndProcedure
Procedure.l XlsSetFont(FontName$,FontHeight.l,FontFormat.l)

	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	XlsFontData.XlsFontType
	XlsFontData\opcode=49
	XlsFontData\length=5+Len(FontName$)
	XlsFontData\FontHeight=FontHeight*20
	XlsFontData\FontAttributes1=FontFormat & $FF ;bold/underline etc...
	XlsFontData\FontAttributes2=0                ;reserved-always zero!!
	XlsFontData\FontNameLength=Len(FontName$) & $FF

	If IpfWriteToFile(XlsFontData,SizeOf(XlsFontType))
		;Then the actual font name data
		ProcedureReturn IpfWriteStringToFile(FontName$)
	EndIf

EndProcedure
Procedure.l XlsSetFontcolor(FontColor.l)

	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	XlsFontColorData.XlsFontColorType
	XlsFontColorData\opcode=69;	$45
	XlsFontColorData\length=2
	Select FontColor
	Case #Black
		XlsFontColorData\Color=0
	Case #White
		XlsFontColorData\Color=1
	Case #Red
		XlsFontColorData\Color=2
	Case #Green
		XlsFontColorData\Color=3
	Case #Blue
		XlsFontColorData\Color=4
	Case #Yellow
		XlsFontColorData\Color=5
	Case #Magenta
		XlsFontColorData\Color=6
	Case #Cyan
		XlsFontColorData\Color=7
	Default
		XlsFontColorData\Color=0
	EndSelect
	; FONTCOLOR_RECORD\r=Red(FontColor)
	; FONTCOLOR_RECORD\g=Green(FontColor)
	; FONTCOLOR_RECORD\b=Blue(FontColor)

	If IpfWriteToFile(XlsFontColorData,SizeOf(XlsFontColorType))
		ProcedureReturn #True
	EndIf

EndProcedure
Procedure.l XlsSetHeader(HeaderText$)
	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	HEADER_RECORD.XlsHEADER_FOOTER_RECORD
	HEADER_RECORD\opcode=20
	HEADER_RECORD\length=1+Len(HeaderText$)
	HEADER_RECORD\TextLength=Len(HeaderText$) & $FF

	If IpfWriteToFile(HEADER_RECORD,SizeOf(XlsHEADER_FOOTER_RECORD))
		;Then the actual Header text
		ProcedureReturn IpfWriteStringToFile(HeaderText$)
	EndIf
EndProcedure
Procedure.l XlsSetFooter(FooterText$)
	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	FOOTER_RECORD.XlsHEADER_FOOTER_RECORD
	FOOTER_RECORD\opcode=21
	FOOTER_RECORD\length=1+Len(FooterText$)
	FOOTER_RECORD\TextLength=Len(FooterText$) & $FF

	If IpfWriteToFile(FOOTER_RECORD,SizeOf(XlsHEADER_FOOTER_RECORD))
		;Then the actual Header text
		ProcedureReturn IpfWriteStringToFile(FooterText$)
	EndIf
EndProcedure
Procedure.l XlsSetFilePassword(PasswordText$)
	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	FILE_PASSWORD_RECORD.XlsPASSWORD_RECORD
	FILE_PASSWORD_RECORD\opcode=47
	FILE_PASSWORD_RECORD\length=Len(PasswordText$)

	If IpfWriteToFile(FILE_PASSWORD_RECORD,SizeOf(XlsPASSWORD_RECORD))
		;Then the actual Password text
		ProcedureReturn IpfWriteStringToFile(PasswordText$)
	EndIf
EndProcedure
Procedure.l XlsPrintGridLines(TrueFalse.l)
	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	GRIDLINES_RECORD.XlsPRINT_GRIDLINES_RECORD
	GRIDLINES_RECORD\opcode=43
	GRIDLINES_RECORD\length=2

	If TrueFalse=0
		GRIDLINES_RECORD\PrintFlag=0
	Else
		GRIDLINES_RECORD\PrintFlag=1
	EndIf

	ProcedureReturn IpfWriteToFile(GRIDLINES_RECORD,SizeOf(XlsPRINT_GRIDLINES_RECORD))
EndProcedure
Procedure.l XlsProtectSpreadsheet(TrueFalse.l)
	If XlsActiveFile=0
		ProcedureReturn #False
	EndIf

	PROTECT_RECORD.XlsPROTECT_SPREADSHEET_RECORD
	PROTECT_RECORD\opcode=18
	PROTECT_RECORD\length=2

	If TrueFalse=0
		PROTECT_RECORD\Protect=0
	Else
		PROTECT_RECORD\Protect=1
	EndIf

	ProcedureReturn IpfWriteToFile(PROTECT_RECORD,SizeOf(XlsPROTECT_SPREADSHEET_RECORD))
EndProcedure
Procedure.l XlsSetDefaultRowHeight(HeightValue.l)
	If XlsActiveFile=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.XlsDEF_ROWHEIGHT_RECORD
	DEFHEIGHT\opcode=37
	DEFHEIGHT\length=2
	DEFHEIGHT\RowHeight=HeightValue*20  ;convert points To 1/20ths of point

	ProcedureReturn IpfWriteToFile(DEFHEIGHT,SizeOf(XlsDEF_ROWHEIGHT_RECORD))
EndProcedure
Procedure.l XlsSetRowHeight(row.l,HeightValue.l)
	If XlsActiveFile=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.XlsROW_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 IpfWriteToFile(ROWHEIGHTREC,SizeOf(XlsROW_HEIGHT_RECORD))
EndProcedure

Antworten