'DataGridViewの2段表示
'http://social.msdn.microsoft.com/Forums/ja-JP/d2250a20-404d-4471-b07e-8a0d8f587c2e/datagridview2
'から改変、行ヘッダを2列表示にする 2013.10 T.F
Imports System.Windows.Forms
Imports System.Drawing
Public Class ExVDataGridView
Inherits DataGridView
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 ドッキングセル() 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
Public RowHeaderWidthR As Integer = 50
<System.ComponentModel.Category("カスタム")> _
<System.ComponentModel.Description("左ヘッダの割合を％で設定")> _
Public Property RowHeaderWidthRate() As Integer
Get
Return RowHeaderWidthR
End Get
Set(ByVal value As Integer)
RowHeaderWidthR = value
End Set
End Property
Public pHedColor() As String
<System.ComponentModel.Category("カスタム")> _
<System.ComponentModel.Description("上部ヘッダー背景色です 色名(RED、BLUEなど)かRGB値(#123456など)で指定します" & _
"行ヘッダテキストの書いてあるのと同じ位置に書きます")> _
Public Property FullHedColor() As String()
Get
Return pHedColor
End Get
Set(ByVal value As String())
pHedColor = value
End Set
End Property
Public pHedVerticalFlag() As Integer
<System.ComponentModel.Category("カスタム")> _
<System.ComponentModel.Description("上部ヘッダー縦書きフラグです 1で縦書き0で横書きです" & _
"行ヘッダテキストの書いてあるのと同じ位置に書きます")> _
Public Property FullHedVerticalFlag() As Integer()
Get
Return pHedVerticalFlag
End Get
Set(ByVal value As Integer())
pHedVerticalFlag = value
End Set
End Property
Private Sub Me_CellPainting(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewCellPaintingEventArgs) Handles Me.CellPainting
ヘッダー結合２(e, pDokCell)
End Sub
'セルの高さを変更した場合上側のセルの左部分にごみが残ることがあるのでDataGridViewを再描画する
Private Sub DataGridView1_RowHeightChanged(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewRowEventArgs) Handles Me.RowHeightChanged
Dim r As Integer = e.Row.Index
Dim dgv As DataGridView = CType(sender, DataGridView)
dgv.Invalidate()
End Sub
Private Sub ヘッダー結合２(ByVal e As System.Windows.Forms.DataGridViewCellPaintingEventArgs, _
ByVal Dokcell As Generic.List(Of Integer))
If Dokcell Is Nothing Then Exit Sub
If e.RowIndex >= 0 AndAlso e.ColumnIndex = -1 Then
Dim StartRow As Integer '結合開始行 結合しない場合は-1を入れる
Dim EndRow As Integer '結合終了行 結合しない場合は-1を入れる
'左右に分かれるセルか繋がったセルかを判別
Dim row As Integer = e.RowIndex
Dim DokFlg As New ArrayList
Dim startar(Me.Rows.Count) As Integer '結合スタートセル位置保存用配列
Dim endar(Me.Rows.Count) As Integer '結合エンドセル位置保存用配列
If row > Dokcell.Count - 1 Then '設定範囲以上＝結合しないセル
StartRow = -1
EndRow = -1
ElseIf Dokcell(row) > 0 Then '結合セルの先頭
StartRow = row
EndRow = row + Dokcell(row) - 1
Else '結合セルの２番目以降か結合しないセル
For iii As Integer = 0 To CInt(Dokcell.Count) - 1 '結合セルセルをリストアップ
If Dokcell(iii) > 0 Then
DokFlg.Add(iii)
startar(iii) = iii
endar(iii) = iii + Dokcell(iii) - 1
For ii As Integer = iii To iii + Dokcell(iii) - 1
DokFlg.Add(ii)
startar(ii) = iii
endar(ii) = iii + Dokcell(iii) - 1
Next
End If
Next
If DokFlg.Contains(row) = False Then '結合しないセル
StartRow = -1
EndRow = -1
Else '結合するセルの２番目以降
StartRow = startar(row)
EndRow = endar(row)
End If
End If
Dim BoPen As New Pen(BorderColor)
Dim sf As New StringFormat() '文字列を中央そろえに設定
sf.Alignment = StringAlignment.Center
sf.LineAlignment = StringAlignment.Center
Try
If StartRow = -1 Then '結合しないセル--------------------------------
Dim Br As New SolidBrush(e.CellStyle.BackColor) '背景色を取得してブラシを作成
e.Graphics.FillRectangle(Br, e.CellBounds) '塗る
Br.Dispose()
Dim x2 As Integer = e.CellBounds.X
Dim Y2 As Integer = e.CellBounds.Y
Dim hei As Integer = e.CellBounds.Height
Dim wid As Integer = CInt(e.CellBounds.Width)
Dim txt As String = CStr(e.Value)
Dim Bou1 As Rectangle = New Rectangle(x2, Y2, wid - 1, hei - 1) '枠線表示
e.Graphics.DrawRectangle(BoPen, Bou1)
e.Graphics.DrawString(txt, e.CellStyle.Font, Brushes.Black, Bou1, sf)
e.Graphics.DrawLine(Pens.White, x2 + 1, Y2, x2 + 1, Y2 + hei - 1) '左のハイライト
e.Graphics.DrawLine(Pens.White, x2 + 1, Y2, x2 + wid - 2, Y2) '上のハイライト
e.Handled = True
Else '結合するセル--------------------------------
Dim x2 As Integer = e.CellBounds.X
Dim Y2 As Integer = e.CellBounds.Y
Dim hei As Integer = e.CellBounds.Height
Dim wid As Integer = CInt(e.CellBounds.Width)
Dim widL As Integer = wid * RowHeaderWidthR / 100
Dim widR As Integer = wid - widL
'右側のセル--------------
Dim Bou1 As Rectangle = New Rectangle(x2 + widL, Y2, widR - 1, hei - 1) '表示矩形
Dim Br As New SolidBrush(e.CellStyle.BackColor) '背景色を取得してブラシを作成
e.Graphics.FillRectangle(Br, Bou1) '塗る
Br.Dispose()
e.Graphics.DrawRectangle(BoPen, Bou1) '枠線
Dim txt As String = CStr(e.Value)
e.Graphics.DrawString(txt, e.CellStyle.Font, Brushes.Black, Bou1, sf) '文字列表示
e.Graphics.DrawLine(Pens.White, x2 + widL, Y2, x2 + widL, Y2 + hei - 1) '左のハイライト
e.Graphics.DrawLine(Pens.White, x2 + widL, Y2, x2 + wid - 2, Y2) '上のハイライト
'左側のセル--------------
Dim hei2 As Integer = 0 '高さ
For i As Integer = StartRow To EndRow
hei2 = hei2 + Me.Rows(i).Height
Next
Dim hei3 As Integer = 0 '現在のセルより上にあるセルの高さ
For i As Integer = StartRow To row - 1
hei3 = hei3 + Me.Rows(i).Height
Next
Dim Bou2 As Rectangle = New Rectangle(x2, Y2 - hei3, widL - 1, hei2 - 1) '表示矩形
Dim Br2 As SolidBrush
If Not pHedColor Is Nothing AndAlso pHedColor.Length > StartRow AndAlso pHedColor(StartRow) <> "" Then
Dim cl As String = IsColorEx(pHedColor(StartRow))
If cl <> "" Then '色を表す文字列
Br2 = New SolidBrush(ColorTranslator.FromHtml(cl)) 'ブラシを作成
Else '色として認識できない記述
Br2 = New SolidBrush(Me.RowHeadersDefaultCellStyle.BackColor) '背景色を取得してブラシを作成
End If
Else
Br2 = New SolidBrush(Me.RowHeadersDefaultCellStyle.BackColor) '背景色を取得してブラシを作成
End If
txt = pHedTXT(StartRow) '文字列を得る
If Not pHedVerticalFlag Is Nothing Then '縦書きフラグをチェック
If pHedVerticalFlag.Length > StartRow Then
If pHedVerticalFlag(StartRow) = 1 Then
sf.FormatFlags = StringFormatFlags.DirectionVertical
End If
End If
End If
If Not Me.FirstDisplayedCell Is Nothing Then
Dim t As Integer = Me.FirstDisplayedCell.RowIndex
If t > StartRow Then '結合セル上方が表示範囲から上にはみ出す
e.Graphics.SetClip(New Rectangle(Me.Left, Me.ColumnHeadersHeight + 1, Me.Width, Me.Height))
Else '結合セル上方は表示範囲内
End If
End If
e.Graphics.FillRectangle(Br2, Bou2) '塗る
e.Graphics.DrawRectangle(BoPen, Bou2) '枠線
e.Graphics.DrawString(txt, e.CellStyle.Font, Brushes.Black, Bou2, sf) '文字列表示
Br2.Dispose()
e.Graphics.DrawLine(Pens.White, x2 + 1, Y2 - hei3, x2 + 1, Y2 + hei2 - 1) '左のハイライト
e.Graphics.DrawLine(Pens.White, x2 + 1, Y2 - hei3, x2 + widL - 2, Y2 - hei3) '上のハイライト
e.Handled = True
End If
Finally
BoPen.Dispose()
sf.Dispose()
End Try
End If
End Sub
'色を表す文字列をチェック、ウィンドウ登録の文字列と数値0〜0xfffffならその文字列を返す
'認識できなかったらNULL文字を返す
Dim IsColorExColorName() As String
Dim IsColorExcomp As StringComparer
Private Function IsColorEx(ByVal s As String) As String
If IsColorExColorName Is Nothing Then
IsColorExColorName = [Enum].GetNames(GetType(KnownColor)) '色を表す文字列を取得
IsColorExcomp = StringComparer.InvariantCultureIgnoreCase
Array.Sort(IsColorExColorName, IsColorExcomp)
End If
s = s.Trim()
If s.Length = 0 Then Return ""
Dim ix As Integer = Array.BinarySearch(IsColorExColorName, s, IsColorExcomp) '大文字小文字を区別せず検索
If ix >= 0 Then '色を表す文字列
Return IsColorExColorName(ix)
End If
Try
ix = -1
If System.Text.RegularExpressions.Regex.IsMatch(s, "^[0-9]*$") = True Then
ix = CInt(s)
If ix >= 0 And ix <= &HFFFFFF Then
IsColorEx = "0x" + ix.ToString("x6")
Return IsColorEx
Else
Return ""
End If
ElseIf s.IndexOf("0x") = 0 Or s.IndexOf("0X") = 0 Or s.IndexOf("&h") = 0 Or s.IndexOf("&H") = 0 Then
s = s.Substring(2)
ElseIf s.IndexOf("#") = 0 Then
s = s.Substring(1)
End If
If s.Length = 0 Then Return ""
If System.Text.RegularExpressions.Regex.IsMatch(s, "^[0-9A-Fa-f]*$") = True Then
ix = Integer.Parse(s, System.Globalization.NumberStyles.HexNumber)
End If
If ix >= 0 And ix <= &HFFFFFF Then
IsColorEx = "0x" + ix.ToString("x6")
Return IsColorEx
Else
Return ""
End If
Catch ex As Exception
Return ""
End Try
End Function
End Class
|
