Imports Microsoft.VisualBasic
Imports System.Text
Imports System.IO
Imports MainMod
Public Class ExcelFile
Public Enum ValueTypes
xlsInteger = 0
xlsNumber = 1
xlsText = 2
End Enum
Public Enum CellAlignment
xlsGeneralAlign = 0
xlsLeftAlign = 1
xlsCentreAlign = 2
xlsRightAlign = 3
xlsFillCell = 4
xlsLeftBorder = 8
xlsRightBorder = 16
xlsTopBorder = 32
xlsBottomBorder = 64
xlsShaded = 128
End Enum
Public Enum CellFont
xlsFont0 = 0
xlsFont1 = 64
xlsFont2 = 128
xlsFont3 = 192
End Enum
Public Enum CellHiddenLocked
xlsNormal = 0
xlsLocked = 64
xlsHidden = 128
End Enum
Public Enum MarginTypes
xlsLeftMargin = 38
xlsRightMargin = 39
xlsTopMargin = 40
xlsBottomMargin = 41
End Enum
Public Enum FontFormatting
xlsNoFormat = 0
xlsBold = 1
xlsItalic = 2
xlsUnderline = 4
xlsStrikeout = 8
End Enum
Private Structure FONT_RECORD
Dim opcode As Short
Dim length As Short
Dim FontHeight As Short
Dim FontAttributes1 As Byte
Dim FontAttributes2 As Byte
Dim FontNameLength As Byte
End Structure
Private Structure PASSWORD_RECORD
Dim opcode As Short
Dim length As Short
End Structure
Private Structure HEADER_FOOTER_RECORD
Dim opcode As Short
Dim length As Short
Dim TextLength As Byte
End Structure
Private Structure PROTECT_SPREADSHEET_RECORD
Dim opcode As Short
Dim length As Short
Dim Protect As Short
End Structure
Private Structure FORMAT_COUNT_RECORD
Dim opcode As Short
Dim length As Short
Dim Count As Short
End Structure
Private Structure FORMAT_RECORD
Dim opcode As Short
Dim length As Short
Dim FormatLenght As Byte
End Structure
Private Structure COLWIDTH_RECORD
Dim opcode As Short
Dim length As Short
Dim col1 As Byte
Dim col2 As Byte
Dim ColumnWidth As Short
End Structure
Private Structure BEG_FILE_RECORD
Dim opcode As Short
Dim length As Short
Dim version As Short
Dim ftype As Short
End Structure
Private Structure END_FILE_RECORD
Dim opcode As Short
Dim length As Short
End Structure
Private Structure PRINT_GRIDLINES_RECORD
Dim opcode As Short
Dim length As Short
Dim PrintFlag As Short
End Structure
Private Structure tInteger
Dim opcode As Short
Dim length As Short
Dim row As Short
Dim col As Short
Dim rgbAttr1 As Byte
Dim rgbAttr2 As Byte
Dim rgbAttr3 As Byte
Dim intValue As Short
End Structure
Private Structure tNumber
Dim opcode As Short
Dim length As Short
Dim row As Short
Dim col As Short
Dim rgbAttr1 As Byte
Dim rgbAttr2 As Byte
Dim rgbAttr3 As Byte
Dim NumberValue As Double
End Structure
Private Structure tText
Dim opcode As Short
Dim length As Short
Dim row As Short
Dim col As Short
Dim rgbAttr1 As Byte
Dim rgbAttr2 As Byte
Dim rgbAttr3 As Byte
Dim TextLength As Byte
End Structure
Private Structure MARGIN_RECORD_LAYOUT
Dim opcode As Short
Dim length As Short
Dim MarginValue As Double
End Structure
Private Structure HPAGE_BREAK_RECORD
Dim opcode As Short
Dim length As Short
Dim NumPageBreaks As Short
End Structure
Private Structure DEF_ROWHEIGHT_RECORD
Dim opcode As Integer
Dim length As Integer
Dim RowHeight As Integer
End Structure
Private Structure ROW_HEIGHT_RECORD
Dim opcode As Integer
Dim length As Integer
Dim RowNumber As Integer
Dim FirstColumn As Integer
Dim LastColumn As Integer
Dim RowHeight As Integer
Dim internal As Integer
Dim DefaultAttributes As Byte
Dim FileOffset As Integer
Dim rgbAttr1 As Byte
Dim rgbAttr2 As Byte
Dim rgbAttr3 As Byte
End Structure
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef lpvDest As String, ByRef lpvSource As Short, ByVal cbCopy As Integer)
Private m_shtFileNumber As Short
Private m_udtBEG_FILE_MARKER As BEG_FILE_RECORD
Private m_udtEND_FILE_MARKER As END_FILE_RECORD
Private m_udtHORIZ_PAGE_BREAK As HPAGE_BREAK_RECORD
Private m_shtHorizPageBreakRows() As Short
Private m_shtNumHorizPageBreaks As Short
Public WriteOnly Property PrintGridLines() As Boolean
Set(ByVal Value As Boolean)
Try
Dim GRIDLINES_RECORD As PRINT_GRIDLINES_RECORD
With GRIDLINES_RECORD
.opcode = 43
.length = 2
If Value = True Then
.PrintFlag = 1
Else
.PrintFlag = 0
End If
End With
FilePut(m_shtFileNumber, GRIDLINES_RECORD)
Catch ex As Exception
End Try
End Set
End Property
Public WriteOnly Property ProtectSpreadsheet() As Boolean
Set(ByVal Value As Boolean)
Try
Dim PROTECT_RECORD As PROTECT_SPREADSHEET_RECORD
With PROTECT_RECORD
.opcode = 18
.length = 2
If Value = True Then
.Protect = 1
Else
.Protect = 0
End If
End With
FilePut(m_shtFileNumber, PROTECT_RECORD)
Catch ex As Exception
End Try
End Set
End Property
Public Sub GetExeclFile(ByVal FileName As String, ByVal StrSql As String)
Dim i As Integer = 0, j As Integer = 0
Dim Arr As Array = Nothing
Dim Brr As Array = Nothing
CreateFile(FileName)
PrintGridLines = False
SetMargin(ExcelFile.MarginTypes.xlsTopMargin, 1.5)
SetMargin(ExcelFile.MarginTypes.xlsLeftMargin, 1.5)
SetMargin(ExcelFile.MarginTypes.xlsRightMargin, 1.5)
SetMargin(ExcelFile.MarginTypes.xlsBottomMargin, 1.5)
SetFont("Microsoft Sans Serif", "9", ExcelFile.FontFormatting.xlsItalic)
SetColumnWidth(1, 20, 9)
SetHeader("This is the header")
SetFooter("This ia the footer")
If StrSql <> "" Then
Arr = Split(StrSql, RECORD_SPLITOR)
For i = 0 To UBound(Arr)
Brr = Split(Arr(i), FIELD_SPLITOR)
For j = 0 To UBound(Brr)
WriteValue(ExcelFile.ValueTypes.xlsText, ExcelFile.CellFont.xlsFont0, ExcelFile.CellAlignment.xlsCentreAlign, ExcelFile.CellHiddenLocked.xlsNormal, i + 1, j + 1, Brr(j))
Next
Next
End If
CloseFile()
End Sub
Public Function CreateFile(ByVal strFileName As String) As Integer
Dim OpenFile As Integer
Try
If File.Exists(strFileName) Then
File.SetAttributes(strFileName, FileAttributes.Normal)
File.Delete(strFileName)
End If
m_shtFileNumber = FreeFile()
'System.IO.File.Create(strFileName)
FileOpen(m_shtFileNumber, strFileName, OpenMode.Binary)
FilePut(m_shtFileNumber, m_udtBEG_FILE_MARKER)
Call WriteDefaultFormats()
ReDim m_shtHorizPageBreakRows(0)
m_shtNumHorizPageBreaks = 0
OpenFile = 0
Catch ex As Exception
OpenFile = Err.Number
End Try
End Function
Public Function CloseFile() As Integer
Dim x As Short
Try
If m_shtFileNumber > 0 Then
Dim lLoop1 As Integer
Dim lLoop2 As Integer
Dim lTemp As Integer
If m_shtNumHorizPageBreaks > 0 Then
For lLoop1 = UBound(m_shtHorizPageBreakRows) To LBound(m_shtHorizPageBreakRows) Step -1
For lLoop2 = LBound(m_shtHorizPageBreakRows) + 1 To lLoop1
If m_shtHorizPageBreakRows(lLoop2 - 1) > m_shtHorizPageBreakRows(lLoop2) Then
lTemp = m_shtHorizPageBreakRows(lLoop2 - 1)
m_shtHorizPageBreakRows(lLoop2 - 1) = m_shtHorizPageBreakRows(lLoop2)
m_shtHorizPageBreakRows(lLoop2) = lTemp
End If
Next lLoop2
Next lLoop1
With m_udtHORIZ_PAGE_BREAK
.opcode = 27
.length = 2 + (m_shtNumHorizPageBreaks * 2)
.NumPageBreaks = m_shtNumHorizPageBreaks
End With
FilePut(m_shtFileNumber, m_udtHORIZ_PAGE_BREAK)
For x = 1 To UBound(m_shtHorizPageBreakRows)
FilePut(m_shtFileNumber, MKI(m_shtHorizPageBreakRows(x)))
Next
End If
FilePut(m_shtFileNumber, m_udtEND_FILE_MARKER)
FileClose(m_shtFileNumber)
CloseFile = 0
Else
CloseFile = -1
End If
Catch ex As Exception
CloseFile = Err.Number
End Try
End Function
Private Sub Init()
With m_udtBEG_FILE_MARKER
.opcode = 9
.length = 4
.version = 2
.ftype = 10
End With
With m_udtEND_FILE_MARKER
.opcode = 10
End With
End Sub
Public Sub New()
MyBase.New()
Init()
End Sub
Public Function InsertHorizPageBreak(ByRef lrow As Integer) As Integer
Dim row As Short
Try
If lrow > 32767 Then
row = CShort(lrow - 65536)
Else
row = CShort(lrow) - 1
End If
m_shtNumHorizPageBreaks = m_shtNumHorizPageBreaks + 1
ReDim Preserve m_shtHorizPageBreakRows(m_shtNumHorizPageBreaks)
m_shtHorizPageBreakRows(m_shtNumHorizPageBreaks) = row
Catch ex As Exception
InsertHorizPageBreak = Err.Number
End Try
End Function
Public Function WriteValue(ByRef ValueType As ValueTypes, ByRef CellFontUsed As CellFont, ByRef Alignment As CellAlignment, ByRef HiddenLocked As CellHiddenLocked, ByRef lrow As Integer, ByRef lcol As Integer, ByRef Value As Object, Optional ByRef CellFormat As Integer = 0) As Integer
Dim l As Short
Dim st As String
Dim col As Short
Dim row As Short
Try
Dim INTEGER_RECORD As tInteger
Dim NUMBER_RECORD As tNumber
Dim TEXT_RECORD As tText
If lrow > 32767 Then
row = CShort(lrow - 65536)
Else
row = CShort(lrow) - 1
End If
If lcol > 32767 Then
col = CShort(lcol - 65536)
Else
col = CShort(lcol) - 1
End If
Select Case ValueType
Case ValueTypes.xlsInteger
With INTEGER_RECORD
.opcode = 2
.length = 9
.row = row
.col = col
.rgbAttr1 = CByte(HiddenLocked)
.rgbAttr2 = CByte(CellFontUsed + CellFormat)
.rgbAttr3 = CByte(Alignment)
.intValue = CShort(Value)
End With
FilePut(m_shtFileNumber, INTEGER_RECORD)
Case ValueTypes.xlsNumber
With NUMBER_RECORD
.opcode = 3
.length = 15
.row = row
.col = col
.rgbAttr1 = CByte(HiddenLocked)
.rgbAttr2 = CByte(CellFontUsed + CellFormat)
.rgbAttr3 = CByte(Alignment)
.NumberValue = CDbl(Value)
End With
FilePut(m_shtFileNumber, NUMBER_RECORD)
Case ValueTypes.xlsText
st = CType(Value, String)
l = GetLength(st)
With TEXT_RECORD
.opcode = 4
.length = 10
.TextLength = l
.length = 8 + l
.row = row
.col = col
.rgbAttr1 = CByte(HiddenLocked)
.rgbAttr2 = CByte(CellFontUsed + CellFormat)
.rgbAttr3 = CByte(Alignment)
FilePut(m_shtFileNumber, TEXT_RECORD)
FilePut(m_shtFileNumber, st)
End With
End Select
WriteValue = 0
Catch ex As Exception
WriteValue = Err.Number
End Try
End Function
Public Function SetMargin(ByRef Margin As MarginTypes, ByRef MarginValue As Double) As Integer
Try
Dim MarginRecord As MARGIN_RECORD_LAYOUT
With MarginRecord
.opcode = Margin
.length = 8
.MarginValue = MarginValue 'in inches
End With
FilePut(m_shtFileNumber, MarginRecord)
SetMargin = 0
Catch ex As Exception
SetMargin = Err.Number
End Try
End Function
Public Function SetColumnWidth(ByRef FirstColumn As Byte, ByRef LastColumn As Byte, ByRef WidthValue As Short) As Integer
Try
Dim COLWIDTH As COLWIDTH_RECORD
With COLWIDTH
.opcode = 36
.length = 4
.col1 = FirstColumn - 1
.col2 = LastColumn - 1
.ColumnWidth = WidthValue * 256
End With
FilePut(m_shtFileNumber, COLWIDTH)
SetColumnWidth = 0
Catch ex As Exception
SetColumnWidth = Err.Number
End Try
End Function
Public Function SetFont(ByRef FontName As String, ByRef FontHeight As Short, ByRef FontFormat As FontFormatting) As Short
Dim l As Short
Try
Dim FONTNAME_RECORD As FONT_RECORD
l = GetLength(FontName)
With FONTNAME_RECORD
.opcode = 49
.length = 5 + l
.FontHeight = FontHeight * 20
.FontAttributes1 = CByte(FontFormat)
.FontAttributes2 = CByte(0)
.FontNameLength = CByte(l)
End With
FilePut(m_shtFileNumber, FONTNAME_RECORD)
FilePut(m_shtFileNumber, FontName)
SetFont = 0
Catch ex As Exception
SetFont = Err.Number
End Try
End Function
Public Function SetHeader(ByRef HeaderText As String) As Integer
Dim l As Short
Try
Dim HEADER_RECORD As HEADER_FOOTER_RECORD
l = GetLength(HeaderText)
With HEADER_RECORD
.opcode = 20
.length = 1 + l
.TextLength = CByte(l)
End With
FilePut(m_shtFileNumber, HEADER_RECORD)
FilePut(m_shtFileNumber, HeaderText)
SetHeader = 0
Catch ex As Exception
SetHeader = Err.Number
End Try
End Function
Public Function SetFooter(ByRef FooterText As String) As Integer
Dim l As Short
Try
Dim FOOTER_RECORD As HEADER_FOOTER_RECORD
l = GetLength(FooterText)
With FOOTER_RECORD
.opcode = 21
.length = 1 + l
.TextLength = CByte(l)
End With
FilePut(m_shtFileNumber, FOOTER_RECORD)
FilePut(m_shtFileNumber, FooterText)
SetFooter = 0
Catch ex As Exception
SetFooter = Err.Number
End Try
End Function
Public Function SetFilePassword(ByRef PasswordText As String) As Integer
Dim l As Short
Try
Dim FILE_PASSWORD_RECORD As PASSWORD_RECORD
l = GetLength(PasswordText)
With FILE_PASSWORD_RECORD
.opcode = 47
.length = l
End With
FilePut(m_shtFileNumber, FILE_PASSWORD_RECORD)
FilePut(m_shtFileNumber, PasswordText)
SetFilePassword = 0
Catch ex As Exception
SetFilePassword = Err.Number
End Try
End Function
Private Function WriteDefaultFormats() As Integer
Dim cFORMAT_COUNT_RECORD As FORMAT_COUNT_RECORD
Dim cFORMAT_RECORD As FORMAT_RECORD
Dim lIndex As Integer
Dim aFormat(23) As String
Dim l As Integer
Dim q As String = 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) = "dd/mm/yy"
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) = "@"
With cFORMAT_COUNT_RECORD
.opcode = &H1FS
.length = &H2S
.Count = CShort(UBound(aFormat))
End With
FilePut(m_shtFileNumber, cFORMAT_COUNT_RECORD)
Dim b As Byte
Dim a As Integer
For lIndex = LBound(aFormat) To UBound(aFormat)
l = Len(aFormat(lIndex))
With cFORMAT_RECORD
.opcode = &H1ES
.length = CShort(l + 1)
.FormatLenght = CShort(l)
End With
FilePut(m_shtFileNumber, cFORMAT_RECORD)
For a = 1 To l
b = Asc(Mid(aFormat(lIndex), a, 1))
FilePut(m_shtFileNumber, b)
Next
Next lIndex
End Function
Private Function MKI(ByRef x As Short) As String
Dim temp As String
temp = Space(2)
CopyMemory(temp, x, 2)
MKI = temp
End Function
Private Function GetLength(ByVal strText As String) As Integer
Return Encoding.Default.GetBytes(strText).Length
End Function
Public Function SetDefaultRowHeight(ByVal HeightValue As Integer) As Integer
Try
Dim DEFHEIGHT As DEF_ROWHEIGHT_RECORD
With DEFHEIGHT
.opcode = 37
.length = 2
.RowHeight = HeightValue * 20
End With
FilePut(m_shtFileNumber, DEFHEIGHT)
SetDefaultRowHeight = 0
Catch ex As Exception
SetDefaultRowHeight = Err.Number
End Try
End Function
Public Function SetRowHeight(ByVal Row As Integer, ByVal HeightValue As Short) As Integer
Dim o_intRow As Integer
Try
If Row > 32767 Then
o_intRow = CInt(Row - 65536)
Else
o_intRow = CInt(Row) - 1
End If
Dim ROWHEIGHTREC As ROW_HEIGHT_RECORD
With ROWHEIGHTREC
.opcode = 8
.length = 16
.RowNumber = o_intRow
.FirstColumn = 0
.LastColumn = 256
.RowHeight = HeightValue * 20
.internal = 0
.DefaultAttributes = 0
.FileOffset = 0
.rgbAttr1 = 0
.rgbAttr2 = 0
.rgbAttr3 = 0
End With
FilePut(m_shtFileNumber, ROWHEIGHTREC)
SetRowHeight = 0
Catch ex As Exception
SetRowHeight = Err.Number
End Try
End Function
End Class
Imports System.Text
Imports System.IO
Imports MainMod
Public Class ExcelFile
Public Enum ValueTypes
xlsInteger = 0
xlsNumber = 1
xlsText = 2
End Enum
Public Enum CellAlignment
xlsGeneralAlign = 0
xlsLeftAlign = 1
xlsCentreAlign = 2
xlsRightAlign = 3
xlsFillCell = 4
xlsLeftBorder = 8
xlsRightBorder = 16
xlsTopBorder = 32
xlsBottomBorder = 64
xlsShaded = 128
End Enum
Public Enum CellFont
xlsFont0 = 0
xlsFont1 = 64
xlsFont2 = 128
xlsFont3 = 192
End Enum
Public Enum CellHiddenLocked
xlsNormal = 0
xlsLocked = 64
xlsHidden = 128
End Enum
Public Enum MarginTypes
xlsLeftMargin = 38
xlsRightMargin = 39
xlsTopMargin = 40
xlsBottomMargin = 41
End Enum
Public Enum FontFormatting
xlsNoFormat = 0
xlsBold = 1
xlsItalic = 2
xlsUnderline = 4
xlsStrikeout = 8
End Enum
Private Structure FONT_RECORD
Dim opcode As Short
Dim length As Short
Dim FontHeight As Short
Dim FontAttributes1 As Byte
Dim FontAttributes2 As Byte
Dim FontNameLength As Byte
End Structure
Private Structure PASSWORD_RECORD
Dim opcode As Short
Dim length As Short
End Structure
Private Structure HEADER_FOOTER_RECORD
Dim opcode As Short
Dim length As Short
Dim TextLength As Byte
End Structure
Private Structure PROTECT_SPREADSHEET_RECORD
Dim opcode As Short
Dim length As Short
Dim Protect As Short
End Structure
Private Structure FORMAT_COUNT_RECORD
Dim opcode As Short
Dim length As Short
Dim Count As Short
End Structure
Private Structure FORMAT_RECORD
Dim opcode As Short
Dim length As Short
Dim FormatLenght As Byte
End Structure
Private Structure COLWIDTH_RECORD
Dim opcode As Short
Dim length As Short
Dim col1 As Byte
Dim col2 As Byte
Dim ColumnWidth As Short
End Structure
Private Structure BEG_FILE_RECORD
Dim opcode As Short
Dim length As Short
Dim version As Short
Dim ftype As Short
End Structure
Private Structure END_FILE_RECORD
Dim opcode As Short
Dim length As Short
End Structure
Private Structure PRINT_GRIDLINES_RECORD
Dim opcode As Short
Dim length As Short
Dim PrintFlag As Short
End Structure
Private Structure tInteger
Dim opcode As Short
Dim length As Short
Dim row As Short
Dim col As Short
Dim rgbAttr1 As Byte
Dim rgbAttr2 As Byte
Dim rgbAttr3 As Byte
Dim intValue As Short
End Structure
Private Structure tNumber
Dim opcode As Short
Dim length As Short
Dim row As Short
Dim col As Short
Dim rgbAttr1 As Byte
Dim rgbAttr2 As Byte
Dim rgbAttr3 As Byte
Dim NumberValue As Double
End Structure
Private Structure tText
Dim opcode As Short
Dim length As Short
Dim row As Short
Dim col As Short
Dim rgbAttr1 As Byte
Dim rgbAttr2 As Byte
Dim rgbAttr3 As Byte
Dim TextLength As Byte
End Structure
Private Structure MARGIN_RECORD_LAYOUT
Dim opcode As Short
Dim length As Short
Dim MarginValue As Double
End Structure
Private Structure HPAGE_BREAK_RECORD
Dim opcode As Short
Dim length As Short
Dim NumPageBreaks As Short
End Structure
Private Structure DEF_ROWHEIGHT_RECORD
Dim opcode As Integer
Dim length As Integer
Dim RowHeight As Integer
End Structure
Private Structure ROW_HEIGHT_RECORD
Dim opcode As Integer
Dim length As Integer
Dim RowNumber As Integer
Dim FirstColumn As Integer
Dim LastColumn As Integer
Dim RowHeight As Integer
Dim internal As Integer
Dim DefaultAttributes As Byte
Dim FileOffset As Integer
Dim rgbAttr1 As Byte
Dim rgbAttr2 As Byte
Dim rgbAttr3 As Byte
End Structure
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef lpvDest As String, ByRef lpvSource As Short, ByVal cbCopy As Integer)
Private m_shtFileNumber As Short
Private m_udtBEG_FILE_MARKER As BEG_FILE_RECORD
Private m_udtEND_FILE_MARKER As END_FILE_RECORD
Private m_udtHORIZ_PAGE_BREAK As HPAGE_BREAK_RECORD
Private m_shtHorizPageBreakRows() As Short
Private m_shtNumHorizPageBreaks As Short
Public WriteOnly Property PrintGridLines() As Boolean
Set(ByVal Value As Boolean)
Try
Dim GRIDLINES_RECORD As PRINT_GRIDLINES_RECORD
With GRIDLINES_RECORD
.opcode = 43
.length = 2
If Value = True Then
.PrintFlag = 1
Else
.PrintFlag = 0
End If
End With
FilePut(m_shtFileNumber, GRIDLINES_RECORD)
Catch ex As Exception
End Try
End Set
End Property
Public WriteOnly Property ProtectSpreadsheet() As Boolean
Set(ByVal Value As Boolean)
Try
Dim PROTECT_RECORD As PROTECT_SPREADSHEET_RECORD
With PROTECT_RECORD
.opcode = 18
.length = 2
If Value = True Then
.Protect = 1
Else
.Protect = 0
End If
End With
FilePut(m_shtFileNumber, PROTECT_RECORD)
Catch ex As Exception
End Try
End Set
End Property
Public Sub GetExeclFile(ByVal FileName As String, ByVal StrSql As String)
Dim i As Integer = 0, j As Integer = 0
Dim Arr As Array = Nothing
Dim Brr As Array = Nothing
CreateFile(FileName)
PrintGridLines = False
SetMargin(ExcelFile.MarginTypes.xlsTopMargin, 1.5)
SetMargin(ExcelFile.MarginTypes.xlsLeftMargin, 1.5)
SetMargin(ExcelFile.MarginTypes.xlsRightMargin, 1.5)
SetMargin(ExcelFile.MarginTypes.xlsBottomMargin, 1.5)
SetFont("Microsoft Sans Serif", "9", ExcelFile.FontFormatting.xlsItalic)
SetColumnWidth(1, 20, 9)
SetHeader("This is the header")
SetFooter("This ia the footer")
If StrSql <> "" Then
Arr = Split(StrSql, RECORD_SPLITOR)
For i = 0 To UBound(Arr)
Brr = Split(Arr(i), FIELD_SPLITOR)
For j = 0 To UBound(Brr)
WriteValue(ExcelFile.ValueTypes.xlsText, ExcelFile.CellFont.xlsFont0, ExcelFile.CellAlignment.xlsCentreAlign, ExcelFile.CellHiddenLocked.xlsNormal, i + 1, j + 1, Brr(j))
Next
Next
End If
CloseFile()
End Sub
Public Function CreateFile(ByVal strFileName As String) As Integer
Dim OpenFile As Integer
Try
If File.Exists(strFileName) Then
File.SetAttributes(strFileName, FileAttributes.Normal)
File.Delete(strFileName)
End If
m_shtFileNumber = FreeFile()
'System.IO.File.Create(strFileName)
FileOpen(m_shtFileNumber, strFileName, OpenMode.Binary)
FilePut(m_shtFileNumber, m_udtBEG_FILE_MARKER)
Call WriteDefaultFormats()
ReDim m_shtHorizPageBreakRows(0)
m_shtNumHorizPageBreaks = 0
OpenFile = 0
Catch ex As Exception
OpenFile = Err.Number
End Try
End Function
Public Function CloseFile() As Integer
Dim x As Short
Try
If m_shtFileNumber > 0 Then
Dim lLoop1 As Integer
Dim lLoop2 As Integer
Dim lTemp As Integer
If m_shtNumHorizPageBreaks > 0 Then
For lLoop1 = UBound(m_shtHorizPageBreakRows) To LBound(m_shtHorizPageBreakRows) Step -1
For lLoop2 = LBound(m_shtHorizPageBreakRows) + 1 To lLoop1
If m_shtHorizPageBreakRows(lLoop2 - 1) > m_shtHorizPageBreakRows(lLoop2) Then
lTemp = m_shtHorizPageBreakRows(lLoop2 - 1)
m_shtHorizPageBreakRows(lLoop2 - 1) = m_shtHorizPageBreakRows(lLoop2)
m_shtHorizPageBreakRows(lLoop2) = lTemp
End If
Next lLoop2
Next lLoop1
With m_udtHORIZ_PAGE_BREAK
.opcode = 27
.length = 2 + (m_shtNumHorizPageBreaks * 2)
.NumPageBreaks = m_shtNumHorizPageBreaks
End With
FilePut(m_shtFileNumber, m_udtHORIZ_PAGE_BREAK)
For x = 1 To UBound(m_shtHorizPageBreakRows)
FilePut(m_shtFileNumber, MKI(m_shtHorizPageBreakRows(x)))
Next
End If
FilePut(m_shtFileNumber, m_udtEND_FILE_MARKER)
FileClose(m_shtFileNumber)
CloseFile = 0
Else
CloseFile = -1
End If
Catch ex As Exception
CloseFile = Err.Number
End Try
End Function
Private Sub Init()
With m_udtBEG_FILE_MARKER
.opcode = 9
.length = 4
.version = 2
.ftype = 10
End With
With m_udtEND_FILE_MARKER
.opcode = 10
End With
End Sub
Public Sub New()
MyBase.New()
Init()
End Sub
Public Function InsertHorizPageBreak(ByRef lrow As Integer) As Integer
Dim row As Short
Try
If lrow > 32767 Then
row = CShort(lrow - 65536)
Else
row = CShort(lrow) - 1
End If
m_shtNumHorizPageBreaks = m_shtNumHorizPageBreaks + 1
ReDim Preserve m_shtHorizPageBreakRows(m_shtNumHorizPageBreaks)
m_shtHorizPageBreakRows(m_shtNumHorizPageBreaks) = row
Catch ex As Exception
InsertHorizPageBreak = Err.Number
End Try
End Function
Public Function WriteValue(ByRef ValueType As ValueTypes, ByRef CellFontUsed As CellFont, ByRef Alignment As CellAlignment, ByRef HiddenLocked As CellHiddenLocked, ByRef lrow As Integer, ByRef lcol As Integer, ByRef Value As Object, Optional ByRef CellFormat As Integer = 0) As Integer
Dim l As Short
Dim st As String
Dim col As Short
Dim row As Short
Try
Dim INTEGER_RECORD As tInteger
Dim NUMBER_RECORD As tNumber
Dim TEXT_RECORD As tText
If lrow > 32767 Then
row = CShort(lrow - 65536)
Else
row = CShort(lrow) - 1
End If
If lcol > 32767 Then
col = CShort(lcol - 65536)
Else
col = CShort(lcol) - 1
End If
Select Case ValueType
Case ValueTypes.xlsInteger
With INTEGER_RECORD
.opcode = 2
.length = 9
.row = row
.col = col
.rgbAttr1 = CByte(HiddenLocked)
.rgbAttr2 = CByte(CellFontUsed + CellFormat)
.rgbAttr3 = CByte(Alignment)
.intValue = CShort(Value)
End With
FilePut(m_shtFileNumber, INTEGER_RECORD)
Case ValueTypes.xlsNumber
With NUMBER_RECORD
.opcode = 3
.length = 15
.row = row
.col = col
.rgbAttr1 = CByte(HiddenLocked)
.rgbAttr2 = CByte(CellFontUsed + CellFormat)
.rgbAttr3 = CByte(Alignment)
.NumberValue = CDbl(Value)
End With
FilePut(m_shtFileNumber, NUMBER_RECORD)
Case ValueTypes.xlsText
st = CType(Value, String)
l = GetLength(st)
With TEXT_RECORD
.opcode = 4
.length = 10
.TextLength = l
.length = 8 + l
.row = row
.col = col
.rgbAttr1 = CByte(HiddenLocked)
.rgbAttr2 = CByte(CellFontUsed + CellFormat)
.rgbAttr3 = CByte(Alignment)
FilePut(m_shtFileNumber, TEXT_RECORD)
FilePut(m_shtFileNumber, st)
End With
End Select
WriteValue = 0
Catch ex As Exception
WriteValue = Err.Number
End Try
End Function
Public Function SetMargin(ByRef Margin As MarginTypes, ByRef MarginValue As Double) As Integer
Try
Dim MarginRecord As MARGIN_RECORD_LAYOUT
With MarginRecord
.opcode = Margin
.length = 8
.MarginValue = MarginValue 'in inches
End With
FilePut(m_shtFileNumber, MarginRecord)
SetMargin = 0
Catch ex As Exception
SetMargin = Err.Number
End Try
End Function
Public Function SetColumnWidth(ByRef FirstColumn As Byte, ByRef LastColumn As Byte, ByRef WidthValue As Short) As Integer
Try
Dim COLWIDTH As COLWIDTH_RECORD
With COLWIDTH
.opcode = 36
.length = 4
.col1 = FirstColumn - 1
.col2 = LastColumn - 1
.ColumnWidth = WidthValue * 256
End With
FilePut(m_shtFileNumber, COLWIDTH)
SetColumnWidth = 0
Catch ex As Exception
SetColumnWidth = Err.Number
End Try
End Function
Public Function SetFont(ByRef FontName As String, ByRef FontHeight As Short, ByRef FontFormat As FontFormatting) As Short
Dim l As Short
Try
Dim FONTNAME_RECORD As FONT_RECORD
l = GetLength(FontName)
With FONTNAME_RECORD
.opcode = 49
.length = 5 + l
.FontHeight = FontHeight * 20
.FontAttributes1 = CByte(FontFormat)
.FontAttributes2 = CByte(0)
.FontNameLength = CByte(l)
End With
FilePut(m_shtFileNumber, FONTNAME_RECORD)
FilePut(m_shtFileNumber, FontName)
SetFont = 0
Catch ex As Exception
SetFont = Err.Number
End Try
End Function
Public Function SetHeader(ByRef HeaderText As String) As Integer
Dim l As Short
Try
Dim HEADER_RECORD As HEADER_FOOTER_RECORD
l = GetLength(HeaderText)
With HEADER_RECORD
.opcode = 20
.length = 1 + l
.TextLength = CByte(l)
End With
FilePut(m_shtFileNumber, HEADER_RECORD)
FilePut(m_shtFileNumber, HeaderText)
SetHeader = 0
Catch ex As Exception
SetHeader = Err.Number
End Try
End Function
Public Function SetFooter(ByRef FooterText As String) As Integer
Dim l As Short
Try
Dim FOOTER_RECORD As HEADER_FOOTER_RECORD
l = GetLength(FooterText)
With FOOTER_RECORD
.opcode = 21
.length = 1 + l
.TextLength = CByte(l)
End With
FilePut(m_shtFileNumber, FOOTER_RECORD)
FilePut(m_shtFileNumber, FooterText)
SetFooter = 0
Catch ex As Exception
SetFooter = Err.Number
End Try
End Function
Public Function SetFilePassword(ByRef PasswordText As String) As Integer
Dim l As Short
Try
Dim FILE_PASSWORD_RECORD As PASSWORD_RECORD
l = GetLength(PasswordText)
With FILE_PASSWORD_RECORD
.opcode = 47
.length = l
End With
FilePut(m_shtFileNumber, FILE_PASSWORD_RECORD)
FilePut(m_shtFileNumber, PasswordText)
SetFilePassword = 0
Catch ex As Exception
SetFilePassword = Err.Number
End Try
End Function
Private Function WriteDefaultFormats() As Integer
Dim cFORMAT_COUNT_RECORD As FORMAT_COUNT_RECORD
Dim cFORMAT_RECORD As FORMAT_RECORD
Dim lIndex As Integer
Dim aFormat(23) As String
Dim l As Integer
Dim q As String = 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) = "dd/mm/yy"
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) = "@"
With cFORMAT_COUNT_RECORD
.opcode = &H1FS
.length = &H2S
.Count = CShort(UBound(aFormat))
End With
FilePut(m_shtFileNumber, cFORMAT_COUNT_RECORD)
Dim b As Byte
Dim a As Integer
For lIndex = LBound(aFormat) To UBound(aFormat)
l = Len(aFormat(lIndex))
With cFORMAT_RECORD
.opcode = &H1ES
.length = CShort(l + 1)
.FormatLenght = CShort(l)
End With
FilePut(m_shtFileNumber, cFORMAT_RECORD)
For a = 1 To l
b = Asc(Mid(aFormat(lIndex), a, 1))
FilePut(m_shtFileNumber, b)
Next
Next lIndex
End Function
Private Function MKI(ByRef x As Short) As String
Dim temp As String
temp = Space(2)
CopyMemory(temp, x, 2)
MKI = temp
End Function
Private Function GetLength(ByVal strText As String) As Integer
Return Encoding.Default.GetBytes(strText).Length
End Function
Public Function SetDefaultRowHeight(ByVal HeightValue As Integer) As Integer
Try
Dim DEFHEIGHT As DEF_ROWHEIGHT_RECORD
With DEFHEIGHT
.opcode = 37
.length = 2
.RowHeight = HeightValue * 20
End With
FilePut(m_shtFileNumber, DEFHEIGHT)
SetDefaultRowHeight = 0
Catch ex As Exception
SetDefaultRowHeight = Err.Number
End Try
End Function
Public Function SetRowHeight(ByVal Row As Integer, ByVal HeightValue As Short) As Integer
Dim o_intRow As Integer
Try
If Row > 32767 Then
o_intRow = CInt(Row - 65536)
Else
o_intRow = CInt(Row) - 1
End If
Dim ROWHEIGHTREC As ROW_HEIGHT_RECORD
With ROWHEIGHTREC
.opcode = 8
.length = 16
.RowNumber = o_intRow
.FirstColumn = 0
.LastColumn = 256
.RowHeight = HeightValue * 20
.internal = 0
.DefaultAttributes = 0
.FileOffset = 0
.rgbAttr1 = 0
.rgbAttr2 = 0
.rgbAttr3 = 0
End With
FilePut(m_shtFileNumber, ROWHEIGHTREC)
SetRowHeight = 0
Catch ex As Exception
SetRowHeight = Err.Number
End Try
End Function
End Class