Aktuelle Zeit: 09.07.2020 11:39

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 11 Beiträge ]  Gehe zu Seite 1, 2  Nächste
Autor Nachricht
 Betreff des Beitrags: XLS_CreateFile ich bin verzweifelt
BeitragVerfasst: 25.11.2019 16:31 
Offline
Benutzeravatar

Registriert: 19.02.2010 20:19
Wohnort: Darmstadt
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:
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)


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: XLS_CreateFile ich bin verzweifelt
BeitragVerfasst: 25.11.2019 16:56 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
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 / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf My Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: XLS_CreateFile ich bin verzweifelt
BeitragVerfasst: 25.11.2019 17:10 
Offline
Benutzeravatar

Registriert: 19.02.2010 20:19
Wohnort: Darmstadt
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)


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: XLS_CreateFile ich bin verzweifelt
BeitragVerfasst: 25.11.2019 19:25 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
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 / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf My Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: XLS_CreateFile ich bin verzweifelt
BeitragVerfasst: 25.11.2019 20:13 
Offline
Benutzeravatar

Registriert: 26.11.2006 19:07
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:
;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.4x (x64), LinuxMint 17.2 - Xfce (x64)

Einsteigerbuch: PureBasic - Eine Einführung in die Computer Programmierung


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: XLS_CreateFile ich bin verzweifelt
BeitragVerfasst: 26.11.2019 11:05 
Offline
Benutzeravatar

Registriert: 19.02.2010 20:19
Wohnort: Darmstadt
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)


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: XLS_CreateFile ich bin verzweifelt
BeitragVerfasst: 26.11.2019 13:54 
Offline
Benutzeravatar

Registriert: 26.11.2006 19:07
@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.4x (x64), LinuxMint 17.2 - Xfce (x64)

Einsteigerbuch: PureBasic - Eine Einführung in die Computer Programmierung


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: XLS_CreateFile ich bin verzweifelt
BeitragVerfasst: 26.11.2019 19:37 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
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 / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf My Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: XLS_CreateFile ich bin verzweifelt
BeitragVerfasst: 29.11.2019 12:28 
Offline
Benutzeravatar

Registriert: 19.02.2010 20:19
Wohnort: Darmstadt
Ich habe den Code von Paul Squires genommen und es funktioniert.
(Am Ende habe ich ein Codebeispiel eingebaut)
Code:
;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)


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: XLS_CreateFile ich bin verzweifelt
BeitragVerfasst: 01.12.2019 18:53 
Offline

Registriert: 16.03.2006 11:20
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:
; 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



Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 11 Beiträge ]  Gehe zu Seite 1, 2  Nächste

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: Google Adsense [Bot] und 14 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye