2

I have a TIF file containing tabular climatic data, described here, which I am trying to export to spreadsheet / CSV format: http://www.helioclim.org/linke/linke_helioserve.html

In summary, it is a TIF with no header, 2160 rows by 4320 columns, where the upper left corner is 90 N, 180 W, and the lower right corner is 90S 180 E. Standard stuff. I also know that the output data is supposed to be an integer roughly between 40 and 140.

All I want to do is to extract the tabular data into a spreadsheet as source data for calculation purposes (I'm well aware that the column count exceeds Excel's capabilities). It seems the TIF is used as a very efficient container of the GIS raw data. And since the TIF contains data that is already in tabular format, I thought it would be relatively easy (not the case).

So far the only thing that has 'kinda' worked I have tried freeware "Grid Convert" to CSV, but it produces 3 columns of output data, the first 2 being all zeros and the third, 7 digits long, presumably 9,331,200 rows. It's still useless, but nothing else has worked. I don't have much experience working with this kind of data format, a starting heads up would be welcome :)

In case it might help, this is a download link to part of the raw data, under "Linke Turbidity Factor: Monthly maps" http://www.soda-is.com/eng/services/climat_free_eng.php

Anybody have any ideas how I may extract the raw data from the TIF file?

Thanks in advance

Improve this question

2 Answers 2

Reset to default
5

A very simple approach which springs to mind is to export the tiff to an ascii grid format such as ESRI's .asc file. You will then have a space delimited plain text file. It will have a few header lines which describe the origin, resolution and NoData values etc and you can easily skip over these for the sake of you calculations. You can do the translation using GDAL_translate or QGIS if you are looking for free tools or obviously use ArcGIS if you have it.

Alternatively, instead of changing the storage format, why not change your approach to performing the calculations? There are various APIs and tools available that will allow you to do all manner of calculations on an array (which is all the Tiff is after all). For example you gould use the GDAL Python Api in conjunction with NumPy and/or SciPy. The latter two modules give you great array handling capabilities. In that way you could analyse the Tiff as-is.

Improve this answer
3
  • I just converted the feb.tif file in QGIS 1.8 to a Arc/Info ascii grid using Raster|Conversion|Translate. Took about 3 seconds and produced a 28MB ascii text file of the values, just like @MappaGnosis said. QGIS with GDAL is probably your best software solution.
    – Chad Cooper
    May 29, 2013 at 14:27
  • Conversion to .ASC worked, and once I figured out the scaling of values in the TIF, the process worked. However the files are large in the extreme (1.5 GB for 12 months of data). Worst case, I know this will work. I will try tinkering with the proposed alternatives, as long as it won't require the user to install new software or activate a VBA add-in as this will cause conflict with the rigid corporate policy on the matter. Thanks for the help, it was thorough and appreciated.
    – W5ALIVE
    May 31, 2013 at 14:41
  • Yes - that's the problem with any ascii version (including csv) of a binary format. Corporate policies like that are annoying and frustrating in the extreme.
    – MappaGnosis
    May 31, 2013 at 14:46
1

I've coded a reader function that can read numeric data from TIF files (with a single layer, assumes no compression). Hope this helps.

'---------------------------------------------------------------------------------------------
'Module: TIF.bas
'Purpose: Functions for reading numerical data from TIF files (works) and writing data into TIF files (not yet complete)
'Author: Nitin Nampalli (National University of Singapore)
'Last updated: 28.10.2021
'----------------------------------------------------------------------------------------------
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
#Else
    Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
#End If

Sub doLoadTIF()
Dim filePath_TIF As String
Dim shtExport As Worksheet
Dim ImageData As Variant

'Specify export sheet
Set shtExport = ThisWorkbook.Sheets("TIF")

'Specify path of TIF file
filePath_TIF = "C:\Users\serniti.NUSSTF\Desktop\NaN Test_asymm.tif"

'Option 1: Extract data from TIF file and dump into a sheet
'Call getDataFromTIF(filePath_TIF, shtExport)

'Option 2: Extract data from TIF file and store in ImageData
ImageData = getDataFromTIF(filePath_TIF)
With shtExport
    If Not (ImageData = Null) Then
        .UsedRange.Clear
        .Range(.Cells(1, 1), .Cells(UBound(ImageData, 1), UBound(ImageData, 2))).Value = ImageData 'Set values into
    End If
End With
End Sub

