BIFFx-Format '.XLS-Datei' PB Souce PureBasic konvertieren?

[Falko]

Kennt sich jemand mit Powerbasic gut aus und
würde den folgenden Source nach PB konvertieren?
Wäre fürs Codearchiv eine Bereicherung zu "ExcelTabellenerstellung"

http://purebasic.myforums.net/viewtopic ... ight=excel
Der Source und die Beschreibung(PDF) sind am Ende dieses englischen Threads.

MfG Falko

[Falko]

Da sich hier evt. wohl keiner mit PowerBasic (außer vielleicht Rings ) auskennt, habe ich mal versucht
die Includedatei nach PureBasic zu konvertieren. Wenn jetzt einer von euch wüßte, wie man das UBOUND bzw. LBOUND nach PB konvertieren kann käme ich ein Stückchen weiter . Aber hier erst mal der Anfang mit den ganzen Excel-Proceduren und Struckturen.

Code: Alles auswählen

;Excel_PureBasic-file For BIFF 2.1 specifications To write Excel files. 
; 
;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. 



;constants To hold cell alignment 
    #xlsGeneralAlign = 0 
    #xlsLeftAlign = 1 
    #xlsCentreAlign = 2 
    #xlsRightAlign = 3 
    #xlsFillCell = 4 
    #xlsLeftBorder = 8 
    #xlsRightBorder = 16 
    #xlsTopBorder = 32 
    #xlsBottomBorder = 64 
    #xlsShaded = 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 
    #xlsFont0 = 0 
    #xlsFont1 = 64 
    #xlsFont2 = 128 
    #xlsFont3 = 192 

    ;used by rgbAttr1 
    ;bits 0-5 must be zero 
    ;bit 6 locked/unlocked 
    ;bit 7 hidden/not hidden 
    #xlsCellNormal = 0 
    #xlsCellLocked = 64 
    #xlsCellHidden = 128 


;set up variables To hold the spreadsheet's layout 
    #xlsLeftMargin = 38 
    #xlsRightMargin = 39 
    #xlsTopMargin = 40 
    #xlsBottomMargin = 41 


   ;add these enums together. For example: xlsBold + xlsUnderline 
   #xlsNoFormat = 0 
   #xlsBold = 1 
   #xlsItalic = 2 
   #xlsUnderline = 4 
   #xlsStrikeout = 8 


Structure FONT_RECORD 
   opcode.l ;49 
   length.l ;5+Len(fontname) 
   FontHeight.l 
    
   ;bit0 bold, bit1 italic, bit2 underline, bit3 strikeout, bit4-7 reserved 
   FontAttributes1.b 
   FontAttributes2.b ;reserved - always 0 
   FontNameLength.b 
EndStructure 


Structure PASSWORD_RECORD 
   opcode.l ;47 
   length.l ;Len(password) 
EndStructure 


Structure HEADER_FOOTER_RECORD 
   opcode.l  ;20 Header, 21 Footer 
   length.l  ;1+Len(text) 
   TextLength.b 
EndStructure 


Structure PROTECT_SPREADSHEET_RECORD 
   opcode.l ;18 
   length.l ;2 
   Protect.l 
EndStructure 

Structure FORMAT_COUNT_RECORD 
   opcode.l ;1f 
   length.l ;2 
   Count.l 
EndStructure 

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

Structure COLWIDTH_RECORD 
   opcode.l  ;36 
   length.l  ;4 
   col1.b    ;first column 
   col2.b    ;last column 
   ColumnWidth.l ;at 1/256th of a character 
EndStructure 

;Beginning Of File record 
Structure BEG_FILE_RECORD 
  opcode.l 
  length.l 
  version.l 
  ftype.l 
EndStructure 

;End Of File record 
Structure END_FILE_RECORD 
  opcode.l 
  length.l 
EndStructure 

;true/false To print gridlines 
Structure PRINT_GRIDLINES_RECORD 
  opcode.l 
  length.l 
  PrintFlag.l 
EndStructure 

;Integer record 
Structure tInteger 
  opcode.l 
  length.l 
  Row.l  ;unsigned integer 
  col.l 
  
  ;rgbAttr1 handles whether cell is hidden and/Or locked 
  rgbAttr1.b 
  
  ;rgbAttr2 handles the Font# And Formatting assigned To this cell 
  rgbAttr2.b 
  
  ;rgbAttr3 handles the Cell Alignment/borders/shading 
  rgbAttr3.b 
  
  intValue.l   ;'the actual integer value 
EndStructure 

;Number record 
Structure tNumber 
  opcode.l 
  length.l 
  Row.l 
  col.l 
  rgbAttr1.b 
  rgbAttr2.b 
  rgbAttr3.b 
  NumberValue.l 
EndStructure 

;Label (Text) record 
Structure tText 
  opcode.l 
  length.l 
  Row.l 
  col.l 
  rgbAttr1.b 
  rgbAttr2.b 
  rgbAttr3.b 
  TextLength.b 
EndStructure 

Structure MARGIN_RECORD_LAYOUT 
  opcode.l 
  length.l 
  MarginValue.l ;  '8 bytes 
EndStructure 

Structure HPAGE_BREAK_RECORD 
  opcode.l 
  length.l 
  NumPageBreaks.l 
EndStructure 

Structure DEF_ROWHEIGHT_RECORD 
  opcode.l 
  length.l 
  RowHeight.l 
EndStructure 

Structure ROW_HEIGHT_RECORD 
  opcode.l;08 
  length.l;should always be 16 bytes 
  RowNumber.l 
  FirstColumn.l 
  LastColumn.l 
  RowHeight.l;written to file as 1/20ths of a point 
  internal.l 
  DefaultAttributes.b;set to zero for no default attributes 
  FileOffset.l 
  rgbAttr1.b 
  rgbAttr2.b 
  rgbAttr3.b 
EndStructure 

Global xlsFileNumber.l 
Global xlsBufferSize.l  ;If > 0 then buffer is active, also holds size of buffer. 
Global xlsBufferString.s 


;create an array that will hold the rows where a horizontal page 
;Break will be inserted just before. 
;Global xlsHorizPageBreakRows.l() 
Global xlsNumHorizPageBreaks.l 


