extablectrl.vb

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

                For i = 0 To y - 1 '每行字符串
                    RCWidthStr(i) = Mid(Value, Semicolon(i) + 2, Semicolon(i + 1) - Semicolon(i) - 1)
                Next i
                For k = 0 To y - 1
                    h = 1
                    Comma(0) = -1
                    For i = 0 To RCWidthStr(k).Length - 1
                        If RCWidthStr(k).Chars(i) = "," And Commf = False Then
                            Comma(h) = i
                            h = h + 1
                            Commf = True
                        Else
                            Commf = False
                        End If
                    Next i
                    Comma(h) = i
                    x = CByte(Val(Mid(RCWidthStr(k), Comma(0) + 2, Comma(1))))
                    For i = 1 To h - 1 '每行的列宽
                        RCWidthChar(x, i - 1) = CByte(Val(Mid(RCWidthStr(k), Comma(i) + 2, Comma(i + 1) - Comma(i) - 1)))
                    Next i
                    While i <= 30   '其它各行的列数为零
                        RCWidthChar(x, i - 1) = 0
                        i = i + 1
                    End While
                    For i = 0 To 30 'CByte(TRowNum - 1) '计算每行中每列的宽度
                        If RCWidthChar(x, i) = 0 Then  '如果某行列数为零,与上一行列数相同
                            RCWidthChar(x, i) = RCWidthChar(x, i - 1)
                        End If
                    Next i
                    h = 0
                    For j = 0 To CByte(TColNum(x) - 1)  '计算列中总宽度(字符数)
                        h = h + RCWidthChar(x, j)
                    Next j
                    ColWidth(x, 0) = 0
                    For j = 1 To CByte(TColNum(x) - 1)  '计算列宽
                        ColWidth(x, j) = CSng(ColWidth(x, j - 1) + RCWidthChar(x, j - 1) / h)
                    Next j
                    ColWidth(x, j) = 1.0F '设置右边线的位置

                Next k
                Me.Width = CInt(h * Me.Font.SizeInPoints)

                Me.Invalidate()
            End If
        End Set
    End Property
    <Description("内边框的宽度")> _
 Public Property 内线宽度() As Integer
        Get
            Return ILinewidth
        End Get
        Set(ByVal Value As Integer)
            If ILinewidth <> Value Then
                ILinewidth = Value
                Me.Invalidate()
            End If
        End Set
    End Property
    <Description("外边框的宽度")> _
 Public Property 外框宽度() As Single
        Get
            Return BLinewidth / 2
        End Get
        Set(ByVal Value As Single)
            If BLinewidth <> 2 * Value Then
                BLinewidth = 2 * Value
                Me.Invalidate()
            End If
        End Set
    End Property
    Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
        MyBase.OnPaint(e)

        Dim grfGraphics As System.Drawing.Graphics  '定义图形对象
        grfGraphics = e.Graphics

        Dim penB As New System.Drawing.Pen(System.Drawing.Color.Black, BLinewidth)
        Dim penN As New System.Drawing.Pen(System.Drawing.Color.Black, ILinewidth)

        Dim i As Integer, j As Integer

        '画外框
        grfGraphics.DrawRectangle(penB, 0, 0, Me.Width, Me.Height)
        '画内线
        For i = 1 To CByte(TRowNum - 1) '画横线
            grfGraphics.DrawLine(penN, 0, Me.Height * RowHeight(i), Me.Width, Me.Height * RowHeight(i))
        Next i
        For i = 0 To CByte(TRowNum - 1) '画竖线
            For j = 0 To TColNum(i) - 1
                grfGraphics.DrawLine(penN, Me.Width * ColWidth(i, j), Me.Height * RowHeight(i), Me.Width * ColWidth(i, j), Me.Height * RowHeight(i + 1))
            Next j
        Next i
        'Dim List As IList = cm.List
        'Dim drawf As New Font("宋体", 12, FontStyle.Bold, GraphicsUnit.Point)
        'Dim drawb As New SolidBrush(Color.Black)
        'Dim drawrect As New Rectangle(2, 2, 167, 123)
        'grfGraphics.DrawString(aa, drawf, drawb, 2, 2) ' drawrect)
        PutData()
        grfGraphics.Dispose()
        penB.Dispose()
        penN.Dispose()
    End Sub

    Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)
        Dim Mark As Byte
        For Mark = 1 To CByte(TRowNum - 1)
            If Me.PointToClient(Me.MousePosition).Y > Me.Height * RowHeight(Mark) - 2 And Me.PointToClient(Me.MousePosition).Y < Me.Height * RowHeight(Mark) + 2 Then 'Me.PointToClient(me.MousePosition).Y .MousePosition.Y - Me.Location.Y - Me.Parent.Location.Y > Me.Height / TRowNum - 5 And Me.MousePosition.Y - Me.Location.Y - Me.Parent.Location.Y < Me.Height / TRowNum + 4 Then
                Me.Cursor = System.Windows.Forms.Cursors.HSplit
                'ReDrawFlag = True
                If mDown Then
                    'Dim i As Byte, j As Byte
                    'Dim grfGraphics As System.Drawing.Graphics
                    'grfGraphics = Me.CreateGraphics()
                    'Dim penN As New System.Drawing.Pen(Me.BackColor, ILinewidth)
                    'For i = Mark To CByte(Mark + 1) '用背景色画竖线即擦竖线
                    'For j = 0 To CByte(TColNum(i - 1) - 1)
                    'grfGraphics.DrawLine(penN, Me.Width * ColWidth(i - 1, j), Me.Height * RowHeight(i - 1), Me.Width * ColWidth(i - 1, j), Me.Height * RowHeight(i))
                    ''grfGraphics.DrawLine(penN, Me.Width * ColWidth(i, j), Me.Height * RowHeight(i - 1), Me.Width * ColWidth(i, j), Me.Height * RowHeight(i))
                    'Next j
                    'Next i
                    'grfGraphics.DrawLine(penN, 0, Me.Height * RowHeight(Mark), Me.Width, Me.Height * RowHeight(Mark))
                    '两条线间不能离得太近,重合后无法处理
                    If RowHeight(Mark - 1) + 0.02 < RowHeight(Mark) And RowHeight(Mark + 1) - 0.02 > RowHeight(Mark) Then
                        RowHeight(Mark) = CSng(Me.PointToClient(Me.MousePosition).Y / Me.Height)
                    Else
                        If RowHeight(Mark - 1) + 0.02 >= RowHeight(Mark) Then
                            RowHeight(Mark) = CSng(RowHeight(Mark - 1) + 0.022)
                        Else
                            If RowHeight(Mark + 1) - 0.02 <= RowHeight(Mark) Then
                                RowHeight(Mark) = CSng(RowHeight(Mark + 1) - 0.022)
                            End If
                        End If
                    End If
                    'penN = New System.Drawing.Pen(System.Drawing.Color.Black, ILinewidth)
                    'grfGraphics.DrawLine(penN, 0, Me.Height * RowHeight(Mark), Me.Width, Me.Height * RowHeight(Mark))
                    'For i = Mark To CByte(Mark + 1) '画竖线
                    'For j = 0 To CByte(TColNum(i - 1) - 1)
                    ''grfGraphics.DrawLine(penN, Me.Width * ColWidth(i, j), Me.Height * RowHeight(i - 1), Me.Width * ColWidth(i, j), Me.Height * RowHeight(i))
                    'grfGraphics.DrawLine(penN, Me.Width * ColWidth(i - 1, j), Me.Height * RowHeight(i - 1), Me.Width * ColWidth(i - 1, j), Me.Height * RowHeight(i))
                    'Next j
                    'Next i
                    'Dim penB As New System.Drawing.Pen(System.Drawing.Color.Black, BLinewidth)
                    'grfGraphics.DrawRectangle(penB, 0, 0, Me.Width, Me.Height)
                    Me.Invalidate()
                End If
                Exit Sub
            Else
                Me.Cursor = System.Windows.Forms.Cursors.Default
                ' ReDrawFlag = False
            End If
        Next Mark

    End Sub
    Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
        mDown = True
    End Sub
    Protected Overrides Sub OnMouseUp(ByVal e As System.Windows.Forms.MouseEventArgs)
        mDown = False
    End Sub
    Private Sub FillStrArray()
        Dim i As Integer, j As Integer = 0
        Dim DataElectNum As Integer
        If (Not cm Is Nothing) AndAlso (Not cm.List Is Nothing) Then '如果数据源设置
            Dim List As IList = cm.List
            Dim currObject As Object
            currObject = List(Index)
            Dim pdValue As System.ComponentModel.PropertyDescriptor
            DataElectNum = cm.GetItemProperties().Count - 1
            For i = 0 To DataElectNum   '把数据库中所有字段名和字段值都放入数组
                pdValue = cm.GetItemProperties()(i)
                DataElect(j) = pdValue.Name '.GetValue(currObject))
                j = j + 1
                DataElect(j) = CStr(pdValue.GetValue(currObject))
                j = j + 1
            Next i
            'Dim PrintColLen As Integer '行中字符长度
            'Dim ColCharNum As Integer, Markb As Integer = 0
            'For i = 0 To TRowNum - 1 '通过计算每行每列中输出字符的数目,设置行高和列宽
            ''ReDim PrintColLen(TColNum(i) - 1)
            'ColCharNum = 0 '行中字符数
            'For j = 0 To TColNum(i) - 1 '统计行中字符数
            'ColCharNum = ColCharNum + Len(DataElect(Markb))
            'Markb = Markb + 1
            'Next j

            'For j = 0 To TColNum(i) - 1
            'ColWidth(i, j) = j * CSng(1 / TColNum(i))
            'Next
            'Next
        Else
            For i = 0 To DataElectNum   '把数据库中所有字段名和字段值都放入数组
                DataElect(i) = Nothing '.GetValue(currObject))
            Next i
        End If

    End Sub
    Private Sub PutData()
        Dim g As Graphics   '定义图形对象
        g = Me.CreateGraphics() '建立图形对象
        Dim i As Integer, j As Integer, Markb As Integer = 0
        Dim DrawF As Font = Me.Font '定义字体为控件字体
        Dim DrawB As New SolidBrush(Me.ForeColor)   '用控件的前景色定义实心刷子
        Dim DrawR As RectangleF '定义矩形对象
        For i = 0 To TRowNum - 1    '控制输出行数
            For j = 0 To TColNum(i) - 1 '控制输出列数
                DrawR = New RectangleF(ColWidth(i, j) * Me.Width + ILinewidth, RowHeight(i) * Me.Height + BLinewidth / 2, (ColWidth(i, j + 1) - ColWidth(i, j)) * Me.Width, (RowHeight(i + 1) - RowHeight(i)) * Me.Height)
                g.DrawString(DataElect(Markb), DrawF, DrawB, DrawR) '在矩形内画出字符串
                Markb = Markb + 1
            Next j
        Next i
    End Sub
    Public Sub MoveNext()
        If Not m_DataSource Is Nothing Then
            Dim innerList As IList = cm.List
            If Not innerList Is Nothing Then
                If (Index < innerList.Count - 1) Then
                    Index = Index + 1
                    FillStrArray()
                    Me.Invalidate()
                Else
                    MsgBox("已到最后一条记录!")
                End If
            End If
        End If
    End Sub
    Public Sub MovePrevious()
        If Not m_DataSource Is Nothing Then
            Dim innerList As IList = cm.List
            If Not innerList Is Nothing Then
                If (Index > 0) Then
                    Index = Index - 1
                    FillStrArray()
                    Me.Invalidate()
                Else
                    MsgBox("已到第一条记录!")
                End If
            End If
        End If
    End Sub
    Public Sub MoveLast()
        If Not m_DataSource Is Nothing Then
            Dim innerList As IList = cm.List
            If Not innerList Is Nothing Then
                If (Index < innerList.Count - 1) Then
                    Index = innerList.Count - 1
                    FillStrArray()
                    Me.Invalidate()
                Else
                    MsgBox("已到最后一条记录!")
                End If
            End If
        End If
    End Sub
    Public Sub MoveFirst()
        If Not m_DataSource Is Nothing Then
            Dim innerList As IList = cm.List
            If Not innerList Is Nothing Then
                If (Index > 0) Then
                    Index = 0
                    FillStrArray()
                    Me.Invalidate()
                Else
                    MsgBox("已到第一条记录!")
                End If
            End If
        End If
    End Sub

    Protected Overrides Sub OnResize(ByVal e As System.EventArgs)
        MyBase.OnResize(e)
        Me.Invalidate()
    End Sub
End Class