Function getDataFromTIF(filePath_TIF As String, Optional ExportSheet As Worksheet) As Variant
'PURPOSE:       Reads a single-layer TIF file (opened as binary) from a given file path (string) and returns the data as an array. Optionally also places data into a sheet at R1C1 (Cell "A1")
'ARGUMENTS:     2 arguments (1 required, 1 optional)
'               filePath_TIF: (String) File Path of TIF file to be read
'               ExportSheet: (Worksheet object) Optional Sheet object into which data is to be dumped
'VALIDATION:    Successfully tested on 10x10 pixel TIF image (MM) from ImageJ and 1024x1024 pixel TIF image (II) from software
'REFERENCES:    Reference for TIF file structure: https://cool.culturalheritage.org/bytopic/imaging/std/tiff5.html
'               Heavily modified from: http://www.vbaexpress.com/forum/showthread.php?47490-Read-and-Write-a-Hexdecimal-tiff-File-Using-VBA

'VARIABLE DEFINITIONS:
'---------------------
    Dim strFileExt As String
    Dim strFileType As String 'TIF mark
    Dim endian As String
    Dim offsetIFD As Long ' first IFD location (IFD = Index file directory)
    Dim iCountDE As Integer ' total number of DE (Directory entry)
    Dim TTID As Integer '
    Dim x As Long, i As Long, j As Long 'loop counters
    Dim fileNumb As Integer
    Dim versionNumber As Integer '2 bytes
    Dim b4(1 To 4) As Byte 'array of 4 bytes
    Dim b2(1 To 2) As Byte 'array of 2 bytes
    Dim FieldType As Integer '2 bytes
    Dim FieldTypeNote As String
    Dim FieldLen As Long '4 bytes
    Dim FieldSizeInBits As Integer
    Dim FieldName As String
    Dim Noffset As Long '2-4 bytes, Number/count of field types in field
    Dim strValue As String 'Value as string
    Dim Value As Variant 'Value of field types in field
    Dim bVal As Byte, cVal As String, sVal As Integer, lVal As Long, rVal1 As Long, rVal2 As Long, rVal As Double 'Value of field
    Dim bValArr() As Byte, sValArr() As Integer, lValArr() As Long, rValArr() As Double 'Array of field values
    Dim currentPos As Variant 'Current read/seek position
    Dim strDebugMsg1 As String, strDebugMsg2 As String 'text for debugging
    Dim N_strips As Long 'number of strips
    Dim RowsPerStrip As Long 'rows per strips
    Dim BytesPerPixel As Variant 'bytes per pixel
    Dim BytesPerRow As Variant 'bytes per row
    Dim StripsPerImage As Variant 'strips per image
    Dim StripOffsets(1 To 1024) As Variant 'offset value of strips
    Dim StripData As Variant 'stores strip data
    Dim ImageWidth As Variant, ImageLength As Variant 'width and length (height) of image
    Dim stripCount As Long, rowCount As Long 'specific counters (for loops)
    Dim lngPixVal As Long, intPixVal As Integer 'Pixel value as integer / long
    Dim dblPixVal As Double, sglPixVal As Single 'Pixel value as float
    Dim pixVal As Variant 'Pixel value as variant
    Dim isAssumePixelsAreFloat As Boolean 'Flag for assuming pixel values are float type
    Dim isFilePathValid As Boolean 'Flag for file path validity check
    Dim ImageData As Variant
    
'USER-DEFINABLE PARAMS:

    'Assume pixel values are float type (double/single) rather than long/int
    isAssumePixelsAreFloat = True

'VALIDATE ARGUMENTS & INPUTS:

    'Check if file location is valid
    If Dir(filePath_TIF) <> "" Then 'Valid path
        strFileExt = Right(filePath_TIF, Len(filePath_TIF) - InStrRev(filePath_TIF, "."))
        'Check if file extension is tif or tiff
        If LCase(strFileExt) = "tif" Or LCase(strFileExt) = "tiff" Then
            isFilePathValid = True
        Else '
            isFilePathValid = False
        End If
    Else    'Invalid path
        isFilePathValid = False
    End If

    If isFilePathValid = False Then
        getDataFromTIF = Null
        Exit Function
    End If

