extablectrl.vb

扩展表格控件ExTableCtrl 扩展表格控件ExTableCtrl

Option Strict On
Imports System.ComponentModel
Public Class ExTableCtrl
    Inherits System.Windows.Forms.Control

    Dim BLinewidth As Single = 4.0F   '表格外框宽度
    Dim ILinewidth As Integer = 1  '表格内线宽度
    Dim TRowNum As Byte = 2       '表格的行数
    Dim TColNum(30) As Byte  '各行的列数
    Dim RowHeight(30) As Single         '表格中每行的高度
    Dim RowHC As String              '接收表格中每行的高度字符数字符串
    Dim RowHChar(30) As Integer               '表格中每行的高度(字符数)
    Dim ColWidth(30, 30) As Single           '每行中列的宽度
    Dim mDown As Boolean = False    '鼠标指针按下标志
    Dim RCNum As String = "2"
    Dim DataElect(100) As String    '存入数据库存中字段的名称和值
    Dim RCWidth As String
    Dim RCWidthChar(30, 30) As Integer  '每行每列字符数
    Dim Index As Integer = 0 '记录索引
#Region " Windows 窗体设计器生成的代码 "

    Public Sub New()
        MyBase.New()

        '该调用是 Windows 窗体设计器所必需的。
        InitializeComponent()

        '在 InitializeComponent() 调用之后添加任何初始化
        Dim i As Byte, j As Byte
        For i = 0 To 30 '初始化默认每行列数和列宽
            TColNum(i) = 2
            RowHChar(i) = 1
            For j = 0 To 30
                RCWidthChar(i, j) = 6
            Next j
            ColWidth(i, 0) = 0
            ColWidth(i, 1) = 0.5
            ColWidth(i, 2) = 1
        Next i
        RowHeight(0) = 0    '初始化默认行高
        RowHeight(1) = 0.5
        RowHeight(2) = 1

    End Sub

    'UserControl1 重写 dispose 以清理组件列表。
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Windows 窗体设计器所必需的
    Private components As System.ComponentModel.IContainer

    '注意: 以下过程是 Windows 窗体设计器所必需的
    '可以使用 Windows 窗体设计器修改此过程。
    '不要使用代码编辑器修改它。
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        components = New System.ComponentModel.Container
    End Sub

#End Region

    Private WithEvents cm As CurrencyManager
    Private m_ValueMember As String
    Private m_DataSource As Object

    <Category("Data")> _
