用VB.Net编写通用报表组件（4） - VB教程 - 新闻中心 - PHP168整站系统 powered by www.php168.com

文章内容

、定义一窗体frmPrintSetup，该窗体给用户提供可视化操作的报表控制界面。 方法是向工程中增加一Window窗体，命名为frmPrintSetup。向窗体中加入一工具控件ToolBar1，向ToolBar1中添加按钮tlbAll（全选）、tlbClear（清除）、tlbBrowse（预览）、tlbPrint（打印）、tlbSave（保存）、tlbColor（颜色）、tlbFont（字体）、tlbExit（退出），一网格控件MsGrid1，文本控件txtFileTitle、txtSubTitle、TextBox2，下拉组合框控件ComboBox2(设置)、ComboBox4(线重)、ComboBox3(线型)、ComboBox1(对齐)、ComboBox5(插入)，在ComboBox2中填充数据“边框，内部”，ComboBox4填充数据“微线，细线，着重线，普通线”，ComboBox3填充数据“无线，实线，虚线，点线，点虚线，双点虚线，斜线，双线”，ComboBox1填充数据“居左，居中，居右”，ComboBox5填充数据“页首插入页码，页尾插入页码，页首插入日期，页尾插入日期，页首插入单位（人），页尾插入单位（人），不插入”，向窗体中加入标签lblInsert其值为“第X码共Y页”、lblMailTitle其值为"第X码共Y页"正标题"、lblSubTitle其值为"第X码共Y页"副标题"、lblHead其值为"第X码共Y页"表头..."、lblFond其值为"第X码共Y页"表体..."；向窗体中加入非可视的控件PrintDocument1（打印设置）、PageSetupDialog1（打印页设置）、FontDialog1（字体设置）、ColorDialog1（颜色设置）、ImageList1（图片）、SaveFileDialog1（保存）。如下：

在窗体frmPrintSetup中定义变量：MainTitle、SubTitle、mDataTable、IsWriteDataToExcel、mCurrTitle, mCurrLine，并申请类CExcelReport的实类mReport。如下：

        Public MainTitle As String                  '文件的大标题--一般为"**学校**系统"
        Public SubTitle As String 
	'文件的次标题--一般为要打印的窗体的title

        '私有数据，内部使用
        Private mDataTable As DataTable             '要打印的网格控件
        Dim mReport As New CExcelReport()
        Private IsWriteDataToExcel As Boolean       '是否写数据到Excel了
        Private mCurrTitle, mCurrLine As Int16

          Public Property DataTable() As DataTable
            Get
                DataTable = mDataTable
            End Get
            Set(ByVal Value As DataTable)
                mDataTable = Value
            End Set
        End Property

'在Load方法中初使化一些数据。报表保存为Excel、dbf、wdl、dif等类式文件，把获得的数据表的列转换为行并填充网格，同时向Excel填充数据。

        Private Sub frmPrintSetup_Load(ByVal sender As System.Object, ByVal e As 
System.EventArgs) Handles MyBase.Load
            txtFileTitle.Text = MainTitle
            txtSubTitle.Text = SubTitle

            With SaveFileDialog1
                .Title = "保存报表"
                .Filter = 
"Excel文件（*.xls)|*.xls|文本文件（*.txt)|*.txt|Web页（*.htm;*.html)
|*.htm|Excel 50/95 工作簿（*.xls)|*.xls|Excel 97-2000工作簿（*.xls)|*.xls|Excel 
4.0（*.xls)|*.xls|DBF 4(dBASEⅣ*.dbf)|*.dbf|DBF 3(dBASEⅢ*.dbf)|*.dbf " & _
                      " |WD1(1-2-3)(*.wdl)|*.wdl|WKS(Works
		     *.wks)|*.wks|DIF(数据交换格式*.dif)|*.dif"
                ' .InitialDirectory = App.Path
                '.Flags = cdlOFNHideReadOnly + cdlOFNPathMustExist + 
