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
本文地址：http://com.8s8s.com/it/it41840.htm