'OPEN TIF AND READ HEADERS:
    'Open file
    fileNumb = 2
    Open filePath_TIF For Binary As fileNumb

    
    'Get TIF file type (Bytes 0-1) = 2 bytes
    strFileType = String(2, 0)
    Get fileNumb, , strFileType ' get TIF mark
    If strFileType <> "II" And strFileType <> "MM" Then
        Close fileNumb
        Exit Function
    End If
    
    'Set endian type for byte to data conversion
    If strFileType = "MM" Then 'Least significant byte first, Big-endian
        endian = "big"
    ElseIf strFileType = "II" Then 'Most significant byte first, Little-endian
        endian = "small"
    End If
    
    'Get TIF file type (Bytes 2-3) = 2 bytes
    versionNumber = getInt(fileNumb, endian)

    'Get TIF file type (Bytes 4-7) = 4 bytes
    offsetIFD = getLong(fileNumb, endian)
    
    'Go to first IFD Location
    Seek fileNumb, offsetIFD + 1 'find next IFD location
    
    'IFD #1
    '------
    'Get count of fields (2 bytes)
    iCountDE = getInt(fileNumb, endian)

    strDebugMsg1 = "TIF File Location: " & filePath_TIF & vbNewLine & _
                    "TIF file type: " & strFileType & vbNewLine & _
                    "TIF version: " & versionNumber & vbNewLine & _
                    "First IFD Location: " & offsetIFD & vbNewLine & _
                    "Total number of Fields: " & iCountDE & vbNewLine

    'Debuggin only - displays file and IFD summary
    'MsgBox strDebugMsg1

    'Looping through 12-byte field entries
    For i = 1 To iCountDE