cdlOFNNoReadOnlyReturn
                .FileName = txtFileTitle.Text
            End With
            FillMsGrid()
            If IsWriteDataToExcel = False Then
                WriteDataToExcel()
            End If
        End Sub
'把获得的数据表的列转换为行并填充网格，网格的首列供用户选择所报表的列。
        Private Sub FillMsGrid()
            Dim i, RowCount As Int16

            RowCount = DataTable.Columns.Count
            With MsGrid1
                .set_ColWidth(0, 350)
                .set_ColWidth(1, 1500)
                .set_ColWidth(2, 0)
                .Rows = RowCount
                For i = 0 To RowCount - 1

                    .set_TextMatrix(i, 1, DataTable.Columns(i).Caption)
                    .set_TextMatrix(i, 2, True)
                    .Row = i
                    .CellPicture = ImageList1.Images(0)

                Next i
            End With
        End Sub

'用户是否选择了该行。
        Private Sub SelectRow(ByVal RowIndex As Long, ByVal IsSelected As Boolean)
            Dim i, Cols As Integer

            IsWriteDataToExcel = False
            With MsGrid1
                If RowIndex >= .Rows Then
                    Exit Sub
                End If
                If .get_TextMatrix(RowIndex, 2) = IsSelected Then
                    Exit Sub
                End If
                .Row = RowIndex
                .Col = 0
                If IsSelected = True Then
                    .CellPicture = ImageList1.Images(0)
                Else
                    .CellPicture = ImageList1.Images(1)
                End If
                .set_TextMatrix(RowIndex, 2, IsSelected)
            End With
        End Sub


        Private Sub mnuPrintSetup_Click(ByVal sender As System.Object, ByVal e As 
System.EventArgs)
            PageSetupDialog1.Document = PrintDocument1
            PageSetupDialog1.ShowDialog()
            If PageSetupDialog1.PageSettings.Landscape = True Then
                mReport.Data.IsPage.Landscape = Excel.XlPageOrientation.xlLandscape
            Else
                mReport.Data.IsPage.Landscape = Excel.XlPageOrientation.xlPortrait
            End If
            mReport.SetPage()
        End Sub