Declare.l xlsCreateFile(mFileName$) 
Declare.l xlsCloseFile() 
Declare.l xlsInsertHorizPageBreak(lrow.l) 
Declare.l xlsWriteInteger(value,lrow,lcol,CellFont,CellAlignment,HiddenLocked,CellFormat) 
Declare.l xlsWriteNumber(value,lrow,lcol,CellFont,CellAlignment,HiddenLocked,CellFormat) 
Declare.l xlsWriteText(value$,lrow,lcol,CellFont,CellAlignment,HiddenLocked,CellFormat) 
Declare.l xlsWriteDate(DateString$,lrow,lcol,CellFont,CellAlignment,HiddenLocked,CellFormat) 
Declare.l xlsSetMargin(Margin,MarginValue) 
Declare.l xlsSetColumnWidth(FirstColumn,LastColumn,WidthValue) 
Declare.l xlsSetFont(FontName$,FontHeight,FontFormat) 
Declare.l xlsSetHeader(HeaderText$) 
Declare.l xlsSetFooter(FooterText$) 
Declare.l xlsSetFilePassword(PasswordText$) 
Declare.l xlsPrintGridLines(TrueFalse) 
Declare.l xlsProtectSpreadsheet(TrueFalse) 
Declare.l xlsWriteDefaultFormats() 
Declare.l xlsSetDefaultRowHeight(HeightValue) 
Declare.l xlsSetRowHeight(lrow,HeightValue) 
Declare.l ConvertRow(lrow.l) 
Declare.l ConvertCol(lcol.l) 
Declare.l DateToJulian(DateString$) 
Declare.s CTOD(PBDate.s) 
Declare.l xlsBuffer(TrueFalse,BufferSize) 
Declare.l UpdateBuffer(BufferString$) 
Declare.l Ubound(*Array)
Declare.l Lbound(*Array)

Procedure Ubound(*Array) 
ProcedureReturn PeekL(*Array-8) 
EndProcedure 

Procedure Lbound(*Array) 
ProcedureReturn PeekL(*Array) 
EndProcedure 



Procedure.l xlsCreateFile(mFileName$) 

    If ReadFile(0,mFileName$) > 0 
       CloseFile(0) 
       ClearError() 
       Function = -1 
       Goto raus
    EndIf 
    
    BEG_FILE_MARKER.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 = FreeFile 
    OpenFile(xlsFileNumber,mFileName$) 
    
    ;if the buffer us active then save the data to the buffer 
    ;otherwise then simply write To the file. 
    If xlsBufferSize  
        stat = UpdateBuffer(Str(BEG_FILE_MARKER)) 
    Else 
        WriteWord(BEG_FILE_MARKER);  'must always be written first 
        ClearError() 
        Function = -1 
        Goto raus
    EndIf 
        
     ;write the default formats to the file 
     ;And Return If error occured. 
    If xlsWriteDefaultFormats 
    Else 
      ;create the Horizontal Page Break array 
      Dim xlsHorizPageBreakRows(0) 
      xlsNumHorizPageBreaks = 0 
    EndIf
      Function = 0  ;'return with no error 
      raus:
    
   ProcedureReturn Function 
EndProcedure 



Procedure.l xlsCloseFile() 
    If xlsFileNumber = 0 
       Function = -1 
       Goto raus1
    EndIf  
    
    ;write the horizontal page breaks If necessary 
    If xlsNumHorizPageBreaks > 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. 
         lLoop1.l 
         lLoop2.l 
         lTemp.l 
         For lLoop1 = UBound(xlsHorizPageBreakRows) To LBound(xlsHorizPageBreakRows) Step -1 
           For lLoop2 = LBound(xlsHorizPageBreakRows) + 1 To lLoop1 
             If xlsHorizPageBreakRows(lLoop2 - 1) > xlsHorizPageBreakRows(lLoop2) 
               lTemp = xlsHorizPageBreakRows(lLoop2 - 1) 
               xlsHorizPageBreakRows(lLoop2 - 1) = xlsHorizPageBreakRows(lLoop2) 
               xlsHorizPageBreakRows(lLoop2) = lTemp 
             EndIf 
           Next lLoop2 
         Next lLoop1 
              
        ;write the Horizontal Page Break Record 
        HORIZ_PAGE_BREAK.HPAGE_BREAK_RECORD 
        HORIZ_PAGE_BREAK\opcode = 27 
        HORIZ_PAGE_BREAK\length = 2 + (xlsNumHorizPageBreaks * 2) 
        HORIZ_PAGE_BREAK\NumPageBreaks = xlsNumHorizPageBreaks 

        If xlsBufferSize 
            stat = UpdateBuffer(Str(HORIZ_PAGE_BREAK)) 
        Else 
            WriteWord(HORIZ_PAGE_BREAK) 
            ClearError() 
            Function = -1 
            Goto raus1
        EndIf    
        
        ;now write the actual page Break values 
        For x = 1 To UBound(xlsHorizPageBreakRows) 
           st$ = Str(xlsHorizPageBreakRows(x)) 
           If xlsBufferSize 
               stat = UpdateBuffer(st$) 
           Else 
               WriteWord(st$) 
               ClearError() 
               Function = -1 
               Goto raus1
           EndIf    
        Next 
     EndIf
      
    END_FILE_MARKER.END_FILE_RECORD 
     ;End of file marker 
    END_FILE_MARKER\opcode = 10 
    
    If xlsBufferSize 
        ;set xlsBufferSize To -1 which will flag the UpdateBuffer routine 
        ;To flush the buffer. 
        xlsBufferSize = -1 
        stat = UpdateBuffer("") 
    EndIf 
        
    WriteWord(END_FILE_MARKER) 

    CloseFile(xlsFileNumber) 

    Function = 0  ;'return with no error code 
    raus1:

 ProcedureReturn Function 
EndProcedure 



Procedure.l xlsInsertHorizPageBreak(lrow) 

;the row And column values are written To the excel file as 
;unsigned integers. Therefore, must convert the longs To integer. 
    If lrow > 32767  
       Row = Int(Int(lrow - 65536) ) 
    Else 
       Row = Int(Int(lrow)) - 1    ;rows/cols in Excel binary file are zero based 
    EndIf 
        
    xlsNumHorizPageBreaks = xlsNumHorizPageBreaks + 1 
    Dim xlsHorizPageBreakRows(xlsNumHorizPageBreaks) 
    
    xlsHorizPageBreakRows(xlsNumHorizPageBreaks) = Row
    
    Function = 0 
  ProcedureReturn Function 
EndProcedure 



Procedure.l ConvertRow(lrow.l) 
;the row And column values are written To the excel file as 
;integers. Therefore, must convert the longs To integer. 
    
    If lrow > 32767 
       Function = Int(lrow - 65536) 
    Else 
       Function = Int(lrow) - 1    ;rows/cols in Excel binary file are zero based 
    EndIf 
ProcedureReturn Function 
EndProcedure 


Procedure.l ConvertCol(lcol.l) 
;the row And column values are written To the excel file as 
;integers. Therefore, must convert the longs To integer. 

    If lcol > 32767 
       Function = Int(lcol - 65536) 
    Else 
       Function = Int(lcol) - 1    ;rows/cols in Excel binary file are zero based 
    EndIf 
  ProcedureReturn Function 
