Option Explicit
‘Demonstration routineSub spload()'[data, xAxis, misc] =’ Reads in spectra from PerkinElmer block structured files.’ This version supports ‘Spectrum’ SP files.’ Note that earlier ‘Data Manager’ formats are not supported.” [data, xAxis, misc] = spload(filename):’ data: 1D array of doubles’ xAxis: vector for abscissa (e.g. Wavenumbers).’ misc: miscellanous information in name,value pairs
‘ Copyright (C)2009′ Kevin z. Chen” History’ 2009-9-19 Initial version
‘ Block IDsDim sFilename As String
Dim iFileNum As Integer, lFileLen As LongDim vThisBlock As Variant, lThisBlock As Long, vFileData As Variant
‘ convert variable types between VBA get and Matlab freadDim uchar As ByteDim unchar(0 To 43) As String
Dim int16 As IntegerDim int32 As LongDim double_ As DoubleDim wavenumber(0 To 3550) As DoubleDim absorbance(0 To 3550) As DoubleDim WavenumberIndex As IntegerDim AbsorbanceIndex As Integer
Dim DSet2DC1DIBlock As IntegerDim HistoryRecordBlock As IntegerDim InstrHdrHistoryRecordBlock As IntegerDim InstrumentHeaderBlock As IntegerDim IRInstrumentHeaderBlock As IntegerDim UVInstrumentHeaderBlock As IntegerDim FLInstrumentHeaderBlock As Integer Dim DataSetDataTypeMember As IntegerDim DataSetAbscissaRangeMember As IntegerDim DataSetOrdinateRangeMember As IntegerDim DataSetIntervalMember As IntegerDim DataSetNumPointsMember As IntegerDim DataSetSamplingMethodMember As IntegerDim DataSetXAxisLabelMember As IntegerDim DataSetYAxisLabelMember As IntegerDim DataSetXAxisUnitTypeMember As IntegerDim DataSetYAxisUnitTypeMember As IntegerDim DataSetFileTypeMember As IntegerDim DataSetDataMember As IntegerDim DataSetNameMember As IntegerDim DataSetChecksumMember As IntegerDim DataSetHistoryRecordMember As IntegerDim DataSetInvalidRegionMember As IntegerDim DataSetAliasMember As IntegerDim DataSetVXIRAccyHdrMember As IntegerDim DataSetVXIRQualHdrMember As IntegerDim DataSetEventMarkersMember As Integer Dim ShortType As IntegerDim UShortType As IntegerDim IntType As IntegerDim UIntType As IntegerDim LongType As IntegerDim BoolType As IntegerDim CharType As IntegerDim CvCoOrdPointType As IntegerDim StdFontType As IntegerDim CvCoOrdDimensionType As IntegerDim CvCoOrdRectangleType As IntegerDim RGBColorType As IntegerDim CvCoOrdRangeType As IntegerDim DoubleType As IntegerDim CvCoOrdType As IntegerDim ULongType As IntegerDim PeakType As IntegerDim CoOrdType As IntegerDim RangeType As IntegerDim CvCoOrdArrayType As IntegerDim EnumType As IntegerDim LogFontType As Integer
DSet2DC1DIBlock = 120HistoryRecordBlock = 121InstrHdrHistoryRecordBlock = 122InstrumentHeaderBlock = 123IRInstrumentHeaderBlock = 124UVInstrumentHeaderBlock = 125FLInstrumentHeaderBlock = 126′ Data member IDsDataSetDataTypeMember = -29839DataSetAbscissaRangeMember = -29838DataSetOrdinateRangeMember = -29837DataSetIntervalMember = -29836DataSetNumPointsMember = -29835DataSetSamplingMethodMember = -29834DataSetXAxisLabelMember = -29833DataSetYAxisLabelMember = -29832DataSetXAxisUnitTypeMember = -29831DataSetYAxisUnitTypeMember = -29830DataSetFileTypeMember = -29829DataSetDataMember = -29828DataSetNameMember = -29827DataSetChecksumMember = -29826DataSetHistoryRecordMember = -29825DataSetInvalidRegionMember = -29824DataSetAliasMember = -29823DataSetVXIRAccyHdrMember = -29822DataSetVXIRQualHdrMember = -29821DataSetEventMarkersMember = -29820’Type code IDsShortType = 29999UShortType = 29998IntType = 29997UIntType = 29996LongType = 29995BoolType = 29988CharType = 29987CvCoOrdPointType = 29986StdFontType = 29985CvCoOrdDimensionType = 29984CvCoOrdRectangleType = 29983RGBColorType = 29982CvCoOrdRangeType = 29981DoubleType = 29980CvCoOrdType = 29979ULongType = 29978PeakType = 29977CoOrdType = 29976RangeType = 29975CvCoOrdArrayType = 29974EnumType = 29973LogFontType = 29972
Dim innerCode As IntegerDim x0 As DoubleDim xEnd As DoubleDim xDelta As DoubleDim xLen As LongDim xLabel() As ByteDim length As IntegerDim yLabel() As ByteDim alias() As ByteDim OriginalName() As ByteDim data() As Double’Dim xLength As IntegerDim offset() As Byte
Dim ucharIndex As IntegerDim uncharIndex As IntegerDim description As StringDim i, j, k, m, n, p As IntegerDim BlockID As IntegerDim BlockSize As LongDim position As LongDim iCountLoop As Long
position = 1
iCountLoop = 0
sFilename = “D:/CalibratedSpectra/5.22.sp”Debug.Print sFilename On Error GoTo ErrFailed If Len(Dir$(sFilename)) > 0 And Len(sFilename) > 0 Then iFileNum = FreeFile Open sFilename For Binary Access Read As #iFileNum ‘lFileLen = LOF(iFileNum) WavenumberIndex = 0 AbsorbanceIndex = 0 For ucharIndex = 0 To 43 Get #iFileNum, , uchar position = position + 1 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) unchar(ucharIndex) = uchar Next ucharIndex ‘ determine the fomart If Chr(unchar(0)) & Chr(unchar(1)) & Chr(unchar(2)) & Chr(unchar(3)) <> “PEPE” Then MsgBox “The file ” & sFilename & ” is not desired Perkin Elmer *.sp binary spectral file.” Exit Sub End If
Debug.Print “The first 4 characters are: ” & Chr(unchar(0)) & Chr(unchar(1)) & Chr(unchar(2)) & Chr(unchar(3))
description = “”For ucharIndex = 4 To 43description = description & Chr(unchar(ucharIndex))Next ucharIndex
Debug.Print “The description of the file is: ” & description
‘xLen = int32(0) Do iCountLoop = iCountLoop + 1 If Seek(iFileNum) <= 50 Then Debug.Print ” Enter the Do-while Loop” End If’ lThisBlock = lThisBlock + 1 Get #iFileNum, , int16 position = position + 2 BlockID = int16 If Seek(iFileNum) <= 52 Then Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Debug.Print “BlockID is: ” & BlockID End If Get #iFileNum, , int32 position = position + 4 BlockSize = int32 If Seek(iFileNum) <= 56 Then Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Debug.Print “Block size is: ” & BlockSize End If If EOF(iFileNum) = True Then Exit Do End If Select Case BlockID Case DSet2DC1DIBlock ‘% Wrapper block. Read nothing. Debug.Print ” —————–Case DSet2DC1DIBlock; Read Nothing—————–” Debug.Print “standard Pointer:” & Seek(iFileNum) Case DataSetAbscissaRangeMember Debug.Print ” —————–Case DataSetAbscissaRangeMember—————–” Get #iFileNum, , innerCode position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) ‘%_ASSERTE(CvCoOrdRangeType == nInnerCode) Get #iFileNum, , x0 position = position + 8 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Get #iFileNum, , xEnd position = position + 8 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Debug.Print “innerCode is: ” & innerCode Debug.Print “x0 is: ” & x0 Debug.Print “xEnd is: ” & xEnd Case DataSetIntervalMember Debug.Print ” —————–Case DataSetIntervalMember—————–” Get #iFileNum, , innerCode position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Get #iFileNum, , xDelta position = position + 8 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Debug.Print “innerCode is: ” & innerCode Debug.Print “xDelta is: ” & xDelta Case DataSetNumPointsMember Debug.Print ” —————–Case DataSetNumPointsMember—————–” Get #iFileNum, , innerCode position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Get #iFileNum, , xLen position = position + 4 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Debug.Print “innerCode is: ” & innerCode Debug.Print “xDelta is: ” & xLen Case DataSetXAxisLabelMember Debug.Print ” —————–Case DataSetXAxisLabelMember—————–” Get #iFileNum, , innerCode position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Get #iFileNum, , length position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) ReDim xLabel(0 To length – 1) As Byte ‘String ‘For i = 0 To length – 1 Get #iFileNum, , xLabel position = position + length Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) ‘Debug.Print xLabel ‘Next i Case DataSetYAxisLabelMember Debug.Print ” —————–Case DataSetYAxisLabelMember—————–” Get #iFileNum, , innerCode position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Get #iFileNum, , length position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) ReDim yLabel(0 To length – 1) As Byte ‘String ‘ For j = 0 To length – 1 Get #iFileNum, , yLabel position = position + length Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) ‘ Next j Case DataSetAliasMember Debug.Print ” —————–Case DataSetAliasMember—————–” Get #iFileNum, , innerCode position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Get #iFileNum, , length position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) ReDim alias(0 To length – 1) As Byte ‘String ‘ For k = 0 To length – 1 Get #iFileNum, , alias position = position + length Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) ‘Next k Case DataSetNameMember Debug.Print ” —————–Case DataSetNameMember—————–” Get #iFileNum, , innerCode position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Get #iFileNum, , length position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) ReDim OriginalName(0 To length – 1) As Byte ‘For m = 0 To length – 1 Get #iFileNum, , OriginalName position = position + length ‘Next m Case DataSetDataMember Debug.Print ” —————–Case DataSetDataMember —————–” Get #iFileNum, , innerCode position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Get #iFileNum, , length position = position + 2 Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) ‘% innerCode should be CvCoOrdArrayType ‘% length should be xLen * 8 If xLen = 0 Then xLen = length / 8 End If ReDim data(0 To xLen – 1) As Double Dim size As Long size = xLen ‘For n = 0 To xLen – 1 Get #iFileNum, , data ‘ActiveWorkbook.Sheets(“data”).cell(“a1”) = data(200) ‘Debug.Print “****************worksheet data input finished!!” position = position + length Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) ‘Next n Case Else Debug.Print ” +++++++++++++++++Case Else+++++++++++++++++++++++” Seek #iFileNum, position + BlockSize position = position + BlockSize Debug.Print “Current Pointer:” & position Debug.Print “standard Pointer:” & Seek(iFileNum) Debug.Print “position + BlockSize is: ” & (position + BlockSize) End Select If iCountLoop >= 3000 Then Exit Sub End If Loop While EOF(iFileNum) = False Close iFileNum Else Exit Sub End If
If xLen = 0 Then MsgBox “The file does not contain spectral data.” Exit SubEnd IfDebug.Print “———— ” & sFilename & ” data importing finished.————“Debug.Print “Now display the data”‘Debug.Print “——————– ———– ———– ————“Dim index As Integer
‘ActiveWorkbook.Sheets(1).cell(“a1”) = data(200)For index = 0 To size – 1’Debug.Print “data(” & index & “) is: ” & data(index)Debug.Print data(index)index = index + 1Next ‘index
Debug.Print “——————– ———– ———– ————“‘ Expand the axes specifications into vectors’wavenumber= x0: xDelta: xEnd
‘ Return the other details as name,value pairs’misc(1,:) = {‘xLabel’, xLabel}’misc(2,:) = {‘yLabel’, yLabel}’misc(3,:) = {‘alias’, alias}’misc(4,:) = {‘original name’, originalName}
ErrFailed: Close iFileNum Debug.Print Err.description
End Sub
心中有愿望一定要去闯，努力实现最初的梦想，