'        Get #1, , TTID 'Get DE
        'Bytes 0-1 (2 bytes): Tag for field
        TTID = getInt(fileNumb, endian)
        
        'Bytes 2-3 (2 bytes): Field type
        'Possible values: 1 = BYTE (8-bit), 2 = ASCII (8-bit, last byte must be null), 3 = SHORT (16-bit unsigned int), 4 = LONG (32-bit unsigned int = long), 5 = RATIONAL (48-bit, 2x LONG, first is numerator, second is denominator)
        FieldType = getInt(fileNumb, endian) 'Read the next 2 bytes to get number of fields

        Select Case FieldType

            Case 1 'BYTE (8-bit)
                FieldSizeInBits = 8
                FieldTypeNote = "BYTE"

            Case 2 'ASCII (8-bit, last byte must be null)
                FieldSizeInBits = 8
                FieldTypeNote = "ASCII"

            Case 3 'SHORT (16-bit unsigned int),
                FieldSizeInBits = 16
                FieldTypeNote = "SHORT"

            Case 4 'LONG (32-bit unsigned int = long)
                FieldSizeInBits = 32
                FieldTypeNote = "LONG"

            Case 5 'RATIONAL (48-bit, 2x LONG, first is numerator, second is denominator)
                FieldSizeInBits = 64
                FieldTypeNote = "RATIONAL"
        End Select
        
        'Bytes 4-7 (4 bytes): Length/count of the field
        'Possible values: >= 1
        FieldLen = getLong(fileNumb, endian)
        
        'Bytes 8-11 (4 bytes): Value offset (even number) relative to start of file
        'If the Value is less than 4 bytes, it is left-justified within the 4-byte Value Offset, i.e., stored in
        'the lower-numbered bytes.  Whether or not the Value fits within 4 bytes is  determined by looking at
        'the FieldType  and FieldLen
        If FieldTypeNote = "SHORT" Then
            Noffset = getInt(fileNumb, endian) 'Read the first 2 bytes to get value (if 4 bytes or less) or value offset (if >4 bytes)
            Seek fileNumb, Seek(fileNumb) + 2
        Else
            Noffset = getLong(fileNumb, endian) 'Read the next 4 bytes to get value (if 4 bytes or less) or value offset (if >4 bytes)
        End If
        
        'Get value
        strValue = ""
        If FieldLen = 1 And FieldSizeInBits / 8 <= 4 Then
        'If there is only 1 count of field values and field size is small enough, then value itself is stored in Noffset
            Value = Noffset
            strValue = Value
            
        Else
        'If N>1 or field size is large, then go to offset to read values
        
            'Get current cursor position
            currentPos = Seek(fileNumb)
            
            'Go to specified offset
            Seek fileNumb, Noffset + 1

            'Debug only - to check if seek is working properly
            'MsgBox "Previously at " & currentPos & ", Now at " & Seek(fileNumb)

            'Set values depending on field type
            If FieldTypeNote = "ASCII" Then
                cVal = getString(fileNumb, FieldLen)
                strValue = cVal
                Value = cVal
            ElseIf FieldTypeNote = "SHORT" Then
                If FieldLen = 1 Then
                    sVal = getInt(fileNumb, endian)
                    strValue = sVal
                    Value = sVal
                Else
                    ReDim sValArr(1 To FieldLen)
                    For x = 1 To FieldLen
                        sValArr(x) = getInt(fileNumb, endian)
                        strValue = strValue & sValArr(x) & ","
                    Next x
                    strValue = Left(strValue, Len(strValue) - 1)
                End If
            ElseIf FieldTypeNote = "LONG" Then
                If FieldLen = 1 Then
                    lVal = getLong(fileNumb, endian)
                    strValue = lVal
                    Value = lVal
                Else
                    ReDim lValArr(1 To FieldLen)
                    For x = 1 To FieldLen
                        lValArr(x) = getLong(fileNumb, endian)
                        strValue = strValue & lValArr(x) & ","
                    Next x
                    strValue = Left(strValue, Len(strValue) - 1)
                End If
            ElseIf FieldTypeNote = "RATIONAL" Then
                If FieldLen = 1 Then
                    rVal1 = getLong(fileNumb, endian) 'Numerator
                    rVal2 = getLong(fileNumb, endian) 'Denominator
                    rVal = rVal1 / rVal2
                    strValue = Format(rVal, "0.000")
                    Value = rVal
                Else
                    ReDim rValArr(1 To FieldLen)
                    For x = 1 To FieldLen
                        rVal1 = getLong(fileNumb, endian) 'Numerator
                        rVal2 = getLong(fileNumb, endian) 'Denominator
                        rValArr(x) = rVal1 / rVal2
                        strValue = strValue & Format(rValArr(x), "0.000")
                    Next x
                    strValue = Left(strValue, Len(strValue) - 1)
                End If

            ElseIf FieldTypeNote = "BYTE" Then
                If FieldLen = 1 Then
                    Get fileNumb, , bVal
                    Value = bVal
                Else
                    ReDim bValArr(1 To FieldLen)
                    For x = 1 To FieldLen
                        Get fileNumb, , bValArr(x)
                    Next x
                    strValue = Left(strValue, Len(strValue) - 1)
                End If
                
            End If
            
            'Return cursor to original position if not the last field
            If i < iCountDE Then
                'MsgBox "After reading, end position is: " & Seek(fileNumb)
                Seek fileNumb, currentPos
                'MsgBox "After reading, now back to " & Seek(fileNumb) & " (should be at " & currentPos & ")"
            End If

        End If
        
        'Identify tags
        'Note: this list is not comprehensive. A complete list of TIF file tags can be found here: https://cool.culturalheritage.org/bytopic/imaging/std/tiff5.html
        Select Case TTID
        
    'Basic fields for all TIFs
            Case 254 'NewSubfileType, Type: LONG (4), N = 1, Default = 0''Note: This  field is  made up of a set of 32 flag bits. Unused bits are expected to be 0.  Bit 0 is the low-order bit.
                FieldName = "NewSubfileType"
            Case 256 'ImageWidth, Type: SHORT (3) or LONG (4), N = 1 ''Note: Width (X-axis) of image in pixels = number of columns
                FieldName = "ImageWidth"
                ImageWidth = Value
            Case 257 'ImageLength, Type: SHORT (3) or LONG (4), N = 1 ''Note: Height (Y-axis) of image in pixels = number of 'scan lines' = number of rows in image
                FieldName = "ImageLength"
                ImageLength = Value
            Case 258 'BitsPerSample, Type: SHORT (3), N = Arb. , Default = 1    ''Note: equals number of bits per pixel
                FieldName = "BitsPerSample"
                BytesPerPixel = Value / 8
            Case 266 'FillOrder, Type: SHORT (3), N = 1 , Default = 1    ''Note: Order of data values within a byte (endian-ness), 1 = Most significant bytes first, 2 = Least significant bytes first
                FieldName = "FillOrder"
                
            Case 274 'Orientation, Type: SHORT (3), N = 1 , Default = 1    ''Note: 1 = Row-Col is top-left, 2 = top-right, 3 = bottom-right, 4 = bottom-left, 5 = Row-Col is left-top, 6 = Row-Col is right-top, 7 = right-bottom, 8 = left-bottom
                FieldName = "Orientation"
                
            Case 277 'SamplesPerPixel, Type: SHORT (3), N = 1, Default = 1    ''Note: 1 for bilevel, grayscale and palette color, 3 for RGB
                FieldName = "SamplesPerPixel"
            Case 278 'RowsPerStrip, Type: SHORT (3) or LONG (4), N = 1
                FieldName = "RowsPerStrip"
                RowsPerStrip = Value
            Case 273 'StripOffsets, Type: SHORT (3) or LONG (4), N = StripsPerImage (for PlanarConfiguration = 1) or SamplesPerPixel * StripsPerImage (for PlanarConfiguration = 2), ''Note: Number of bytes in strip
                FieldName = "StripOffsets"
                N_strips = FieldLen
                If N_strips = 1 Then
                    StripOffsets(1) = Value
                Else
                    If FieldTypeNote = "LONG" Then
                        For x = 1 To N_strips
                            StripOffsets(x) = lValArr(x)
                        Next x
                    Else 'FieldTypeNote = "SHORT"
                        For x = 1 To N_strips
                            StripOffsets(x) = sValArr(x)
                        Next x
                    End If
                End If
            Case 279 'StripByteCounts, Type: SHORT (3) or LONG (4), N = StripsPerImage (for PlanarConfiguration = 1) or SamplesPerPixel * StripsPerImage (for PlanarConfiguration = 2), ''Note: Number of bytes in strip
                FieldName = "StripByteCounts"
                
            Case 270 'ImageDescription, Type: ASCII (2) ''Note: description of image
                FieldName = "ImageDescription"
                
    'Grayscale fields
            Case 262 'PhotometricInterpretation, Type: SHORT (3), N = 1, Default = 1 ''Note: Should be equal to GrayResponseCurve, 0 = 0 is white in bi-level and grayscale images., 1 = 0 is black in bi-level and grayscale images, 2 = RGB, 3 = Palette color, 4 = Transparency Mask
                FieldName = "PhotometricInterpretation"
            Case 291 'GrayResponseCurve, Type: SHORT, N = 2^BitsPerSample
                FieldName = "GrayResponseCurve"
            Case 290 'GrayResponseUnit, Type: SHIRT, N = 1, Default = 2 ''Note: 1 = tenths of unit, 2 = hundredths of unit, 3 = thousandths, 4 = ten-thousandths, 5 = hundred-thousandths. Modifies the GrayResponseCurve
                FieldName = "GrayResponseUnit"
    'Advanced fields for all TIFs
            Case 283 'YResolution, Type: RATIONAL (5), N = 1''Note: Number of pixels per resolution unit in Y direction
                FieldName = "YResolution"
            Case 282 'XResolution, Type: RATIONAL (5), N = 1''Note: Number of pixels per resolution unit in X direction
                FieldName = "XResolution"
            Case 286 'XPosition, Type: RATIONAL (5) ''Note: X offset of left side of image wrt left side of page in ResolutionUnits
                FieldName = "XPosition"
            Case 287 'YPosition, Type: RATIONAL (5) ''Note: Y offset of left side of image wrt left side of page in ResolutionUnits
                FieldName = "YPosition"
            Case 296 'ResolutionUnit, Type: SHORT (3), N = 1, Default = 2 ''Note: 1 = no absolute unit of measurement, 2 = inch, 3 = centimeter
                FieldName = "ResolutionUnit"
    'Informational fields
            Case 305 'Software, Type: ASCII (2) ''Note: Name and release number of software package that created image
                FieldName = "Software"
            Case 306 'DateTime, Type: ASCII (2), N = 20 ''Note: Format = "YYYY:MM:DD HH:MM:SS" - 20 chars including null char.
                FieldName = "DateTime"
            Case 315 'Artist, Type: ASCII (2) ''Note: used for copyright info, etc
                FieldName = "Artist"
            Case 316 'HostComputer, Type: ASCII (2) ''Note: type of computer
                FieldName = "HostComputer"
            Case 271 'Make, Type: ASCII (2) ''Note: manufacturer of scanner, digitizer, etc
                FieldName = "Make"
            Case 272 'Model, Type: ASCII (2) ''Note: model of scanner, digitizer, etc
                FieldName = "Model"
            
    'Compression fields
            Case 259 'Compression, Type: SHORT (3), N = 1, Default = 1  ''Note: 1 = No compression, 2 = CCITT compression, 5 = LZW Compression
                FieldName = "Compression"
            
            Case 317 'Predictor, Type: SHORT (3), N = 1 ''Note: To be used when Compression = 5 (LZW)
                FieldName = "Predictor"
            
    'Colour fields
            Case 320 'ColorMap, Type: SHORT (3), N = 3 * (2 ^ BitsPerSample), Default N/R
                FieldName = "ColorMap"
        
            Case 284 'PlanarConfiguration, Type: SHORT (3), N = 1, Default = 1 ''Note: Only required when SamplesPerPixel > 1. 1 = pixels stored contiguously (e.g. RGBRGBRGB), 2 = pixels in separate planes, requires StripOffsets and StripByteCounts to be defined
                FieldName = "PlanarConfiguration"
            Case 339
                FieldName = "Unknown??"
            Case Else
                FieldName = "Unknown??"
        End Select
        
        'Prepare a summary string file
        strDebugMsg2 = strDebugMsg2 & i & "- " & FieldName & " (" & TTID & "): " & strValue & vbNewLine

    Next i
    
    'Debug - summarizes all fields and outputs in a message box for review - useful for developers
    'MsgBox msg
    