Public Property DataSource() As Object
        Get
            Return m_DataSource
        End Get
        Set(ByVal Value As Object)
            If Value Is Nothing Then '数据源没设或设为Nothing
                cm = Nothing
                FillStrArray() '填充数据
            Else '否则
                If Not (TypeOf Value Is IList Or _
                          TypeOf Value Is IListSource) Then '非IList或IListSource
                    Throw New System.Exception("无效 DataSource")
                Else
                    If TypeOf Value Is IListSource Then '是IListSource
                        Dim myListSource As IListSource
                        myListSource = CType(Value, IListSource)
                        If myListSource.ContainsListCollection = True Then '若含多个IList,不合适
                            Throw New System.Exception("无效 DataSource")
                        Else '正确数据源
                            m_DataSource = Value
                            cm = CType(Me.BindingContext(Value), _
                                CurrencyManager)
                            FillStrArray()
                        End If
                    Else '正确数据源
                        m_DataSource = Value
                        cm = CType(Me.BindingContext(Value), _
                            CurrencyManager)
                        FillStrArray()
                    End If
                End If
            End If
        End Set
    End Property
    <Description("表格中行数")> _
   Public Property 行数() As Byte
        Get
            Return TRowNum
        End Get
        Set(ByVal Value As Byte)
            If Value < 1 Then
                MsgBox("表格中行数不能小于1")
                Exit Property
            End If
            Dim i As Byte, j As Byte
            If TRowNum <> Value Then    '现行数与原来不同处理,否则不处理
                'If Value > TRowNum Then '现设置行数比原来多,处理
                'For i = CByte(TRowNum) To Value  '设置增加行的列数与这上面的相同
                'TColNum(i) = TColNum(i - 1)
                'For j = 0 To CByte(TColNum(i) - 1)
                'ColWidth(i, j) = ColWidth(i - 1, j)
                'Next j
                'Next i
                'End If
                TRowNum = Value
                'RowHeight(0) = 0 '设置行高
                'For i = 1 To CByte(TRowNum)
                'RowHeight(i) = CSng(RowHeight(i - 1) + 1 / TRowNum)
                'Next i
                Dim SumChar As Integer = 0
                For i = 0 To 30 'CByte(TRowNum - 1) '计算每行的高度
                    If RowHChar(i) = 0 Then  '如果某行高为零,与上一行高相同
                        RowHChar(i) = RowHChar(i - 1)
                    End If
                Next i
                For i = 0 To CByte(TRowNum - 1) '统计字符数
                    SumChar = SumChar + RowHChar(i)
                Next i
                RowHeight(0) = 0
                For j = 1 To CByte(TRowNum - 1) 'CByte(RowHChar(i) - 1)  '计算行高
                    RowHeight(j) = RowHChar(j - 1) * CSng(1 / SumChar) + RowHeight(j - 1)
                Next j
                RowHeight(j) = 1.0F '设置右边线的位置
                'Next i
                Me.Height = SumChar * (Me.Font.Height + ILinewidth)
                Me.Invalidate()
            End If
        End Set
    End Property
    <Description("设置表格中每行中高度(字符的行数),各数字用逗号','隔开,如果以后各行与前同,可省")> _
       Public Property 行高() As String
        Get
            Return RowHC
        End Get
        Set(ByVal Value As String)
            Dim i As Int32, j As Int32 = 1, Comma(16) As Int32 '存放逗号位置变量
            Dim Commf As Boolean = False
            RowHC = Value               '把值给变量
            If Value <> "" Then         'Value不空时处理
                Comma(0) = -1
                For i = 0 To Value.Length - 1
                    If Value.Chars(i) = "," And Commf = False Then
                        Comma(j) = i
                        j = j + 1
                        Commf = True
                    Else
                        Commf = False
                    End If
                Next i
                Comma(j) = i
                For i = 0 To j - 1 '每行的高度
                    RowHChar(i) = CByte(Val(Mid(Value, Comma(i) + 2, Comma(i + 1) - Comma(i) - 1)))
                Next i
                While i <= 30   '其它各行的列数为零
                    RowHChar(i) = 0
                    i = i + 1
                End While
                Dim SumChar As Integer = 0
                For i = 0 To 30 'CByte(TRowNum - 1) '计算每行的高度
                    If RowHChar(i) = 0 Then  '如果某行高为零,与上一行高相同
                        RowHChar(i) = RowHChar(i - 1)
                    End If
                Next i
                For i = 0 To CByte(TRowNum - 1) '统计字符数
                    SumChar = SumChar + RowHChar(i)
                Next i
                RowHeight(0) = 0
                For j = 1 To CByte(TRowNum - 1) 'CByte(RowHChar(i) - 1)  '计算行高
                    RowHeight(j) = RowHChar(j - 1) * CSng(1 / SumChar) + RowHeight(j - 1)
                Next j
                RowHeight(j) = 1.0F '设置右边线的位置
                'Next i
                Me.Height = SumChar * (Me.Font.Height + ILinewidth)
                Me.Invalidate()
            End If
        End Set
    End Property
    <Description("设置表格中每行中列数,各数字用逗号','隔开,如果以后各行与前同,可省")> _
       Public Property 行中列数() As String
        Get
            Return RCNum
        End Get
        Set(ByVal Value As String)
            Dim i As Int32, j As Int32 = 1, Comma(16) As Int32 '存放逗号位置变量
            Dim Commf As Boolean = False
            RCNum = Value               '把值给变量
            If Value <> "" Then         'Value不空时处理
                Comma(0) = -1
                For i = 0 To Value.Length - 1
                    If Value.Chars(i) = "," And Commf = False Then
                        Comma(j) = i
                        j = j + 1
                        Commf = True
                    Else
                        Commf = False
                    End If
                Next i
                Comma(j) = i
                For i = 0 To j - 1 '每行的列数
                    TColNum(i) = CByte(Val(Mid(Value, Comma(i) + 2, Comma(i + 1) - Comma(i) - 1)))
                Next i
                While i <= 30   '其它各行的列数为零
                    TColNum(i) = 0
                    i = i + 1
                End While
                Dim h As Integer
                For i = 0 To 30 'CByte(TRowNum - 1) '计算每行中每列的宽度
                    If TColNum(i) = 0 Then  '如果某行列数为零,与上一行列数相同
                        TColNum(i) = TColNum(i - 1)
                    End If
                    For j = 0 To CByte(TColNum(i) - 1)  '计算没指定宽度列的宽度与前同(字符数)
                        If RCWidthChar(i, j) = 0 Then
                            RCWidthChar(i, j) = RCWidthChar(i, j - 1)
                        End If
                    Next j
                    h = 0
                    For j = 0 To CByte(TColNum(i) - 1)  '计算列中总宽度(字符数)
                        h = h + RCWidthChar(i, j)
                    Next j
                    ColWidth(i, 0) = 0
                    For j = 1 To CByte(TColNum(i) - 1)  '计算列宽
                        ColWidth(i, j) = CSng(ColWidth(i, j - 1) + RCWidthChar(i, j - 1) / h)
                    Next j
                    ColWidth(i, j) = 1.0F '设置右边线的位置

                Next i
                Me.Invalidate()
            End If
        End Set
    End Property
    <Description("设置表格中每行中每列的宽度(字符数),不同行数字用分号';'隔开,同行数字用逗号','隔开,其中第一个数字为行号,其余为列宽,如果以后各行与前同,可省")> _
        Public Property 行中列宽() As String
        Get
            Return RCWidth
        End Get
        Set(ByVal Value As String)
            Dim i As Int32, j As Int32, Comma(16) As Int32  '存放逗号位置变量
            Dim Commf As Boolean = False, Semicolon(30) As Integer '存放分号位置
            Dim RCWidthStr(30) As String
            Dim k As Integer, h As Integer, x As Integer, y As Integer = 1
            RCWidth = Value               '把值给变量
            If Value <> "" Then         'Value不空时处理
                Semicolon(0) = -1
                For i = 0 To Value.Length - 1
                    If Value.Chars(i) = ";" And Commf = False Then
                        Semicolon(y) = i
                        y = y + 1
                        Commf = True
                    Else
                        Commf = False
                    End If
                Next i
                Semicolon(y) = i 'Comma(j) = i