Option Explicit
Private Type BOF opcode As Integer length As Integer version As Integer ftype As Integer End Type
'End Of File record Private Type EOF opcode As Integer length As Integer End Type
'Integer record Private Type tInteger opcode As Integer length As Integer Row As Integer Col As Integer rgbAttr1 As Byte rgbAttr2 As Byte rgbAttr3 As Byte Value As Integer End Type
'Number = double record Private Type tNumber opcode As Integer length As Integer Row As Integer Col As Integer rgbAttr1 As Byte rgbAttr2 As Byte rgbAttr3 As Byte Value As Double End Type
'Label (Text) record Private Type tLabel opcode As Integer length As Integer Row As Integer Col As Integer rgbAttr1 As Byte rgbAttr2 As Byte rgbAttr3 As Byte strLength As Byte End Type
Dim fhFile As Integer Dim bof1 As BOF Dim eof1 As EOF Dim l1 As tLabel Dim i1 As tInteger Dim n1 As tNumber
Private Sub Class_Initialize() 'Set up default values for records 'These should be the values that are the same for every record
With bof1 .opcode = 9 .length = 4 .version = 2 .ftype = 10 End With
With eof1 .opcode = 10 End With
With l1 .opcode = 4 .length = 10 .Row = 0 .Col = 0 .rgbAttr1 = 0 .rgbAttr2 = 0 .rgbAttr3 = 0 .strLength = 2 End With
With i1 .opcode = 2 .length = 9 .Row = 0 .Col = 0 .rgbAttr1 = 0 .rgbAttr2 = 0 .rgbAttr3 = 0 .Value = 0 End With
With n1 .opcode = 3 .length = 15 .Row = 0 .Col = 0 .rgbAttr1 = 0 .rgbAttr2 = 0 .rgbAttr3 = 0 .Value = 0 End With
End Sub
Public Sub OpenFile(ByVal FileName As String) fhFile = FreeFile Open FileName For Binary As #fhFile Put #fhFile, , bof1 End Sub
Public Sub CloseFile() Put #fhFile, , eof1 Close #fhFile End Sub
Function EWriteString(ExcelRow As Integer, ExcelCol As Integer, Text As String) Dim b As Byte, l As Byte, a As Byte 'Length of the text portion of the record l = Len(Text) l1.strLength = l
'Total length of the record l1.length = 8 + l1.strLength
l1.Row = ExcelRow - 1 l1.Col = ExcelCol - 1
'Put record header Put #fhFile, , l1
'Then the actual string data 'We have to write the string one character at a time, so we loop 'through all characters in the string, assign thier ASCII value to b 'and do a Put on b (which is declared as Byte) For a = 1 To l b = Asc(Mid$(Text, a, 1)) Put #fhFile, , b Next
End Function
Function EWriteInteger(ExcelRow As Integer, ExcelCol As Integer, Value As Integer) With i1 .Row = ExcelRow - 1 .Col = ExcelCol - 1 .Value = Value End With
Put #fhFile, , i1 End Function
Function EWriteDouble(ExcelRow As Integer, ExcelCol As Integer, Value As Double) With n1 .Row = ExcelRow - 1 .Col = ExcelCol - 1 .Value = Value End With
Put #fhFile, , n1 End Function

|