'GET DATA FROM TIF
'-----------------

    'Define Image
    ReDim ImageData(1 To ImageWidth, 1 To ImageLength)
    
    'Calculate strips per image - sanity check
    If RowsPerStrip <= 0 Then
        RowsPerStrip = ImageLength / N_strips
    End If
    StripsPerImage = (ImageLength + RowsPerStrip - 1) \ RowsPerStrip
    If N_strips <> StripsPerImage Then
        MsgBox "Function getDataFromTIF(): N_strips (" & N_strips & ") does not match StripsPerImage (" & StripsPerImage & ")! Error in data extraction.", , "Error with function getDataFromTIF()"
        Exit Function
    End If
    
    'Define size of strip data
    ReDim StripData(1 To ImageWidth * RowsPerStrip, 1 To N_strips)
    
    'Loop through strips
    rowCount = 1
    x = 1
    For stripCount = 1 To N_strips
        currentPos = Seek(fileNumb)
        Seek fileNumb, StripOffsets(stripCount) + 1
        
        'Debug only - check if seek was correct
        'MsgBox "Was at " & currentPos & ", now looking for image data at " & Seek(fileNumb)
        
        'Get data from each strip
        If BytesPerPixel = 2 Then 'INT
            'Extract strip as integer
            For i = 1 To ImageWidth * RowsPerStrip
                intPixVal = getInt(fileNumb, endian)
                StripData(i, stripCount) = intPixVal
                
                ImageData(x, rowCount) = intPixVal
                x = x + 1 'Increment pixel count
                If x > ImageWidth Then
                    x = 1
                    rowCount = rowCount + 1
                End If
            Next i
        ElseIf BytesPerPixel = 4 Then 'SINGLE or LONG
            If isAssumePixelsAreFloat = True Then
                
                'Extract strip as single
                For i = 1 To ImageWidth * RowsPerStrip
                    sglPixVal = getSingle(fileNumb, endian)
                    StripData(i, stripCount) = sglPixVal
                
                    ImageData(x, rowCount) = sglPixVal
                    x = x + 1 'Increment pixel count
                    If x > ImageWidth Then
                        x = 1
                        rowCount = rowCount + 1
                    End If
                Next i
                
            Else
            
                'Extract strip as long
                For i = 1 To ImageWidth * RowsPerStrip
                    lngPixVal = getLong(fileNumb, endian)
                    StripData(i, stripCount) = lngPixVal
                
                    ImageData(x, rowCount) = lngPixVal
                    x = x + 1 'Increment pixel count
                    If x > ImageWidth Then
                        x = 1
                        rowCount = rowCount + 1
                    End If
                Next i
            End If
        
        ElseIf BytesPerPixel = 8 Then 'DOUBLE
        
            'Extract strip as double
            For i = 1 To ImageWidth * RowsPerStrip
                dblPixVal = getDouble(fileNumb, endian)
                StripData(i, stripCount) = dblPixVal
            
                ImageData(x, rowCount) = dblPixVal
                x = x + 1 'Increment pixel count
                If x > ImageWidth Then
                    x = 1
                    rowCount = rowCount + 1
                End If
            Next i
        End If
    Next stripCount
    
    'Close file
    Close fileNumb
    
    'Dump data into a sheet if needed
    If Not IsMissing(ExportSheet) Then
        If Not (ExportSheet Is Nothing) Then
            With ExportSheet
                .UsedRange.Clear
                .Range(.Cells(1, 1), .Cells(ImageLength, ImageWidth)) = WorksheetFunction.Transpose(ImageData) 'Transpose paste
            End With
        End If
    End If
    
    'Export data into a paste-able form
    getDataFromTIF = WorksheetFunction.Transpose(ImageData)
