Tween/DetailsListView.vb

   1 ' Tween - Client of Twitter
   2 ' Copyright (c) 2007-2011 kiri_feather (@kiri_feather) <kiri.feather@gmail.com>
   3 '           (c) 2008-2011 Moz (@syo68k)
   4 '           (c) 2008-2011 takeshik (@takeshik) <http://www.takeshik.org/>
   5 '           (c) 2010-2011 anis774 (@anis774) <http://d.hatena.ne.jp/anis774/>
   6 '           (c) 2010-2011 fantasticswallow (@f_swallow) <http://twitter.com/f_swallow>
   7 ' All rights reserved.
   8 '
   9 ' This file is part of Tween.
  10 '
  11 ' This program is free software; you can redistribute it and/or modify it
  12 ' under the terms of the GNU General Public License as published by the Free
  13 ' Software Foundation; either version 3 of the License, or (at your option)
  14 ' any later version.
  15 '
  16 ' This program is distributed in the hope that it will be useful, but
  17 ' WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  18 ' or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
  19 ' for more details.
  20 '
  21 ' You should have received a copy of the GNU General Public License along
  22 ' with this program. If not, see <http://www.gnu.org/licenses/>, or write to
  23 ' the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
  24 ' Boston, MA 02110-1301, USA.
  25
  26 Imports System
  27 Imports System.Drawing
  28 Imports System.Runtime.InteropServices
  29 Imports System.Windows.Forms
  30 Imports System.Diagnostics
  31
  32 Namespace TweenCustomControl
  33
  34     Public NotInheritable Class DetailsListView
  35         Inherits ListView
  36
  37         Private changeBounds As Rectangle
  38         Private multiSelected As Boolean
  39         Private _handlers As New System.ComponentModel.EventHandlerList()
  40
  41         Public Event VScrolled As System.EventHandler
  42         Public Event HScrolled As System.EventHandler
  43
  44         Public Sub New()
  45             View = Windows.Forms.View.Details
  46             FullRowSelect = True
  47             HideSelection = False
  48             DoubleBuffered = True
  49         End Sub
  50
  51         '<System.ComponentModel.DefaultValue(0), _
  52         ' System.ComponentModel.RefreshProperties(System.ComponentModel.RefreshProperties.Repaint)> _
  53         'Public Shadows Property VirtualListSize() As Integer
  54         '    Get
  55         '        Return MyBase.VirtualListSize
  56         '    End Get
  57         '    Set(ByVal value As Integer)
  58         '        If value = MyBase.VirtualListSize Then Exit Property
  59         '        If MyBase.VirtualListSize > 0 And value > 0 Then
  60         '            Dim topIndex As Integer = 0
  61         '            If Not Me.IsDisposed Then
  62         '                If MyBase.VirtualListSize < value Then
  63         '                    If Me.TopItem Is Nothing Then
  64         '                        topIndex = 0
  65         '                    Else
  66         '                        topIndex = Me.TopItem.Index
  67         '                    End If
  68         '                    topIndex = Math.Min(topIndex, Math.Abs(value - 1))
  69         '                    Me.TopItem = Me.Items(topIndex)
  70         '                Else
  71         '                    If Me.TopItem Is Nothing Then
  72         '                        topIndex = 0
  73         '                    Else
  74
  75         '                    End If
  76         '                    Me.TopItem = Me.Items(0)
  77         '                End If
  78         '            End If
  79         '        End If
  80         '        MyBase.VirtualListSize = value
  81         '    End Set
  82         'End Property
  83
  84         Public Sub ChangeItemBackColor(ByVal index As Integer, ByVal backColor As Color)
  85             ChangeSubItemBackColor(index, 0, backColor)
  86         End Sub
  87
  88         Public Sub ChangeItemForeColor(ByVal index As Integer, ByVal foreColor As Color)
  89             ChangeSubItemForeColor(index, 0, foreColor)
  90         End Sub
  91
  92         Public Sub ChangeItemFont(ByVal index As Integer, ByVal fnt As Font)
  93             ChangeSubItemFont(index, 0, fnt)
  94         End Sub
  95
  96         Public Sub ChangeItemFontAndColor(ByVal index As Integer, ByVal foreColor As Color, ByVal fnt As Font)
  97             ChangeSubItemStyles(index, 0, BackColor, foreColor, fnt)
  98         End Sub
  99
 100         Public Sub ChangeItemStyles(ByVal index As Integer, ByVal backColor As Color, ByVal foreColor As Color, ByVal fnt As Font)
 101             ChangeSubItemStyles(index, 0, backColor, foreColor, fnt)
 102         End Sub
 103
 104         Public Sub ChangeSubItemBackColor(ByVal itemIndex As Integer, ByVal subitemIndex As Integer, ByVal backColor As Color)
 105             Me.Items(itemIndex).SubItems(subitemIndex).BackColor = backColor
 106             SetUpdateBounds(itemIndex, subitemIndex)
 107             Me.Update()
 108             Me.changeBounds = Rectangle.Empty
 109         End Sub
 110
 111         Public Sub ChangeSubItemForeColor(ByVal itemIndex As Integer, ByVal subitemIndex As Integer, ByVal foreColor As Color)
 112             Me.Items(itemIndex).SubItems(subitemIndex).ForeColor = foreColor
 113             SetUpdateBounds(itemIndex, subitemIndex)
 114             Me.Update()
 115             Me.changeBounds = Rectangle.Empty
 116         End Sub
 117
 118         Public Sub ChangeSubItemFont(ByVal itemIndex As Integer, ByVal subitemIndex As Integer, ByVal fnt As Font)
 119             Me.Items(itemIndex).SubItems(subitemIndex).Font = fnt
 120             SetUpdateBounds(itemIndex, subitemIndex)
 121             Me.Update()
 122             Me.changeBounds = Rectangle.Empty
 123         End Sub
 124
 125         Public Sub ChangeSubItemFontAndColor(ByVal itemIndex As Integer, ByVal subitemIndex As Integer, ByVal foreColor As Color, ByVal fnt As Font)
 126             Me.Items(itemIndex).SubItems(subitemIndex).ForeColor = foreColor
 127             Me.Items(itemIndex).SubItems(subitemIndex).Font = fnt
 128             SetUpdateBounds(itemIndex, subitemIndex)
 129             Me.Update()
 130             Me.changeBounds = Rectangle.Empty
 131         End Sub
 132
 133         Public Sub ChangeSubItemStyles(ByVal itemIndex As Integer, ByVal subitemIndex As Integer, ByVal backColor As Color, ByVal foreColor As Color, ByVal fnt As Font)
 134             Me.Items(itemIndex).SubItems(subitemIndex).BackColor = backColor
 135             Me.Items(itemIndex).SubItems(subitemIndex).ForeColor = foreColor
 136             Me.Items(itemIndex).SubItems(subitemIndex).Font = fnt
 137             SetUpdateBounds(itemIndex, subitemIndex)
 138             Me.Update()
 139             Me.changeBounds = Rectangle.Empty
 140         End Sub
 141
 142         Private Sub SetUpdateBounds(ByVal itemIndex As Integer, ByVal subItemIndex As Integer)
 143             Try
 144                 If itemIndex > Me.Items.Count Then
 145                     Throw New ArgumentOutOfRangeException("itemIndex")
 146                 End If
 147                 If subItemIndex > Me.Columns.Count Then
 148                     Throw New ArgumentOutOfRangeException("subItemIndex")
 149                 End If
 150                 Dim item As ListViewItem = Me.Items(itemIndex)
 151                 If item.UseItemStyleForSubItems Then
 152                     Me.changeBounds = item.Bounds
 153                 Else
 154                     Me.changeBounds = Me.GetSubItemBounds(itemIndex, subItemIndex)
 155                 End If
 156             Catch ex As ArgumentException
 157                 'タイミングによりBoundsプロパティが取れない？
 158                 Me.changeBounds = Rectangle.Empty
 159             End Try
 160         End Sub
 161
 162         Private Function GetSubItemBounds(ByVal itemIndex As Integer, ByVal subitemIndex As Integer) As Rectangle
 163             Dim item As ListViewItem = Me.Items(itemIndex)
 164             If subitemIndex = 0 And Me.Columns.Count > 0 Then
 165                 Dim col0 As Rectangle = item.Bounds
 166                 Return New Rectangle(col0.Left, col0.Top, item.SubItems(1).Bounds.X + 1, col0.Height)
 167             Else
 168                 Return item.SubItems(subitemIndex).Bounds
 169             End If
 170         End Function
 171
 172         <StructLayout(LayoutKind.Sequential)>
 173         Private Structure SCROLLINFO
 174             Public cbSize As Integer
 175             Public fMask As Integer
 176             Public nMin As Integer
 177             Public nMax As Integer
 178             Public nPage As Integer
 179             Public nPos As Integer
 180             Public nTrackPos As Integer
 181         End Structure
 182
 183         Private Enum ScrollBarDirection
 184             SB_HORZ = 0
 185             SB_VERT = 1
 186             SB_CTL = 2
 187             SB_BOTH = 3
 188         End Enum
 189
 190         Private Enum ScrollInfoMask
 191             SIF_RANGE = &H1
 192             SIF_PAGE = &H2
 193             SIF_POS = &H4
 194             SIF_DISABLENOSCROLL = &H8
 195             SIF_TRACKPOS = &H10
 196             SIF_ALL = (SIF_RANGE Or SIF_PAGE Or SIF_POS Or SIF_TRACKPOS)
 197         End Enum
 198
 199         <DllImport("user32.dll")> _
 200         Private Shared Function GetScrollInfo(ByVal hWnd As IntPtr, ByVal fnBar As ScrollBarDirection, ByRef lpsi As SCROLLINFO) As Integer
 201         End Function
 202
 203         Private si As New SCROLLINFO With { _
 204             .cbSize = Len(si), _
 205             .fMask = ScrollInfoMask.SIF_POS
 206         }
 207
 208         <DebuggerStepThrough()> _
 209         Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
 210             Const WM_ERASEBKGND As Integer = &H14
 211             Const WM_PAINT As Integer = &HF
 212             Const WM_MOUSEWHEEL As Integer = &H20A
 213             Const WM_MOUSEHWHEEL As Integer = &H20E
 214             Const WM_HSCROLL As Integer = &H114
 215             Const WM_VSCROLL As Integer = &H115
 216             Const WM_KEYDOWN As Integer = &H100
 217             Const LVM_SETITEMCOUNT As Integer = &H102F
 218             Const LVSICF_NOSCROLL As Long = &H2
 219             Const LVSICF_NOINVALIDATEALL As Long = &H1
 220
 221             Dim hPos As Integer = -1
 222             Dim vPos As Integer = -1
 223
 224             Select Case m.Msg
 225                 Case WM_ERASEBKGND
 226                     If Me.changeBounds <> Rectangle.Empty Then
 227                         m.Msg = 0
 228                     End If
 229                 Case WM_PAINT
 230                     If Me.changeBounds <> Rectangle.Empty Then
 231                         Win32Api.ValidateRect(Me.Handle, IntPtr.Zero)
 232                         Me.Invalidate(Me.changeBounds)
 233                         Me.changeBounds = Rectangle.Empty
 234                     End If
 235                 Case WM_HSCROLL
 236                     RaiseEvent HScrolled(Me, EventArgs.Empty)
 237                 Case WM_VSCROLL
 238                     RaiseEvent VScrolled(Me, EventArgs.Empty)
 239                 Case WM_MOUSEWHEEL, WM_MOUSEHWHEEL, WM_KEYDOWN
 240                     If GetScrollInfo(Me.Handle, ScrollBarDirection.SB_VERT, si) <> 0 Then
 241                         vPos = si.nPos
 242                     End If
 243                     If GetScrollInfo(Me.Handle, ScrollBarDirection.SB_HORZ, si) <> 0 Then
 244                         hPos = si.nPos
 245                     End If
 246                 Case LVM_SETITEMCOUNT
 247                     m.LParam = New IntPtr(LVSICF_NOSCROLL Or LVSICF_NOINVALIDATEALL)
 248             End Select
 249
 250             Try
 251                 MyBase.WndProc(m)
 252             Catch ex As ArgumentOutOfRangeException
 253                 'Substringでlengthが0以下。アイコンサイズが影響？
 254             Catch ex As AccessViolationException
 255                 'WndProcのさらに先で発生する。
 256             End Try
 257             If Me.IsDisposed Then Exit Sub
 258
 259             If vPos <> -1 Then
 260                 If GetScrollInfo(Me.Handle, ScrollBarDirection.SB_VERT, si) <> 0 AndAlso vPos <> si.nPos Then
 261                     RaiseEvent VScrolled(Me, EventArgs.Empty)
 262                 End If
 263             End If
 264             If hPos <> -1 Then
 265                 If GetScrollInfo(Me.Handle, ScrollBarDirection.SB_HORZ, si) <> 0 AndAlso hPos <> si.nPos Then
 266                     RaiseEvent HScrolled(Me, EventArgs.Empty)
 267                 End If
 268             End If
 269         End Sub
 270     End Class
 271 End Namespace