|
■No100124 (KOZ) に返信
> 面倒すぎるのでサンプルを書く気にはなりません。ごめんなさい。
とは書きましたが、Alignment = Top 固定の手抜き実装で書いてみました。
マウスのトラッキングはしていないのですが、意外にスムーズに見えます。
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Public Class TabControlEx
Inherits TabControl
Protected ButtonFont As New Font("Marlett", 6)
Protected CloseButtonChar As String = "r"
Protected Overrides Sub Dispose(disposing As Boolean)
MyBase.Dispose(disposing)
ButtonFont.Dispose()
End Sub
' Alignment プロパティを隠す
<Browsable(False)>
<EditorBrowsable(False)>
<DesignerSerializationVisibility(False)>
Public Shadows Property Alignment As TabAlignment
' ボタンの枠を求める
Protected Overridable Function GetTabButtonRect(index As Integer) As Rectangle
' 小さいキャプション ボタンのサイズと TabItem の高さでサイズを調整
Dim tmpSize As Size = SystemInformation.ToolWindowCaptionButtonSize
Dim itemHeight As Integer = ((ItemSize.Height - 5) \ 2) * 2
If tmpSize.Height < itemHeight Then
itemHeight = tmpSize.Height
End If
Dim buttonSize As New Size(itemHeight, itemHeight)
' 位置を調整
Dim tabRect As Rectangle = GetTabRect(index)
Dim buttonLeft As Integer = tabRect.Right - buttonSize.Width - 2
Dim buttonTop As Integer = (tabRect.Height - buttonSize.Height) \ 2
' 選択されていないタブはちょっと小さい
If index <> SelectedIndex Then
buttonLeft -= 2
buttonTop += 2
End If
Return New Rectangle(New Point(buttonLeft, buttonTop), buttonSize)
End Function
' ボタンを描画
Protected Overridable Sub DrawButton(g As Graphics, index As Integer)
Dim buttonRect As Rectangle = GetTabButtonRect(index)
g.FillRectangle(Brushes.Red, buttonRect)
Dim fmt As New StringFormat With {
.FormatFlags = StringFormatFlags.NoClip,
.Alignment = StringAlignment.Center,
.LineAlignment = StringAlignment.Center
}
g.DrawString(CloseButtonChar, ButtonFont, Brushes.White, buttonRect, fmt)
End Sub
Protected Overrides Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case WM_PAINT
Using bmp As New Bitmap(ClientSize.Width, ClientSize.Height)
Using g As Graphics = Graphics.FromImage(bmp)
' コントロールを Bitmap に描画
Dim dc As IntPtr = g.GetHdc()
Dim msg As Message = Message.Create(m.HWnd, m.Msg, dc, m.LParam)
MyBase.WndProc(msg)
g.ReleaseHdc(dc)
' Bitmap にボタンを上書き
For index As Integer = 0 To TabCount - 1
Dim mouseClientPos As Point = PointToClient(MousePosition)
Dim tabRect As Rectangle = GetTabRect(index)
' アクティブな TabPage またはマウス下の TabPage に描画する
If index = SelectedIndex OrElse tabRect.Contains(mouseClientPos) Then
DrawButton(g, index)
End If
Next
End Using
If m.WParam = IntPtr.Zero Then
' コントロールに描画
Dim ps As New PAINTSTRUCT()
Dim hdc As IntPtr = BeginPaint(m.HWnd, ps)
Using g As Graphics = Graphics.FromHdc(hdc)
g.DrawImage(bmp, Point.Empty)
End Using
EndPaint(m.HWnd, ps)
Else
' WParam に渡された hdc に描画
Using g As Graphics = Graphics.FromHdc(m.WParam)
g.DrawImage(bmp, Point.Empty)
End Using
End If
End Using
Case Else
MyBase.WndProc(m)
End Select
End Sub
Protected Overrides Sub OnClick(e As EventArgs)
MyBase.OnClick(e)
' マウスの位置がボタン上なら、そのタブを消す
Dim mouseClientPos As Point = PointToClient(MousePosition)
For index As Integer = 0 To TabCount - 1
Dim btnRect As Rectangle = GetTabButtonRect(index)
If btnRect.Contains(mouseClientPos) Then
TabPages.RemoveAt(index)
Exit For
End If
Next
End Sub
Private Const WM_PAINT As Integer = &HF
<StructLayout(LayoutKind.Sequential)>
Private Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=4)>
Private Structure PAINTSTRUCT
Public hdc As IntPtr
Public fErase As Integer
Public rcPaint As RECT
Public fRestore As Integer
Public fIncUpdate As Integer
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=32)>
Public rgbReserved As Byte()
End Structure
<DllImport("user32.dll")>
Private Shared Function BeginPaint(ByVal hwnd As IntPtr, <Out()> ByRef lpPaint As PAINTSTRUCT) As IntPtr
End Function
<DllImport("user32.dll")>
Private Shared Function EndPaint(ByVal hwnd As IntPtr, <[In]()> ByRef lpPaint As PAINTSTRUCT) As IntPtr
End Function
End Class
|