End Function

Public Function getInt(fileNumb As Variant, endian As String) As Integer
    Dim b2(1 To 2) As Byte
    Dim i As Integer
    For i = 1 To 2
        Get fileNumb, , b2(i)
    Next i
    getInt = IntFromBytes(b2, endian)
End Function

Public Function getLong(fileNumb As Variant, endian As String) As Long
    Dim b4(1 To 4) As Byte
    Dim i As Integer
    For i = 1 To 4
        Get fileNumb, , b4(i)
    Next i
    getLong = LongFromBytes(b4, endian)
End Function

Public Function getString(fileNumb As Variant, count As Variant) As String
    Dim str As String
    str = String(count - 1, 0)
    Get fileNumb, , str
    getString = str
End Function

Public Function getDouble(fileNumb As Variant, endian As String) As Double
Dim b8(1 To 8) As Byte
Dim b8_rev(1 To 8) As Byte
Dim d As Double, i As Integer, j As Integer
    For i = 1 To 8
        Get fileNumb, , b8(i)
    Next i
    If endian <> "small" Or endian <> "little" Then
        j = 8
        For i = 1 To 8
            b8_rev(i) = b8(j)
            j = j - 1
        Next i
        getDouble = DoubleFromBytes(b8_rev)
    Else
        getDouble = DoubleFromBytes(b8)
    End If
