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("結合するヘッダーを設定する値 設定する値は1列目から2列分、4列目から3列分結合であれば 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列目から2列分結合した部分のテキストを""A""4列目から3列分結合させた部分のテキストを""B""とする場合 A、空白、空白、B というふうに設定" & _
                                      " 空白に設定している列は元のヘッダーテキストが表示される")> _
    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