'定义工具栏的功能。
        Private Sub ToolBar1_ButtonClick_1(ByVal sender As System.Object, ByVal e As 
System.Windows.Forms.ToolBarButtonClickEventArgs) Handles ToolBar1.ButtonClick

            Dim i, j As Long

            Select Case e.Button.Text
                Case "全选"
                    For i = 0 To MsGrid1.Rows - 1
                        SelectRow(i, True)
                    Next
                    Exit Sub
                Case "清除"
                    For i = 0 To MsGrid1.Rows - 1
                        SelectRow(i, False)
                    Next
                    Exit Sub
                Case "预览"
                    If IsWriteDataToExcel = False Then
                        WriteDataToExcel()
                    End If
                    mReport.PrintPreview()
                    Exit Sub
                Case "字体"
                    FontDialog1.ShowDialog()
                Case "颜色"
                    ColorDialog1.ShowDialog()
                Case "打印"
                    If IsWriteDataToExcel = False Then
                        WriteDataToExcel()
                    End If
                    mReport.Print()
                    Exit Sub
                Case "保存"
                    If IsWriteDataToExcel = False Then
                        WriteDataToExcel()
                    End If
                    SaveFileDialog1.FileName = txtFileTitle.Text
                    SaveFileDialog1.ShowDialog()
                    mReport.SaveAs(SaveFileDialog1.FileName)
                    Exit Sub
            End Select

            Select Case mCurrTitle
                Case 0
                    ' lblInsert()
                Case 1
                    lblMailTitle.Font = FontDialog1.Font
                    lblMailTitle.ForeColor = ColorDialog1.Color

                    With mReport.Data.MainTitle.ItemFont
                        .Bold = lblMailTitle.Font.Bold
                        .Italic = lblMailTitle.Font.Italic
                        .Underline = lblMailTitle.Font.Underline
                        .Name = lblMailTitle.Font.Name
                        .Size = lblMailTitle.Font.Size
                        .ForeColor = lblMailTitle.ForeColor.ToKnownColor
                    End With
                    mReport.SetCellFont(mReport.Data.MainTitle)
                Case 2
                    lblSubTitle.Font = FontDialog1.Font
                    lblSubTitle.ForeColor = ColorDialog1.Color

                    With mReport.Data.SubTitle.ItemFont
                        .Bold = lblSubTitle.Font.Bold
                        .Italic = lblSubTitle.Font.Italic
                        .Underline = lblSubTitle.Font.Underline
                        .Name = lblSubTitle.Font.Name
                        .Size = lblSubTitle.Font.Size
                        .ForeColor = lblSubTitle.ForeColor.ToKnownColor
                    End With
                    mReport.SetCellFont(mReport.Data.SubTitle)
                Case 3
                    lblHead.Font = FontDialog1.Font
                    lblHead.ForeColor = ColorDialog1.Color

                    For i = 0 To mReport.Data.GridColCount - 1
                        With mReport.Data.GridHeads(i).ItemFont
                            .Bold = lblHead.Font.Bold
                            .Italic = lblHead.Font.Italic
                            .Underline = lblHead.Font.Underline
                            .Name = lblHead.Font.Name
                            .Size = lblHead.Font.Size
                            .ForeColor = lblHead.ForeColor.ToKnownColor
                        End With
                    Next
                    mReport.SetCellFont(mReport.Data.GridHeads(0))
                Case 4
                    lblFond.Font = FontDialog1.Font
                    lblFond.ForeColor = ColorDialog1.Color

                    For i = 0 To mReport.Data.GridRowCount - 1
                        For j = 0 To mReport.Data.GridColCount - 1
                            With mReport.Data.GridBodys(i, j).ItemFont
                                .Bold = lblFond.Font.Bold
                                .Italic = lblFond.Font.Italic
                                .Underline = lblFond.Font.Underline
                                .Name = lblFond.Font.Name
                                .Size = lblFond.Font.Size
                                .ForeColor = lblFond.ForeColor.ToKnownColor
                            End With
                        Next
                        mReport.SetCellFont(mReport.Data.GridBodys(i, 0))
                    Next
            End Select

        End Sub

        Private Sub MsGrid1_ClickEvent(ByVal sender As Object, ByVal e As 
System.EventArgs) Handles MsGrid1.ClickEvent
            With MsGrid1
                If .get_TextMatrix(.RowSel, 2) = True Then
                    SelectRow(.Row, False)
                Else
                    SelectRow(.Row, True)
                End If
            End With
        End Sub
