DataGridView merge colunm header

?
Imports System.Windows.Forms
Imports System.Drawing
Imports Usac.Control
 
Public Class ExDataGridView
    Inherits USGrid
 
    Public Sub New()
        MyBase.new()
    End Sub
    Public pBorderColor As Color = SystemColors.ControlDark
    <System.ComponentModel.Category("カスタム")> _
    <System.ComponentModel.Description("境界線のカラー")> _
    Public Property BorderColor() As Color
        Get
            Return pBorderColor
        End Get
        Set(ByVal value As Color)
            pBorderColor = value
        End Set
    End Property
 
    Public pDokCell As New Generic.List(Of Integer)
    <System.ComponentModel.Category("カスタム")> _
    <System.ComponentModel.Description("結合するヘッダーを設定する値　設定する値は１列目から２列分、４列目から３列分結合であれば　2,0,0,3というふうに設定  Generic.List型 ")> _
    Public Property DockingCell() As Generic.List(Of Integer)
        Get
            Return pDokCell
        End Get
        Set(ByVal value As Generic.List(Of Integer))
            pDokCell = value
        End Set
    End Property
 
    Public pHedTXT() As String
    <System.ComponentModel.Category("カスタム")> _
    <System.ComponentModel.Description("上部ヘッダーテキストです 1列目から２列分結合した部分のテキストを""Ａ""４列目から３列分結合させた部分のテキストを""Ｂ""とする場合　Ａ、空白、空白、Ｂ　というふうに設定" & _
                                      "　空白に設定している列は元のヘッダーテキストが表示される")> _
    Public Property FullHedTxt() As String()
        Get
            Return pHedTXT
        End Get
        Set(ByVal value As String())
            pHedTXT = value
        End Set
    End Property
 
    Private Sub Me_CellPainting(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewCellPaintingEventArgs) Handles Me.CellPainting
        MergeCell(e, pDokCell)
    End Sub
 
    Public Function HedTxtSet() As ArrayList
 
        Dim arry As New ArrayList
        Dim cel As New ArrayList
        Dim col As Integer = Me.ColumnCount - 1
        For i As Integer = 0 To col
            arry(i) = Me.Columns(i).HeaderText
        Next
        For Each d As Integer In DockingCell
            For ii As Integer = d To d + DockingCell(d) - 1
                arry(d) = FullHedTxt(d)
            Next
        Next
        Return arry
    End Function
 
    Public Event HedPaint()
 
    Private Sub aaExDataGridView_v6_HedPaint() Handles Me.HedPaint
 
        Dim dok As Integer = 0
        For Each d As Integer In DockingCell
            If d > 1 Then
                dok = 1
            End If
        Next
        If dok = 1 Then
            Me.ColumnHeadersHeightSizeMode = DataGridViewColumnHeadersHeightSizeMode.DisableResizing
            Me.ColumnHeadersHeight = 40
        End If
    End Sub
 
    Private Sub MergeCell(ByVal e As System.Windows.Forms.DataGridViewCellPaintingEventArgs, _
            ByVal Dokcell As Generic.List(Of Integer))
 
        RaiseEvent HedPaint()
 
        If Dokcell Is Nothing Then Exit Sub
 
        If e.ColumnIndex >= 0 AndAlso e.RowIndex = -1 Then
            Dim cWid As New Hashtable
            Dim ww As Integer
            For iii As Integer = 0 To CInt(Dokcell.Count) - 1
                ww = 0
                If Dokcell(iii) <> Nothing Then
 
                    For id As Integer = iii To iii + Dokcell(iii) - 1
                        ww = ww + Me.Columns(id).Width
                    Next
                    cWid(iii + Dokcell(iii) - 1) = ww
                End If
            Next
 
            Dim txt As String = CStr(e.Value)
            Dim DokSetMain As New ArrayList
            Dim DokSub As New ArrayList
            Dim DokTxt As New Hashtable
            Dim HedTX As New Hashtable
 
            Dim cc As Integer
            For Each d As Integer In Dokcell
                If d > 0 Then
                    Dim int As Integer = cc + d - 1
                    DokSetMain.Add(int)
                    DokTxt(int) = Me.Columns(cc).HeaderCell.Value
                    Dim max As Integer
                    If Not FullHedTxt Is Nothing Then
                        max = FullHedTxt.Length
                    End If
 
                    If cc < max Then
                        HedTX(int) = FullHedTxt(cc)
                    End If
 
                    If d > 0 Then
                        For i As Integer = cc To cc + d - 1
                            DokSub.Add(i)
                        Next
                    End If
                End If
                cc += 1
            Next
        Dim col As Integer = e.ColumnIndex
        Dim x2 As Integer = e.CellBounds.X
        Dim Y2 As Integer = e.CellBounds.Y
        Dim hei As Integer = CInt(e.CellBounds.Height / 2)
        Dim wid As Integer = e.CellBounds.Width
 
 
        Dim backBrush As New SolidBrush(e.CellStyle.BackColor)
        Dim newRect As New Rectangle(e.CellBounds.X, e.CellBounds.Y, _
            e.CellBounds.Width - 1, e.CellBounds.Height - 1)
        Dim backColorBrush As New SolidBrush(e.CellStyle.BackColor)
        Dim gridBrush As New SolidBrush(Me.GridColor)
        Dim gridLinePen As New Pen(gridBrush)
        Dim BoPen As New Pen(BorderColor)
 
        Dim Bou1 As New Rectangle( _
                                    x2 - 1, _
                                    Y2 + hei, _
                                    wid, _
                                    hei - 1)
        Try
            'ドッキングセル上段
            If DokSetMain.Contains(col) = True Then
 
                e.Graphics.FillRectangle(backBrush, e.CellBounds)
 
                Dim Bou2 As New Rectangle(x2 - 1, _
                                          Y2 + hei - 1, _
                                          wid, _
                                          hei)
                With e.Graphics
                    .DrawString(CStr(e.Value), e.CellStyle.Font, Brushes.Black, _
                                                x2 + 2, Y2 + hei + 2, _
                                                StringFormat.GenericDefault)
                    .DrawLine(Pens.White, x2, Y2 + hei, x2, Y2 + hei + hei - 1)
                    .DrawLine(Pens.White, x2, Y2 + hei, x2 + wid - 1, Y2 + hei)
 
                End With
 
                txt = HedTX(col)
                If txt Is Nothing OrElse txt = "" Then
                    txt = CStr(DokTxt(col))
                End If
 
                Dim wid2 As Integer = CInt(cWid(col))
                x2 = x2 - (wid2 - wid)
 
                Bou1 = New Rectangle(x2 - 1, _
                                     Y2, _
                                     wid2, _
                                     hei - 1)
                With e.Graphics
                    .DrawRectangle(BoPen, Bou1)
                    .DrawRectangle(BoPen, Bou2)
                    .DrawString(txt, e.CellStyle.Font, Brushes.Black, _
                                                           x2 + 2, Y2 + 2, _
                                                           StringFormat.GenericDefault)
                    .DrawLine(Pens.White, x2, Y2 + 1, x2, Y2 + hei - 1)
                    .DrawLine(Pens.White, x2, Y2 + 1, x2 + wid2 - 1, Y2 + 1)
                End With
                e.Handled = True
            Else
                'ドッキングセル以外
                If DokSub.Contains(col) = False Then
                    e.Graphics.FillRectangle(backBrush, e.CellBounds)
                    Bou1 = New Rectangle(x2 - 1, _
                                         Y2, _
                                         wid, _
                                         hei * 2 - 1)
                    e.Graphics.DrawRectangle(BoPen, Bou1)
                    Dim max As Integer = 0
                    If Not FullHedTxt Is Nothing Then
                        max = FullHedTxt.Length
                    End If
                    Dim txt3 As String = Nothing
                    If col < max Then
                        txt3 = FullHedTxt(col)
                    End If
                    If Not txt3 Is Nothing AndAlso txt3 <> "" Then
                        txt = txt3
                    Else
                        txt = CStr(e.Value)
                    End If
                    With e.Graphics
                        .DrawString(txt, e.CellStyle.Font, Brushes.Black, _
                                                        x2 + 2, Y2 + 8 + 2, _
                                                        StringFormat.GenericDefault)
                        .DrawLine(Pens.White, x2, Y2 + 1, x2, Y2 + hei * 2 - 1)
                        .DrawLine(Pens.White, x2, Y2 + 1, x2 + wid - 1, Y2 + 1)
                    End With
                    e.Handled = True
                Else
                    'ドッキングセル下段
                    Bou1 = New Rectangle(x2 - 1, _
                                         Y2 + hei - 1, _
                                         wid, _
                                         hei)
                    With e.Graphics
                        .FillRectangle(backBrush, e.CellBounds)
                        .DrawRectangle(BoPen, Bou1)
                        .DrawString(CStr(e.Value), e.CellStyle.Font, Brushes.Black, _
                                             x2 + 2, Y2 + hei + 2, _
                                             StringFormat.GenericDefault)
                        .DrawLine(Pens.White, x2, Y2 + hei, x2, Y2 + hei * 2)
                        .DrawLine(Pens.White, x2, Y2 + hei, x2 + wid - 1, Y2 + hei)
                    End With
                    e.Handled = True
                End If
            End If
        Finally
 
            BoPen.Dispose()
            backColorBrush.Dispose()
            gridLinePen.Dispose()
            gridBrush.Dispose()
            backBrush.Dispose()
 
        End Try
        End If
 
    End Sub
 