End Function

Public Function getSingle(fileNumb As Variant, endian As String) As Single
Dim b4(1 To 4) As Byte
Dim b4_rev(1 To 4) As Byte
Dim d As Double, i As Integer, j As Integer
    For i = 1 To 4
        Get fileNumb, , b4(i)
    Next i
    If endian <> "small" Or endian <> "little" Then
        j = 4
        For i = 1 To 4
            b4_rev(i) = b4(j)
            j = j - 1
        Next i
        getSingle = SingleFromBytes(b4_rev)
    Else
        getSingle = SingleFromBytes(b4)
    End If
End Function

Private Function LongFromBytes(b4 As Variant, endian As String) As Long
Dim myLong As Long
Dim i As Integer

    If endian = "small" Or endian = "little" Then
        For i = LBound(b4) To UBound(b4)
            myLong = myLong + b4(i) * (256 ^ (i - 1))
        Next i
    Else
        i = UBound(b4)
        Do While i >= LBound(b4)
            myLong = myLong + b4(i) * (256 ^ (UBound(b4) - i))
            i = i - 1
        Loop
    End If
    LongFromBytes = myLong
End Function

Private Function IntFromBytes(b2 As Variant, endian As String) As Integer
Dim myInt As Integer
Dim i As Integer

    If endian = "small" Or endian = "little" Then
        For i = LBound(b2) To UBound(b2)
            myInt = myInt + b2(i) * (256 ^ (i - 1))
            'MsgBox myInt
        Next i
    Else
        i = UBound(b2)
        Do While i >= LBound(b2)
            myInt = myInt + b2(i) * (256 ^ (UBound(b2) - i))
            'MsgBox myInt
            i = i - 1
        Loop
    End If
    IntFromBytes = myInt
End Function

Function SingleFromBytes(ByVal b4 As Variant) As Single
'Converts Bytes to Single
    Dim s As Single
    Dim MyBytes(1 To 4) As Byte
    Dim i As Integer
    
    For i = 1 To 4
        MyBytes(i) = b4(i)
    Next i
    CopyMemory s, MyBytes(1), 4
    SingleFromBytes = s
   'MsgBox b4(1) & ", " & b4(2) & ", " & b4(3) & ", " & b4(4) & vbNewLine & s
End Function

Function DoubleFromBytes(b8 As Variant) As Single
'Converts Bytes to double
    Dim s As Double
    Dim MyBytes(1 To 8) As Byte
    
    For i = 1 To 8
        MyBytes(i) = b8(i)
    Next i
    CopyMemory s, MyBytes(1), 8 
   DoubleFromBytes = s
End Function
Improve this answer

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.