'向Excel写入数据
        Private Function WriteDataToExcel() As Boolean
            Dim dt As New DataTable()
            Dim name As String
            Dim i As Int16

            With mReport
                .MainTitle = txtFileTitle.Text
                .SubTitle = txtSubTitle.Text
                .Data.IsPeople.Text = TextBox2.Text

                dt = DataTable.Copy
                For i = 0 To DataTable.Columns.Count - 1
                    If MsGrid1.get_TextMatrix(i, 2) = False Then
                        name = DataTable.Columns(i).ColumnName
                        dt.Columns.Remove(name)
                    End If
                Next
                .DataTable = dt
            End With
            mReport.PrintExcel()

            IsWriteDataToExcel = True
        End Function

        Private Sub lblMailTitle_Click(ByVal sender As System.Object, ByVal e As 
System.EventArgs) Handles lblMailTitle.Click

            Me.lblFond.BorderStyle = BorderStyle.None
            Me.lblHead.BorderStyle = BorderStyle.None
            Me.lblInsert.BorderStyle = BorderStyle.None
            Me.lblSubTitle.BorderStyle = BorderStyle.None

            lblMailTitle.BorderStyle = BorderStyle.FixedSingle
            mCurrTitle = 1

            Me.tlbColor.Enabled = True
            Me.tlbFont.Enabled = True
            ComboBox1.Enabled = True
            ComboBox3.Enabled = True
            ComboBox4.Enabled = True
        End Sub

        Private Sub lblSubTitle_Click(ByVal sender As System.Object, ByVal e As 
System.EventArgs) Handles lblSubTitle.Click
            Me.lblFond.BorderStyle = BorderStyle.None
            Me.lblHead.BorderStyle = BorderStyle.None
            Me.lblInsert.BorderStyle = BorderStyle.None
            Me.lblMailTitle.BorderStyle = BorderStyle.None

            lblSubTitle.BorderStyle = BorderStyle.FixedSingle
            mCurrTitle = 2

            Me.tlbColor.Enabled = True
            Me.tlbFont.Enabled = True
            ComboBox1.Enabled = True
            ComboBox3.Enabled = True
            ComboBox4.Enabled = True
        End Sub

        Private Sub lblHead_Click(ByVal sender As System.Object, ByVal e As 
System.EventArgs) Handles lblHead.Click
            Me.lblFond.BorderStyle = BorderStyle.None
            Me.lblSubTitle.BorderStyle = BorderStyle.None
            Me.lblInsert.BorderStyle = BorderStyle.None
            Me.lblMailTitle.BorderStyle = BorderStyle.None

            lblHead.BorderStyle = BorderStyle.FixedSingle
            mCurrTitle = 3

            Me.tlbColor.Enabled = True
            Me.tlbFont.Enabled = True
            ComboBox1.Enabled = True
            ComboBox3.Enabled = True
            ComboBox4.Enabled = True
        End Sub

        Private Sub lblFond_Click(ByVal sender As System.Object, ByVal e As 
System.EventArgs) Handles lblFond.Click
            Me.lblHead.BorderStyle = BorderStyle.None
            Me.lblSubTitle.BorderStyle = BorderStyle.None
            Me.lblInsert.BorderStyle = BorderStyle.None
            Me.lblMailTitle.BorderStyle = BorderStyle.None

            lblFond.BorderStyle = BorderStyle.FixedSingle
            mCurrTitle = 4

            Me.tlbColor.Enabled = True
            Me.tlbFont.Enabled = True
            ComboBox1.Enabled = True
            ComboBox3.Enabled = True
            ComboBox4.Enabled = True
        End Sub

        'Private Sub lblInsert_Click(ByVal sender As System.Object, ByVal e As 