EndProcedure 




Procedure.l xlsWriteInteger(value,lrow,lcol,CellFont,CellAlignment,HiddenLocked,CellFormat) 

    ;convert the row, col from LONG To INTEGER. 
    Row = Int(ConvertRow(lrow)) 
    Col = Int(ConvertCol(lcol)) 
    
    INTEGER_RECORD.tInteger 
    INTEGER_RECORD\opcode = 2 
    INTEGER_RECORD\length = 9 
    INTEGER_RECORD\Row = Row 
    INTEGER_RECORD\col = col 
    INTEGER_RECORD\rgbAttr1 = Int(HiddenLocked)
    INTEGER_RECORD\rgbAttr2 = Int(CellFont + CellFormat)
    INTEGER_RECORD\rgbAttr3 = Int(CellAlignment)
    INTEGER_RECORD\intValue = value 

    If xlsBufferSize 
       stat = UpdateBuffer(Str(INTEGER_RECORD))    
    Else 
       WriteWord(INTEGER_RECORD) 
       ClearError() 
       Function = -1 
       Goto raus2
     EndIf    

    Function = 0    ;Return with no error 
    raus2: 
   ProcedureReturn Function 
EndProcedure 



Procedure.l xlsWriteNumber(value,lrow,lcol,CellFont,CellAlignment,HiddenLocked,CellFormat) 

    ;convert the row, col from LONG To INTEGER. 
    Row = Int(ConvertRow(lrow)) 
    Col = Int(ConvertCol(lcol)) 

    NUMBER_RECORD.tNumber 
    NUMBER_RECORD\opcode = 3 
    NUMBER_RECORD\length = 15 
    NUMBER_RECORD\Row = Row 
    NUMBER_RECORD\col = col 
    NUMBER_RECORD\rgbAttr1 = Int(HiddenLocked) 
    NUMBER_RECORD\rgbAttr2 = Int(CellFont + CellFormat) 
    NUMBER_RECORD\rgbAttr3 = Int(CellAlignment) 
    NUMBER_RECORD\NumberValue = value 

    If xlsBufferSize  
       stat = UpdateBuffer(Str(NUMBER_RECORD))    
    Else 
       WriteWord(NUMBER_RECORD) 
       ClearError() 
       Function = -1 
       Goto raus3
    EndIf    

    Function = 0   ;Return with no error 
    raus3:
  ProcedureReturn Function 
EndProcedure 


Procedure.l xlsWriteText(value$,lrow,lcol,CellFont,CellAlignment,HiddenLocked,CellFormat) 

    ;convert the row, col from LONG To INTEGER. 
    Row = Int(ConvertRow(lrow)) 
    Col = Int(ConvertCol(lcol)) 

    b.b 
    st$ = value$ 
    l = Len(st$) 
    
    TEXT_RECORD.tText 
    TEXT_RECORD\opcode = 4 
    TEXT_RECORD\length = 10 
    ;Length of the text portion of the record 
    TEXT_RECORD\TextLength = l 
    
    ;Total length of the record 
    TEXT_RECORD\length = 8 + l 
    
    TEXT_RECORD\Row = Int(Row) 
    TEXT_RECORD\col = Int(col) 
      
    TEXT_RECORD\rgbAttr1 = Int(HiddenLocked) 
    TEXT_RECORD\rgbAttr2 = Int(CellFont + CellFormat) 
    TEXT_RECORD\rgbAttr3 = Int(CellAlignment) 
    
    ;Put record header 
    If xlsBufferSize 
       stat = UpdateBuffer(Str(TEXT_RECORD))    
    Else 
       WriteWord(TEXT_RECORD) 
    EndIf    
    
    ;Then the actual string Data 
    For a = 1 To l 
        b = Asc(Mid(st$, a, 1)) 
        If xlsBufferSize  
           stat = UpdateBuffer(Str(Int(b)))    
        Else 
           WriteByte(b) 
           ClearError() 
           Function = -1 
           Goto raus4
        EndIf   
    Next


    Function = 0   ;return with no error 
    raus4:
  ProcedureReturn Function 
EndProcedure 



Procedure.l xlsWriteDate(DateString$,lrow,lcol,CellFont,CellAlignment,HiddenLocked,CellFormat) 

    ;convert the row, col from LONG to INTEGER. 
    Row = Int(ConvertRow(lrow)) 
    Col = Int(ConvertCol(lcol)) 
    
    ;convert the DateString$ from YYYYMMDD To a Julian date number 
    value = (DateToJulian(DateString$) - DateToJulian("19000100")) + 1 
    
    NUMBER_RECORD.tNumber 
    NUMBER_RECORD\opcode = 3 
    NUMBER_RECORD\length = 15 
    NUMBER_RECORD\Row = Row 
    NUMBER_RECORD\col = col 
    NUMBER_RECORD\rgbAttr1 = Int(HiddenLocked) 
    NUMBER_RECORD\rgbAttr2 = Int(CellFont + CellFormat) 
    NUMBER_RECORD\rgbAttr3 = Int(CellAlignment) 
    NUMBER_RECORD\NumberValue = Int(value)
    

    If xlsBufferSize 
        stat = UpdateBuffer(Str(NUMBER_RECORD))    
    Else 
        WriteWord(NUMBER_RECORD) 
        ClearError() 
        Function = -1 
        Goto raus5
    EndIf    

    Function = 0   ;Return with no error 
    raus5: 
  ProcedureReturn Function 
EndProcedure 
  


Procedure.l xlsSetMargin(Margin,MarginValue) 

    ;write the spreadsheet's layout information (in inches) 
    MARGINRECORD.MARGIN_RECORD_LAYOUT 

    ;Margin& should be one of the following.... 
    ;xlsLeftMargin = 38 
    ;xlsRightMargin = 39 
    ;xlsTopMargin = 40 
    ;xlsBottomMargin = 41 
    
    MARGINRECORD\opcode = Margin 
    MARGINRECORD\length = 8 
    MARGINRECORD\MarginValue = MarginValue ; 'in inches 

    If xlsBufferSize 
        stat = UpdateBuffer(Str(MARGINRECORD))    
    Else 
        WriteWord(MARGINRECORD) 
        ClearError() 
        Function = -1 
        Goto raus6
    EndIf    

    Function = 0 
    raus6:
  ProcedureReturn Function 
EndProcedure 


Procedure.l xlsSetColumnWidth(FirstColumn,LastColumn,WidthValue) 

    COLWIDTH.COLWIDTH_RECORD 
    COLWIDTH\opcode = 36 
    COLWIDTH\length = 4 
    COLWIDTH\col1 = Int(FirstColumn) - 1 
    COLWIDTH\col2 = Int(LastColumn) - 1 
    COLWIDTH\ColumnWidth = WidthValue * 256  ;values are specified as 1/256 of a character 

    If xlsBufferSize 
        stat = UpdateBuffer(Str(COLWIDTH))    
    Else 
        WriteWord(COLWIDTH) 
        ClearError() 
        Function = -1 
        Goto raus7
    EndIf    

    Function = 0 
    raus7:
  ProcedureReturn Function 