End Class

　　Sample

?
    Private Sub ExDataGridView1_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles ExDataGridView1.Scroll
        Dim rtHeader As Rectangle = Me.Grd1.DisplayRectangle
        rtHeader.Height = Me.Grd1.ColumnHeadersHeight - 2
        Me.Grd1.Invalidate(rtHeader)
    End Sub
 
    Private Sub ExDataGridView1_Resize(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ExDataGridView1.Resize
        Dim rtHeader As Rectangle = Me.Grd1.DisplayRectangle
        rtHeader.Height = Me.Grd1.ColumnHeadersHeight - 2
        Me.Grd1.Invalidate(rtHeader)
    End Sub
 
 
ExDataGridView1.Columns.Add("a1", "Team")
ExDataGridView1.Columns.Add("a2", "Name")
ExDataGridView1.Columns.Add("a3", "AB")
ExDataGridView1.Columns.Add("a4", "BA")
ExDataGridView1.Columns.Add("a5", "SLG")
ExDataGridView1.Columns.Add("a6", "OPS")
ExDataGridView1.Columns.Add("a7", "SO")
ExDataGridView1.Columns.Add("b1", "A1")
ExDataGridView1.Columns.Add("b2", "A2")
ExDataGridView1.Columns.Add("b3", "A3")
ExDataGridView1.Columns.Add("b4", "A4")
ExDataGridView1.Columns.Add("b5", "A5")
ExDataGridView1.Columns.Add("b6", "A6")
ExDataGridView1.Columns.Add("b7", "A7")
ExDataGridView1.Columns.Add("b8", "A8")
ExDataGridView1.Columns(0).Width = 40
ExDataGridView1.Columns(1).Width = 40
ExDataGridView1.Columns(2).Width = 40
ExDataGridView1.Columns(3).Width = 40
ExDataGridView1.Columns(4).Width = 40
ExDataGridView1.Columns(5).Width = 40
ExDataGridView1.Columns(6).Width = 40
 
ExDataGridView1.Columns(7).Width = 40
ExDataGridView1.Columns(8).Width = 40
ExDataGridView1.Columns(9).Width = 40
ExDataGridView1.Columns(10).Width = 40
ExDataGridView1.Columns(11).Width = 40
ExDataGridView1.Columns(12).Width = 40
ExDataGridView1.Columns(13).Width = 40
ExDataGridView1.Columns(14).Width = 40
 
 
Dim GL As New Generic.List(Of Integer)
GL.Add(2)
GL.Add(0)
GL.Add(0)
GL.Add(2)
GL.Add(0)
GL.Add(0)
GL.Add(0)
GL.Add(8)
ExDataGridView1.ドッキングセル = GL
Dim text() As String = {" Number One", "", "", " Sluger!", "", "", "", "TEST"}
ExDataGridView1.FullHedTxt = text
ExDataGridView1.Rows.Add()
ExDataGridView1(0, 0).Value = "SEA"
ExDataGridView1(1, 0).Value = "Ichiro"
ExDataGridView1(2, 0).Value = 438
ExDataGridView1(3, 0).Value = 0.345
ExDataGridView1(4, 0).Value = 0.543
ExDataGridView1(5, 0).Value = 0.876
ExDataGridView1(6, 0).Value = 25
 
ExDataGridView1(7, 0).Value = 1
ExDataGridView1(8, 0).Value = 2
ExDataGridView1(9, 0).Value = 3
ExDataGridView1(10, 0).Value = 4
ExDataGridView1(11, 0).Value = 5
ExDataGridView1(12, 0).Value = 6
ExDataGridView1(13, 0).Value = 7
ExDataGridView1(14, 0).Value = 8

　　

点击右上角即可分享
微信分享提示