System.EventArgs) Handles lblInsert.Click
        '    Me.lblHead.BorderStyle = BorderStyle.None
        '    Me.lblSubTitle.BorderStyle = BorderStyle.None
        '    Me.lblFond.BorderStyle = BorderStyle.None
        '    Me.lblMailTitle.BorderStyle = BorderStyle.None

        '    lblInsert.BorderStyle = BorderStyle.FixedSingle
        '    mCurrTitle = 0
        'End Sub

        Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As System.Object, 
ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
            Dim Postion As Int16
            Dim Align As Excel.XlHAlign

            Select Case ComboBox1.SelectedIndex
                Case 0
                    Postion = 36
                    Align = Excel.Constants.xlLeft
                Case 1
                    Postion = 64
                    Align = Excel.Constants.xlCenter
                Case 2
                    Postion = 100
                    Align = Excel.Constants.xlRight
            End Select

            Select Case mCurrTitle
                Case 0
                    ' lblInsert()
                Case 1
                    lblMailTitle.Left = Postion
                    mReport.Data.MainTitle.Alignment = Align
                    mReport.SetExcelBorde(mReport.Data.MainTitle)
                Case 2
                    lblSubTitle.Left = Postion
                    mReport.Data.SubTitle.Alignment = Align
                    mReport.SetExcelBorde(mReport.Data.SubTitle)

                Case 3
                    Me.lblHead.Left = Postion

                    mReport.Data.GridHeads(0).Alignment = Align
                    mReport.SetExcelBorde(mReport.Data.GridHeads(0))
                Case 4
                    Me.lblFond.Left = Postion

                    mReport.Data.GridBodys(0, 0).Alignment = Align
                    mReport.SetExcelFontBorde(mReport.Data.GridBodys(0, 0))
            End Select

        End Sub

        Private Sub ComboBox2_SelectedIndexChanged(ByVal sender As System.Object, 
ByVal e As System.EventArgs) Handles ComboBox2.SelectedIndexChanged
            mCurrLine = ComboBox2.SelectedIndex
        End Sub

        Private Sub ComboBox3_SelectedIndexChanged(ByVal sender As System.Object, 
ByVal e As System.EventArgs) Handles ComboBox3.SelectedIndexChanged
            Dim LineType As Excel.XlLineStyle

            Select Case ComboBox3.SelectedIndex
                Case 0
                    LineType = Excel.XlLineStyle.xlLineStyleNone ' .Constants.xlNone
                Case 1
                    LineType = Excel.XlLineStyle.xlContinuous  '连续线  
                Case 2
                    LineType = Excel.XlLineStyle.xlDash
                Case 3
                    LineType = Excel.XlLineStyle.xlDot
                Case 4
                    LineType = Excel.XlLineStyle.xlDashDot
                Case 5
                    LineType = Excel.XlLineStyle.xlDashDotDot
                Case 6
                    LineType = Excel.XlLineStyle.xlSlantDashDot
                Case 7
                    LineType = Excel.XlLineStyle.xlDouble

            End Select

            Select Case mCurrTitle

                Case 1

                    mReport.Data.MainTitle.LineType = LineType
                    mReport.SetExcelBorde(mReport.Data.MainTitle)
                Case 2

                    mReport.Data.SubTitle.LineType = LineType
                    mReport.SetExcelBorde(mReport.Data.SubTitle)

                Case 3
                    If mCurrLine = 1 Then
                        mReport.Data.GridHeads(0).InsideVertical = LineType
                        mReport.Data.GridHeads(0).InsideWeight = LineType
                    Else
                        mReport.Data.GridHeads(0).LineType = LineType
                    End If
                    mReport.SetExcelBorde(mReport.Data.GridHeads(0))

                Case 4
                    If mCurrLine = 1 Then
                        mReport.Data.GridBodys(0, 0).InsideVertical = LineType
                        mReport.Data.GridBodys(0, 0).InsideHorizontal = LineType
                    Else
                        mReport.Data.GridBodys(0, 0).LineType = LineType
                    End If
                    mReport.SetExcelFontBorde(mReport.Data.GridBodys(0, 0))
            End Select
        End Sub

        Private Sub ComboBox4_SelectedIndexChanged(ByVal sender As System.Object, 
ByVal e As System.EventArgs) Handles ComboBox4.SelectedIndexChanged
            Dim LineWeight As Excel.XlBorderWeight

            Select Case ComboBox4.SelectedIndex
                Case 0
                    LineWeight = Excel.XlBorderWeight.xlHairline
                Case 1
                    LineWeight = Excel.XlBorderWeight.xlThin
                Case 2
                    LineWeight = Excel.XlBorderWeight.xlThick
                Case 3
                    LineWeight = Excel.XlBorderWeight.xlMedium

            End Select

            Select Case mCurrTitle

                Case 1

                    mReport.Data.MainTitle.LineWeight = LineWeight
                    mReport.SetExcelBorde(mReport.Data.MainTitle)
                Case 2

                    mReport.Data.SubTitle.LineWeight = LineWeight
                    mReport.SetExcelBorde(mReport.Data.SubTitle)

                Case 3
                    If mCurrLine = 1 Then
                        mReport.Data.GridHeads(0).InsideWeight = LineWeight
                    Else
                        mReport.Data.GridHeads(0).LineWeight = LineWeight
                    End If
                    mReport.SetExcelBorde(mReport.Data.GridHeads(0))
                Case 4
                    If mCurrLine = 1 Then
                        mReport.Data.GridBodys(0, 0).InsideWeight = LineWeight
                    Else
                        mReport.Data.GridBodys(0, 0).LineType = LineWeight
                    End If

                    mReport.SetExcelFontBorde(mReport.Data.GridBodys(0, 0))
            End Select
        End Sub

        Private Sub ComboBox5_SelectedIndexChanged(ByVal sender As System.Object, 
ByVal e As System.EventArgs) Handles ComboBox5.SelectedIndexChanged

            lblInsert1.Text = Date.UtcNow
            Select Case sender.SelectedIndex
                Case 0
                    lblInsert.Visible = True
                    lblInsert.Top = 23
                    mReport.Data.IsPage.IsPrint = True
                    mReport.Data.IsPage.PrintPostion = 0
                Case 1
                    lblInsert.Visible = True
                    lblInsert.Top = 23
                    mReport.Data.IsPage.IsPrint = True
                    lblInsert.Top = 74
                    mReport.Data.IsPage.PrintPostion = 1
                Case 2

                    lblInsert1.Visible = True
                    lblInsert1.Top = 23
                    mReport.Data.IsTime.IsPrint = True
                    mReport.Data.IsTime.PrintPostion = 0
                Case 3
                    lblInsert1.Visible = True
                    lblInsert1.Top = 74
                    mReport.Data.IsTime.IsPrint = True
                    mReport.Data.IsTime.PrintPostion = 1
                Case 4
                    lblInsert2.Visible = True
                    lblInsert2.Top = 23
                    mReport.Data.IsPeople.IsPrint = True
                    mReport.Data.IsPeople.PrintPostion = 0
                    TextBox2.Enabled = True
                    TextBox2.Focus()
                Case 5
                    lblInsert2.Visible = True
                    lblInsert2.Top = 74
                    mReport.Data.IsPeople.IsPrint = True
                    mReport.Data.IsPeople.PrintPostion = 1
                    TextBox2.Enabled = True
                    TextBox2.Focus()
                Case 6
                    lblInsert.Visible = False
                    lblInsert1.Visible = False
                    lblInsert2.Visible = False
                    mReport.Data.IsPage.IsPrint = False
                    mReport.Data.IsTime.IsPrint = False
                    mReport.Data.IsPeople.IsPrint = False
                    TextBox2.Enabled = False
            End Select
            mReport.SetPage()
        End Sub

        Private Sub TextBox2_TextChanged(ByVal sender As System.Object, ByVal e As 
System.EventArgs) Handles TextBox2.TextChanged
            lblInsert1.Text = TextBox2.Text
            mReport.Data.IsPeople.Text = TextBox2.Text
            mReport.SetPage()
            lblInsert1.Visible = True
        End Sub

        Private Sub txtFileTitle_TextChanged(ByVal sender As System.Object, ByVal e 
As System.EventArgs) Handles txtFileTitle.TextChanged
            IsWriteDataToExcel = False
        End Sub

        Private Sub txtSubTitle_TextChanged(ByVal sender As System.Object, ByVal e As 
System.EventArgs) Handles txtSubTitle.TextChanged
            IsWriteDataToExcel = False
        End Sub

7、把上面的代码加入到Reopot命名空间中，以使整个组件封装在命名空间中, 把frmPrintSetup改为Friend，原因如上。代码如下：

    Imports System.Windows.Forms
Namespace Reopot
    Friend Class frmPrintSetup
        Inherits System.Windows.Forms.Form

        Public MainTitle As String                 '文件的大标题--一般为"**学校**系统"
        Public SubTitle As String                  
	'文件的次标题--一般为要打印的窗体的title

        '私有数据，内部使用
        Private mDataTable As DataTable             '要打印的网格控件
        Dim mReport As New CExcelReport()
        Private IsWriteDataToExcel As Boolean       '是否写数据到Excel了
        Private mCurrTitle, mCurrLine As Int16
   …
        Public Property DataTable() As DataTable
            Get
                DataTable = mDataTable
            End Get
            Set(ByVal Value As DataTable)
                mDataTable = Value
            End Set
  End Property
…
End Class
End Namespace

【