EndProcedure 

Procedure.l xlsSetFont(FontName$,FontHeight,FontFormat) 

    ;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.FONT_RECORD 
    
    l = Len(FontName$) 
    
    FONTNAME_RECORD\opcode = 49 
    FONTNAME_RECORD\length = 5 + l 
    FONTNAME_RECORD\FontHeight = FontHeight * 20 
    FONTNAME_RECORD\FontAttributes1 = Int(FontFormat)    ;bold/underline etc... 
    FONTNAME_RECORD\FontAttributes2 = Int(0)             ;reserved-always zero!! 
    FONTNAME_RECORD\FontNameLength = Int(l) 

    If xlsBufferSize 
        stat = UpdateBuffer(Str(FONTNAME_RECORD))    
    Else 
        WriteWord(FONTNAME_RECORD) 
    EndIf    

    ;Then the actual font name Data 
    b.b 
    For a = 1 To l 
       b = Asc(Mid(FontName$, a, 1)) 
       If xlsBufferSize 
           stat = UpdateBuffer(Str(Int(b)))    
       Else 
           WriteByte(b) 
           ClearError() 
           Function = -1 
           Goto raus8
       EndIf    

    Next 
         Function = 0 
         raus8:
  ProcedureReturn Function 
EndProcedure 




Procedure.l xlsSetHeader(HeaderText$) 

    HEADER_RECORD.HEADER_FOOTER_RECORD 
    
    l = Len(HeaderText$) 
    
    HEADER_RECORD\opcode = 20 
    HEADER_RECORD\length = 1 + l 
    HEADER_RECORD\TextLength = Int(l) 

    If xlsBufferSize 
       stat = UpdateBuffer(Str(HEADER_RECORD))    
    Else 
       WriteWord(HEADER_RECORD) 
    EndIf    

    ;Then the actual Header text 
    b.b 
    For a = 1 To l 
       b = Asc(Mid(HeaderText$, a, 1)) 
       If xlsBufferSize 
          stat = UpdateBuffer(Str(Int(b)))    
       Else 
          WriteByte(b) 
          ClearError() 
          Function = -1 
          Goto raus9 
       EndIf    
    Next 


    Function = 0 
    raus9:
  ProcedureReturn Function 
EndProcedure 




Procedure.l xlsSetFooter(FooterText$) 

    FOOTER_RECORD.HEADER_FOOTER_RECORD 
    
    l = Len(FooterText$) 
    
    FOOTER_RECORD\opcode = 21 
    FOOTER_RECORD\length = 1 + l 
    FOOTER_RECORD\TextLength = Int(l) 

    If xlsBufferSize 
       stat = UpdateBuffer(Str(FOOTER_RECORD))    
    Else 
       WriteWord(FOOTER_RECORD) 
    EndIf    

    ;Then the actual Header text 
    b.b 
    For a = 1 To l 
       b = Asc(Mid(FooterText$, a, 1)) 
       If xlsBufferSize 
          stat = UpdateBuffer(Str(Int(b)))    
       Else 
          WriteByte(b) 
          ClearError() 
          Function = -1 
          Goto raus10 
       EndIf    
    Next 

    Function = 0 
    raus10:
  ProcedureReturn Function 
EndProcedure 
  



Procedure.l xlsSetFilePassword(PasswordText$) 

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

    If xlsBufferSize 
       stat = UpdateBuffer(Str(FILE_PASSWORD_RECORD))
    Else 
       WriteWord(FILE_PASSWORD_RECORD) 
    EndIf    

    ;Then the actual Password text 
    b.b 
    For a = 1 To l 
       b = Asc(Mid(PasswordText$, a, 1)) 
       If xlsBufferSize 
          stat = UpdateBuffer(Str(Int(b)))    
       Else 
          WriteByte(b) 
          ClearError() 
          Function = -1 
          Goto raus11
       EndIf    
    Next 

    Function = 0 
    raus11:
  ProcedureReturn Function 
EndProcedure 





Procedure.l xlsPrintGridLines(TrueFalse) 

    GRIDLINES_RECORD.PRINT_GRIDLINES_RECORD 
    
    GRIDLINES_RECORD\opcode = 43 
    GRIDLINES_RECORD\length = 2 
    
    If TrueFalse = 0 
       GRIDLINES_RECORD\PrintFlag = 0 
    Else 
       GRIDLINES_RECORD\PrintFlag = 1 
    EndIf 
      
    If xlsBufferSize 
       stat = UpdateBuffer(Str(GRIDLINES_RECORD))    
    Else 
       WriteWord(GRIDLINES_RECORD) 
       ClearError() 
       Function = -1 
       Goto raus12
    EndIf    
    
    Function = 0 
    raus12:
  ProcedureReturn Function 
EndProcedure 




Procedure.l xlsProtectSpreadsheet(TrueFalse) 

    PROTECT_RECORD.PROTECT_SPREADSHEET_RECORD 
    
    PROTECT_RECORD\opcode = 18 
    PROTECT_RECORD\length = 2 
    
    If TrueFalse = 0 
       PROTECT_RECORD\Protect = 0 
    Else 
       PROTECT_RECORD\Protect = 1 
    EndIf 
      
    If xlsBufferSize 
       stat = UpdateBuffer(Str(PROTECT_RECORD))
    Else 
       WriteWord(PROTECT_RECORD) 
       ClearError() 
       Function = -1 
       Goto raus13
    EndIf    
    
    Function = 0 
    raus13:
  ProcedureReturn Function 
EndProcedure 
  


Procedure.l xlsWriteDefaultFormats() 
    
    cFORMAT_COUNT_RECORD.FORMAT_COUNT_RECORD 
    cFORMAT_RECORD.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 = $2 
    cFORMAT_COUNT_RECORD\Count = Int(UBound(aFormat)) 

    If xlsBufferSize 
       stat = UpdateBuffer(Str(cFORMAT_COUNT_RECORD))
    Else 
       WriteWord(cFORMAT_COUNT_RECORD) 
    EndIf 
    
    For lIndex = LBound(aFormat) To UBound(aFormat) 
        l = Len(aFormat(lIndex)) 

        cFORMAT_RECORD\opcode = $1E 
        cFORMAT_RECORD\length = l + 1 
        cFORMAT_RECORD\FormatLength = l 

        If xlsBufferSize 
           stat = UpdateBuffer(Str(cFORMAT_RECORD))    
        Else 
           WriteWord(cFORMAT_RECORD) 
        EndIf    
    
        ;Then the actual format 
        b.b 
        a.l 
        For a = 1 To l 
           b = Asc(Mid(aFormat(lIndex), a, 1)) 
           If xlsBufferSize 
              stat = UpdateBuffer(Str(Int(b)))    
           Else 
              WriteByte(b) 
              ClearError() 
              Function = -1 
              Goto raus14 
           EndIf    
        Next 
    Next 

    Function = 0 
    raus14:
  ProcedureReturn Function 
EndProcedure  



Procedure.l xlsSetDefaultRowHeight(HeightValue) 

;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 
;4 point And converts it the correct size before writing it To the file. 

    DEFHEIGHT.DEF_ROWHEIGHT_RECORD 
    DEFHEIGHT\opcode = 37 
    DEFHEIGHT\length = 2 
    DEFHEIGHT\RowHeight = HeightValue& * 20  ;convert points To 1/20ths of point 

    If xlsBufferSize 
       stat = UpdateBuffer(Str(DEFHEIGHT))    
    Else 
       WriteWord(DEFHEIGHT) 

       ClearError()
       Function = -1 
       Goto raus15
    EndIf    
    Function = 0 
    raus15: 
  ProcedureReturn Function 
EndProcedure  


Procedure.l xlsSetRowHeight(lrow,HeightValue) 

    ;convert the row, col from LONG To INTEGER. 
    Row = Int(ConvertRow(lrow)) 

    ;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.ROW_HEIGHT_RECORD 
    ROWHEIGHTREC\opcode = 8 
    ROWHEIGHTREC\length = 16 
    ROWHEIGHTREC\RowNumber = Row 
    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 

    If xlsBufferSize 
       stat = UpdateBuffer(Str(ROWHEIGHTREC))  
    Else 
       WriteWord(ROWHEIGHTREC) 
       ClearError() 
       Function = -1 
       Goto raus16
    EndIf    
    Function = 0 
    raus16:
  ProcedureReturn Function 
EndProcedure 


 Procedure.l DateToJulian(DateString$) 

  ;DateString$ must be in YYYYMMDD 
  
  Elapsed.l 
  
  If Len(DateString$) <> 8 
     Function = 0 
     Else    

  Year.l = Val(Left(DateString$, 4)) 
  month = Val(Mid(DateString$, 5, 2)) 
  day = Val(Right(DateString$, 2)) 
  
  If month < 3                      ; January or February? 
     month = month + 12                 ; 13th Or 14th month .... 
     year+1                              ; .... of prev. year 
  EndIf 
  
  Elapsed = Int(365.25*(year + 4712))  ; 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. 
  Function = Elapsed + day               ; days of final month 
  EndIf 
ProcedureReturn Function 
EndProcedure 



Procedure.s CTOD$(PBDate.s) 
;¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ 
;Converts a PowerBASIC formated date string into an xBase date 
; Usage:   ans$ = CTOD("12-13-2001") 
;          ans$ = "20011213" 
;¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ 
;First parse PBDate 
;Dim month$, day$, year$ 
;Dim ChekYear& 

  month$ = RemoveString(Str(PBDate),"-", 1)     ;month 
  day$ = RemoveString(Str(PBDate),"-", 2)       ;day 
  year$ = RemoveString(Str(PBDate),"-", 3)      ;year 

  ChekYear = Val(year$) 

; Adjust If user enters only 2 digit year 
   If ChekYear < 80       ;assume we've rolled into the Next century 
      year$ = "20" + year$ 
   ElseIf ChekYear < 100   ;between 1980 And 1999 
      year$ = "19" + year$ 
   EndIf 

; Force the reformat of strings into proper xBase length. 
  month$ = FormatDate("%mm",Val(month$)) 
  day$ = FormatDate("%dd",Val(day$)) 
  year$ = FormatDate("%yyyy",Val(year$)) 


  Function$ = year$ + month$ + day$

ProcedureReturn Function$
EndProcedure  


Procedure.l xlsBuffer(TrueFalse,BufferSize) 

    If BufferSize <= 0 
    Goto raus17
    If TrueFalse <> 0 
       xlsBufferSize = BufferSize  ;flag that buffer is active & also contains the buffer size 
       xlsBufferString$ = Space(xlsBufferSize) 
    EndIf    
    EndIf 
    raus17:
ProcedureReturn Function 
EndProcedure  
  

Procedure.l UpdateBuffer(*BufferData$) 

    Static CurBufferPos 
    
    ;If xlsBufferSize equals -1 then the flag To flush the buffer has 
    ;been set And the file is about To be closed. 
    If xlsBufferSize = -1  
       WriteString(Left(xlsBufferString$, CurBufferPos)) 
       ;reset the buffer so old Data does not get carried forward 
       ;To any new file being created. 
       xlsBufferString$ = "" 
       CurBufferPos = 0 
     Else
    ;If the current Data would be too big For the buffer then flush 
    ;the buffer And reset its size. 
    If Len(BufferData$) + CurBufferPos > xlsBufferSize  
       WriteString(Left(xlsBufferString$, CurBufferPos)) 
       CurBufferPos = 0 
    EndIf 
    
    ;write the Data To the buffer And update the buffer size indicator 
   BufferData$ = Mid(xlsBufferString$,CurBufferPos, CurBufferPos + 1)  
    CurBufferPos = CurBufferPos + Len(BufferData$) 
  EndIf          
 
ProcedureReturn CurBufferPos 
EndProcedure 

;Hauptprogramm ab hier
;
#XLSTRUE=1
#XLSFALSE=0
 ; starttime! = TIMER
    ;enable the buffer. This is optional, but enabling a buffer will speed
    ;up file access.
     stat = xlsBuffer(#XLSTRUE, 512*1024)  ;a 512K buffer
    ;Create the new spreadsheet
     mFileName$=".\vbtest.xls"  ;create spreadsheet in the current directory
     stat = xlsCreateFile(mFileName$)
    ;stat returns non-zero if an error occured.

    ;set a Password for the file. If set, the rest of the spreadsheet will
    ;be encrypted. If a password is used it must immediately follow the
    ;xlsCreateFile function call.

    ;This is different then protecting the spreadsheet (see below).
    ;NOTE: For some reason this function does not work. Excel will
    ;recognize that the file is password protected, but entering the password
    ;will not work. Also, the file is not encrypted. Therefore, do not use
    ;this function until I can figure out why it doesn;t work. There is not
    ;much documentation on this function available.
    ;xlsSetFilePassword("whatever")


    ;specify whether to print the gridlines or not
    ;this should come before the setting of fonts and margins
     stat = xlsPrintGridLines(#XLSTRUE)


    ;it is a good idea to set margins, fonts and column widths
    ;prior to writing any text/numerics to the spreadsheet. These
    ;should come before setting the fonts.

     stat = xlsSetMargin(#xlsTopMargin, 1.5)   ;set to 1.5 inches
     stat = xlsSetMargin(#xlsLeftMargin, 1.5)
     stat = xlsSetMargin(#xlsRightMargin, 1.5)
     stat = xlsSetMargin(#xlsBottomMargin, 1.5)


    ;Up to 4 fonts can be specified for the spreadsheet. This is a
    ;limitation of the Excel 2.1 format. For each value written to the
    ;spreadsheet you can specify which font to use.

     stat = xlsSetFont("Arial", 10, #xlsNoFormat)             ;font0
     stat = xlsSetFont("Arial", 10, #xlsBold)                 ;font1
     stat = xlsSetFont("Arial", 10, #xlsBold + #xlsUnderline) ;font2
     stat = xlsSetFont("Courier", 18, #xlsItalic)             ;font3


    ;Column widths are specified in Excel as 1/256th of a character.
     stat = xlsSetColumnWidth(1, 1, 50)

    ;set the global row height for the entire spreadsheet
     stat = xlsSetDefaultRowHeight(16)

    ;set the height of the first two rows a little bigger to allow for the
    ;title of the spreadsheet.
     stat = xlsSetRowHeight(1, 24)
     stat = xlsSetRowHeight(2, 24)


    ;set any header or footer that you want to print on
    ;every page. This text will be centered at the top and/or
    ;bottom of each page. The font will always be the font that
    ;is specified as font0, therefore you should only set the
    ;header/footer after specifying the fonts through SetFont.
     stat = xlsSetHeader("This is the header")
     stat = xlsSetFooter("This is the footer")


    ;write some data to the spreadsheet
     stat = xlsWriteInteger(20, 6, 1, #xlsFont0, #xlsLeftAlign, #xlsCellNormal, 0)

    ;write a cell with a shaded number with a bottom border
     stat = xlsWriteNumber(12123.456, 7, 1, #xlsFont1, #xlsrightAlign + #xlsBottomBorder + #xlsShaded, #xlsCellNormal, 0)

    ;write a normal left aligned string using font2 (bold & underline)
     stat = xlsWriteText("This is a test string", 8, 1, #xlsFont2, #xlsLeftAlign, #xlsCellNormal, 0)

    ;write a locked cell. The cell will not be able to be overwritten, BUT you
    ;must set the sheet PROTECTION to on before it will take effect!!!
     stat = xlsWriteText("This cell is locked.", 9, 1, #xlsFont3, #xlsLeftAlign, #xlsCellLocked, 0)

    ;fill the cell with "F";s
     stat = xlsWriteText("F", 10, 1, #xlsFont3, #xlsFillCell, #xlsCellNormal, 0)

    ;write a hidden cell to the spreadsheet. This only works for cells
    ;that contain formulae. Text, Number, Integer value text can not be hidden
    ;using this feature. It is included here for the sake of completeness.
     stat = xlsWriteText("If this were a formula it would be hidden!", 11, 1, #xlsFont0, #xlsCentreAlign, #xlsCellHidden, 0)

    ;write a date to the file. Dates can be written as literal text strings but doing so will not allow
    ;the date to be formatted. The date will be eventually written as a number after conversion to a
    ;Julian date number.
    ;Write todays date..... Use format #12 mm/dd/yy (you can change the different formats by modifying
    ;the code in xlsWriteDefaultFormats. The date is expected to be in the YYYYMMDD format. You can convert
    ;from mm-dd-yyyy format to YYYYMMDD by calling the CTOD$ function.
    mDate$ = CTOD(Str(Date()))
    
    stat = xlsWriteDate(mDate$, 15, 1, #xlsFont1, #xlsLeftAlign, #xlsCellNormal, 12)

    mDate$ = "19991128"
    stat = xlsWriteDate(mDate$, 16, 1, #xlsFont1, #xlsLeftAlign, #xlsCellNormal, 13)

    mDate$ = "20000331"
    stat = xlsWriteDate(mDate$, 17, 1, #xlsFont1, #xlsLeftAlign, #xlsCellNormal, 14)

    mDate$ = "20010630"
    stat = xlsWriteDate(mDate$, 18, 1, #xlsFont1, #xlsLeftAlign, #xlsCellNormal, 15)

    mDate$ = "19991023"
    stat = xlsWriteDate(mDate$, 19, 1, #xlsFont1, #xlsLeftAlign, #xlsCellNormal, 20)

    ;insert a page break
    stat = xlsInsertHorizPageBreak(20)


    ;write consecutive numbers in the column
    ;This demonstrates that this Excel code can exceed the normal BIFF 2.1 and Excel 95 row limit
    ;of 32,767 rows.
    NumRows.l = 50000
    For x.l = 1 To NumRows
    stat = xlsWriteNumber(x, 20+x, 1, #xlsFont1, #xlsLeftAlign, #xlsCellNormal, 0)
    Next


    ;PROTECT the spreadsheet so any cells specified as LOCKED will not be
    ;overwritten. Also, all cells with HIDDEN set will hide their formulae.
    ;PROTECT does not use a password.
    stat = xlsProtectSpreadsheet(#XLSTRUE)


    ;Finally, close the spreadsheet
    stat = xlsCloseFile()


    ;endtime! = TIMER

    MessageRequester("INFO","Excel BIFF Spreadsheet created")

Und hier aus der Hilfe aus Powerbasic zu ARRAY-Funktionen

UBOUND function
Purpose Return the largest possible subscript for an array's specified dimension.

Syntax y = UBOUND(array {[(dimension), ]dimension})

Remarks array is the array of interest. dimension is an integer from 1 up to the number of dimensions in array; it specifies which dimension's upper bound will be returned. If you omit dimension, it defaults to 1 (the first dimension). To find the lower bound of an array's dimension, use the LBOUND function. Use LBOUND and UBOUND together to determine an array's size.

See also DIM, LBOUND, REDIM

Example ' dimension an array with lower and upper bounds

DIM MyArray%(1900:2000,5:10)
' print out the values of the array
Message$ = "The array's first dimension is from" + _
STR$(LBOUND(MyArray%(1))) + "to" + _
STR$(UBOUND(MyArray%(1)))
Message$ = "The array's second dimension is from" + _
STR$(LBOUND(MyArray%(2))) + "to" + _
STR$(UBOUND(MyArray%(2)))

Result The array's first dimension is from 1900 to 2000

The array's second dimension is from 5 to 10

Ich würde mich sehr freuen, wenn ihr mir weiterhelfen könntet, danke.
MfG Falko

[EDIT] habe noch was gefunden und den Rest hinzugefügt. Ist aber noch nicht richtig! Aber der Source ist soweit umgeschrieben und muß hier und da korrigiert werden. Bitte nicht lästern, sondern lieber mithelfen, damit man aus PureBasic Exceltabellen erzeugt werden können. Der laufende Powerbasicprogramm im nächsten Thread zeigt, was die Funktionen alles machen können.
[/EDIT]
Pure

[Falko]

Hier habe ich mal den Source in PBDLL6 angepaßt und eine Exe daraus gemacht, damit man sehen kann wie dieser Source, den ich auch in die Zip gepackt habe eine Echte Exceltabelle erstellt. So kann man sich schon
mal Anschauen, wie das Ergebnis des PowerbasicProgramms aussieht.
Ich würde mich freuen, wenn mir jemand zum Purebasic-Source oben weiter helfen könnte. Denn das ARRAY von Powerbasic bietet Funktionen, die so in Purebasic wohl nicht möglich sind, bzw. wüßte ich nicht, wie ich
in ein und der selben Arrayvarible unterschiedliche Bereiche (Bounds) dimensionieren soll wie Powerbasic das über LBound() und Ubound() machen kann. Aber hier mal der Link zum fertigen ExcelProg:

http://www.falko-pure.de/Tests/Excel.zip

MfG Falko

[Falko]

Ich geb's erstmal auf . Irgendwie kriege ich das mit den Arrays, Structuren in PB nicht hin so wie es im Powerbasic-Programm läuft.
Hat denn keiner einen Tip was ich da falsch mache oder geht das nicht
ohne Pointer?

Gruß Falko

[Jason]

Vielleicht hilft das ja schon:

Aus meinem PowerBasic 3.20 (DOS)

Die Funktion UBOUND

Liefert die obere Grenze (der größtmögliche Index) einer Array-Dimension zurück.

Syntax: y = UBOND(array(dimension))
y = UBOND(array,dimension)
y = UBOND(array)

dimenson ist ein Integer-Wert von 1 bis zu der Dimensionszahl im Array (höchstens . Sie legt fest, von welcher Dimension die größte Index-nummer zurückgeliefert werden soll. Ohne Angabe von dimension wird standardmäßig 1 verwendet.


Die Funktion LBOUND

Liefert die untere Grenze (der kleinstmögliche Index) einer Array-Dimension zurück.

Syntax: y = LBOND(array(dimension))
y = LBOND(array,dimension)
y = LBOND(array)

dimenson ist ein Integer-Wert von 1 bis zu der Dimensionszahl im Array (höchstens . Ohne Angabe von dimension wird standardmäßig 1 verwendet.

[Falko]

Dann wird ein Problem sein, wenn ich den Powerbasicsource verstehe, das Purebasic mit Lbound größer null nichts anfangen kann. Ich vermute
das gleiche Arrays auch variabel in seinem niedrigsten Bereich sein müssen. Aber da sind noch einige andere Sachen die ich in Purebasic wohl nicht so konvertieren bzw. richtig interpretieren kann, wie es mit Powerbasic geht.
Irgendwie habe ich mich mit dem Code zu Purebasic verfranst und so keinen Überblick .
Wäre schön, wenn mir das mal richtig wie im englischen Beispielprogramm, jemand in Purebasic zusammenstellen könnte, wenn es überhaupt so möglich ist.
Aber trotzdem, "vielen dank für deine Aufmerksamkeit".
Hatte schon das Gefühl, das es keinen interessiert.

MfG Falko

[Unimatrix Zero]

Hallo Falko,

nein, genau das Gegenteil ist der Fall, ich verfolge diesen Thread schon eine Weile und warte wie Du darauf, daß sich jemand berufen fühlt darauf zu antworten. Das Thema halte ich für äußerst spannend, da ich es für sehr wichtig halte, daß PB mit WinzigWeich Produkten kann, da auf absehbare Zeit wohl das Monopol nicht gebrochen wird (leider). Wenn man seine Brötchen mit Programmieren verdienen will, bleibt einem nichts anderes übrig, als sich damit abzufinden. Auch halte ich es für den kommerziellen Erfolg von PB für sehr wichtig. Ich komme ja mehr so aus der VB und VBA Ecke und mache auch viel mit Datenbanken und kann nur sagen, daß ich mit einem Textfile als Ausgabe im Prinzip nichts anfangen kann, meine Kunden wollen alle Excel-Tabellen haben, mit denen Sie gleich weiterarbeiten können. So mit allem SchnickSchnack wie Diagrammen und Formatierungen und Gruppierungen u.s.w. (wären da nicht diese Gruppierungen und Gliederungen könnte man ja evtl. noch auf XML ausweichen) und das ganze dann auch noch teilweise über 60 und mehr Worksheets, da kommt man dann auch mit .csv Dateien nicht mehr sehr weit. Und wenn ich ehrlich bin, dann muß ich zugeben, daß, als Tabellen-Kalkulations-Programm, Excel nahezu unschlagbar ist.
Deswegen würde ich sehr gerne, schon aus eigenem Interesse und weil mir PB sehr gut gefällt, im Rahmen meiner Möglichkeiten, an einer Lösung dieses Problems mitarbeiten.
Ich habe da auch noch einen ganz anderen Lösungsansatz im engl. Forum von aXend gefunden:
http://purebasic.myforums.net/viewtopic ... sc&start=0
Es gibt da auch noch einen Thread, der auch ein Excel Beispiel enthält, da es aber schon sehr spät ist, mag ich den Link jetzt nicht mehr suchen.
So ein direkter Zugriff auf Excel oder Word u.s.w Objekte wäre schon eine feine Sache.
Deswegen, dieser Thread darf erst sterben, wenn das funktioniert!
In diesem Sinne

[Falko]

@Unimatrix Zero
Erstmal danke für deine Unterstützung und das du dich auch für diesen
Thread interessierst

Ich bin schon mal sehr froh, das ich nicht der Einzigste hier im Forum bin,
der an einer optimalen Verbesserung an Purebasic interessiert ist.
Den Link hatte ich auch schon gelesen. Das mit den Interfaces,
welches dort erzeugt werden sollte bzw. ist wäre der richtige Weg zur
Konvertierung und erstellung von Office-, und Exceldateien aus PB,
aber auch zu Access. Wenn man dort noch ein Beispiel angegeben hätte,
wie man diese Interfaces, wobei einem die PB-Hilfe zu Interfaces leider
auch nicht weiter hilft, einsetzen könnte, wären wir einen riesen Schritt
weiter. Lt. Fred braucht man folgende RES-Dateien
in Purebasic\RES-Ordner kopieren und diese Interfaces ständen einem
dann in PB zur Verfügung. Hier die beiden Links dazu.

http://home.planet.nl/~aXend/purebasic/MSWord.zip
http://home.planet.nl/~aXend/purebasic/MSExcel.zip

Und hier ist die bebilderte MS-Doku:

http://msdn.microsoft.com/library/en-us ... cation.asp
http://msdn.microsoft.com/library/en-us ... cation.asp

Jetzt müßt man nur noch aufgeklärt werden, wie das nun in PB über
den Interfaces ausgeführt wird um z.B eine Excel-Tabelle damit zu Schreiben.

Da gibt es hier so einige Profis, die haben sich für den Einbau von
Interfaces in PB eingesetzt.
Jetzt würde ich hoffen ob diese "Profis" mit den beiden RES-Dateien ein
vernünftiges Beispiel zu Word und Excel hier vorstellen könnten!
Damit hätte man auch vernünftige Beispiele in der PB-Hilfe als Basis!
Das sollte doch für einen PB-Profi kein Problem sein und er
würde hiermit wirklich allen anderen Proggern weiterhelfen.
Also habt Erbarmen mit denen, die auch gerne das Prinzip dieser
Interfaces in PB erlernen möchten.


MfG Falko

[Jason]

Hallo Falko!

Hatte schon das Gefühl, das es keinen interessiert.

MfG Falko

Doch, das ist eigentlich sogar wichtig. Nur, mir fehlt im Moment einfach die Zeit deshalb habe ich nur einen Auszug aus der Hilfe gepostet. Mein PowerBasic ist etwas eingerostet und PureBasic habe ich erst ca. 1 Jahr und bin dort aus Zeitmangel noch nicht besonders tief eingearbeitet, deshalb bin ich momentan keine grosse Hilfe.

Die Portierung lohnt sich aber auf jeden Fall. Für zukünftige Projekte habe ich da auch deutlichen Bedarf. Überhaupt sind Im/Export bzw. Generierung von MS-Dateiformaten interessant und einigermaßen wichtig für eine Programmiersprache(n)/umgebung.

[Unimatrix Zero]

Hallo zusammen,

na endlich kommt mal etwas Leben in diesen Thread
diese Dateien habe ich auch schon alle hier bei mir und habe sie mir auch mit einem Freund zusammen mal durchgeschaut. Man wird natürlich erst mal erschlagen, alleine schon vom Umfang her. Auch ich habe natürlich ein mehr oder weniger großes Zeitproplem, aber es hift ja nichts, wat mut dat mut.
Wenn ich es richtig im engl. Forum verstanden habe (wäre ich mal früher in der Schule nicht so faul gewesen ), braucht man auch noch die verschiedenen DatenTypen wie Variant z.Bsp. dazu.

Code: Alles auswählen

; All kind of constants and structures needed to work with the VARIANT type.
; The VARIANT type is used by COM components like ActiveX and others.

Enumeration
  #VT_EMPTY           = 0
  #VT_NULL            = 1
  #VT_I2              = 2
  #VT_I4              = 3
  #VT_R4              = 4
  #VT_R8              = 5
  #VT_CY              = 6
  #VT_DATE            = 7
  #VT_BSTR            = 8
  #VT_DISPATCH        = 9
  #VT_ERROR           = 10
  #VT_BOOL            = 11
  #VT_VARIANT         = 12
  #VT_UNKNOWN         = 13
  #VT_DECIMAL         = 14
  #VT_I1              = 16
  #VT_UI1             = 17
  #VT_UI2             = 18
  #VT_UI4             = 19
  #VT_I8              = 20
  #VT_UI8             = 21
  #VT_INT             = 22
  #VT_UINT            = 23
  #VT_VOID            = 24
  #VT_HRESULT         = 25
  #VT_PTR             = 26
  #VT_SAFEARRAY       = 27
  #VT_CARRAY          = 28
  #VT_USERDEFINED     = 29
  #VT_LPSTR           = 30
  #VT_LPWSTR          = 31
  #VT_RECORD          = 36
  #VT_FILETIME        = 64
  #VT_BLOB            = 65
  #VT_STREAM          = 66
  #VT_STORAGE         = 67
  #VT_STREAMED_OBJECT = 68
  #VT_STORED_OBJECT   = 69
  #VT_BLOB_OBJECT     = 70
  #VT_CF              = 71
  #VT_CLSID           = 72
  #VT_BSTR_BLOB       = $fff
  #VT_VECTOR          = $1000
  #VT_ARRAY           = $2000
  #VT_BYREF           = $4000
  #VT_RESERVED        = $8000
  #VT_ILLEGAL         = $ffff
  #VT_ILLEGALMASKED   = $fff
  #VT_TYPEMASK        = $fff
EndEnumeration               

Structure DOUBLE        ; You cant use this type without a special function that generates double values
  high.l
  low.l
EndStructure

Structure BRECORD       ; No idea where this is used
  pvRecord.l;
  IRecordInfo.l
EndStructure

Structure VARIANT       ; 16 bytes
  vt.w
  wReserved1.w
  wReserved2.w   
  wReserved3.w
  StructureUnion
    bVal.b              ; 1 byte, 8-bits
    iVal.w              ; 2 bytes, 16-bits
    lVal.l              ; 4 bytes, 32-bits
    value.l             ; same as lVal, defined for compatibility reasons
    dVal.DOUBLE         ; 8 bytes, 64-bits
    boolVal.w           ; boolean TRUE ($FFFF) or FALSE ($0000), see below
    bstrVal.l           ; pointer to BSTR (unicode string)
    scode.l             ; special code, e.g. for optional parameters, see below
    record.BRECORD
  EndStructureUnion
EndStructure

Structure SIGNSCALE
  scale.b               ; The number of decimal places for the number. Valid values are from 0 To 28.
  sign.b                ; 0 for positive numbers or DECIMAL_NEG for negative numbers. So -1 is represented as 1 with the DECIMAL_NEG bit set.
EndStructure

Structure DECIMAL      ; Special type of VARIANT, also 16 bytes
  wReserved.w
  signscale.SIGNSCALE
  high32.l
  low64.DOUBLE
EndStructure
 
Structure pToVariant   ; Used to pass a VARIANT to a method when you can't us a pointer, also 16 bytes
  a.l
  b.l
  c.l
  d.l
EndStructure

#VARIANT_TRUE   = $FFFF ; Variant version of TRUE
#VARIANT_FALSE  = $0000 ; Variant version of FALSE 

Hier noch der Link:
http://purebasic.myforums.net/viewtopic ... ht=variant
Aber so ganz sind wir auch noch nicht durchgestiegen, wie man das Ganze jetzt zusammensetzten muß, aber wir arbeiten daran.
Schön wäre es natürlich, wenn auch andere sich daran noch beteiligen würden, dann sollte das doch in ein-zwei Wochen kein Thema mehr sein.
Guter Witz was!